I have defined an F-Algebra, as per Bartosz Milewski's articles (one, two):
(This is not to say my code is an exact embodiment of Bartosz's ideas, it's merely my limited understanding of them, and any faults are mine alone.)
module Algebra where
data Expr a = Branch [a] | Leaf Int
instance Functor Expr where
fmap f (Branch xs) = Branch (fmap f xs)
fmap _ (Leaf i ) = Leaf i
newtype Fix a = Fix { unFix :: a (Fix a) }
branch = Fix . Branch
leaf = Fix . Leaf
-- | This is an example algebra.
evalSum (Branch xs) = sum xs
evalSum (Leaf i ) = i
cata f = f . fmap (cata f) . unFix
I can now do pretty much anything I want about it, for example, sum the leaves:
λ cata evalSum $ branch [branch [leaf 1, leaf 2], leaf 3]
6
This is a contrived example that I made up specifically for this question, but I actually tried some less trivial things (such as evaluating and simplifying polynomials with any number of variables) and it works like a charm. One may indeed fold and replace any parts of a structure as one runs a catamorphism through, with a suitably chosen algebra. So, I am pretty sure an F-Algebra subsumes a Foldable, and it even appears to subsume Traversable as well.
Now, can I define Foldable / Traversable instances in terms of an F-Algebra?
It seems to me that I cannot.
- I can only run a catamorphism on an initial algebra, which is a nullary type constructor. And the algebra I give it has a type
a b -> b
rather thana -> b
, that is to say, there is a functional dependency between the "in" and "out" type. - I don't see an
Algebra a => Foldable a
anywhere in type signatures. If this is not done, it must be impossible.
It seems to me that I cannot define Foldable
in terms of an F-Algebra for the reason that an Expr
must for that be a Functor
in two variables: one for carrier, another for values, and then a Foldable
in the second. So, it may be that a bifunctor is more suitable. And we can construct an F-Algebra with a bifunctor as well:
module Algebra2 where
import Data.Bifunctor
data Expr a i = Branch [a] | Leaf i
instance Bifunctor Expr where
bimap f _ (Branch xs) = Branch (fmap f xs)
bimap _ g (Leaf i ) = Leaf (g i)
newtype Fix2 a i = Fix2 { unFix2 :: a (Fix2 a i) i }
branch = Fix2 . Branch
leaf = Fix2 . Leaf
evalSum (Branch xs) = sum xs
evalSum (Leaf i ) = i
cata2 f g = f . bimap (cata2 f g) g . unFix2
It runs like this:
λ cata2 evalSum (+1) $ branch [branch [leaf 1, leaf 2], leaf 3]
9
But I still can't define a Foldable. It would have type like this:
instance Foldable \i -> Expr (Fix2 Expr i) i where ...
Unfortunately, one doesn't get lambda abstractions on types, and there's no way to put an implied type variable in two places at once.
I don't know what to do.
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
来源:https://stackoverflow.com/questions/48488021/once-i-have-an-f-algebra-can-i-define-foldable-and-traversable-in-terms-of-it