Using Haskell, I'm writing a function that counts the total number of leaves in a tree. I have defined the tree as so:
data Tree a = Leaf | Node a (Tree a) (Tree a)
I writing a function that does this by:
countL :: Tree a -> Int
countL Leaf = 1
countL (Node x tL tR) = (countL tL) + (countL tR)
This works but I want to take it a step further by doing the same thing using the fold function. I've having a working fold function for trees that I defined by doing:
mytFold :: (a -> b -> b -> b) -> b -> Tree a -> b
mytFold f g Leaf = g
mytFold f g (Node a xl xr) = f a (mytFold f g xl) (mytFold f g xr)
I tried to include the fold function (also used a helper function that I defined by doing this:
countL' :: Tree a -> Integer
countL' Leaf = 1
countL' = mytFold leafy 0 where
leafy tL tR = tL + tR
But I'm getting some weird errors. Does anyone have any insight on what's wrong?
There are two syntactic/type problems. Firstly, every top level binding must have the same number of arguments, so
countL' Leaf = ..
countL' = ..
isn't valid. One solution is
countL' Leaf = ..
countL' tree = mytFold leafy 0 tree
Once you've done this, then GHC gives you an error like
Couldn't match expected type `Integer -> Integer'
with actual type `Integer'
Expected type: Integer -> Integer -> Integer -> Integer
Actual type: Integer -> Integer -> Integer
In the first argument of `mytFold', namely `leafy'
In the expression: mytFold leafy 0 tree
Which is because mytFold requires a 3-argument function as its first argument, and leafy just takes 2. Fix this by using leafy _ tL tR = tL + tR.
However, once you have done this, you will see that this gives the wrong answer: countL' (Node 1 Leaf Leaf) == 0. A way that might make the solution clear is to removing the countL' Leaf case, and trying to write countL as just the fold. i.e.
countL'' = mytFold f a
where you have do decide what f and a are (hint: you already have f == leafy == const (+)). Consider mytFold leafy a Leaf.
Related
I really like the repmin problem:
Write down repmin :: Tree Int -> Tree Int, which replaces all the numbers in the tree by their minimum in a single pass.
If I were writing something like this in python, I would go for passing values by their reference (let's say one-element lists instead of numbers is good enough):
def repmin(tree, wrapped_min_link=None):
x, subforest = tree
if wrapped_min_link is None:
wrapped_min_link = [x]
else:
[m] = wrapped_min_link
wrapped_min_link = [min(m, x)]
n = len(subforest)
subforest_min = [None] * n
for i in range(n):
if subforest[i]:
subforest_min[i] = repmin(subforest[i], wrapped_min_link)
return (wrapped_min_link, subforest_min)
It seems to me like a fitting way to wrap one's head around the knot-tying solution in Haskell (I wrote this one for rose trees from Data.Tree):
copyRose :: Tree Int -> Int -> (Tree Int, Int)
copyRose (Node x []) m = (Node m [], x)
copyRose (Node x fo) m =
let
unzipIdMinimum =
foldr (\ ~(a, b) ~(as, bmin) -> (a:as, b `min` bmin)) ([], maxBound :: Int)
(fo', y) = unzipIdMinimum . map (flip copyRose m) $ fo
in (Node m fo', x `min` y)
repmin :: Tree Int -> Tree Int
repmin = (loop . uncurry) copyRose
Yet, I reckon the solutions to work very differently. Here is my understanding of the latter one:
Let us rewrite loop for (->) a bit:
loop f b = let cd = f (b, snd cd) in fst cd
I reckon it to be loop for (->)'s workalike as snd gives the same degree of laziness as pattern-matching within let.
So, when repmin traverses through the tree, it is:
Building up the minimum in the tree to be returned as the second element of the pair.
Leaves snd $ copyRose (tree, m) behind in every node.
Thus, when the traversal comes to an end, the programme knows the value of snd $ copyRose (tree, m) (that is, the minimum in the tree) and is able to show it whenever some node of the tree is being computed.
Do I understand repmin in Haskell correctly?
This is more an extended comment than an answer, but I don't really think of your implementation as single-pass. It looks like it traverses the tree once, producing a new, lazily-generated, tree and the global minimum, but it actually produces a lazily generated tree and an enormous tree of thunks that will eventually calculate the minimum. To avoid this, you can get closer to the Python code by generating the tree eagerly, keeping track of the minimum as you go.
You'll note that I've generalized the type from Int to an arbitrary Ord type. You'll also note that I've used to different type variables to refer to the type of elements in the given tree and the type of the minimum passed in to generate a new tree—this lets the type system tell me if I mix them up.
repmin :: Tree a -> Tree a
repmin = (loop . uncurry) copyRose
copyRose :: Ord a => Tree a -> b -> (Tree b, a)
copyRose (Node x ts) final_min
| (ts', m) <- copyForest x ts final_min
= (Node final_min ts', m)
copyForest :: Ord a => a -> [Tree a] -> b -> ([Tree b], a)
copyForest !m [] _final_min = ([], m)
copyForest !m (t : ts) final_min
| (t', m') <- copyTree m t final_min
, (ts', m'') <- copyForest m' ts final_min
= (t' : ts', m'')
copyTree :: Ord a => a -> Tree a -> b -> (Tree b, a)
copyTree !m (Node x ts) final_min
| (ts', m') <- copyForest (min m x) ts final_min
= (Node final_min ts', m')
Exercise: rewrite this in monadic style using ReaderT to pass the global minimum and State to keep track of the minimum so far.
Given a tree that looks like this:
data Tree a = Leaf | Node (Tree a) a (Tree a)
And a fold function that looks like this:
foldTree :: (b -> a -> b -> b) -> b -> Tree a -> b
foldTree _ b Leaf = b
foldTree fn b (Node lt x rt) = f (foldTree fn b lt) x (foldTree fn b rt)
I want to be able to write a takeWhileTree function that looks like this:
treeTakeWhile :: (a -> Bool) -> Tree a -> Tree a
I want it to mimic the 'normal' list takeWhile function so that it returns the largest possible tree whose elements satisfy the given condition.
So, if a tree t = Node (Node Leaf 10 Leaf) 4 (Node Leaf 5 Leaf), then:
treeTakeWhile (> 5) T = Leaf
treeTakeWhile (>= 4) T = T
treeTakeWhile (< 5) T = Node Leaf 4 Leaf
treeTakeWHile (< 8) T = Node Leaf 4 (Node Leaf 5 Leaf)
So far I seem to not be able to formulate what to pass into foldTree.
In the definition of foldtree, the function can be broken down as: b probably being the left subtree, a probably being the value in the current node and b probably being the right subtree.
Therefore, the function passed to treeTakeWhile has to be applied to all these parts of the node in some manner while being able to stop when the operation no longer applies.
treeTakeWhile fn = foldTree (\xs x ys -> if y then g else Leaf) Node()
where g = (lt, x, rt)
y = fn (Node lt x rt)
The above is clearly wrong but I am not sure how to express the act of applying the function to the current node's value followed by the left tree and the right tree here. Could somebody point me in the right direction? And how will the fold be able to produce the required tree?
Edit 1:
Okay, based on your feedback, I have gotten to a place where I think I am pretty close to the answer but cannot figure out why the compiler still complains:
treeTakeWhile :: (a -> Bool) -> Tree a -> Tree a
treeTakeWhile c = foldTree f acc
where acc = Leaf
f l x r = if c x then Node (f lt) x (f rt) else Leaf
As far as I can tell, foldTree is being passed the right arguments now. And the predicate is also being evaluated as required at each level of the tree. The return value is always of type Tree as well.
Instead of using foldTree immediately, let's first aim to define the function itself.
Basically there are three options here:
the tree is a Leaf, regardless what the condition is, the result is a Leaf as well;
the tree is a Node and the condition is satsified, then we yield the element, and recurse on the subtrees;
the tree is a Node and the condition is not satisfied, then the result is a Leaf.
We can encode these rules as:
treeTakeWhile :: (a -> Bool) -> Tree a -> Tree a
treeTakeWhile c = go
where go Leaf = Leaf -- (1)
go (Node l x r) | c x = Node (go l) x (go r) -- (2)
| otherwise = Leaf -- (3)
this then yields the expected results:
Prelude> treeTakeWhile (>5) t
Leaf
Prelude> treeTakeWhile (>=4) t
Node (Node Leaf 10 Leaf) 4 (Node Leaf 5 Leaf)
Prelude> treeTakeWhile (<5) t
Node Leaf 4 Leaf
Prelude> treeTakeWhile (<8) t
Node Leaf 4 (Node Leaf 5 Leaf)
Moving this to a foldTree
Now we aim to move the logic to a foldTree, we can thus write the function as:
treeTakeWhile :: (a -> Bool) -> Tree a -> Tree a
treeTakeWhile c = foldTree f x0
where f tl x tr = -- ...
x0 = -- ...
The x0 is the value we should fill in for Leafs, but we already know what that is: it is the first rule (1) and we should thus return a Leaf as well.
For f we need a function Tree a -> a -> Tree a -> Tree a. The first operand tl is the treeTakeWhile of the left subtree (this would be equivalent to go l in the original function implementation), the second parameter x is the value encoded in the Node, and the last parameter tr is the result of treeTakeWhile on the second subtree (so equivalent to go r), so:
treeTakeWhile :: (a -> Bool) -> Tree a -> Tree a
treeTakeWhile c = foldTree f x0
where f tl x tr = -- ...
x0 = -- ...
(leave this as an exercise).
I got the task of getting all leafs from a binary tree of this datatype:
data Bintree el = Empty |
Tree {left :: Bintree el, node :: el, right :: Bintree el} deriving Show
Now I have this Treefold function which works perfectly in tests:
binTreeFold :: (a -> b -> a -> a) -> a -> Bintree b -> a
binTreeFold f el Empty = el
binTreeFold f el tree#(Tree leftTree node rightTree) = f (binTreeFold f el leftTree) node (binTreeFold f el rightTree)
And I try to get all leafs but somehow it simply doesnt work (Compile issues mentioned below):
leavesWithFold :: Bintree a -> [a]
leavesWithFold Empty = []
leavesWithFold tree = binTreeFold (\left -> \node -> \right -> if (checkIfTreeIsLeaf node) then left ++ [node] ++ right else left ++ [] ++ right) [] tree
using the following function:
checkIfTreeIsLeaf :: Bintree a -> Bool
checkIfTreeIsLeaf Empty = False
checkIfTreeIsLeaf (Tree Empty node Empty) = True
checkIfTreeIsLeaf _ = False
The compiler tells me
Couldn't match type `a' with `Bintree a0'
But in former functions the use of
left ++ [node] ++ right
Was working perfectly fine. Have you any idea what I did wrong and probably what I could change?
Best Whishes
Well typically the idea of a using a fold function is that it does all the work for you. So by writing a function that branches into an Empty case and a tree case, this is already a bit strange.
A recursive approach
But let us simply start with a recursive approach. Forget about folding, etc. for now. How would we generate a list of leaves in general?
Well there are basically three cases here:
in case we encounter an Empty, then we return the empty list, since Empty is not a leaf, and we are supposed to return all leaves, so:
leaves Empty = []
in case we encounter a Tree with Empty both as left and right subtree, we know that that Tree is a leaf, so we return the element it carries, as a list:
leaves (Tree Empty x Empty) = [x]
in case one of the two subtrees (or both) are not Empty, we recursively would call the leaves function, and concatenate the two together:
leaves (Tree l _ r) = leaves l ++ leaves r
So now in full we got:
leaves :: Bintree a -> [a]
leaves Empty = []
leaves (Tree Empty x Empty) = [x]
leaves (Tree l x r) = leaves l ++ leaves r
How to detect through recursion that this is a leaf
We of course can not do that with the binTreeFold approach. But can't we detect whether a tree is in fact a leaf? In case the two recursive calls both result in an empty list, we know that the current Bintree is in fact a leaf. Indeed: if the left (and right) subtree are Empty, they result in empty lists. And in case these are not empty, then these either are leaves, that will recursively produce a singleton list, or those are not Trees with descendants, that will eventually lead to leaves, and therefore to non-empty lists.
Encoding this in the fold function
So we an first take a look at the recursive calls, and then based on the fact whether these are both empty lists, either return a singleton list with the leaf element, or concatenate the two lists together, like:
f [] x [] = [x]
f l _ r = l ++ r
Or using this in the binTreeFold function:
leavesWithFold :: Bintree a -> [a]
leavesWithFold = binTreeFold f []
where f [] x [] = [x]
f l _ r = l ++ r
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
My tree looks like this, a tree which at each node can or cannot have an integer:
data Tree = Empty | Node (Maybe Integer) Tree Tree deriving Show
I want to sum all the values in the tree, not including Nothing values and if tree is not empty but has only Nothing values, just return Nothing, or empty tree is 0. These cases I understand how to.
I want thinking depth first traversal would be best, or just some basic traversal in general, but struggling on how to implement it elegantly.
treeValues :: Tree -> Maybe Integer
You can make your Tree a Foldable instance, and you get many functions for free, including sum:
sum :: (Foldable t, Num a) => t a -> a Source
The sum function computes the sum of the numbers of a structure.
But you need to make your Tree a parametric type:
data Tree a = Empty | Node (Maybe a) Tree Tree
Also, with GHC 7.10, almost all Prelude functions will use Foldable and Traversable typeclasses instead of lists, and then you can use them freely for your tree, if you implement those typeclasses.
You already know how to sum lists, so you could transform your tree into a list first:
> toList :: Tree -> [Integer]
> toList Empty = []
> toList (Node a l r) = maybeToList a ++ toList l ++ toList r
> where maybeToList (Just x) = [x]
> maybeToList Nothing = []
Now, you want to differ between an empty tree (Empty) and a tree that contains only Nothing. Since toList filters all Nothing values, this boils down to
> sumTree :: Tree -> Maybe Integer
> sumTree Empty = Just 0
> sumTree tree = case toList tree of
> [] -> Nothing -- all values in the tree are Nothing
> xs -> Just $ sum xs -- some were Just x
But wait, there's more!
sumTree isn't that nice yet. What if we want to compute the product of a Tree? Hm. Well, we can take a tree, transform it to a list, and use… a folding function!
> type I = Integer -- otherwise the lines get ridiculously long
>
> foldrTree' :: (I -> I -> I) -> I -> Tree -> Maybe I
> foldrTree' _ init Empty = init
> foldrTree' f init tree = case toList tree of
> [] -> Nothing
> xs -> Just $ foldr f init xs
> -- ^^^^^
Now we can take any (Integer -> Integer -> Integer) and produce a single value, as long as our operation is associative:
> productTree :: Tree -> Maybe Integer
> productTree = foldrTree' (*) 1
>
> sumTree' :: Tree -> Maybe Integer
> sumTree' = foldrTree' (+) 0
Here's a hint:
data Tree a = Empty | Node a (Tree a) (Tree a)
reduce :: (a -> r -> r -> r) -> r -> Tree a -> r
reduce f z = go
where
go Empty = z
go (Node x l r) = f x (go l) (go r)
Regarding the above solutions and comments plus lyah and Brent Yorgeys advice I compiled the following proposal (try as you might like in ghci):
:set -XDeriveFoldable -XDeriveFunctor
:m + Data.Foldable Data.Monoid
data Tree a = Empty | Node (Maybe a) (Tree a) (Tree a) deriving (Show, Functor, Foldable)
let tree :: Tree Integer ; tree = Node Nothing (Node (Just 42) Empty Empty) (Node Nothing Empty Empty)
foldMap Sum tree
It though returns only 0 in both cases only Nothing values given and tree is Empty but I hope it gives a hint later for learners like me.