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).
Related
Basically, I'm trying to insert elements from the list into the binary tree one by one, or that's what I thought it should be done when inserting list to the tree.
Here is my tree for inserting:
data Tree = EmptyTree | Node Integer Tree Tree deriving (Show, Eq, Ord)
insertElement x EmptyTree = Node x EmptyTree EmptyTree
insertElement x (Node a left right) = if x == a
then (Node x left right)
else if x < a
then (Node a (insertElement x left) right)
else
Node a left (insertElement x right)
and I thought I could use map to get elements from list and insert it into the list.
Something like this: inserter x = map (insertElement x EmptyTree)
where I get list with inserter and insert it into the list.
But, this code is pretty much incorrect I think, and I was wondering how can I do this?
If you would use inserter xs = map (`insertElement` EmptyTree) you will create a list of trees where each item is inserted once.
What you can do is use foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b or foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b to each time pass the accumulator, the thus far build up list, and thus insert the next item, so:
inserter :: Foldable f => f Integer -> Tree
inserter = foldr insertElement EmptyTree
or:
inserter :: Foldable f => f Integer -> Tree
inserter = foldl (flip insertElement) EmptyTree
It might however make more sense to allow to specify the base tree, and thus using inserter to insert a Foldable of items to a Tree that might already contain items, for example:
inserter :: Foldable f => Tree -> f Integer -> Tree
inserter = foldl (flip insertElement)
I have a typical binary search tree data type:
data Tree a
= Empty
| Branch a (Tree a) (Tree a) deriving Show
and a catamorphism
foldt :: b -> (a -> b -> b -> b) -> Tree a -> b
foldt empty _ Empty = empty
foldt empty branch (Branch a l r) = branch a (foldt empty branch l) (foldt empty branch r)
I tried to define an insert function using foldt and got some interesting results:
insert :: (Ord a) => a -> Tree a -> Tree a
insert x = foldt (single x) insertb
where insertb a left right
| x == a = Branch x left right
| x < a = Branch a (insert x left) right
| x > a = Branch a left (insert x right)
ghci> mytree = insert 2 (Branch 3 Empty Empty)
ghci> mytree
Branch 3 (Branch 2 (Branch 2 Empty Empty) (Branch 2 Empty Empty)) (Branch 2 Empty Empty)
ghci>
Of course, a traditional insert method behaves as expected:
insert' :: (Ord a) => a -> Tree a -> Tree a
insert' x Empty = single x
insert' x (Branch a left right)
| x == a = Branch x left right
| x < a = Branch a (insert' x left) right
| x > a = Branch a left (insert' x right)
ghci> mytree2 = insert' 2 (Branch 3 Empty Empty)
ghci> mytree2
Branch 3 (Branch 2 Empty Empty) Empty
ghci>
Is there a way to define insert in terms of foldt, or am I barking up the wrong tree (ha) here?
Let's define a function
insertMaybe :: Ord a => Tree a -> Maybe a -> Tree a
This function takes a tree, and maybe an element. In the Just case, the element is inserted. In the Nothing case, the tree is returned unchanged. So then we can define
insert a t = insertMaybe t (Just a)
Now:
insertMaybe :: Ord a => Tree a -> Maybe a -> Tree a
insertMaybe = foldt leaf branch
where
leaf (Just new) = ?
leaf Nothing = ?
branch a l r Nothing = ?
branch a l r (Just new)
| ... = ?
...
Alternatively:
data Ins a = Ins
{ inserted :: Tree a
, notInserted :: Tree a }
insert a t = inserted (insertAndNot a t)
-- Return the tree with the
-- element inserted, and also unchanged.
insertAndNot :: Ord a => a -> Tree a -> Ins a
insertAndNot new = foldt leaf branch
where
leaf = Ins ? ?
branch a ~(Ins li lni) ~(Ins ri rni)
| ... = Ins ? ?
...
Paramorphism
The above solutions have a major efficiency problem: they completely rebuild the tree structure just to insert an element. As amalloy suggested, we can fix that by replacing foldt (a catamorphism) by parat (a paramorphism). parat gives the branch function access to both the recursively modified and the unmodified subtrees.
parat :: b -> (a -> (Tree a, b) -> (Tree a, b) -> b) -> Tree a -> b
parat leaf _branch Empty = leaf
parat leaf branch (Branch a l r) =
branch a
(l, parat leaf branch l)
(r, parat leaf branch r)
Conveniently, it's also slightly easier to define insert using parat. Can you see how? This ends up being an efficient version of the "alternative" way I suggested for using foldt.
Thanks to dfeuer and amalloy for the tips on paramorphisms, TIL!
Given a paramorphism for the Tree data type:
parat :: b -> (a -> (Tree a, b) -> (Tree a, b) -> b) -> Tree a -> b
parat empty _ Empty = empty
parat empty branch (Branch a l r) =
branch a
(l, parat leaf branch l)
(r, parat leaf branch r)
we can write an insert function as:
insert :: Ord a => a -> Tree a -> Tree a
insert x = parat (single x) branch
where branch a (l, l') (r, r')
| x == a = Branch x l r
| x < a = Branch a l' r
| x > a = Branch a l r'
ghci> mytree = insert 2 (Branch 3 Empty Empty)
ghci> mytree
Branch 3 (Branch 2 Empty Empty) Empty
ghci>
testing a bigger tree...
import Data.Function
mytree :: Tree Integer
mytree = (Branch 3 Empty Empty) & insert 2 & insert 4 & insert 6 & insert 5 & insert 10
inorder :: Tree a -> [a]
inorder = foldt [] (\a l r -> l ++ [a] ++ r)
ghci> mytree
Branch 3 (Branch 2 Empty Empty) (Branch 4 Empty (Branch 6 (Branch 5 Empty Empty) (Branch 10 Empty Empty)))
ghci> inorder mytree
[2,3,4,5,6,10]
ghci>
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
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.
I would like to represent a "tree" of the following shape in Haskell:
/\
/\/\
/\/\/\
/\/\/\/\
` ` ` ` `
/ and \ are the branches and ` the leaves. You can see that starting at any node, following the left path, then the right gets you to the same node as following the right path then the left. You should be able to label the leaves, apply a function of the two decendants at each node, and propagate this information to the root in O(n^2) time. My naive efforts are giving me an exponential run time. Any hints?
It is certainly possible to construct a tree with shared nodes. For example, we could just define:
data Tree a = Leaf a | Node (Tree a) (Tree a)
and then carefully construct a value of this type as in
tree :: Tree Int
tree = Node t1 t2
where
t1 = Node t3 t4
t2 = Node t4 t5
t3 = Leaf 2
t4 = Leaf 3
t5 = Leaf 5
to achieve sharing of subtrees (in this case t4).
However, as this form of sharing is not observable in Haskell, it is very hard to maintain: for example if you traverse a tree to relabel its leaves
relabel :: (a -> b) -> Tree a -> Tree b
relabel f (Leaf x) = Leaf (f x)
relabel f (Node l r) = Node (relabel f l) (relabel f r)
you loose sharing. Also, when doing a bottom-up computation such as
sum :: Num a => Tree a -> a
sum (Leaf n) = n
sum (Node l r) = sum l + sum r
you end up not taking advantage of sharing and possibly duplicate work.
To overcome these problems, you can make sharing explicit (and hence observable) by encoding your trees in a graph-like manner:
type Ptr = Int
data Tree' a = Leaf a | Node Ptr Ptr
data Tree a = Tree {root :: Ptr, env :: Map Ptr (Tree' a)}
The tree from the example above can now be written as
tree :: Tree Int
tree = Tree {root = 0, env = fromList ts}
where
ts = [(0, Node 1 2), (1, Node 3 4), (2, Node 4 5),
(3, Leaf 2), (4, Leaf 3), (5, Leaf 5)]
The price to pay is that functions that traverse these structures are somewhat cumbersome to write, but we can now define for example a relabeling function that preserves sharing
relabel :: (a -> b) -> Tree a -> Tree b
relabel f (Tree root env) = Tree root (fmap g env)
where
g (Leaf x) = Leaf (f x)
g (Node l r) = Node l r
and a sum function that doesn't duplicate work when the tree has shared nodes:
sum :: Num a => Tree a -> a
sum (Tree root env) = fromJust (lookup root env')
where
env' = fmap f env
f (Leaf n) = n
f (Node l r) = fromJust (lookup l env') + fromJust (lookup r env')
Perhaps you can represent it simply as a list of leaves and apply the function level by level until you're down to one value, i.e. something like this:
type Tree a = [a]
propagate :: (a -> a -> a) -> Tree a -> a
propagate f xs =
case zipWith f xs (tail xs) of
[x] -> x
xs' -> propagate f xs'