Representing Contractive Functions on Streams
Graham Hutton and Mauro Jaskelioff, October 2011
Streams:
> data Stream a = Cons a (Stream a)
> deriving Show
>
> shead :: Stream a -> a
> shead (Cons x xs) = x
>
> stail :: Stream a -> Stream a
> stail (Cons x xs) = xs
>
> smap :: (a -> b) -> Stream a -> Stream b
> smap f (Cons x xs) = Cons (f x) (smap f xs)
>
> smap2 :: (a -> b -> c) -> Stream a -> Stream b -> Stream c
> smap2 f (Cons x xs)
> (Cons y ys) = Cons (f x y) (smap2 f xs ys)
>
> smerge :: Stream a -> Stream a -> Stream a
> smerge (Cons x xs) ys = Cons x (smerge ys xs)
>
> sindex :: Stream a -> Int -> a
> sindex (Cons x xs) 0 = x
> sindex (Cons x xs) (n+1) = sindex xs n
>
> stake :: Int -> Stream a -> [a]
> stake 0 _ = []
> stake (n+1) (Cons x xs) = x : stake n xs
Example streams:
> ones :: Stream Int
> ones = Cons 1 ones
>
> nats :: Stream Int
> nats = Cons 0 (smap (+1) nats)
>
> fibs :: Stream Integer
> fibs = Cons 0 (Cons 1 (smap2 (+) fibs (stail fibs)))
>
> zeros :: Stream Int
> zeros = Cons 0 (smerge zeros (stail zeros))
Generating functions:
> type Gen a b = [a] -> b
>
> gen :: Gen a b -> (Stream a -> Stream b)
> gen g ~(Cons x xs) = Cons (g []) (gen (g . (x:)) xs)
>
> rep :: (Stream a -> Stream b) -> Gen a b
> rep f [] = shead (f any_a)
> rep f (x:xs) = rep (stail . f . Cons x) xs
>
> any_a :: Stream a
> any_a = any_a
Fixed points:
> fix :: (a -> a) -> a
> fix f = let x = f x in x
>
> gfix :: Gen a a -> Stream a
> gfix g = fix (gen g)
Example generating functions:
> gones :: Gen Int Int
> gones [] = 1
> gones xs = last xs
>
> gones' :: Gen Int Int
> gones' xs = 1
>
> gnats :: Gen Int Int
> gnats [] = 0
> gnats xs = last xs + 1
>
> gnats' :: Gen Int Int
> gnats' xs = length xs
>
> gfibs :: Gen Integer Integer
> gfibs [] = 0
> gfibs [x] = 1
> gfibs xs = last (init xs) + last xs
>
> gfibs' :: Gen Integer Integer
> gfibs' xs = case length xs of
> 0 -> 0
> 1 -> 1
> n -> xs !! (n-2) + xs !! (n-1)
>
> gzeros :: Gen Int Int
> gzeros [] = 0
> gzeros xs = xs !! (length xs `div` 2)
Example streams:
> myones :: Stream Int
> myones = gfix gones
>
> myones' :: Stream Int
> myones' = gfix gones'
>
> mynats :: Stream Int
> mynats = gfix gnats
>
> mynats' :: Stream Int
> mynats' = gfix gnats'
>
> myfibs :: Stream Integer
> myfibs = gfix gfibs
>
> myfibs' :: Stream Integer
> myfibs' = gfix gfibs'
>
> myzeros :: Stream Int
> myzeros = gfix gzeros
Reversing the history:
> rgen :: Gen a b -> (Stream a -> Stream b)
> rgen g = rgen' g []
>
> rgen' :: Gen a b -> [a] -> (Stream a -> Stream b)
> rgen' g ys ~(Cons x xs) = Cons (g ys) (rgen' g (x:ys) xs)
Fixed points:
> rgfix :: Gen a a -> Stream a
> rgfix g = fix (rgen g)
Example generating functions with reversed history:
> rgones :: Gen Int Int
> rgones [] = 1
> rgones (x:xs) = x
>
> rgnats :: Gen Int Int
> rgnats [] = 0
> rgnats (x:xs) = x+1
>
> rgfibs :: Gen Integer Integer
> rgfibs [] = 0
> rgfibs [x] = 1
> rgfibs (x:y:zs) = y+x
>
> rgzeros :: Gen Int Int
> rgzeros [] = 0
> rgzeros xs = xs !! ((length xs - 1) `div` 2)
Example streams:
> rones :: Stream Int
> rones = rgfix rgones
>
> rnats :: Stream Int
> rnats = rgfix rgnats
>
> rfibs :: Stream Integer
> rfibs = rgfix rgfibs
>
> rzeros :: Stream Int
> rzeros = rgfix rgzeros
Generating trees:
> data Tree a b = Node b (a -> Tree a b)
>
> label :: Tree a b -> b
> label (Node y f) = y
>
> branches :: Tree a b -> (a -> Tree a b)
> branches (Node y f) = f
Conversion functions:
> gen' :: Tree a b -> Gen a b
> gen' (Node y f) [] = y
> gen' (Node y f) (x:xs) = gen' (f x) xs
>
> rep' :: Gen a b -> Tree a b
> rep' g = Node (g []) (\x -> rep' (g . (x:)))
Unfold operator for generating trees:
> type Coalg c a b = (c -> b, c -> a -> c)
>
> unfold :: Coalg c a b -> c -> Tree a b
> unfold (h,t) z = Node (h z) (\x -> unfold (h,t) (t z x))
Generate function:
> generate :: Coalg c a b -> c -> (Stream a -> Stream b)
> generate (h,t) z ~(Cons x xs) = Cons (h z) (generate (h,t) (t z x) xs)
Fixed points:
> cfix :: Coalg c a a -> c -> Stream a
> cfix (h,t) z = fix (generate (h,t) z)
Stream of ones:
> cones :: Stream Int
> cones = cfix (hones,tones) 1
>
> hones :: Int -> Int
> hones x = x
>
> tones :: Int -> Int -> Int
> tones x _ = x
Natural numbers:
> cnats :: Stream Int
> cnats = cfix (hnats,tnats) 0
>
> hnats :: Int -> Int
> hnats x = x
>
> tnats :: Int -> Int -> Int
> tnats x _ = x+1
Fibonacci numbers:
> cfibs :: Stream Integer
> cfibs = cfix (hfibs,tfibs) (0,1)
>
> hfibs :: (Integer,Integer) -> Integer
> hfibs (x,y) = x
>
> tfibs :: (Integer,Integer) -> Integer -> (Integer,Integer)
> tfibs (x,y) _ = (y, x+y)
Stream of zeros by merging:
> czeros :: Stream Int
> czeros = cfix (hzeros,tzeros) ([],-1)
>
> hzeros :: ([Int],Int) -> Int
> hzeros ([],_) = 0
> hzeros (xs,n) = xs !! (n `div` 2)
>
> tzeros :: ([Int],Int) -> Int -> ([Int],Int)
> tzeros (xs,n) x = (x:xs, n+1)
Producing a stream from a generating tree:
> fromtree :: Tree a a -> Stream a
> fromtree = cfix (label,branches)
Producing a stream from a generating function:
> fromgen :: Gen a a -> Stream a
> fromgen = cfix (hgen,tgen)
>
> hgen :: Gen a b -> b
> hgen g = g []
>
> tgen :: Gen a b -> a -> Gen a b
> tgen g x = g . (x:)
Producing a stream from a generating function with reversed history:
> fromrgen :: (Gen a a, [a]) -> Stream a
> fromrgen = cfix (hrgen,trgen)
>
> hrgen :: (Gen a b, [a]) -> b
> hrgen (g,xs) = g xs
>
> trgen :: (Gen a b, [a]) -> a -> (Gen a b,[a])
> trgen (g,xs) x = (g, x:xs)