[Haskell-beginners] Named (custom) recursions vs clever comonadic
recursions
apfelmus
apfelmus at quantentunnel.de
Sun Sep 14 03:39:26 EDT 2008
Federico Brubacher wrote:
> What I don't get yet (as the subject says) is a real-world example on where
> you might apply category theory to a recursion.
In a sense, the core task of the paper "Functional Programming with Bananas,
Lenses, etc." is to write a general fold function that works for many data
types at once, not just for lists.
Here is fold for lists:
data ListF a b = Empty | Cons a b
foldList :: (ListF a b -> b) -> [a] -> b
foldList f = foldr (\a b -> f (Cons a b)) (f Empty)
sumList :: [Int] -> Int
sumList = foldList f
where
f Empty = 0
f (Cons x s) = x + s
and here is fold for binary trees
data Tree a = Leaf a | Node (Tree a) (Tree a)
data TreeF a b = Leaf' a | Node' b b
foldTree :: (TreeF a b -> b) -> Tree a -> b
foldTree f (Leaf x ) = f $ Leaf' x
foldTree f (Node u v) = f $ Node' (foldTree f u) (foldTree f v)
sumTree :: Tree Int -> Int
sumTree = foldTree f
where
f (Leaf' x ) = x
f (Node' s t) = s + t
In other words, the fold captures the process of traversing the data structure
while the user-supplied function tells it how to calculate the result (without
performing recursion itself).
Both folds are one and the same function when viewed through the right glasses:
data Fix f = In { out :: f (Fix f) }
fold :: Functor f => (f b -> b) -> Fix f -> b
fold f (In x) = f . fmap (fold f) x
type Tree a = Fix (TreeF a)
foldTree :: (TreeF a b -> b) -> Tree a -> b
foldTree = fold
instance Functor (TreeF a) where
fmap f (Node' b c) = Node' (f b) (f c)
fmap f x = x
type List a = Fix (ListF a)
foldList :: (ListF a b -> b) -> List a -> b
foldList = fold
instance Functor (ListF a) where
fmap f (Cons a b) = Cons a (f b)
fmap f x = x
Regards,
apfelmus
PS: The scary name for "fold" is "catamorhpism"
More information about the Beginners
mailing list