Monoidal folds at fixed points

Question

For an arbitrary fixed-point data structure, we can construct a monoidal algebra without specifying all cases:

Suppose we are given an Expr data Expr , as shown below. Using the recursion-schemes library, we can get the ExprF base functor, which also automatically has Functor , Foldable and Traversable instances.

 {-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TemplateHaskell #-} import Data.Semigroup (Sum(..)) import Data.Functor.Foldable import Data.Functor.Foldable.TH import Prelude hiding (fail) data Expr = Var String | Const Int | Add [Expr] | Mult [Expr] deriving Show $(makeBaseFunctor ''Expr) expr :: Fix ExprF expr = ana project $ Add [Const 1, Const 2, Mult [Const 3, Const 4], Var "hello"] 

Now let's say we want to count the number of leaves in Expr . We can easily write algebra for such a small data structure:

 alg (ConstF _) = 1 alg (VarF _) = 1 alg (AddF xs) = sum xs alg (MulF xs) = sum xs 

Now we can call cata alg expr , which returns 5 , the correct result.

Suppose Expr getting really big and complex, and we don’t want to manually record cases for all data constructors. How does cata know how to combine results from all cases? I suspect this is possible using Monoid s, possibly in combination with the Const functor (not quite sure about this last part).

 fail = getSum $ foldMap (const (Sum 1) . unfix) $ unfix expr 

fail returns 4 , whereas we actually have 5 . I assume that the problem lies at a fixed point, because we can only clear one Fix layer, and therefore Mult [..] considered only as one sheet.

Is it possible to somehow hide the entire fixed point and collect the results in the Monoid structure without manually specifying all instances manually? What I want looks like foldMap , but in a more general way.

I feel like I'm missing something really obvious.

Answer 1

Here is the essence of the solution. I turned on

 {-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable, PatternSynonyms #-} 

Let me simply reformulate fixed points and catamorphisms.

 newtype Fix f = In {out :: f (Fix f)} cata :: Functor f => (ft -> t) -> Fix f -> t cata alg = alg . fmap (cata alg) . out 

Algebra alg :: ft -> t takes a node, where the children are already replaced by the value t , and then returns t for the parent. The cata statement works by unpacking the parent node, recursively processing all its children, and then applying alg to complete the job.

So, if we want to count the leaves in such a structure, we can start like this:

 leaves :: (Foldable f, Functor f) => Fix f -> Integer leaves = cata sumOrOne where -- sumOrOne :: f Integer -> Integer 

Algebra, sumOrOne can see the number of leaves in each descendant of the parent node. We can use cata because f is a Functor . And since f is Foldable , we can calculate the total number of leaves in the children.

  sumOrOne fl = case sum fl of ... 

There are then two possibilities: if the parent does not have children, its sum will be 0 , which we can find, but this means that the parent itself is a sheet, so 1 must be returned. Otherwise, the sum of the leaves will be non-zero, in which case the parent is not a leaf, therefore, its sum of leaves is really the total sum of the leaves of their children. It gives us

 leaves :: (Foldable f, Functor f) => Fix f -> Integer leaves = cata sumOrOne where sumOrOne fl{- number of leaves in each child-} = case sum fl of 0 -> 1 -- no leaves in my children means I am a leaf l -> l -- otherwise, pass on the total 

A quick example based on Hutton Razor (an expression language with integers and append, which is often the simplest that illustrates the point). Expressions are generated from the Hatton functor.

 data HF h = Val Int | h :+: h deriving (Functor, Foldable, Traversable) 

I introduce some template synonyms to restore the look of a personalized type.

 pattern V x = In (Val x) pattern s :+ t = In (s :+: t) 

I am preparing an expression for a quick example, and some leaves have three levels of depth.

 example :: Fix HF example = (V 1 :+ V 2) :+ ((V 3 :+ V 4) :+ V 5) 

Sure,

 Ok, modules loaded: Leaves. *Leaves> leaves example 5 

An alternative approach should be functorial and developing in the substructures of interest, in this case, on the leaves. (We get exactly free monads.)

 data Tree fx = Leaf x | Node (f (Tree fx)) deriving (Functor, Foldable) 

After you have separated the dividing part of the / node sheet of your main structure, you can visit the leaves directly with foldMap . Throwing a little Control.Newtype , we get

 ala' Sum foldMap (const 1) :: Foldable f => fx -> Integer 

which is below the Fairbairn threshold (i.e., short enough to not require a name and increasingly clear so as not to have one).

The problem, of course, is that data structures are often functional in “substructures of interest” in several interesting but controversial ways. Haskell is not always the best, allowing us to access the “found functoriality”: we somehow have to predict the functoriality that we need when we parameterize the data type during the declaration. But there is still time to change all this ...