[Haskell-cafe] Re: Construct all possible trees
Andrew Coppin
andrewcoppin at btinternet.com
Wed Jun 13 16:15:00 EDT 2007
Jon Fairbairn wrote:
>> I'm trying to construct a function
>>
>> all_trees :: [Int] -> [Tree]
>>
>> such that all_trees [1,2,3] will yield
>>
>> [
>> Leaf 1,
>> Leaf 2,
>> Leaf 3,
>> Branch (Leaf 1) (Leaf 2),
>> Branch (Leaf 1) (Leaf 3),
>> Branch (Leaf 2) (Leaf 1),
>> Branch (Leaf 2) (Leaf 3),
>> Branch (Leaf 3) (Leaf 1),
>> Branch (Leaf 3) (Leaf 2),
>> Branch (Branch (Leaf 1) (Leaf 2)) (Leaf 3),
>> Branch (Branch (Leaf 1) (Leaf 3)) (Leaf 1),
>> 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),
>> Branch (Leaf 1) (Branch (Leaf 2) (Leaf 3)),
>> Branch (Leaf 1) (Branch (Leaf 3) (Leaf 2)),
>> Branch (Leaf 2) (Branch (Leaf 1) (Leaf 3)),
>> Branch (Leaf 2) (Branch (Leaf 3) (Leaf 2)),
>> Branch (Leaf 3) (Branch (Leaf 1) (Leaf 2)),
>> Branch (Leaf 3) (Branch (Leaf 2) (Leaf 1))
>> ]
>>
>
> Why does it stop there? That's not all the trees, surely?
Really? OK, what other trees do *you* think you can construct from the
numbers 1, 2 and 3?
> Otherwise I'd suggest something like this:
>
>
>> module Main where
>>
>
> derive some classes for demo purposes
>
>
>> data Tree = Leaf Integer | Branch Tree Tree deriving (Show, Eq, Ord)
>>
>
> A fair product (can't find one in the libraries):
>
>
>> as >< bs
>> = strip 1 [[(a,b) | b <-bs] | a <- as]
>> where
>> strip n [] = []
>> strip n ll = heads
>> ++ strip (n+1) (tails ++ rest)
>> where (first_n, rest) = splitAt n ll
>> heads = [a | (a:_) <- first_n]
>> tails = [as | (_:as) <- first_n]
>>
>
> works by generating a list of lists representing the product
> matrix and then repeatedly stripping off the leading
> edge. I'm sure something like this must be in a library
> somewhere, but I couldn't find it in quick search. Once
> we've got that, all_trees is simple:
>
>
>> all_trees l
>> = at
>> where at = map Leaf l ++ map (uncurry Branch) (at >< at)
>>
>
> ... and mutter something about using bulk operations and
> laziness.
>
I'll have to sit down and think about why that works... ;-)
More information about the Haskell-Cafe
mailing list