[Haskell-cafe] permutations and performance
John D. Ramsdell
ramsdell0 at gmail.com
Sat Aug 16 15:38:54 EDT 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)
More information about the Haskell-Cafe
mailing list