[Haskell-cafe] Re: Construct all possible trees

apfelmus apfelmus at quantentunnel.de
Wed Jun 13 10:11:00 EDT 2007

Mirko Rahn wrote:
> apfelmus wrote:
>>     data Tree a = Leaf a | Branch (Tree a) (Tree a) deriving (Show)
>>     permTrees xs = concat . takeWhile (not . null) . map
>>         (flip evalStateT xs . Traversable.sequence) $ trees select
>>         where
>>         select = StateT $ \xs ->
>>             [(z,ys++zs) | (ys,z:zs) <- zip (inits xs) (tails xs)]
>>     trees x = ts
>>         where ts = concat $ ([Leaf x] :) $ convolution Branch ts ts
> But something is wrong here. Unfortunately, I cannot say what, but for
> example the following trees are missing in permTrees [1,2,3,4]:
> Branch (Branch (Branch (Leaf 1) (Leaf 2)) (Leaf 3)) (Leaf 4)
> [...]
> So please, what's going on here?

Tricky, tricky :) It turns out that the function trees which generates
all possible tree shapes doesn't miss any shape but it doesn't generate
them ordered by tree size:

 ghci> mapM_ print $ take 11 $ trees 1
 Leaf 1
 Branch (Leaf 1) (Leaf 1)
 Branch (Leaf 1) (Branch (Leaf 1) (Leaf 1))
 Branch (Branch (Leaf 1) (Leaf 1)) (Leaf 1)
 Branch (Leaf 1) (Branch (Leaf 1) (Branch (Leaf 1) (Leaf 1)))
 Branch (Branch (Leaf 1) (Leaf 1)) (Branch (Leaf 1) (Leaf 1))
 Branch (Branch (Leaf 1) (Branch (Leaf 1) (Leaf 1))) (Leaf 1)
 Branch (Leaf 1) (Branch (Branch (Leaf 1) (Leaf 1)) (Leaf 1))
 Branch (Branch (Leaf 1) (Leaf 1))
        (Branch (Leaf 1) (Branch (Leaf 1)  (Leaf 1)))
 Branch (Branch (Leaf 1) (Branch (Leaf 1) (Leaf 1)))
        (Branch (Leaf 1) (Leaf 1))
 Branch (Branch (Branch (Leaf 1) (Leaf 1)) (Leaf 1)) (Leaf 1)

The missing tree with 4 leaves appears after one with 5 leaves but
permTerms stops searching as soon as it encounters a tree shape that
doesn't has more leaves than possible elements to permute.

Actually, the definition of trees is not what I originally intended,
it's equivalent to Jon Fairbairn's fair product. My original intention was

  trees x = concat ts
    where ts = [Leaf x] : map concat (convolution (liftM2 Branch) ts ts)

Here, (ts !! (k-1)) is to contain a list of all trees with exactly k
leaves. The nature of convolution makes it clear that (ts) doesn't hang,
that it doesn't miss a tree and that it it doesn't contain duplicate
trees. Moreover, it generates all trees ordered by size and permTrees
works :)

Nevertheless, the fair product approach

  trees x = ts
    where ts = Leaf x : map (uncurry Branch) (ts >< ts)

seems to generate each possible shape exactly once (although not ordered
by size). But how to proof that?

The extremal principle comes to rescue. Assuming that the function does
not hang (no "_|_ inside®"), we can prove that it doesn't miss and
doesn't duplicate trees:

- Assume that trees are missing from the list. Among those, choose the
one with the least height. If this tree t is a (Leaf a), it's in the
list, contradiction. If it's a (Branch x y), x and y must be in the list
or one of them would have a smaller height than t. But then, (x,y)
appears in the fair product and (Branch x y) is in the list, contradiction.

- Assume that there is a duplicate, i.e. there are
  t  = Branch x  y
  t' = Branch x' y'
with x = x' and y = y' in the list. Choose the very first duplicate,
i.e. such that t is the first ever duplicated tree in the list. But
since the list doesn't hang, x and y must come before t in the list. But
x and x' are already duplicates themselves which contradicts the fact
that t is the first.

As a last note, the given definition of convolution is no good for
finite lists (i.e. multiplication of polynomials). It should actually be

    convolution (*) [x1,x2] [y1,y2]
 == [[x1*y1],[x1*y2, x2*y1],[x2*y2]]

The fair product can be adapted to implement this.


>> PPS: A naive parsing algorithm is not as efficient as it could
>> be because parses from different permutations can be reused for
>> parsing larger ones. Note that the same observation carries over
>> to the algorithm presented here, and I'm not sure,
>> but I think it does the sharing.

Now, I'm quite sure that it does not share because "select" may be
called multiple times with the same argument (i.e. equal
sub-permutations) and this of course means that things get recalculated.

Note that Mirko's algorithm does proper sharing of sub-permutations.

More information about the Haskell-Cafe mailing list