[Haskell-cafe] adding the elements of two lists

Richard O'Keefe ok at cs.otago.ac.nz
Thu Mar 29 05:34:46 CEST 2012


On 29/03/2012, at 3:08 PM, Doug McIlroy wrote:
> --------- without newtype
> 
> toSeries f = f : repeat 0   -- coerce scalar to series
> 
> instance Num a => Num [a] where
>   (f:fs) + (g:gs) = f+g : fs+gs
>   (f:fs') * gs@(g:gs') = f*g : fs'*gs + (toSeries f)*gs'
> 
> --------- with newtype
> 
> newtype Num a => PS a = PS [a] deriving (Show, Eq)
> 
> fromPS (PS fs) = fs         -- extract list
> toPS f = PS (f : repeat 0)  -- coerce scalar to series
> 
> instance Num a => Num (PS a) where
>   (PS (f:fs)) + (PS (g:gs)) = PS (f+g : fs+gs)
>   (PS (f:fs)) * gPS@(PS (g:gs)) =
>      PS $ f*g : fromPS ((PS fs)*gPS + (toPS f)*(PS gs))

Try it again.

newtype PS a = PS [a] deriving (Eq, Show)

u f (PS x)        = PS $ map f x
b f (PS x) (PS y) = PS $ zipWith f x y
to_ps x           = PS (x : repeat 0)

ps_product (f:fs) (g:gs) = whatever

instance Num a => Num (PS a)
  where
    (+)     = b (+)
    (-)     = b (-)
    (*)     = b ps_product
    negate  = u negate
    abs     = u abs
    signum  = u signum
    fromInteger = to_ps . fromInteger

I've avoided defining ps_product because I'm not sure what
it is supposed to do: the definition doesn't look commutative.

> The code suffers a pox of PS.

But it doesn't *need* to.





More information about the Haskell-Cafe mailing list