[Haskell-cafe] permutations and performance

16 Aug 2008

      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] permutations and performance

John D. Ramsdell