Construct all possible trees

newer
practicality of typeful programming

Andrew Coppin

12 Jun 2007 12 Jun '07

6:04 p.m.

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)) ] So far I'm not doing too well. Here's what I've got: data Tree = Leaf Int | Branch Tree Tree pick :: [x] -> [(x,[x])] pick = pick_from [] pick_from :: [x] -> [x] -> [(x,[x])] pick_from ks [] = [] pick_from ks [x] = [] pick_from ks xs = (head xs, ks ++ tail xs) : pick_from (ks ++ [head xs]) (tail xs) setup :: [Int] -> [Tree] setup = map Leaf tree2 :: [Tree] -> [Tree] tree2 xs = do (x0,xs0) <- pick xs (x1,xs1) <- pick xs0 return (Branch x0 x1) all_trees ns = (setup ns) ++ (tree2 $ setup ns) Clearly I need another layer of recursion here. (The input list is of arbitrary length.) However, I need to somehow avoid creating duplicate subtrees... (BTW, I'm really impressed with how useful the list monad is for constructing tree2...)

Show replies by date

Jon Fairbairn

12 Jun 12 Jun

7:48 p.m.

Andrew Coppin 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@cl.cam.ac.uk http://www.chaos.org.uk/~jf/Stuff-I-dont-want.html (updated 2007-05-07)

Andrew Coppin

13 Jun 13 Jun

8:15 p.m.

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... ;-)

Jon Fairbairn

9:53 p.m.

Andrew Coppin 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@cl.cam.ac.uk

Mirko Rahn

14 Jun 14 Jun

7:40 a.m.

Jon Fairbairn wrote:

...

Trees with all the elements of a list in that order:

...

...
the_trees [x] = [Leaf x] the_trees l = zipWith Branch (concat (map the_trees (tail $ inits l))) (concat (map the_trees (tail $ tails l)))

Sorry, but this problem seems to trigger incorrect codes, somehow. Here we have the_trees [1,2,3,4] outputs Branch (Leaf 1) (Branch (Leaf 2) (Branch (Leaf 3) (Leaf 4))) Branch (Branch (Leaf 1) (Leaf 2)) (Branch (Branch (Leaf 2) (Leaf 3)) (Leaf 4)) Branch (Branch (Leaf 1) (Branch (Leaf 2) (Leaf 3))) (Branch (Leaf 3) (Leaf 4)) Branch (Branch (Branch (Leaf 1) (Leaf 2)) (Leaf 3)) (Leaf 4) which is certainly not as wanted. The problem is that you do the concat before the zip. We have for splits xs = zip (tail . inits $ xs) (tail . tails $ xs) splits [1,2,3,4] == ([1],[2,3,4]) : ([1,2],[3,4]) : ... So now length (the_trees [1] ) == 1 length (the_trees [1,2] ) == 1 length (the_trees [2,3,4]) == 2 So we build a Branch from the first tree with labels [1,2] and the last tree with labels [2,3,4]. That's wrong! A fixed version could look like the_trees [x] = [Leaf x] the_trees xs = nonempty_splits xs >>= \ (l,r) -> [ Branch a b | a <- the_trees l, b <- the_trees r ] nonempty_splits (x:y:ys) = ([x],y:ys) : [ (x:l,r) | (l,r) <- nonempty_splits (y:ys) ] nonempty_splits _ = [] /BR -- -- Mirko Rahn -- Tel +49-721 608 7504 -- --- http://liinwww.ira.uka.de/~rahn/ ---

Jon Fairbairn

9:58 a.m.

Mirko Rahn writes:

...

Jon Fairbairn wrote:

...
Trees with all the elements of a list in that order:

...
...
the_trees [x] = [Leaf x] the_trees l = zipWith Branch (concat (map the_trees (tail $ inits l))) (concat (map the_trees (tail $ tails l)))

Sorry, but this problem seems to trigger incorrect codes, somehow.

I don't think it's the problem in this case -- it's writing code when half asleep. The network connexion had been down for hours, so it was past my bedtime when I started...

...

splits xs = zip (tail . inits $ xs) (tail . tails $ xs)

I should have defined this (though I might have called it partitions), probably like this:

...

partitions l = inits l `zip` tails l

