How to represent tree with sharing in Haskell

Question

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?

Answer 1

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')

Answer 2

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'