[Haskell] Fixed-length vectors in Haskell, Part 2: Using no extensions

[David Menendez]

This is the second of two modules implementing fixed-length vectors in
Haskell. The first used GADTs, a recent extension which currently
requires GHC 6.4. This module uses no extensions to Haskell 98.

This message is literate Haskell. To use, save it as "Vector_H98.lhs".

> module Vector_H98 where

In Vector_GADT, we used a single type constructor, Vec, which was
parameterized by a type representing its length. When the data
constructor was Nil, the length was Zero, when the constructor was Cons,
the length was Succ n, where n was the length of vector passed to Cons.

Without GADTs, we can't tie the type parameter to the data constructors.
Instead, we split Nil and Cons into separate types corresponding to Vec
Zero and Vec (Succ n):

> data Vec_0   a = Nil
> data Vec_s v a = Cons a (v a)

Some aliases for convenience:

> type Vec_1 = Vec_s Vec_0
> type Vec_2 = Vec_s Vec_1
> type Vec_3 = Vec_s Vec_2
> type Vec_4 = Vec_s Vec_3


Once again, it's possible to declare head and tail as total functions:

> vhead :: Vec_s v a -> a
> vhead (Cons x xs) = x
>
> vtail :: Vec_s v a -> v a
> vtail (Cons x xs) = xs

Unfortunately, every other useful function requires us to distinguish
between Nil and Cons values. Since those now belong to different types,
we have to use a type-class. Using Ralf Hinze's technique again, we
create a class for vector types and a class for vector functions:

> class Functor v => Vec v where vecCase :: VecCase g => g v
>
> instance          Vec Vec_0     where vecCase = caseNil
> instance Vec v => Vec (Vec_s v) where vecCase = caseCons
>
> class VecCase g where
>    caseNil  ::          g Vec_0
>    caseCons :: Vec v => g (Vec_s v)

(More on that Functor superclass later.)

Our example functions from before are less convenient to write.

> newtype ZipWith a b c v = ZipWith
>     { runZipWith :: (a -> b -> c) -> v a -> v b -> v c }
>
> vzipWith :: Vec v => (a -> b -> c) -> v a -> v b -> v c
> vzipWith = runZipWith vecCase
>
> instance VecCase (ZipWith a b c) where
>     caseNil  = ZipWith (\f Nil Nil -> Nil)
>     caseCons = ZipWith (\f (Cons x xs) (Cons y ys) ->
>                    Cons (f x y) (vzipWith f xs ys))
> --
> newtype Foldr a b v = Foldr
>     { runFoldr :: (a -> b -> b) -> b -> v a -> b }
>
> vfoldr :: Vec v => (a -> b -> b) -> b -> v a -> b
> vfoldr = runFoldr vecCase
>
> instance VecCase (Foldr a b) where
>     caseNil  = Foldr (\f z Nil -> z)
>     caseCons = Foldr (\f z (Cons x xs) -> f x (vfoldr f z xs))
> --
> 
> toList :: Vec v => v a -> [a]
> toList = vfoldr (:) []
>
> inner :: (Vec v, Num a) => v a -> v a -> a
> inner x y = vfoldr (+) 0 (vzipWith (*) x y)
> 
> --
> newtype MkVec a v = MkVec { runVec :: a -> v a }
>
> vec :: Vec v => a -> v a
> vec = runVec vecCase
>
> instance VecCase (MkVec a) where
>     caseNil  = MkVec (\_ -> Nil)
>     caseCons = MkVec (\x -> Cons x (vec x))
> --
> newtype FromList a v = FromList { runFromList :: [a] -> Maybe (v a) }
>
> fromList :: Vec v => [a] -> Maybe (v a)
> fromList = runFromList vecCase
>
> instance VecCase (FromList a) where
>     caseNil  = FromList (\_ -> Just Nil)
>     caseCons = FromList (\l -> case l of
>                    x:xs -> fmap (Cons x) (fromList xs)
>                    []   -> Nothing
>                )

