[Haskell-cafe] Re: Construct all possible trees
Jon Fairbairn
jon.fairbairn at cl.cam.ac.uk
Wed Jun 13 17:53:06 EDT 2007
Andrew Coppin <andrewcoppin at btinternet.com> writes:
> 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?
Oh, you mean "with each member of the list appearing at most
once"? Why didn't you /say/ so? :-P
Trees with all the elements of a list in that order:
> the_trees:: [Integer] -> [Tree]
> the_trees [x] = [Leaf x]
> the_trees l = zipWith Branch (concat (map the_trees (tail $ inits l)))
> (concat (map the_trees (tail $ tails l)))
> combinations [] = []
> combinations (h:t)
> = [h]:combinations t ++ (concat $ map insertions $ combinations t)
> where insertions l = zipWith (\a b -> a ++ h: b)
> (inits l)
> (tails l)
Trees with all the members of a list appearing at most once
(in any order)
> combination_trees l = concat $ map the_trees $ combinations l
* * *
It looks like Lennart was writing something very similar at
the same time as me. That obviously means that this is the
/right/ approach :-). As with his version, the order isn't
exactly as you listed them, but it's not far off ...
--
Jón Fairbairn Jon.Fairbairn at cl.cam.ac.uk
More information about the Haskell-Cafe
mailing list