Well, I eventually came up with this: --------------------------------- data Tree = Leaf Int | Branch Tree Tree deriving Show pick :: [x] -> [(x,[x])] pick = pick_from [] pick_from :: [x] -> [x] -> [(x,[x])] pick_from ks [] = [] pick_from ks xs = (head xs, ks ++ tail xs) : pick_from (ks ++ [head xs]) (tail xs) trees :: [Int] -> [Tree] trees = map fst . (\ts -> all_trees 1 (2 * length ts) ts) . map Leaf all_trees :: Int -> Int -> [Tree] -> [(Tree,[Tree])] all_trees n m ts | n > m = [] | otherwise = pick ts ++ sub_trees n m ts sub_trees :: Int -> Int -> [Tree] -> [(Tree,[Tree])] sub_trees n m ts = do let n2 = n * 2 (t0,ts0) <- all_trees n2 m ts (t1,ts1) <- all_trees n2 m ts0 return (Branch t0 t1, ts1) ----------------------------- For example, trees [1,2,3] now gives Leaf 1 Leaf 2 Leaf 3 Branch (Leaf 1) (Leaf 2) Branch (Leaf 1) (Leaf 3) Branch (Leaf 1) (Branch (Leaf 2) (Leaf 3)) Branch (Leaf 1) (Branch (Leaf 3) (Leaf 2)) Branch (Leaf 2) (Leaf 1) Branch (Leaf 2) (Leaf 3) Branch (Leaf 2) (Branch (Leaf 1) (Leaf 3)) Branch (Leaf 2) (Branch (Leaf 3) (Leaf 1)) Branch (Leaf 3) (Leaf 1) Branch (Leaf 3) (Leaf 2) Branch (Leaf 3) (Branch (Leaf 1) (Leaf 2)) Branch (Leaf 3) (Branch (Leaf 2) (Leaf 1)) Branch (Branch (Leaf 1) (Leaf 2)) (Leaf 3) Branch (Branch (Leaf 1) (Leaf 3)) (Leaf 2) 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) which looks pretty comprehensive to me! The derivation wasn't easy. It goes something like this: First, the "pick" function takes a list and picks a single element from it, returning the element picked and the remaining unpicked elements. It does this inside the list monad, thus representing every possibel choice. (It's defined in terms of pick_from, which isn't used anywhere else. The algorithm should be fairly self-evident.) Next, we have "trees" which transforms a list of integers into a list of trivial 1-leaf trees to be processed by "all_trees". The "all_trees" function calls pick to select all possible trivial trees, and then calls "sub_trees" to pick all possible nontrivial trees. The code for sub_trees would go something like this: sub_trees ts = do t0 <- ts t1 <- ts return (Branch t0 t1) But now t0 == t1 sometimes, which we cannot allow. Hence the "pick" function: sub_trees ts = do (t0,ts0) <- pick ts (t1,ts1) <- pick ts0 return (Branch t0 t1, ts1) And now the problem is solved. However, this only generates all possible 2-leaf trees. To make *all* possible trees, we must be recursive: sub_trees ts = do (t0,ts0) <- all_trees ts (t1,ts1) <- all_trees ts0 return (Branch t0 t1, ts1) And now it works properly. Er... wait. Now we have an infinite recursive loop! all_trees --> sub_trees --> all_trees (with the same arguments)! The only way I could figure out to avoid that is to count how big the input list is - and hence how deep the tree can possibly be. Then you keep track of how deep you are, and abort when you get too deep. I added lots of hackery to avoid recomputing stuff. Makes the code look very messy and ugly...
Andrew Coppin wrote:
The size of the deepest possible *balanced* tree with N leaves is log2 N. The deepest possible *unbalanced* tree has N nodes!
My God... even when I correct myself I make mistakes! >_< Anyway, I eventually got my program to work. But it's absurdly slow. So I'm looking at ways to make it faster. You'll recall I wanted to construct all possible expressions from a set of numbers. The trouble is, the set of ALL possible expressions turns out to be vast - 33.6 million, roughly. It takes forever to check them all. Part of the problem is that the computer considers x + y and y + x to be two seperate expressions, when in fact they are completely equivilent. On the other hand, x - y and y - x are most certainly NOT equivilent. I am currently sitting down and trying to write some code that does the construction correctly, based on some basic algebraic properties of the four functions of arithmetic. I'm hoping that if I can get it so that fewer expressions are generated, I will have a smaller search space to test. (Of course, one way would be to generate all possible trees and then throw away "equivilent" ones - but that would be orders of magnitude slower still!) In the code I'm currently working on, I've come up with this: type Pick x = (x,[x]) type Picks x = ([x],[x]) pick :: [x] -> [Pick x] pick = pick_from [] pick_from :: [x] -> [x] -> [Pick x] pick_from ks [] = [] pick_from ks (x:xs) = (x, ks ++ xs) : pick_from (ks ++ [x]) xs picks :: [x] -> [Picks x] picks [] = [] picks [x] = [([],[x]), ([x],[])] picks (x:xs) = do (as,bs) <- picks xs [(as,x:bs), (x:as,bs)] I think these functions are quite interesting, and I don't recall ever seeing them in any library. Have I discovered something new here, or am I reinventing the wheel? Anyway, I'm really loving the way the whole "list is a monad" concept allows you to write code like every variable is a superposition of all possible values... all_sums :: [Term] -> [Pick Term] all_sums ts = do (as,bs) <- picks ts if length as < 2 then fail "trivial sum" else return (Sum as, bs) all_negates :: [Term] -> [[Term]] all_negates [] = [[]] all_negates (t:ts) = do ts' <- all_negates ts [(t : ts'), (Negate t : ts')] Neat, eh?
participants (1)
-
Andrew Coppin