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)