I tried to replace a permutation generator with one that generates each permutation from the previous one, in a stream-like fashion. I had hoped the stream-based algorithm would be more efficient because I use only one permutation at a time, so only the permutation and the previous one need be in memory at one time. I thought I'd share the results of testing the two algorithms.
I first forced the algorithms to produce answers by printing the length of their results. Bad idea. The stream-based algorithm produces a stack overflow on an input that it can handle when the contents of every permutation is forced. In this run, touch = length. $ ghc -O perms.lhs $ echo '(True, 9)' | ./a.out Stack space overflow: current size 8388608 bytes. Use `+RTS -Ksize' to increase it. $ echo '(False, 9)' | ./a.out 362880 $ I forced all parts of the computation by summing all of the numbers in the output. The result show the more obvious algorithm is faster. $ ghc -O perms.lhs $ echo '(True, 12)' | time ./a.out 31614105600 299.56user 0.97system 5:00.75elapsed 99%CPU (0avgtext+0avgdata 0maxresident)k 0inputs+0outputs (0major+479minor)pagefaults 0swaps $ echo '(False, 12)' | time ./a.out 31614105600 213.86user 0.55system 3:34.90elapsed 99%CPU (0avgtext+0avgdata 0maxresident)k 0inputs+0outputs (0major+841minor)pagefaults 0swaps $ > module Main(main) where > main = > do (new, n) <- readLn :: IO (Bool, Int) > case new of > True -> print $ touch $ npermutations n > False -> print $ touch $ permutations n Touch all the numbers in the output. Originally, touch = length. > touch :: [[Int]] -> Int > touch xs = > sum (map sum xs) The permutation algorithm used by Serge Mechveliani in The Algebraic Domain Constructor DoCon. The idea of the algorithm was suggested to him by S.M.Abramov. > npermutations :: Int -> [[Int]] > npermutations n = > first : next (spanMonotoneous first) > where > first = take n [0..] > next (_ , []) = [] > next (decr, j:js) = > p : next (spanMonotoneous p) > where > p = concat [reverse smallers, [j], reverse greaters, [i], js] > (greaters, i:smallers) = span (> j) decr > spanMonotoneous (x:y:xs) > | x <= y = ([x], y:xs) > | otherwise = (x:ys, zs) > where > (ys,zs) = spanMonotoneous (y:xs) > spanMonotoneous xs = (xs, []) > p : next (spanMonotoneous p) > where > p = concat [reverse smallers, [j], reverse greaters, [i], js] > (greaters, i:smallers) = span (> j) decr > spanMonotoneous (x:y:xs) > | x <= y = ([x], y:xs) > | otherwise = (x:ys, zs) > where > (ys,zs) = spanMonotoneous (y:xs) > spanMonotoneous xs = (xs, []) Straight forward permation algorithm. > permutations :: Int -> [[Int]] > permutations n > | n <= 0 = [] > | n == 1 = [[0]] > | otherwise = > concatMap (insertAtAllPos (n - 1)) (permutations (n - 1)) > where > insertAtAllPos x [] = [[x]] > insertAtAllPos x (y : l) = > (x : y : l) : map (y :) (insertAtAllPos x l) _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe