[Haskell-cafe] Are there arithmetic composition of functions?

Ryan Ingram ryani.spam at gmail.com
Tue Mar 20 22:40:56 CET 2012


Oh man, I came late to this party.

I'll throw what little weight I have here behind Jerry's argument.  Yes,
this change to base is not Haskell2010 compatible, but it's still a good
change and I hope that Haskell2012 or 2013 or whatever the next version of
the standard that comes out incorporates it.

As to why it's a good change:

(1) People were doing it anyways with bogus Eq instances; the syntactic
benefit of being able to use integer literals is huge; using the standard
+/-/* etc functions is a nice bonus.  For an example, see
http://twanvl.nl/blog/haskell/simple-reflection-of-expressions
(2) Pattern matching on numeric literals is what requires Eq, and combined
with (1) leads to fragile code.  Now, for example,

    fac 0 = 1
    fac n = n * fac (n-1)

Now the type of fac explicitly states that it requires Eq to work; with the
'hack' version of Eq in the expressions above, "fac x" doesn't terminate
and instead gives x * (x-1) * (x-1-1) * ... forever.  Other versions (like
the version in this thread with Num (e -> a)) turn fac into a function that
always returns bottom.

  -- ryan

On Tue, Mar 20, 2012 at 12:02 PM, Ryan Ingram <ryani.spam at gmail.com> wrote:

> This instance can be made more general without changing the code; change
> the first line to
>
> instance Num a => Num (e -> a) where
>
> I think this version doesn't even require FlexibleInstances.
>
> This lets you do
>
> f x = if x then 2 else 3
> g x = if x then 5 else 10
>
> -- f + g = \x -> if x then 7 else 13
>
>   -- ryan
>
> On Mon, Mar 19, 2012 at 10:38 AM, Ozgur Akgun <ozgurakgun at gmail.com>wrote:
>
>> Hi,
>>
>> If you are feeling adventurous enough, you can define a num instance for
>> functions:
>>
>> {-# LANGUAGE FlexibleInstances #-}
>>
>> instance Num a => Num (a -> a) where
>>     f + g = \ x -> f x + g x
>>     f - g = \ x -> f x - g x
>>     f * g = \ x -> f x * g x
>>     abs f = abs . f
>>     signum f = signum . f
>>     fromInteger = const . fromInteger
>>
>> ghci> let f x = x * 2
>> ghci> let g x = x * 3
>> ghci> (f + g) 3
>> 15
>> ghci> (f+g+2) 2
>> 17
>>
>> HTH,
>> Ozgur
>>
>>
>> On 19 March 2012 16:57, <sdiyazg at sjtu.edu.cn> wrote:
>>
>>> By arithmetic I mean the everyday arithmetic operations used in
>>> engineering.
>>> In signal processing for example, we write a lot of expressions like
>>> f(t)=g(t)+h(t)+g'(t) or f(t)=g(t)*h(t).
>>> I feel it would be very natural to have in haskell something like
>>>   g::Float->Float
>>>   --define g here
>>>   h::Float->Float
>>>   --define h here
>>>   f::Float->Float
>>>   f = g+h --instead of f t = g t+h t
>>>   --Of course, f = g+h is defined as f t = g t+h t
>>>
>>
>>
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>
>>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20120320/536c544b/attachment.htm>


More information about the Haskell-Cafe mailing list