and used (with appropriate discarding) it in both the_trees and combinations, and I should have written a proper combinations rather than writing "nonempty_combinations" and calling it "combinations". -- Jón Fairbairn Jon.Fairbairn@cl.cam.ac.uk

Colin DeVilbiss

12 Jun 12 Jun

8:20 p.m.

On 6/12/07, Andrew Coppin wrote: Based on the sample output, I'm guessing that the desired output is "every tree which, when flattened, gives a permutation of a non-empty subset of the supplied list". This limits the output to trees with up to "n" leaves.

...

Branch (Branch (Leaf 1) (Leaf 3)) (Leaf 1),

If I'm guessing the desired output correctly, this must be a typo? I'd be tempted to solve the "list-only" problem first (generate all "sub-permutations" of a list), then solve the tree problem (generate all "un-flattenings" of a list). Colin DeVilbiss

Andrew Coppin

13 Jun 13 Jun

8:17 p.m.

Colin DeVilbiss wrote:

...

On 6/12/07, Andrew Coppin wrote:

Based on the sample output, I'm guessing that the desired output is "every tree which, when flattened, gives a permutation of a non-empty subset of the supplied list". This limits the output to trees with up to "n" leaves.

Every possible tree, using the supplied elements as leaf elements, without ever duplicating them. (Note, however, that the initial list may contain duplicates in the first place, so you can't just test for and remove duplicates in the produced lists; you must avoid repeating elements by construction.)

...

...
Branch (Branch (Leaf 1) (Leaf 3)) (Leaf 1),

If I'm guessing the desired output correctly, this must be a typo?

Erm... yes.

...

I'd be tempted to solve the "list-only" problem first (generate all "sub-permutations" of a list), then solve the tree problem (generate all "un-flattenings" of a list).

I can already create all possible 2-element trees. It seems like there should be a way to recurse that... but without duplicating elements. Hmm, I don't know - there's probably several correct solutions to this problem. ;-)

apfelmus

9:33 a.m.

Andrew Coppin 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)) ]

