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

Ozgur Akgun ozgurakgun at gmail.com
Mon Mar 19 18:38:31 CET 2012


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
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20120319/ef00a311/attachment.htm>


More information about the Haskell-Cafe mailing list