-- An F-algebra over a carrier sort x is set of functions (and constants) -- whose types involve x. In Haskell we can simulate this by a data definition -- for a functor (F x) and a function (F x) -> x data Algebra f c = Algebra (f c -> c) data F1 x = Zero | One | Plus x x f :: F1 Int -> Int f Zero = 0 f One = 1 f (Plus x y) = x+y g :: F1 [Int] -> [Int] g Zero = [] g One = [1] g (Plus x y) = x ++ y alg1 :: Algebra F1 Int alg1 = Algebra f alg2 :: Algebra F1 [Int] alg2 = Algebra g data ListF a x = Nil | Cons a x h :: ListF b Int -> Int h Nil = 0 h (Cons x xs) = 1 + xs alg3 :: Algebra (ListF a) Int alg3 = Algebra h -- An initial Algebra is the set of terms we can obtain be iteratively applying -- the functions to the constants and other function applications. This set -- can be simulated in Haskell by the data definitions. -- here the function is Init :: alg (Init alg) -> Init alg -- Note how this fits the pattern f :: T x -> x data Initial alg = Init (alg (Initial alg)) ex1 :: Initial F1 ex1 = Init(Plus (Init One) (Init Zero)) ex2 :: Initial (ListF Int) ex2 = Init(Cons 2 (Init Nil)) initialAlg :: Algebra f (Initial f) initialAlg = Algebra Init -- We can write functions by a case analysis over the functions and -- constants that generate the initial algebra len :: Num a => Initial (ListF b) -> a len (Init Nil) = 0 len (Init (Cons x xs)) = 1 + len xs app :: Initial (ListF a) -> Initial (ListF a) -> Initial (ListF a) app (Init Nil) ys = ys app (Init (Cons x xs)) ys = Init(Cons x (app xs ys)) -- An F-algebra, f, is said to be initial to any other algebra, g, if there -- is a UNIQUE homomorphism, from f to g (this is an arrow in the category of -- F algebras). We can show the existence of this homomorphism by building -- it as a datatype in Haskell. Note: that for each "f", (Arrow f a b) denotes -- an arrow in the category of f-algebras. data Arrow f a b = Arr (Algebra f a) (Algebra f b) (a->b) -- For every Arrow (Arr (Algebra f) (Algebra g) h) it must be the case that -- -- F a ---- fmap h -----> F b -- | | -- | f | g -- | | -- V V -- a -------- h --------> b valid :: (Eq b, Functor f) => Arrow f a b -> f a -> Bool valid (Arr (Algebra f) (Algebra g) h) x = h(f x) == g(fmap h x) -- To show the existence of "h" for any F-algebra means we can compute -- a function with the type (a -> b) from the algebra. To do this we first define cata: cata :: Functor f => (Algebra f b) -> Initial f -> b cata (Algebra phi) (Init x) = phi(fmap (cata (Algebra phi)) x) exhibit :: Functor f => Algebra f a -> Arrow f (Initial f) a exhibit x = Arr initialAlg x (cata x) -- Lots of functions can be written directly as cata's len2 x = cata (Algebra phi) x where phi Nil = 0 phi (Cons x n) = 1 + n app2 x y = cata (Algebra phi) x where phi Nil = y phi (Cons x xs) = Init(Cons x xs) -- With initiality comes the inductive proof method. So to prove something -- (prop x) where x::Initial A prop1 :: Initial (ListF Int) -> Bool prop1 x = len(Init(Cons 1 x)) == 1 + len x -- Prove: prop1 (Init Nil) -- Assume prop1 xs -- The prove: prop1 (Init (Cons x xs)) -- we need a function from A(prop x) -> prop x data Proof = Simple Bool | Induct (Algebra (ListF Int) Proof) p1 :: ListF a Proof -> Proof p1 Nil = Simple(prop1 (Init Nil)) p1 (Cons x xs) = undefined -- xs = Proof that prop1 ys holds -- we need a proof that (prop1 (Init (Cons x ys))) holds prop2 :: Initial (ListF a) -> Initial (ListF a) -> Bool prop2 x y = len(app x y) == len x + len y ------------------------------------------------------------------- -- CoAlgebras data CoAlgebra f c = CoAlgebra (c -> f c) unCoAlgebra (CoAlgebra x) = x countdown :: CoAlgebra (ListF Int) Int countdown = CoAlgebra f where f 0 = Nil f n = Cons n (n-1) data StreamF n x = C n x ----------------------------------------------------------- -- We can write CoAlgebras by expanding a "seed" into an F structure -- filled with new seeds. seed -> F seed, the non-parameterized slots -- can be filled with things computed from the seed. These are -- sometimes called observations. endsIn0s :: CoAlgebra (StreamF Integer) [Integer] endsIn0s = CoAlgebra f where f [] = C 0 [] f (x:xs) = C x xs split :: CoAlgebra F1 Integer split = CoAlgebra f where f 0 = Zero f 1 = One f n = Plus (n-1) (n-2) fibs :: CoAlgebra (StreamF Int) (Int,Int) fibs = CoAlgebra f where f (x,y) = C (x+y) (y,x+y) instance Functor (StreamF n) where fmap f (C x y) = C x (f y) instance Functor F1 where fmap f Zero = Zero fmap f One = One fmap f (Plus x y) = Plus (f x) (f y) ----------------------------------------- -- Final CoAlgebras -- sequences (branching trees?) of observations of the internal state -- This allows us to iterate all the possible observations. -- Sometimes these are infinite structures. data Final f = Final (f (Final f)) unFinal :: Final a -> a (Final a) unFinal (Final x) = x finalCoalg :: CoAlgebra a (Final a) finalCoalg = CoAlgebra unFinal f1 :: Final (ListF a) f1 = Final Nil ones :: Final (StreamF Integer) ones = Final(C 1 ones) ----------------------------------------------------------- -- We can write functions producing elements in the sort of -- Final CoAlgebras by expanding a "seed" into an F structure -- filled with observations and recursive calls in the "slots" -- then all thats really left is the observations. nats :: Final (StreamF Integer) nats = g 0 where g n = Final (C n (g (n+1))) data NatF x = Z | S x omega :: Final NatF omega = f undefined where f x = Final(S(f x)) n :: Int -> Final NatF n x = f x where f 0 = Final Z f n = Final(S (f (n-1))) ---------------------------------------------------------------- -- A CoHomomorphism is an arrow in the category of F-CoAlgebras data CoHom f a b = CoHom (CoAlgebra f a) (CoAlgebra f b) (a->b) -- For every arrow in the category -- (CoHom (CoAlgebra f) (CoAlgebra g) h) it must be the case that -- -- F a ---- fmap h -----> F b -- ^ ^ -- | | -- | f | g -- | | -- a -------- h --------> b covalid :: (Eq (f b), Functor f) => CoHom f a b -> a -> Bool covalid (CoHom (CoAlgebra f) (CoAlgebra g) h) x = fmap h (f x) == g(h x) ------------------------------------------------------------------------- -- A F-CoAlgebra, g, is Final if for any other F-CoAlgebra, f, there -- is a unique F-CoAlgebra homomorphism, h, from f to g. We can show -- its existence be building a function that computes it from the -- CoAlgebra, f. ana :: Functor f => (CoAlgebra f seed) -> seed -> (Final f) ana (CoAlgebra phi) seed = Final(fmap (ana (CoAlgebra phi)) (phi seed)) exhibit2 :: Functor f => CoAlgebra f seed -> CoHom f seed (Final f) exhibit2 x = CoHom x finalCoalg (ana x) ------------------------------------------------------------------ -- we use ana to iteratively unfold any coAgebra to record its observations final1 = ana endsIn0s final2 = ana split final3 = ana fibs tak :: Num a => a -> Final (StreamF b) -> [b] tak 0 _ = [] tak n (Final (C x xs)) = x : tak (n-1) xs fibs5 = tak 5 (final3 (1,1)) ------------------------------------------------------ -- Lets use CoAlgebras to represent Points in the 2-D -- plane as we would in an OO-language data P x = P { xcoord :: Float , ycoord :: Float , move :: Float -> Float -> x} pointF :: (Float,Float) -> P (Float,Float) pointF (x,y) = P {xcoord = x, ycoord = y, move = \ m n -> (m+x,n+y) } type Point = CoAlgebra P (Float,Float) point1 :: Point point1 = CoAlgebra pointF --