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/ ---
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
