Writing foldLeft equivalent for recursion schemes

Question

This is a definition of foldr and foldl in terms of foldr:

foldr :: (a -> b -> b) -> b -> [a] -> b
foldr f z []     = z
foldr f z (x:xs) = f x (foldr f z xs)


foldl :: (a -> b -> a) -> a -> [b] -> a
foldl f a bs =
   foldr (\b g x -> g (f x b)) id bs a

foldr evaluates right to left and foldl evaluates left to right

In the case of multiplying integers, foldr would do operations in the following order

(1*(2*(3*(4*5))))

Whereas foldl would do

((((1*2)*3)*4)*5)

I’m wondering if/how this could be done more abstractly for recursion schemes over all algebraic datatypes?

Specifically, if I’ve defined catamorphism, anamorphism, paramorphism and apomorphism as follows:

deriving instance (Eq (f (Fix f))) => Eq (Fix f)
deriving instance (Ord (f (Fix f))) => Ord (Fix f)
deriving instance (Show (f (Fix f))) => Show (Fix f)

out :: Fix f -> f (Fix f)
out (In f) = f

-- Catamorphism
type Algebra f a = f a -> a

cata :: (Functor f) => Algebra f a -> Fix f -> a                                                                                                                                
cata f = f . fmap (cata f) . out                                                                                                                                                
                                                                                                                                                                                
-- Anamorphism                                                                                                                                                                  
type Coalgebra f a = a -> f a                                                                                                                                                   
                                                                                                                                                                                
ana :: (Functor f) => Coalgebra f a -> a -> Fix f                                                                                                                               
ana f = In . fmap (ana f) . f                                                                                                                               

-- Paramorphism
type RAlgebra f a = f (Fix f, a) -> a                                                                                          
        
para :: (Functor f) => RAlgebra f a -> Fix f -> a
para rAlg = rAlg . fmap fanout . out
        where fanout t = (t, para rAlg t)
                                                                                                                                                                                
-- Apomorphism
type RCoalgebra f a = a -> f (Either (Fix f) a)                                        
                                                                                       
apo :: Functor f => RCoalgebra f a -> a -> Fix f                                       
apo rCoalg = In . fmap fanin . rCoalg                                                                                                                                           
        where fanin = either id (apo rCoalg)

How could I write catamorphismLeft, anamorphismLeft, paramorphismLeft and apomorphismLeft?

Answer 1

The direction of the search is determined by the coalgebra used, not the recursion scheme itself. We'll use the following definition of a tree and its corresponding base functor for use with the recursion-schemes package.

{-# LANGUAGE TemplateHaskell, TypeFamilies #-}

import Data.Functor.Foldable
import Data.Functor.Foldable.TH

data Tree a = Node a [Tree a]
makeBaseFunctor ''Tree

type Algebra f a = f a -> a
type Coalgebra f a = a -> f a

A search can be seen as a linear search on some traversal of the tree. The search is always the same, using the following algebra parameterized by the search key:

 searchAlg :: Eq a => a -> Algebra (ListF a) (Maybe a)
 searchAlg _ Nil = Nothing
 searchAlg key (Cons x result) = if key == x then Just x else result

The traversal is generated by a coalgebra that uses some collection of nodes as its seed. The direction is determined by how the coalgebra creates the next seed from the current node and the existing seed.

1. Depth-first searches use a stack. Breadth-first searches use a queue.
2. Left-to-right searches add nodes in order; right-to-left searches add nodes in reverse order.

traverseCoalg :: ([Tree a] ~ m) 
              => (m -> m -> m)
              -> (m -> m)
              -> Coalgebra (ListF a) m
traverseCoalg _ _ [] = Nil
traverseCoalg update dir (Node a children: ts) = Cons a (update ts (dir children))

So four different search algorithms can be generated by altering the arguments to traverseCoalg.

bfs_lr key t = hylo (searchAlg key) (traverseCoalg (++)        id)      [t]
bfs_rl key t = hylo (searchAlg key) (traverseCoalg (++)        reverse) [t]
dfs_lr key t = hylo (searchAlg key) (traverseCoalg (flip (++)) id)      [t]
dfs_rl key t = hylo (searchAlg key) (traverseCoalg (flip (++)) reverse) [t]