title: A non-regular data type challenge
date: 2009-04-23
tags: haskell
sourcelink: This post is literate Haskell, click here to download the source code.
While playing around with generalized functional references I encountered the following list-like data type:
> -- IGNORE
> {-# LANGUAGE ExistentialQuantification #-}
> import Control.Applicative
> data FunList a b
> = Done b
> | More a (FunList a (a -> b))
This is a non-regular data type, meaning that inside the @FunList a b@ there is a @FunList a !!!*not-b*!!!@. So, what does a value of this type look like? Well, it can be
* @Done (x :: b)@, or
* @More a__1 (Done (x :: a -> b))@, or
* @More a__1 (More a__2 (Done (x :: a -> a -> b)))@, etc.
We either have just @b@, or an @a@ and a function @a->b@, or two @a@s (i.e. @a@$^2$) and a function @a!!!^{2}!!!->b@, or @a@$^3$ and @a!!!^{3}!!!->b@, etc.
A @FunList a b@ is therefore a list of @a@s together with a function that takes ''exactly'' that number of @a@s to give you a @b@.
Extracting the single represented @b@ value is easy:
> getB :: FunList a b -> b
> getB (Done b) = b
> getB (More a z) = getB z a
As is getting to the list of @a@s:
> getAs :: FunList a b -> [a]
> getAs (Done _) = []
> getAs (More a z) = a : getAs z
But then things quickly get much trickier.
Since a @FunList a b@ holds exactly one @b@, we might ask how much access we have to it.
First of, @FunList a@ is a Functor, so the @b@ value can be changed:
> instance Functor (FunList a) where
> fmap f (Done b) = Done (f b)
> fmap f (More a z) = More a (fmap (f .) z)
The above case for @More@ looks a bit strange, but remember that the data type is non-regular, so we recurse with a different function @f@. In this case instead of having type @b -> c@ as the outer @f@ does, we need something with type @(a -> b) -> (a -> c)@.
The @Applicative@ instance is even stranger. There is a @flip@ there, where the heck did that come from?
> instance Applicative (FunList a) where
> pure = Done
> Done b <*> c = fmap b c -- follows from Applicative laws
> More a z <*> c = More a (flip <$> z <*> c) -- flip??
Aside from manipulating the @b@ value we can also do more list like things to the list of @a@s, such as zipping:
> zipFun :: FunList a b -> FunList c d -> FunList (a,c) (b,d)
> zipFun (Done b) d = Done (b,getB d)
> zipFun b (Done d) = Done (getB b,d)
> zipFun (More a b) (More c d) = More (a,c) (applyPair <$> zipFun b d)
> where applyPair (f,g) (x,y) = (f x,g y)
Surprisingly, the applicative operator defined above can be used as a kind of append, just look at the type:
] (<*>) :: FunList a (b -> c) -> FunList a b -> FunList a c
it takes two 'lists' and combines them into one. It is indeed true that @getAs a ++ getAs b == getAs (a <*> b)@.
This is as far as I got, so I will end this post with a couple of challenges:
* Show that @FunList a@ is a monad.
* Show that @FunList a@ is not a monad.
* Write a function @reverseFun :: FunList a b -> FunList a b@ that reverses a FunList, i.e. @getAs . reverseFun == reverse . getAs@.
* Write a $O(n)$ reverse function.
> -- IGNORE
> -- here is a O(n^2) reverse function
>
> -- snocFun x a == x <*> A a (B id)
> snocFun :: FunList a (a -> b) -> a -> FunList a b
> snocFun (Done b) z = More z (Done b)
> snocFun (More a f) z = More a (snocFun f z)
>
> reverseFun :: FunList a b -> FunList a b
> reverseFun (Done b) = (Done b)
> reverseFun (More a z) = reverseFun z `snocFun` a
> -- IGNORE
> -- for the existential version everything seems to work without change:
>
> data FunList2 b = Done2 b | forall a. More2 a (FunList2 (a -> b))
>
> instance Functor FunList2 where
> fmap f (Done2 b) = Done2 (f b)
> fmap f (More2 a z) = More2 a (fmap (f .) z)
>
> instance Applicative FunList2 where
> pure = Done2
> Done2 b <*> c = fmap b c
> More2 a z <*> c = More2 a (flip <$> z <*> c)
>
> getB2 :: FunList2 b -> b
> getB2 (Done2 b) = b
> getB2 (More2 a z) = getB2 z a
>
> zipFun2 :: FunList2 b -> FunList2 d -> FunList2 (b,d)
> zipFun2 (Done2 b) d = Done2 (b,getB2 d)
> zipFun2 b (Done2 d) = Done2 (getB2 b,d)
> zipFun2 (More2 a b) (More2 c d) = More2 (a,c) (applyPair <$> zipFun2 b d)
> where applyPair (f,g) (x,y) = (f x,g y)
>
> -- obviously getAs and reverseFun will not work here