[Haskell-cafe] Re: Construct all possible trees
Jon Fairbairn
jon.fairbairn at cl.cam.ac.uk
Tue Jun 12 15:48:36 EDT 2007
Andrew Coppin <andrewcoppin at btinternet.com> writes:
> 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? So
I don't understand the question, 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.
--
Jón Fairbairn Jon.Fairbairn at cl.cam.ac.uk
http://www.chaos.org.uk/~jf/Stuff-I-dont-want.html (updated 2007-05-07)
More information about the Haskell-Cafe
mailing list