Here's a way to do this. First, some imports and the definition of Tree. import Data.List import Control.Applicative import qualified Data.Foldable as Foldable import Data.Traversable as Traversable import Control.Monad.State data Tree a = Leaf a | Branch (Tree a) (Tree a) deriving (Show) Let's assume that someone has given us a function trees :: a -> [Tree a] that builds a list of all possible trees whose leaves are all equal to (Leaf x) where x is the argument given. In other words, 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))) , ... ] Is this of any use? It is, the idea is to not put single elements into the leaves, but something more clever. For instance, we can put the list itself into the leaves trees [1,2,3] :: [Tree [Int]] Now, we can view the inner list as a monad. Thus, we have a tree of nondeterministic values but want to have a nondeterministic tree. Can we flatten it somehow? ? :: Tree [a] -> [Tree a] Indeed we can, for this is nothing more than a generalization of the well-known sequence :: Monad m => [m a] -> m [a] from lists to trees: sequence :: Monad m => Tree (m a) -> m (Tree a) Setting m a = [a] then gives the desired sequence :: Tree [a] -> [Tree a] In fact, the generalization works for many types and the pattern behind is captured by applicative functors and Data.Traversable. instance Traversable Tree where traverse f (Leaf a) = Leaf <$> f a traverse f (Branch x y) = Branch <$> traverse f x <*> traverse f y instance Functor Tree where fmap = fmapDefault instance Foldable.Foldable Tree where foldMap = foldMapDefault Explaining how this works exactly would explode this mail, but the haddocks for Data.Traversable are a good start to learn more. What counts is that we now have Traversable.sequence :: Monad m => Tree (m a) -> m (Tree a) for free and we can formulate our idea -- all possible trees whose leaves are from the given list mutlisetTrees :: [a] -> [Tree a] mutlisetTrees xs = concatMap Traversable.sequence $ trees xs This gives mutlisetTrees [1,2,3] = [ Leaf 1 , Leaf 2 , Leaf 3 , Branch (Leaf 1) (Leaf 1) , Branch (Leaf 1) (Leaf 2) , Branch (Leaf 1) (Leaf 3) , Branch (Leaf 2) (Leaf 1) , Branch (Leaf 2) (Leaf 2) , Branch (Leaf 2) (Leaf 3) , Branch (Leaf 3) (Leaf 1) , Branch (Leaf 3) (Leaf 2) , Branch (Leaf 3) (Leaf 3) , Branch (Leaf 1) (Branch (Leaf 1) (Leaf 1)) , ...] A good try, but this gives all combinations of elements from [1,2,3]. This was to be expected, because do x <- [1,2,3] y <- [1,2,3] return (x,y) analogously gives all pairs [(1,1),(1,2),(1,3),(2,1),...]. How to make permutations out of this? The idea is to incorporate state into our monad, namely the list of elements not yet used. Every time we generate a new nondeterministic value, we choose it from this list and supply all subsequent monadic action a list where this value is removed. Here's the code: -- all possible trees whose leaves are -- a permutation of the given list permTrees :: [a] -> [Tree a] 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)] all_trees = permTrees Instead of putting [1,2,3] into the leaves of our trees, we put a monadic action called "select" in there. We can put state on top of the list monad with the StateT monad transformer so that "select" has the type select :: StateT [a] [] a Now, all that remains is to implement trees. For that, we note that a tree with n leaves always has the form n leaves = Branch (k leaves) (n-k leaves) for some k. This reminds us of the multiplication of power series and hints that we should build a list trees = [1 leaves, 2 leaves, 3 leaves, 4 leaves, ...] which is equal to = [1 leaves , [Branch (1 leaves, 1 leaves)] , [Branch (1 leaves, 2 leaves), Branch (2 leaves, 1 leaves)] , .. (1 .. 3) .. (2 .. 2) .. (3 .. 1) , ... ] Now, we can get the (k leaves) recursively from trees itself! -- all possible trees with leaves all equal to (Leaf x) trees :: a -> [Tree a] trees x = ts where ts = concat $ ([Leaf x] :) $ convolution Branch ts ts Here, "convolution" pairs the (k leaves) and (n-k leaves). For example, convolution (*) [x1,x2,x3] [y1,y2,y3] == [[x1*y1)],[x1*y2, x2*y1],[x1*y3, x2*y2, x3*y1]] It's implemented as convolution :: (a -> a -> b) -> [a] -> [a] -> [[b]] convolution f xs ys = tail $ zipWith (zipWith f) (inits' xs) $ scanl (flip (:)) [] ys The implementation here closely follows the "Method of the sliding bars" for the multiplication of power series as coined in my old math book. There is a small problem in the recursive definition of trees, namely that it only works if "convolution" is lazy enough. Unfortunately, the Prelude function "inits" is *too strict* inits (1:_|_) == []:_|_ and not inits (1:_|_) == []:[1]:_|_ as one would expect. I think that this counts as bug in the Prelude. Here's a correct definition inits' xs = []:case xs of [] -> [] (x:xs) -> map (x:) $ inits' xs Regards, apfelmus PS: There is at least one other way to solve the problem. It works by generating all permutations first and parsing the resulting permutations in all possible ways as trees. PSS: A naive parsing algorithm is not as efficient as it good 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.

Mirko Rahn

12:27 p.m.

apfelmus wrote: Explanation and the code:

...

import Data.List import Control.Applicative import qualified Data.Foldable as Foldable import Data.Traversable as Traversable import Control.Monad.State

data Tree a = Leaf a | Branch (Tree a) (Tree a) deriving (Show)

...

instance Traversable Tree where traverse f (Leaf a) = Leaf <$> f a traverse f (Branch x y) = Branch <$> traverse f x <*> traverse f y

instance Functor Tree where fmap = fmapDefault

instance Foldable.Foldable Tree where foldMap = foldMapDefault

...

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

...

convolution f xs ys = tail $ zipWith (zipWith f) (inits' xs) $ scanl (flip (:)) [] ys

...

inits' xs = []:case xs of [] -> [] (x:xs) -> map (x:) $ inits' xs

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) Branch (Branch (Branch (Leaf 1) (Leaf 2)) (Leaf 4)) (Leaf 3) Branch (Branch (Branch (Leaf 1) (Leaf 3)) (Leaf 2)) (Leaf 4) Branch (Branch (Branch (Leaf 1) (Leaf 3)) (Leaf 4)) (Leaf 2) Branch (Branch (Branch (Leaf 1) (Leaf 4)) (Leaf 2)) (Leaf 3) Branch (Branch (Branch (Leaf 1) (Leaf 4)) (Leaf 3)) (Leaf 2) Branch (Branch (Branch (Leaf 2) (Leaf 1)) (Leaf 3)) (Leaf 4) Branch (Branch (Branch (Leaf 2) (Leaf 1)) (Leaf 4)) (Leaf 3) Branch (Branch (Branch (Leaf 2) (Leaf 3)) (Leaf 1)) (Leaf 4) Branch (Branch (Branch (Leaf 2) (Leaf 3)) (Leaf 4)) (Leaf 1) Branch (Branch (Branch (Leaf 2) (Leaf 4)) (Leaf 1)) (Leaf 3) Branch (Branch (Branch (Leaf 2) (Leaf 4)) (Leaf 3)) (Leaf 1) Branch (Branch (Branch (Leaf 3) (Leaf 1)) (Leaf 2)) (Leaf 4) Branch (Branch (Branch (Leaf 3) (Leaf 1)) (Leaf 4)) (Leaf 2) Branch (Branch (Branch (Leaf 3) (Leaf 2)) (Leaf 1)) (Leaf 4) Branch (Branch (Branch (Leaf 3) (Leaf 2)) (Leaf 4)) (Leaf 1) Branch (Branch (Branch (Leaf 3) (Leaf 4)) (Leaf 1)) (Leaf 2) Branch (Branch (Branch (Leaf 3) (Leaf 4)) (Leaf 2)) (Leaf 1) Branch (Branch (Branch (Leaf 4) (Leaf 1)) (Leaf 2)) (Leaf 3) Branch (Branch (Branch (Leaf 4) (Leaf 1)) (Leaf 3)) (Leaf 2) Branch (Branch (Branch (Leaf 4) (Leaf 2)) (Leaf 1)) (Leaf 3) Branch (Branch (Branch (Leaf 4) (Leaf 2)) (Leaf 3)) (Leaf 1) Branch (Branch (Branch (Leaf 4) (Leaf 3)) (Leaf 1)) (Leaf 2) Branch (Branch (Branch (Leaf 4) (Leaf 3)) (Leaf 2)) (Leaf 1) One could guess it has something to do with the special structure of the missing trees, but at one hand permTrees [1,2,3] gives all trees and at the other in permTrees [1,2,3,4,5] are also other structures missing, like Branch (Leaf 3) (Branch (Branch (Leaf 2) (Leaf 1)) (Branch (Leaf 4) (Leaf 5))) So please, what's going on here? -- -- Mirko Rahn -- Tel +49-721 608 7504 -- --- http://liinwww.ira.uka.de/~rahn/ ---

apfelmus

2:11 p.m.

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. Regards, apfelmus PS:

...

...
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.

Mirko Rahn

11:45 a.m.

Andrew Coppin wrote:

...

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)) ]

