[Haskell-beginners] Type classes and synonyms

Felipe Lessa felipe.lessa at gmail.com
Sat Nov 21 11:07:14 EST 2009


Well, let's begin by making some suggestions to your current
code.  Below I tell my answer to your question as well. :)

On Sat, Nov 21, 2009 at 03:20:30PM +0000, Philip Scott wrote:
] t (x,y) = x
] v (x,y) = y

> t = fst
> v = snd

] mergeSkip _  [] = []
] mergeSkip [] _  = []
] mergeSkip (x:xs) (y:ys)
]     | t x == t y = ( t x, (v x, v y) ) : (mergeSkip xs ys)
]     | t x > t y  = mergeSkip xs (y:ys)
]     | t x < t y  = mergeSkip (x:xs) ys

Using 't' and 'v' isn't very readable, so probably it would be
better to just type two more characters and use 'fst' and 'snd':

> mergeSkip (x:xs) (y:ys)
>     | fst x == fst y = (fst x, (snd x, snd y)) : mergeSkip xs ys
>     | fst x >  fst y = mergeSkip xs (y:ys)
>     | fst x <  fst y = mergeSkip (x:xs) ys

Or, even better yet,

> mergeSkip xss@((xa,xb):xs) yss@((ya,yb):ys)
>     | xa == ya = (xa, (xb, yb)) : mergeSkip xs ys
>     | xa >  ya = mergeSkip xs yss
>     | xa <  ya = mergeSkip xss ys

] binaryValueFunc f [] = []
] binaryValueFunc f ((t,(a,b)):xs) = (t, f a b):binaryValueFunc f xs

> import Control.Arrow (second)
> binaryValueFunc f = map (second $ uncurry f)



Now, to your question!

] So addSkip will nicely take two of my time series, merge them by throwing out
] any pairs which don't have a time stamp that exists in both and then add the
] values to return a new series. All is well. But how do I make it so that I can
] use the + operator to add two of them?
]
] Well of course, I tried making a custom data type:
]
] data Ts a b = Ts [(a,b)]
] intance Ts Num where
]    <blaa blaa blaa>
]
] But then I have to rewrite all of my functions to pattern match on Ts instead
] of just the list. Worse, when I am writing recursive functions I have to
] construct a Ts again for the recursive call. I guess I could make my own
] 'list-like' datastructure

The common idiom is to write

> newtype Ts a b = Ts {unTs :: [(a,b)]} deriving (Eq, Show)

We use a newtype just to guarantee that there will be no overhead
in using this data type instead of just using a plain list
(i.e. at runtime Ts and unTs will be striped out).  We name the
field as unTs to use it when composing functions (see below).  So
your definitions above will become:

> mergeSkip' (T xs) (T ys) = T (mergeSkip xs ys)

if you want to keep the old definition, or

> mergeSkip'' (T []) _ = T []
> mergeSkip'' _ (T []) = T []
> mergeSkip'' xss@(T ((xa,xb):xs)) yss@(T ((ya,yb):ys))
>     | xa == ya = T $ (xa, (xb, yb)) : mergeSkip'' xs ys
>     | xa >  ya = mergeSkip'' (T xs) yss
>     | xa <  ya = mergeSkip'' xss (T ys)

Not that bad, I think.  Continuing, let's use unTs:

> binaryValueFunc f = Ts . map (second $ uncurry f) . unTs

Not bad at all :).  However we can just define:

> instance Functor (Ts a) where
>   fmap f = Ts . fmap (second f) . unTs

Using the Functor we can rewrite binaryValueFunc to just

> binaryValueFunc' :: Functor f => (a -> b -> c) -> f (a,b) -> f c
> binaryValueFunc' f = fmap (uncurry f)

I've written the type explicitly to show how general we just got.
However, I guess the following function is more useful for the
Num instance:

> liftBin f xs ys = fmap (uncurry f) $ mergeSkip xs ys

Now our Num instance is just

> instance (Ord a, Num b) => Num (Ts a b) where
>   (+) = liftBin (+)
>   (-) = liftBin (-)
>   (*) = liftBin (*)
>   abs = fmap abs
>   negate = fmap negate
>   signum = fmap signum
>   fromInteger = error "I don't know how you would define this :)"

I hope that helps!

(Note that if you can implement the Applicative type class for
your Ts data type and then get liftBin = liftA2 for free.)

--
Felipe.


More information about the Beginners mailing list