List rooted trees: Difference between revisions

Content added Content deleted

Inline

@@ Line 356: / Line 356: @@
 There probably is a nicer way than the following--
 <lang haskell>-- break n down into sum of smaller integers
-parts n = f n 1 where
+parts :: Int -> [[(Int, Int)]]
-	f n x	| n == 0 = [[]]
+parts n = f n 1
+  where
-		| x > n = []
+    f n x
-		| otherwise = f n (x+1) ++ concatMap (\c->map ((c,x):) (f (n-c*x) (x+1))) [1 .. n`div`x]
+      | n == 0 = [[]]
+      | x > n = []
+      | otherwise =
+        f n (x + 1) ++
+        concatMap
+          (\c -> map ((c, x) :) (f (n - c * x) (x + 1)))
+          [1 .. n `div` x]
 -- choose n strings out of a list and join them
+pick :: Int -> [String] -> [String]
 pick _ [] = []
 pick 0 _ = [""]
-pick n aa@(a:as) = map (a++) (pick (n-1) aa) ++ pick n as
+pick n aa@(a:as) = map (a ++) (pick (n - 1) aa) ++ pick n as
--- pick parts to build a series of subtrees that add up to n-1, then wrap them up
+-- pick parts to build a series of subtrees that add up to n-1,
+-- then wrap them up
-trees n = map (\x->"("++x++")") $ concatMap (foldr (prod.build) [""]) (parts (n-1)) where
+trees :: Int -> [String]
-	build (c,x) = pick c $ trees x
+trees n =
-	prod aa bb = [ a++b | a<-aa, b<-bb ]
+  map (\x -> "(" ++ x ++ ")") $
+  concatMap (foldr (prod . build) [""]) (parts (n - 1))
+  where
+    build (c, x) = pick c $ trees x
+    prod aa bb =
+      [ a ++ b
+      | a <- aa
+      , b <- bb ]
+main :: IO ()
 main = mapM_ putStrLn $ trees 5</lang>
 {{out}}