Once I have an F-Algebra, can I define Foldable and Traversable in terms of it?

若如初见. 提交于 2019-11-30 08:48:32

An F-algebra defines a recipe for evaluating a single level of a recursive data structure, after you have evaluated all the children. Foldable defines a way of evaluating a (not necessarily recursive) data structure, provided you know how to convert values stored in it to elements of a monoid.

To implement foldMap for a recursive data structure, you may start by defining an algebra, whose carrier is a monoid. You would define how to convert a leaf to a monoidal value. Then, assuming that all children of a node were evaluated to monoidal values, you'd define a way to combine them within a node. Once you've defined such an algebra, you can run a catamorphism to evaluate foldMap for the whole tree.

So the answer to your question is that to make a Foldable instance for a fixed-point data structure, you have to define an appropriate algebra whose carrier is a monoid.

Edit: Here's an implementation of Foldable:

data Expr e a = Branch [a] | Leaf e

newtype Ex e = Ex { unEx :: Fix (Expr e) }

evalM :: Monoid m => (e -> m) -> Algebra (Expr e) m
evalM _ (Branch xs) = mconcat xs
evalM f (Leaf   i ) = f i

instance Foldable (Ex) where
  foldMap f = cata (evalM f) . unEx

tree :: Ex Int
tree = Ex $ branch [branch [leaf 1, leaf 2], leaf 3]

x = foldMap Sum tree

Implementing Traversable as a catamorphism is a little more involved because you want the result to be not just a summary--it must contain the complete reconstructed data structure. The carrier of the algebra must therefore be the type of the final result of traverse, which is (f (Fix (Expr b))), where f is Applicative.

tAlg :: Applicative f => (e -> f b) -> Algebra (Expr e) (f (Fix (Expr b)))

Here's this algebra:

tAlg g (Leaf e)    = leaf   <$> g e
tAlg _ (Branch xs) = branch <$> sequenceA xs

And this is how you implement traverse:

instance Traversable Ex where
  traverse g = fmap Ex . cata (tAlg g) . unEx

The superclass of Traversable is a Functor, so you need to show that the fixed-point data structure is a functor. You can do it by implementing a simple algebra and running a catamorphism over it:

fAlg :: (a -> b) -> Algebra (Expr a) (Fix (Expr b))
fAlg g (Leaf e) = leaf (g e)
fAlg _ (Branch es) = branch es

instance Functor Ex where
  fmap g = Ex . cata (fAlg g) . unEx

(Michael Sloan helped me write this code.)

It's very nice, that you used Bifunctor. Using Bifunctor of a base functor (Expr) to define Functor on a fixpoint (Fix Expr). That approach generalises to Bifoldable and Bitraversable (they are in base now) too.

Let's see how this would like using recursion-schemes. It looks a bit different, as there we define normal recursive type, say Tree e, and also its base functor: Base (Tree e) = TreeF e a with two functions: project :: Tree e -> TreeF e (Tree e) and embed :: TreeF e (Tree e) -> Tree e. The recursion machinery is derivable using TemplateHaskell:

Note that we have Base (Fix f) = f (project = unFix, embed = Fix), therefore we can use refix convert Tree e to Fix (TreeF e) and back. But we don't need to use Fix, as we able to cata Tree directly!

First includes:

{-# LANGUAGE TemplateHaskell, KindSignatures, TypeFamilies, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
import Data.Functor.Foldable
import Data.Functor.Foldable.TH

import Data.Bifunctor
import Data.Bifoldable
import Data.Bitraversable

Then the data:

data Tree e = Branch [Tree e] | Leaf e deriving Show

-- data TreeF e r = BranchF [r] | LeafF e
-- instance Traversable (TreeF e)
-- instance Foldable (TreeF e)
-- instance Functor (TreeF e)
makeBaseFunctor ''Tree

Now as we have machinery in place, we can have catamorphisms

cata :: Recursive t => (Base t a -> a) -> t -> a
cata f = c where c = f . fmap c . project

or (which we will need later)

cataBi :: (Recursive t, Bifunctor p, Base t ~ p x) => (p x a -> a) -> t -> a
cataBi f = c where c = f . second c . project

First a Functor instance. The Bifunctor instance for TreeF is as OP has written, note how Functor falls out by itself.

instance Bifunctor TreeF where
    bimap f _ (LeafF e)    = LeafF (f e)
    bimap _ g (BranchF xs) = BranchF (fmap g xs)

instance Functor Tree where
    fmap f = cata (embed . bimap f id)

Not surprisingly, Foldable for fixpoint can be defined in terms of Bifoldable of base functor:

instance Bifoldable TreeF where
    bifoldMap f _ (LeafF e)    = f e
    bifoldMap _ g (BranchF xs) = foldMap g xs

instance Foldable Tree where
    foldMap f = cata (bifoldMap f id)

And finally Traversable:

instance Bitraversable TreeF where
    bitraverse f _ (LeafF e)    = LeafF <$> f e
    bitraverse _ g (BranchF xs) = BranchF <$> traverse g xs

instance Traversable Tree where
    traverse f = cata (fmap embed . bitraverse f id)

As you can see the definitions are very straight forward and follow similarish pattern.

Indeed we can define traverse-like function for every fix-point which base functor is Bitraversable.

traverseRec
    :: ( Recursive t, Corecursive s, Applicative f
       , Base t ~ base a, Base s ~ base b, Bitraversable base)
    => (a -> f b) -> t -> f s
traverseRec f = cataBi (fmap embed . bitraverse f id)

Here we use cataBi to make type-signature prettier: no Functor (base b) as it's "implied" by Bitraversable base. Btw, that's a one nice function as its type signature is three times longer than the implementation).

To conclude, I must mention that Fix in Haskell is not perfect: We use the last argument to fix base-functor:

Fix :: (* -> *) -> * -- example: Tree e ~ Fix (TreeF e)

Thus Bartosz needs to define Ex in his answer to make kinds align, however it would be nicer to fix on the first argument:

Fix :: (* -> k) -> k -- example: Tree e = Fix TreeF' e

where data TreeF' a e = LeafF' e | BranchF' [a], i.e. TreeF with indexes flipped. That way we could have Functor (Fix b) in terms of Bifunctor f, Bifunctor (Fix b) in terms of (non-existing in common libraries) Trifunctor etc.

You can read about my failed attempts about that and Edward Kmett's comments on the issue in https://github.com/ekmett/recursion-schemes/pull/23

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!