Just another way (assuming the given order is not relevant), based on the idea that it is quite easy to insert a new node on all possible positions in an already existing tree. data Tree a = Leaf a | Branch (Tree a) (Tree a) deriving Show decomp (Branch l r) = [(l,flip Branch r),(r,Branch l)] decomp _ = [] insert x t = Branch x t : Branch t x : [re b | (part,re) <- decomp t, b <- insert x part] all_trees [] = [] all_trees (x:xs) = let this = Leaf x more = all_trees xs in this : more ++ concatMap (insert this) more /BR -- -- Mirko Rahn -- Tel +49-721 608 7504 -- --- http://liinwww.ira.uka.de/~rahn/ ---

Lennart Augustsson

9:08 p.m.

This doesn't enumerate them in the order you want, but maybe it doesn't matter. module Trees where combinations :: [a] -> [[a]] combinations [] = [[]] combinations (x:xs) = combinations xs ++ [ x:xs' | xs' <- combinations xs ] data Tree = Leaf Int | Branch Tree Tree deriving (Show) trees [x] = [Leaf x] trees (x:xs) = [ s | t <- trees xs, s <- insert x t ] insert x t@(Leaf y) = [Branch s t, Branch t s] where s = Leaf x insert x (Branch l r) = [Branch l' r | l' <- insert x l] ++ [Branch l r' | r' <- insert x r] allTrees xs = [ t | ys <- combinations xs, not (null ys), t <- trees ys ] -- Lennart On 6/12/07, Andrew Coppin 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)) ]

