I'm struggling with define map over tree using foldBT. My idea is to convert the tree into list, map the operator over the list, and then convert the list back to tree. But it sounds inefficient and also doesn't make use of foldBT... I tried to run foldBT (*2) Nil (numTree [3,5,7] but ghci reported error. I don't really understand how the function foldBt works. An example would be great.
data SimpleBT a = Nil | N a (SimpleBT a) (SimpleBT a) deriving (Show, Eq)
foldBT :: (a -> b -> b -> b) -> b -> SimpleBT a -> b
foldBT f e Nil = e
foldBT f e (N a left right) = f a (foldBT f e left) (foldBT f e right)
mapTree :: (a -> b) -> SimpleBT a -> SimpleBT b
mapTree f Nil = Nil
mapTree f (N a left right) = N (f a) (mapTree f left) (mapTree f right)
size :: SimpleBT a -> Int
size Nil = 0
size (N _ left right) = 1 + size left + size right
insert :: SimpleBT a -> a -> SimpleBT a
insert Nil a = N a Nil Nil
insert (N x left right) a
| size left <= size right = N x (insert left a) right
| otherwise = N x left (insert right a)
numTree :: [a] -> SimpleBT a
numTree xs = foldl insert Nil xs
Let us hypothesize mapTree f = foldBT g e, and solve for g and e. The definition of foldBT says:
foldBT g e Nil = e
Meanwhile, from the definition of mapTree, we get:
mapTree f Nil = Nil
From our hypothesis that mapTree f = foldBT g e, we can transform the second equation and stick it next to the first equation:
foldBT g e Nil = Nil
foldBT g e Nil = e
So e = Nil.
Let's do the other clauses now. The definition of foldBT says:
foldBT g e (N a left right) = g a (foldBT g e left) (foldBT g e right)
Meanwhile, mapTree's definition says:
mapTree f (N a left right) = N (f a) (mapTree f left) (mapTree f right)
Again, using our hypothesis mapTree f = foldBT g e, we can now rewrite this equation, and stick it next to the first one:
foldBT g e (N a left right) = N (f a) (foldBT g e left) (foldBT g e right)
foldBT g e (N a left right) = g a (foldBT g e left) (foldBT g e right)
So g a = N (f a) would validate this equation. Writing these all down in one spot, we get:
mapTree f = foldBT g e where
e = Nil
g a = N (f a)
You can inline the definitions of e and g if you like; I would.
mapTree f = foldBT (N . f) Nil
The idea of the foldBT function is that it takes an argument for each constructor of your data type (plus the one holding the whole SimpleBT a itself that you wish to fold over). The first one, of type a -> b -> b -> b corresponds to the recursive N constructor, and shows how to combine the value at the node with the results of the fold of the two subtrees into the result of the entire fold. The second argument corresponds to the Nil constructor, and since this constructor takes no arguments, the corresponding argument to fold is simply a constant.
It's completely analagous to folding over a list. The list type [a] also has 2 constructors. One of them takes an a and a list and adds the element to the front of the list: a -> [a] -> [a], this gives rise to a "fold function" of type a -> b -> b. The other constructor, as in your case, is nullary (the empty list), so again corresponds to an argument whose type is just b. Hence foldr for a list has type (a -> b -> b) -> b -> [a] -> b.
There is a great discussion of this, with more examples, in this chapter of the Haskell wikibook: https://en.wikibooks.org/wiki/Haskell/Other_data_structures
As for how to build a map from a fold, for your particular tree type - bearing in mind what I've said above, you need (given a mapping function f :: a -> a0), we need to think about what this does to both the Nil tree, and what it does recursively to trees with a leaf and 2 branches. Also, since our return type will of course be another tree of the same type, b here will be SimpleBT a0.
For Nil, obviously we want map to leave it unchanged, so the second argument to foldBT will be Nil. And for the other constructor, we want the map to apply the base function to the value at the leaf, and then recursively map over the 2 branches. This leads us to the function \a left right -> N (f a) (mapTree f left) (mapTree f right).
So we can conclude that the map function can be defined as follows (thanks to #DanielWagner and #WillemVanOnsen for helping me fix my first broken version):
mapTree :: (a -> b) -> SimpleBT a -> SimpleBT b
mapTree f = foldBT foldFunc Nil
where foldFunc a l r = N (f a) l r
Related
I am trying to define a minTree function using foldTree define by:
foldTree :: (b -> a -> b -> b) -> b -> Tree a -> b
foldTree f e Leaf = e
foldTree f e (Node left x right) = f (foldTree f e left) x (foldTree f e right)
Here what I have so far.
minTree :: (Ord a) => Tree a -> Maybe a
minTree f e Leaf = e
minTree tree = foldTree f e tree
where
f x nothing = Just x
f x (Just y) = Just (min x y)
e = Nothing
But this code does not work and give a some error that I don't understand how to fix. Can someone help me to figure out what is wrong and how to fix it.
In your example b ~ Maybe a. This thus means that the first and the third parameter of f are Maybe as. You thus will need to check both. The second item is an a. Your f should thus determine the minimum of two Maybe as and an a, so something like:
minTree :: Ord a => Tree a -> Maybe a
minTree tree = foldTree f Nothing tree
where f Nothing y Nothing = Just y
f Nothing y (Just z) = …
f (Just x) y Nothing = …
f (Just x) y (Just z) = …
where I leave implementing the … parts as an exercise. Since a is a member of the Ord typeclass, you can work with min :: Ord a => a -> a -> a.
listTree' :: Tree a -> [a]
listTree' t = foldTree f z t []
where
f = undefined
z [] = []
Need help solving for f. when I insert f a b c = a ++ [b] ++ c I get an error
data Tree a
= Tip
| Bin (Tree a) a (Tree a)
deriving (Show, Eq)
foldTree :: (b -> a -> b -> b) -> b -> Tree a -> b
foldTree f z Tip = z
foldTree f z (Bin l x r) = f (foldTree f z l) x (foldTree f z r)
here is foldTree and data type for tree
In order to achieve linear time, you should let foldTree f z t return a function that takes a list and returns a list.
This means that for z, a leaf, we simply return the given list, and we thus do not prepend any value. For f we will take the list, call it with the right subtree, then prepend that list with the value of that Bin node, and finally call it with the left subtree, so:
listTree' :: Tree a -> [a]
listTree' t = foldTree f id t []
where f x y z ls = x (y: z ls)
Here ls is thus the list we need to process, z is a function to prepend the items of the right subtree to ls, y is the value stored in that node, and x is a function that prepends the items of the left subtree to the list.
We can define f, as #chi says as f x y z = x . (y:) . z. We thus first apply the function generated for the right subtree, then prepend the list with y, and then run it through the function of the left subtree.
I am currently doing an assigment for a class in which I have to implement a function which checks if an element is in a tree.
It is supposed to return Nothing when the element is not in the tree and Just (depth at which it was found) when it is.
An example:
sample1
##1
#3 2
###7 5 6 4
- contains 6 sample1 returns Just 2
- contains 1 sample1 returns Just 0
- contains 2 sample1 returns Just 1
- contains 8 sample1 returns Nothing
Here is what we are given:
Heap functional data structure:
module Fdata.Heap where
-- A signature for min-heaps
data Heap e t = Heap {
empty :: t e,
insert :: e -> t e -> t e,
findMin :: t e -> Maybe e,
deleteMin :: t e -> Maybe (t e),
merge :: t e -> t e -> t e,
contains :: e -> t e -> Maybe Int
}
An implementation of self-adjusting heaps:
import Fdata.Heap
import Fdata.Tree
-- An implementation of self-adjusting heaps
heap :: (Eq e, Ord e) => Heap e Tree
heap = Heap {
empty = Empty,
insert = \x t -> merge' (Node x Empty Empty) t,
findMin = \t -> case t of
Empty -> Nothing
(Node x _ _) -> Just x,
deleteMin = \t -> case t of
Empty -> Nothing
(Node _ l r) -> Just (merge' r l),
merge = \l r -> case (l, r) of
(Empty, t) -> t
(t, Empty) -> t
(t1#(Node x1 l1 r1), t2#(Node x2 l2 r2)) ->
if x1 <= x2
then Node x1 (merge' t2 r1) l1
else Node x2 (merge' t1 r2) l2,
contains = \x t -> case (x,t) of
(x,Empty)-> Nothing
(x,tx#(Node x1 l1 r1) ->
|x==x1 = Just 0
|x>x1 = (1+ (contains x l)
|x<x1 = (1+ (contains x r)
}
where
merge' = merge heap
The tree implementation
module Fdata.Tree where
import Fdata.Heap
data Tree x
= Empty
| Node x (Tree x) (Tree x)
deriving (Eq, Show)
leaf x = Node x Empty Empty
-- Convert a list to a heap
list2heap :: Heap x t -> [x] -> t x
list2heap i = foldl f z
where
f = flip $ insert i
z = empty i
-- Convert a heap to a list
heap2list :: Heap x t -> t x -> [x]
heap2list i t
= case (findMin i t, deleteMin i t) of
(Nothing, Nothing) -> []
(Just x, Just t') -> x : heap2list i t'
I am supposed to implement the contains function in the implementation for self-adjusting heaps.
I am not allowed to use any helper functions and I am supposed to use the maybe function.
My current implementation:
contains = \x t -> case (x,t) of
(x,Empty) -> Nothing
(x,tx#(Node x1 l1 r1))
|x==x1 -> Just 0
|x>x1 -> (1+ (contains x l1)
|x<x1 -> (1+ (contains x r1)
This does not work, since I get a parse error on input |.
I really dont know how to fix this since I did use 4 spaces instead of tabs and according to this: https://wiki.haskell.org/Case
the syntax is correct...
I once managed to fix this, but I got a type error about (1+ (contains x l), so this probably is not correct.
Any hint would be appreciated.
EDIT:
Thanks to everyone who answered!
Really appreciate that everyone took the time to explain their answers in great detail.
First of all:
there were some smaller mistakes, as pointed out by some of you in the comments:
I missed one closing parenthesis and accidentially named one argument l1 and another r1 and afterwards used r and l.
Fixed both mistakes.
Someone wrote that I do not need to use a lambda function. The problem is when I use something like:
contains _ Empty = Nothing
I get the error:
parse Error on input '_'.
However, lambda functions do not give me any errors about the input arguments.
Currently the only function that works without any errors is:
contains = \e t -> case (e,t) of
(_,Empty) -> Nothing
(e , Node x t1 t2) ->
if e == (head (heap2list heap (Node x t1 t2)))
then Just 0
else if (fmap (+1) (contains heap e t1))== Nothing
then (fmap (+1) (contains heap e t2))
else (fmap (+1) (contains heap e t1))
Found at:
Counting/Getting "Level" of a hierarchical data
Found by:Krom
One way of structuring contains :: Eq a => a -> Tree a -> Maybe Integer is to first label each element in your tree with its depth, using something like this, then fold the tree to find the element you're looking for, pulling its depth out with it. You can do this without very much code!
Jumping right in where this answer left off, here's contains.
contains :: Eq a => a -> Tree a -> Maybe Integer
contains x = fmap fst . find ((== x) . snd) . labelDepths
That's the whole function! This is classic functional programming style: rather than hand-crank a bespoke recursive tree traversal function I've structured the code as a pipeline of reusable operations. In Haskell pipelines are constructed using the composition operator (.) and are read from left to right. The result of labelDepths is passed to find ((== x) . snd), whose result is then passed to fmap fst.
labelDepths :: Tree a -> Tree (Integer, a), which I've explained in detail in the answer I linked above, attaches an Integer depth to each element of the input tree.
find :: Foldable t => (a -> Bool) -> t a -> Maybe a is a standard function which extracts the first element of a container (like a tree, or a list) that satisfies a predicate. In this instance, the Foldable structure in question is a Tree, so t ~ Tree and find :: (a -> Bool) -> Tree a -> Maybe a. The predicate I've given to find is ((== x) . snd), which returns True if the second element of its input tuple equals x: find ((== x) . snd) :: Tree (Integer, a) -> Maybe (Integer, a). find works by folding the input structure - testing its elements one at a time until it finds one that matches the predicate. The order in which elements are processed is defined by the container's Foldable instance, of which more below.
fmap :: Functor f => (a -> b) -> f a -> f b is another standard function. It applies a mapping function uniformly to each element of a container, transforming its elements from type a to type b. This time the container in question is the return value of find, which is a Maybe, so fmap :: (a -> b) -> Maybe a -> Maybe b. The mapping function I've supplied is fst, which extracts the first element of a tuple: fmap fst :: Maybe (Integer, a) -> Maybe Integer.
So putting it all together, you can see that this is a fairly direct implementation of my English description of the process above. First we label every element in the tree with its depth, then we find an element which matches the item we're looking for, then we extract the depth with which the element was previously labelled.
I mentioned above that Tree is a Foldable container. In fact, this isn't the case quite yet - there's no instance of Foldable for Tree. The easiest way to get a Foldable instance for Tree is to turn on the DeriveFoldable GHC extension and utter the magic words deriving Foldable.
{-# LANGUAGE DeriveFoldable #-}
data Tree x = Empty | Node x (Tree x) (Tree x) deriving Foldable
This automatically-implemented instance of Foldable will perform a preorder traversal, processing the tree in a top-down fashion. (x is considered to be "to the left of" l and r in the expression Node x l r.) You can adjust the derived traversal order by adjusting the layout of the Node constructor.
That said, I'm guessing that this is an assignment and you're not allowed to modify the definition of Tree or apply any language extensions. So you'll need to hand-write your own instance of Foldable, following the template at the bottom of this post. Here's an implementation of foldr which performs a preorder traversal.
instance Foldable Tree where
foldr f z Empty = z
foldr f z (Node x l r) = f x (foldr f (foldr f z r) l)
The Node case is the interesting one. We fold the tree from right to left (since this is a foldr) and from bottom to top. First we fold the right subtree, placing z at the rightmost leaf. Then we use the aggregated result of the right subtree as the seed for folding the left subtree. Finally we use the result of folding all of the Node's children as the aggregator to apply to f x.
Hopefully you didn't find this answer too advanced! (Happy to answer any questions you have.) While the other answers do a good job of showcasing how to write recursive tree traversal functions, I really wanted to give you a glimpse of the real power of functional programming. When you think at a higher level - breaking down a problem into its component parts, structuring operations as pipelines, and learning to spot common patterns like zipping, folding and mapping - you can be very productive and solve problems with very little code.
An instance of Foldable for a binary tree
To instantiate Foldable you need to provide a definition for at least foldMap or foldr.
data Tree a = Leaf
| Node (Tree a) a (Tree a)
instance Foldable Tree where
foldMap f Leaf = mempty
foldMap f (Node l x r) = foldMap f l `mappend` f x `mappend` foldMap f r
foldr f acc Leaf = acc
foldr f acc (Node l x r) = foldr f (f x (foldr f acc r)) l
This implementation performs an in-order traversal of the tree.
ghci> let myTree = Node (Node Leaf 'a' Leaf) 'b' (Node Leaf 'c' Leaf)
-- +--'b'--+
-- | |
-- +-'a'-+ +-'c'-+
-- | | | |
-- * * * *
ghci> toList myTree
"abc"
The DeriveFoldable extension allows GHC to generate Foldable instances based on the structure of the type. We can vary the order of the machine-written traversal by adjusting the layout of the Node constructor.
data Inorder a = ILeaf
| INode (Inorder a) a (Inorder a) -- as before
deriving Foldable
data Preorder a = PrLeaf
| PrNode a (Preorder a) (Preorder a)
deriving Foldable
data Postorder a = PoLeaf
| PoNode (Postorder a) (Postorder a) a
deriving Foldable
-- injections from the earlier Tree type
inorder :: Tree a -> Inorder a
inorder Leaf = ILeaf
inorder (Node l x r) = INode (inorder l) x (inorder r)
preorder :: Tree a -> Preorder a
preorder Leaf = PrLeaf
preorder (Node l x r) = PrNode x (preorder l) (preorder r)
postorder :: Tree a -> Postorder a
postorder Leaf = PoLeaf
postorder (Node l x r) = PoNode (postorder l) (postorder r) x
ghci> toList (inorder myTree)
"abc"
ghci> toList (preorder myTree)
"bac"
ghci> toList (postorder myTree)
"acb"
This function doesn't need to be a lambda:
contains x t =
Adding x to the case serves no purpose, since you only match it back to x. You can instead use pattern matching in the function head:
contains _ Empty = Nothing
The Node case has three sub-cases, where the value being searched for is less-than, greater-than, or equal to the value in the Node. If you order them that way, you get a symmetry from the less-than and greater-than tests, and can handle the equal case with an otherwise.
When recusring, you are going to get a Maybe Int, to which you want to add one. You can't do that directly because the Int is inside the Maybe. Normally, you would lift the addition, but I suspect that this is where the required call to maybe should go (however unnatural it may seem):
contains x (Node x' l r) | x < x' = maybe Nothing (Just . (+1)) $ contains x l
| x > x' = maybe Nothing (Just . (+1)) $ contains x r
| otherwise = Just 0
Instead of using maybe, the (+1) could have been lifted into the Maybe with fmap (or <$>):
... = fmap (+1) $ contains ...
Using maybe is unnatural because it has to explicitly pass the Nothing, and also re-wrap the Just.
This does not work, since I get a parse error on input |
Your previous line misses a closing parenthesis.
I got a Typ error about (1+ (contains x l)), so this probably is not correct.
The idea is totally correct, the issue is that contains x l returns a Maybe Int instead of an Int so you cannot directly add to that. You can only add to the result when it's a Just. There's a helper function that does exactly that, do something to Justs and keep Nothings: fmap (from Functor).
contains = \x t -> case (x,t) of
(x,Empty)-> Nothing
(x,tx#(Node x1 l1 r1))
|x==x1 -> Just 0
|x>x1 -> fmap (1+) (contains x l)
|x<x1 -> fmap (1+) (contains x r)
Btw, I'd write this as
contains x Empty = Nothing
contains x (Node v l r) = if x == v
then Just 0
else fmap (+1) $ contains x $ if x > v then l else r
I ended up figuring it out. See the video and slides of a talk I gave:
slides/pdf
video
Original question:
In my effort to understand generic recursion schemes (i.e., that use Fix) I have found it useful to write list-only versions of the various schemes. It makes it much easier to understand the actual schemes (without the additional overhead of the Fix stuff).
However, I have not yet figured out how to define list-only versions of zygo and futu.
Here are my specialised definitions so far:
cataL :: (a -> b -> b) -> b -> [a] -> b
cataL f b (a : as) = f a (cataL f b as)
cataL _ b [] = b
paraL :: (a -> [a] -> b -> b) -> b -> [a] -> b
paraL f b (a : as) = f a as (paraL f b as)
paraL _ b [] = b
-- TODO: histo
-- DONE: zygo (see below)
anaL :: (b -> (a, b)) -> b -> [a]
anaL f b = let (a, b') = f b in a : anaL f b'
anaL' :: (b -> Maybe (a, b)) -> b -> [a]
anaL' f b = case f b of
Just (a, b') -> a : anaL' f b'
Nothing -> []
apoL :: ([b] -> Maybe (a, Either [b] [a])) -> [b] -> [a]
apoL f b = case f b of
Nothing -> []
Just (x, Left c) -> x : apoL f c
Just (x, Right e) -> x : e
-- DONE: futu (see below)
hyloL :: (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
hyloL f z g = cataL f z . anaL' g
hyloL' :: (a -> c -> c) -> c -> (c -> Maybe (a, c)) -> c
hyloL' f z g = case g z of
Nothing -> z
Just (x,z') -> f x (hyloL' f z' g)
How do you define histo, zygo and futu for lists?
Zygomorphism is the high-falutin' mathsy name we give to folds built from two semi-mutually recursive functions. I'll give an example.
Imagine a function pm :: [Int] -> Int (for plus-minus) which intersperses + and - alternately through a list of numbers, such that pm [v,w,x,y,z] = v - (w + (x - (y + z))). You can write it out using primitive recursion:
lengthEven :: [a] -> Bool
lengthEven = even . length
pm0 [] = 0
pm0 (x:xs) = if lengthEven xs
then x - pm0 xs
else x + pm0 xs
Clearly pm0 is not compositional - you need to inspect the length of the whole list at each position to determine whether you're adding or subtracting. Paramorphism models primitive recursion of this sort, when the folding function needs to traverse the whole subtree at each iteration of the fold. So we can at least rewrite the code to conform to an established pattern.
paraL :: (a -> [a] -> b -> b) -> b -> [a] -> b
paraL f z [] = z
paraL f z (x:xs) = f x xs (paraL f z xs)
pm1 = paraL (\x xs acc -> if lengthEven xs then x - acc else x + acc) 0
But this is inefficient. lengthEven traverses the whole list at each iteration of the paramorphism resulting in an O(n2) algorithm.
We can make progress by noting that both lengthEven and para can be expressed as a catamorphism with foldr...
cataL = foldr
lengthEven' = cataL (\_ p -> not p) True
paraL' f z = snd . cataL (\x (xs, acc) -> (x:xs, f x xs acc)) ([], z)
... which suggests that we may be able to fuse the two operations into a single pass over the list.
pm2 = snd . cataL (\x (isEven, total) -> (not isEven, if isEven
then x - total
else x + total)) (True, 0)
We had a fold which depended on the result of another fold, and we were able to fuse them into one traversal of the list. Zygomorphism captures exactly this pattern.
zygoL :: (a -> b -> b) -> -- a folding function
(a -> b -> c -> c) -> -- a folding function which depends on the result of the other fold
b -> c -> -- zeroes for the two folds
[a] -> c
zygoL f g z e = snd . cataL (\x (p, q) -> (f x p, g x p q)) (z, e)
On each iteration of the fold, f sees its answer from the last iteration as in a catamorphism, but g gets to see both functions' answers. g entangles itself with f.
We'll write pm as a zygomorphism by using the first folding function to count whether the list is even or odd in length and the second one to calculate the total.
pm3 = zygoL (\_ p -> not p) (\x isEven total -> if isEven
then x - total
else x + total) True 0
This is classic functional programming style. We have a higher order function doing the heavy lifting of consuming the list; all we had to do was plug in the logic to aggregate results. The construction evidently terminates (you need only prove termination for foldr), and it's more efficient than the original hand-written version to boot.
Aside: #AlexR points out in the comments that zygomorphism has a big sister called mutumorphism, which captures mutual recursion in all
its glory. mutu generalises zygo in that both the folding
functions are allowed to inspect the other's result from the previous
iteration.
mutuL :: (a -> b -> c -> b) ->
(a -> b -> c -> c) ->
b -> c ->
[a] -> c
mutuL f g z e = snd . cataL (\x (p, q) -> (f x p q, g x p q)) (z, e)
You recover zygo from mutu simply by ignoring the extra argument.
zygoL f = mutuL (\x p q -> f x p)
Of course, all of these folding patterns generalise from lists to the fixed point of an arbitrary functor:
newtype Fix f = Fix { unFix :: f (Fix f) }
cata :: Functor f => (f a -> a) -> Fix f -> a
cata f = f . fmap (cata f) . unFix
para :: Functor f => (f (Fix f, a) -> a) -> Fix f -> a
para f = snd . cata (\x -> (Fix $ fmap fst x, f x))
zygo :: Functor f => (f b -> b) -> (f (b, a) -> a) -> Fix f -> a
zygo f g = snd . cata (\x -> (f $ fmap fst x, g x))
mutu :: Functor f => (f (b, a) -> b) -> (f (b, a) -> a) -> Fix f -> a
mutu f g = snd . cata (\x -> (f x, g x))
Compare the definition of zygo with that of zygoL. Also note that zygo Fix = para, and that the latter three folds can be implemented in terms of cata. In foldology everything is related to everything else.
You can recover the list version from the generalised version.
data ListF a r = Nil_ | Cons_ a r deriving Functor
type List a = Fix (ListF a)
zygoL' :: (a -> b -> b) -> (a -> b -> c -> c) -> b -> c -> List a -> c
zygoL' f g z e = zygo k l
where k Nil_ = z
k (Cons_ x y) = f x y
l Nil_ = e
l (Cons_ x (y, z)) = g x y z
pm4 = zygoL' (\_ p -> not p) (\x isEven total -> if isEven
then x - total
else x + total) True 0
Histomorphism models dynamic programming, the technique of tabulating the results of previous subcomputations. (It's sometimes called course-of-value induction.) In a histomorphism, the folding function has access to a table of the results of earlier iterations of the fold. Compare this with the catamorphism, where the folding function can only see the result of the last iteration. The histomorphism has the benefit of hindsight - you can see all of history.
Here's the idea. As we consume the input list, the folding algebra will output a sequence of bs. histo will jot down each b as it emerges, attaching it to the table of results. The number of items in the history is equal to the number of list layers you've processed - by the time you've torn down the whole list, the history of your operation will have a length equal to that of the list.
This is what the history of iterating a list(ory) looks like:
data History a b = Ancient b | Age a b (History a b)
History is a list of pairs of things and results, with an extra result at the end corresponding to the []-thing. We'll pair up each layer of the input list with its corresponding result.
cataL = foldr
history :: (a -> History a b -> b) -> b -> [a] -> History a b
history f z = cataL (\x h -> Age x (f x h) h) (Ancient z)
Once you've folded up the whole list from right to left, your final result will be at the top of the stack.
headH :: History a b -> b
headH (Ancient x) = x
headH (Age _ x _) = x
histoL :: (a -> History a b -> b) -> b -> [a] -> b
histoL f z = headH . history f z
(It happens that History a is a comonad, but headH (née extract) is all we need to define histoL.)
History labels each layer of the input list with its corresponding result. The cofree comonad captures the pattern of labelling each layer of an arbitrary structure.
data Cofree f a = Cofree { headC :: a, tailC :: f (Cofree f a) }
(I came up with History by plugging ListF into Cofree and simplifying.)
Compare this with the free monad,
data Free f a = Free (f (Free f a))
| Return a
Free is a coproduct type; Cofree is a product type. Free layers up a lasagne of fs, with values a at the bottom of the lasagne. Cofree layers up the lasagne with values a at each layer. Free monads are generalised externally-labelled trees; cofree comonads are generalised internally-labelled trees.
With Cofree in hand, we can generalise from lists to the fixpoint of an arbitrary functor,
newtype Fix f = Fix { unFix :: f (Fix f) }
cata :: Functor f => (f b -> b) -> Fix f -> b
cata f = f . fmap (cata f) . unFix
histo :: Functor f => (f (Cofree f b) -> b) -> Fix f -> b
histo f = headC . cata (\x -> Cofree (f x) x)
and once more recover the list version.
data ListF a r = Nil_ | Cons_ a r deriving Functor
type List a = Fix (ListF a)
type History' a b = Cofree (ListF a) b
histoL' :: (a -> History' a b -> b) -> b -> List a -> b
histoL' f z = histo g
where g Nil_ = z
g (Cons_ x h) = f x h
Aside: histo is the dual of futu. Look at their types.
histo :: Functor f => (f (Cofree f a) -> a) -> (Fix f -> a)
futu :: Functor f => (a -> f (Free f a)) -> (a -> Fix f)
futu is histo with the arrows flipped and with Free replaced by
Cofree. Histomorphisms see the past; futumorphisms predict the future.
And much like cata f . ana g can be fused into a hylomorphism,
histo f . futu g can be fused into a
chronomorphism.
Even if you skip the mathsy parts, this paper by Hinze and Wu features a good, example-driven tutorial on histomorphisms and their usage.
Since no one else has answered for futu yet, I'll try to stumble my way through. I'm going to use ListF a b = Base [a] = ConsF a b | NilF
Taking the type in recursion-schemes: futu :: Unfoldable t => (a -> Base t (Free (Base t) a)) -> a -> t.
I'm going to ignore the Unfoldable constraint and substitute [b] in for t.
(a -> Base [b] (Free (Base [b]) a)) -> a -> [b]
(a -> ListF b (Free (ListF b) a)) -> a -> [b]
Free (ListF b) a) is a list, possibly with an a-typed hole at the end. This means that it's isomorphic to ([b], Maybe a). So now we have:
(a -> ListF b ([b], Maybe a)) -> a -> [b]
Eliminating the last ListF, noticing that ListF a b is isomorphic to Maybe (a, b):
(a -> Maybe (b, ([b], Maybe a))) -> a -> [b]
Now, I'm pretty sure that playing type-tetris leads to the only sensible implementation:
futuL f x = case f x of
Nothing -> []
Just (y, (ys, mz)) -> y : (ys ++ fz)
where fz = case mz of
Nothing -> []
Just z -> futuL f z
Summarizing the resulting function, futuL takes a seed value and a function which may produce at least one result, and possibly a new seed value if it produced a result.
At first I thought this was equivalent to
notFutuL :: (a -> ([b], Maybe a)) -> a -> [b]
notFutuL f x = case f x of
(ys, mx) -> ys ++ case mx of
Nothing -> []
Just x' -> notFutuL f x'
And in practice, perhaps it is, more or less, but the one significant difference is that the real futu guarantees productivity (i.e. if f always returns, you will never be stuck waiting forever for the next list element).
John Hughes, in his famous article entitled Why Functional Programming Matters, describes data types for lists and ordered labelled trees,
listof * ::= Nil | Cons * (listof *)
treeof * ::= Node * (listof (treeof *))
and a function called foldtree,
foldtree f g a (Node label subtrees) =
f label (foldtree f g a subtrees)
foldtree f g a (Cons subtree rest) =
g (foldtree f g a subtree) (foldtree f g a rest)
foldtree f g a Nil = a
I've implemented those two data types in Haskell and I'm currently trying to implement foldtree,
data Listof a = Nil | Cons a (Listof a)
deriving (Read, Show, Eq)
-- implementation of some list functions... (skipped)
data Treeof a = Node a (Listof (Treeof a))
deriving (Read, Show, Eq)
foldtree f g a (Node label subtrees) = f label (foldtree f g a subtrees)
foldtree f g a (Cons subtree rest) = g (foldtree f g a subtree) (foldtree f g a rest)
foldtree f g a Nil = a
but I'm getting type mismatches:
Couldn't match expected type ‘Treeof t’
with actual type ‘Listof (Treeof t)’
Relevant bindings include
subtrees :: Listof (Treeof t) (bound at whyFunMatters.hs:27:28)
label :: t (bound at whyFunMatters.hs:27:22)
f :: t -> t1 -> t1 (bound at whyFunMatters.hs:27:10)
foldtree :: (t -> t1 -> t1)
-> (t1 -> t1 -> t1) -> t1 -> Treeof t -> t1
(bound at whyFunMatters.hs:27:1)
In the fourth argument of ‘foldtree’, namely ‘subtrees’
In the second argument of ‘f’, namely ‘(foldtree f g a subtrees)’
(etc.)
After thinking some more about Hughes (pseudo)implementation of foldtree, I'm not so sure I understand it, and those type mismatches now seem obvious to me. More specifically, the type of foldtree's fourth argument doesn't seem consistent across the three patterns:
in the first pattern, that argument has type Treeof a, whereas
in the last two patterns, it has type Listof (Treeof a).
What am I missing?
A proper definition should consist of a pair of mutually recursive functions, one for folding trees and one for folding forests (lists of trees):
foldtree :: (a -> c -> b) -> (b -> c -> c) -> c -> Treeof a -> b
foldtree f g a (Node label subtrees) = f label (foldforest f g a subtrees)
foldforest :: (a -> c -> b) -> (b -> c -> c) -> c -> Listof (Treeof a) -> c
foldforest f g a (Cons subtree rest) = g (foldtree f g a subtree) (foldforest f g a rest)
foldforest f g a Nil = a
I think the author has mistakenly combined two different (but closely related) functions together. I suspect what the author wrote is not really Haskell but more of a Haskell-like pseudocode, so the code was just used to present the algorithm in an informal way.
Note that the paper seems to suggest it's Miranda, a predecessor of Haskell, but I can't confirm if this is legal Miranda code either.
Searching on Google I found the link https://gist.github.com/vu3rdd/14f10df24fbeffda09ae where the author informs that the document has been updated and is available at http://www.cse.chalmers.se/~rjmh/Papers/whyfp.pdf.
Author John Hughes even apologizes for the examples not being on haskell!
This paper dates from 1984, and circulated as a Chalmers memo for many
years. Slightly revised versions appeared in 1989 and 1990 as [Hug90]
and [Hug89]. This version is based on the original Chalmers memo nroff
source, lightly edited for LaTeX and to bring it closer to the
published versions, and with one or two errors corrected. Please
excuse the slightly oldfashioned type-setting, and the fact that the
examples are not in Haskell!
Below the corrections presented by the author...
redtree f g a (node label subtrees) =
f label (redtree’ f g a subtrees)
redtree’ f g a (cons subtree rest) =
g (redtree f g a subtree) (redtree’ f g a rest)
redtree’ f g a nil = a
Rufflewind's answer is the most obvious way to fix the questionable definition of foldtree from Hughes' famous paper. Yet there is a much more concise and modular solution requiring only one line of code and reusing foldr. Scroll to the bottom of this post to see this definition. Keep on reading for some kind of derivation of the definition.
Compare Rufflewind's definition of foldforest:
foldforest f g a (Cons subtree rest) = g (foldtree f g a subtree) (foldforest f g a rest)
foldforest f g a Nil = a
...with Hughes' (slightly changed) definition of foldr from the paper:
foldr f a (Cons e rest) = f e (foldr f a rest)
foldr f a Nil = a
Don't they both look awfully similar? In fact the only difference is that in foldforest we apply foldtree f g a to subtree and (through recursion) to all the other elements in the list of subtrees before "merging" them with g. Can we define an operator that does this and can be passed to foldr?
Let's take a closer look at the core of foldforest where the actual work is done: g (foldtree f g a subtree). Using function composition (defined in Hughes' paper as (f . g) h = f (g h)) we can express this part differently:
foldforest f g a (Cons subtree rest) = (g . foldtree f g a) subtree (foldforest f g a rest)
Now let's define h = (g . foldtree f g a) for brevity and pass a concrete list of subtrees to foldforest unfolding the recursion using our new notation:
foldforest f g a (Cons subtree1 (Cons subtree2 Nil))
= h subtree1 (h subtree2 a)
What does it look like to unfold the recursion of a similar call to foldr?
foldr f a (Cons subtree1 (Cons subtree2 Nil))
= f subtree1 (f subtree2 a)
It is now obvious that we were able to extract an operator from foldforest which we can pass to foldr along with a starting state a and a list of Treeofs. The complete definition of foldtree, maximizing modularity and conciseness, should therefor be:
foldtree f g a (Node label subtrees) = f label (foldr (g . foldtree f g a) a subtrees)