Declaring class instances for vectors is also less convenient; we have
to declare separate instances for Vec_0 and Vec_s:

> instance Functor Vec_0 where
>     fmap f Nil = Nil
>
> instance Functor v => Functor (Vec_s v) where
>     fmap f (Cons x xs) = Cons (f x) (fmap f xs)

This means that a function which uses, say, vec and fmap together would
need to have (Vec v, Functor v) in its context. We can avoid this by
explicitly making Functor a superclass of Vec, but this obviously isn't
practical for every class.

Here are the instances for Show, Eq, and Num. Note that the instances
for Vec_s don't depend on those for Vec_0. (In fact, the instances for
Vec_0 are somewhat pointless, as it only has one value: Nil. They're
included for completeness.)

> instance Show (Vec_0 a) where show _ = "[]"
> instance (Vec v, Show a) => Show (Vec_s v a) where
>     show = show . toList
>
> instance Eq (Vec_0 a) where Nil == Nil = True
> instance (Vec v, Eq a) => Eq (Vec_s v a) where
>     x == y = vfoldr (&&) True (vzipWith (==) x y)
>
> instance (Num a) => Num (Vec_0 a) where
>     (+)         = const
>     (*)         = const
>     (-)         = const
>     negate      = id
>     abs         = id
>     signum      = id
>     fromInteger = const Nil
>
> instance (Num a, Vec v) => Num (Vec_s v a) where
>     (+)         = vzipWith (+)
>     (*)         = vzipWith (*)
>     (-)         = vzipWith (-)
>     negate      = fmap negate
>     abs         = fmap abs
>     signum      = fmap signum
>     fromInteger = vec . fromInteger
>
> --
> newtype Diag a v = Diag { runDiag :: v (v a) -> v a }
>
> diag :: Vec v => v (v a) -> v a
> diag = runDiag vecCase
>
> instance VecCase (Diag a) where
>     caseNil  = Diag (\_ -> Nil)
>     caseCons = Diag (\(Cons x xs) ->
>                    Cons (vhead x) (diag (fmap vtail xs)))
> --
>
> instance Monad Vec_0 where
>     return _ = Nil
>     m >>= k  = Nil
>
> instance Vec v => Monad (Vec_s v) where
>     return  = vec
>     m >>= k = diag (fmap k m)

We can't declare a type synonym for matrices, because vector lengths are
no longer a separate part of the type signature, but we can still define
matrix functions.

> mat :: (Vec v, Vec w) => a -> v (w a)
> mat x = vec (vec x)
>
> fromLists :: (Vec v, Vec w) => [[a]] -> Maybe (v (w a))
> fromLists xs = mapM fromList xs >>= fromList
>
> row :: v a -> Vec_1 (v a)
> row v = Cons v Nil
>
> col :: Vec v => v a -> v (Vec_1 a)
> col = fmap (\v -> Cons v Nil)
>
> --
> newtype Transpose a w v = Transpose
>     { runTranspose :: v (w a) -> w (v a) }
>
> transpose :: (Vec v, Vec w) => v (w a) -> w (v a)
> transpose = runTranspose vecCase
> 
> instance Vec w => VecCase (Transpose a w) where
>     caseNil  = Transpose (\Nil -> vec Nil)
>     caseCons = Transpose (\(Cons x xs) ->
>                    vzipWith Cons x (transpose xs))
> --
>
> mult :: (Vec v, Vec t, Vec w, Num a) => v (t a) -> t (w a) -> v (w a)
> mult x y = fmap (\r -> fmap (inner r) y') x
>     where y' = transpose y
>
> --
> newtype IdMat a v = IdMat { runIdMat :: v (v a) }
>
> idMat :: (Vec v, Num a) => v (v a)
> idMat = runIdMat vecCase
>
> instance Num a => VecCase (IdMat a) where
>     caseNil  = IdMat Nil
>     caseCons = IdMat (Cons (Cons 1 (vec 0)) (fmap (Cons 0) idMat))
> --
-- 
David Menendez <zednenem at psualum.com> <http://www.eyrie.org/~zednenem/>