So far I'm not doing too well. Here's what I've got:

data Tree = Leaf Int | Branch Tree Tree

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

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

setup :: [Int] -> [Tree] setup = map Leaf

tree2 :: [Tree] -> [Tree] tree2 xs = do (x0,xs0) <- pick xs (x1,xs1) <- pick xs0 return (Branch x0 x1)

all_trees ns = (setup ns) ++ (tree2 $ setup ns)

Clearly I need another layer of recursion here. (The input list is of arbitrary length.) However, I need to somehow avoid creating duplicate subtrees...

(BTW, I'm really impressed with how useful the list monad is for constructing tree2...)

_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Lennart Augustsson

10:50 p.m.

I now realize that my solution is needlessly complicated. Here's a simpler one. module Trees where data Tree = Leaf Int | Branch Tree Tree deriving (Show) insert x t@(Leaf y) = [Branch s t, Branch t s] where s = Leaf x insert x (Branch l r) = [Branch l' r | l' <- insert x l] ++ [Branch l r' | r' <- insert x r] allTrees [] = [] allTrees (x:xs) = Leaf x : ts ++ [ s | t <- ts, s <- insert x t ] where ts = allTrees xs -- Lennart On 6/13/07, Lennart Augustsson wrote:

...

This doesn't enumerate them in the order you want, but maybe it doesn't matter.

module Trees where

combinations :: [a] -> [[a]] combinations [] = [[]] combinations (x:xs) = combinations xs ++ [ x:xs' | xs' <- combinations xs ]

data Tree = Leaf Int | Branch Tree Tree deriving (Show)

trees [x] = [Leaf x] trees (x:xs) = [ s | t <- trees xs, s <- insert x t ]

insert x t@(Leaf y) = [Branch s t, Branch t s] where s = Leaf x insert x (Branch l r) = [Branch l' r | l' <- insert x l] ++ [Branch l r' | r' <- insert x r]

allTrees xs = [ t | ys <- combinations xs, not (null ys), t <- trees ys ]

-- Lennart

On 6/12/07, Andrew Coppin 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)) ]

So far I'm not doing too well. Here's what I've got:

data Tree = Leaf Int | Branch Tree Tree

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

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

(tail xs)

setup :: [Int] -> [Tree] setup = map Leaf

tree2 :: [Tree] -> [Tree] tree2 xs = do (x0,xs0) <- pick xs (x1,xs1) <- pick xs0 return (Branch x0 x1)

all_trees ns = (setup ns) ++ (tree2 $ setup ns)

Clearly I need another layer of recursion here. (The input list is of arbitrary length.) However, I need to somehow avoid creating duplicate subtrees...

(BTW, I'm really impressed with how useful the list monad is for constructing tree2...)

_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Mirko Rahn

14 Jun 14 Jun

6:31 a.m.

I'm afraid, but you are missing a case here. For example the tree Branch (Leaf 1) (Branch (Leaf 3) (Leaf 2)) is not constructed by your program. Correct is insert x t@(Leaf y) = [Branch s t, Branch t s] where s = Leaf x insert x t@(Branch l r) = [Branch l' r | l' <- insert x l] ++ [Branch l r' | r' <- insert x r] ++ {- missed this: -} [Branch s t,Branch t s] where s = Leaf x With this modification, your program becomes essentially the same as my version but with suboptimal sharing (you construct Leaf x twice and with the correction even three times). As a consequence my version is faster and eats less memory. /BR -- -- Mirko Rahn -- Tel +49-721 608 7504 -- --- http://liinwww.ira.uka.de/~rahn/ ---

6599

Age (days ago)

6601

Last active (days ago)

List overview

Download

14 comments

6 participants

participants (6)

Andrew Coppin
apfelmus
Colin DeVilbiss
Jon Fairbairn
Lennart Augustsson
Mirko Rahn