[Haskell-cafe] Construct all possible trees

Andrew Coppin andrewcoppin at btinternet.com
Thu Jun 14 13:32:58 EDT 2007

Well, I eventually came up with this:


data Tree = Leaf Int | Branch Tree Tree deriving Show

pick :: [x] -> [(x,[x])]
pick = pick_from []

pick_from :: [x] -> [x] -> [(x,[x])]
pick_from ks [] = []
pick_from ks xs = (head xs, ks ++ tail xs) : pick_from (ks ++ [head xs]) 
(tail xs)

trees :: [Int] -> [Tree]
trees = map fst . (\ts -> all_trees 1 (2 * length ts) ts) . map Leaf

all_trees :: Int -> Int -> [Tree] -> [(Tree,[Tree])]
all_trees n m ts
  | n > m     = []
  | otherwise = pick ts ++ sub_trees n m ts

sub_trees :: Int -> Int -> [Tree] -> [(Tree,[Tree])]
sub_trees n m ts = do
  let n2 = n * 2
  (t0,ts0) <- all_trees n2 m ts
  (t1,ts1) <- all_trees n2 m ts0
  return (Branch t0 t1, ts1)


For example, trees [1,2,3] now gives

Leaf 1
Leaf 2
Leaf 3
Branch (Leaf 1) (Leaf 2)
Branch (Leaf 1) (Leaf 3)
Branch (Leaf 1) (Branch (Leaf 2) (Leaf 3))
Branch (Leaf 1) (Branch (Leaf 3) (Leaf 2))
Branch (Leaf 2) (Leaf 1)
Branch (Leaf 2) (Leaf 3)
Branch (Leaf 2) (Branch (Leaf 1) (Leaf 3))
Branch (Leaf 2) (Branch (Leaf 3) (Leaf 1))
Branch (Leaf 3) (Leaf 1)
Branch (Leaf 3) (Leaf 2)
Branch (Leaf 3) (Branch (Leaf 1) (Leaf 2))
Branch (Leaf 3) (Branch (Leaf 2) (Leaf 1))
Branch (Branch (Leaf 1) (Leaf 2)) (Leaf 3)
Branch (Branch (Leaf 1) (Leaf 3)) (Leaf 2)
Branch (Branch (Leaf 2) (Leaf 1)) (Leaf 3)
Branch (Branch (Leaf 2) (Leaf 3)) (Leaf 1)
Branch (Branch (Leaf 3) (Leaf 1)) (Leaf 2)
Branch (Branch (Leaf 3) (Leaf 2)) (Leaf 1)

which looks pretty comprehensive to me!

The derivation wasn't easy. It goes something like this:

First, the "pick" function takes a list and picks a single element from 
it, returning the element picked and the remaining unpicked elements. It 
does this inside the list monad, thus representing every possibel 
choice. (It's defined in terms of pick_from, which isn't used anywhere 
else. The algorithm should be fairly self-evident.)

Next, we have "trees" which transforms a list of integers into a list of 
trivial 1-leaf trees to be processed by "all_trees". The "all_trees" 
function calls pick to select all possible trivial trees, and then calls 
"sub_trees" to pick all possible nontrivial trees.

The code for sub_trees would go something like this:

  sub_trees ts = do
    t0 <- ts
    t1 <- ts
    return (Branch t0 t1)

But now t0 == t1 sometimes, which we cannot allow. Hence the "pick" 

  sub_trees ts = do
    (t0,ts0) <- pick ts
    (t1,ts1) <- pick ts0
    return (Branch t0 t1, ts1)

And now the problem is solved.

However, this only generates all possible 2-leaf trees. To make *all* 
possible trees, we must be recursive:

  sub_trees ts = do
    (t0,ts0) <- all_trees ts
    (t1,ts1) <- all_trees ts0
    return (Branch t0 t1, ts1)

And now it works properly.

Er... wait. Now we have an infinite recursive loop! all_trees --> 
sub_trees --> all_trees (with the same arguments)!

The only way I could figure out to avoid that is to count how big the 
input list is - and hence how deep the tree can possibly be. Then you 
keep track of how deep you are, and abort when you get too deep. I added 
lots of hackery to avoid recomputing stuff. Makes the code look very 
messy and ugly...

More information about the Haskell-Cafe mailing list