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.