Add benchmarks for Mutable.(next|prev)Permutation

Implement benchmarks to test performance of nextPermutation and
prevPermutation on mutable vectors. Tests include:

- Looping through all permutations on small vectors
- Applying bijective versions n times on:
  - Ascending permutations of size n
  - Descending permutations of size n
  - Random permutations of size n
- For a baseline, copying a vector of size n once. Benchmarks for
  bijective permutations begins with such a copy, and you might want
  to remove the impact of copying from the results.

Benchmarks cover both forward (next) and reverse (prev) operations.

vector/benchlib/Bench/Vector/Algo/NextPermutation.hs

@@ -0,0 +1,122 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Bench.Vector.Algo.NextPermutation (generatePermTests) where
+
+import qualified Data.Vector.Unboxed as V
+import qualified Data.Vector.Unboxed.Mutable as M
+import qualified Data.Vector.Generic.Mutable as G
+import System.Random.Stateful
+    ( StatefulGen, UniformRange(uniformRM) )
+
+-- | Generate a list of benchmarks for permutation algorithms.
+-- The list contains pairs of benchmark names and corresponding actions.
+-- The actions are to be executed by the benchmarking framework.
+-- 
+-- The list contains the following benchmarks:
+-- - @(next|prev)Permutation@ on a small vector repeated until the end of the permutation cycle
+-- - Bijective versions of @(next|prev)Permutation@ on a vector of size @n@, repeated @n@ times
+--  - ascending permutation
+--  - descending permutation
+--  - random permutation
+-- - Baseline for bijective versions: just copying a vector of size @n@. Note that the tests for
+--   bijective versions begins with copying a vector.
+generatePermTests :: StatefulGen g IO => g -> Int -> IO [(String, IO ())]
+generatePermTests gen useSize = do
+  let !k = useSizeToPermLen useSize
+  let !vasc = V.generate useSize id
+      !vdesc = V.generate useSize (useSize-1-)
+  !vrnd <- randomPermutationWith gen useSize
+  return
+    [ ("nextPermutation (small vector, until end)", loopPermutations k)
+    , ("nextPermutationBijective (ascending perm of size n, n times)", repeatNextPermutation vasc useSize)
+    , ("nextPermutationBijective (descending perm of size n, n times)", repeatNextPermutation vdesc useSize)
+    , ("nextPermutationBijective (random perm of size n, n times)", repeatNextPermutation vrnd useSize)
+    , ("prevPermutation (small vector, until end)", loopRevPermutations k)
+    , ("prevPermutationBijective (ascending perm of size n, n times)", repeatPrevPermutation vasc useSize)
+    , ("prevPermutationBijective (descending perm of size n, n times)", repeatPrevPermutation vdesc useSize)
+    , ("prevPermutationBijective (random perm of size n, n times)", repeatPrevPermutation vrnd useSize)
+    , ("baseline for *Bijective (just copying the vector of size n)", V.thaw vrnd >> return ())
+    ]
+
+-- | Given a PRNG and a length @n@, generate a random permutation of @[0..n-1]@.
+randomPermutationWith :: (StatefulGen g IO) => g -> Int -> IO (V.Vector Int)
+randomPermutationWith gen n = do
+  v <- M.generate n id
+  V.forM_ (V.generate (n-1) id) $ \ !i -> do
+    j <- uniformRM (i,n-1) gen
+    M.swap v i j
+  V.unsafeFreeze v
+
+-- | Given @useSize@ benchmark option, compute the largest @n <= 12@ such that @n! <= useSize@.
+-- Repeat-nextPermutation-until-end benchmark will use @n@ as the length of the vector.
+-- Note that 12 is the largest @n@ such that @n!@ can be represented as an 'Int32'.
+useSizeToPermLen :: Int -> Int
+useSizeToPermLen us = case V.findIndex (> max 0 us) $ V.scanl' (*) 1 $ V.generate 12 (+1) of
+    Just i -> i-1
+    Nothing -> 12
+
+-- | A bijective version of @G.nextPermutation@ that reverses the vector
+-- if it is already in descending order.
+-- "Bijective" here means that the function forms a cycle over all permutations
+-- of the vector's elements.
+--
+-- This has a nice property that should be benchmarked: 
+-- this function takes amortized constant time each call,
+-- if successively called either Omega(n) times on a single vector having distinct elements,
+-- or arbitrary times on a single vector initially in strictly ascending order.
+nextPermutationBijective :: (G.MVector v a, Ord a) => v G.RealWorld a -> IO Bool
+nextPermutationBijective v = do
+  res <- G.nextPermutation v
+  if res then return True else G.reverse v >> return False
+
+-- | A bijective version of @G.prevPermutation@ that reverses the vector
+-- if it is already in ascending order.
+-- "Bijective" here means that the function forms a cycle over all permutations
+-- of the vector's elements.
+--
+-- This has a nice property that should be benchmarked:
+-- this function takes amortized constant time each call,
+-- if successively called either Omega(n) times on a single vector having distinct elements,
+-- or arbitrary times on a single vector initially in strictly descending order.
+prevPermutationBijective :: (G.MVector v a, Ord a) => v G.RealWorld a -> IO Bool
+prevPermutationBijective v = do
+  res <- G.prevPermutation v
+  if res then return True else G.reverse v >> return False
+
+-- | Repeat @nextPermutation@ on @[0..n-1]@ until the end.
+loopPermutations :: Int -> IO ()
+loopPermutations n = do
+  v <- M.generate n id
+  let loop = do
+        res <- M.nextPermutation v
+        if res then loop else return ()
+  loop
+
+-- | Repeat @prevPermutation@ on @[n-1,n-2..0]@ until the end.
+loopRevPermutations :: Int -> IO ()
+loopRevPermutations n = do
+  v <- M.generate n (n-1-)
+  let loop = do
+        res <- M.prevPermutation v
+        if res then loop else return ()
+  loop
+
+-- | Repeat @nextPermutationBijective@ on a given vector given times.
+repeatNextPermutation :: V.Vector Int -> Int -> IO ()
+repeatNextPermutation !v !n = do
+  !mv <- V.thaw v
+  let loop !i | i <= 0 = return ()
+      loop !i = do
+        _ <- nextPermutationBijective mv
+        loop (i-1)
+  loop n
+
+-- | Repeat @prevPermutationBijective@ on a given vector given times.
+repeatPrevPermutation :: V.Vector Int -> Int -> IO ()
+repeatPrevPermutation !v !n = do
+  !mv <- V.thaw v
+  let loop !i | i <= 0 = return ()
+      loop !i = do
+        _ <- prevPermutationBijective mv
+        loop (i-1)
+  loop n

vector/benchmarks/Main.hs

@@ -1,16 +1,17 @@
 {-# LANGUAGE BangPatterns #-}
 module Main where
 
-import Bench.Vector.Algo.MutableSet (mutableSet)
-import Bench.Vector.Algo.ListRank   (listRank)
-import Bench.Vector.Algo.Rootfix    (rootfix)
-import Bench.Vector.Algo.Leaffix    (leaffix)
-import Bench.Vector.Algo.AwShCC     (awshcc)
-import Bench.Vector.Algo.HybCC      (hybcc)
-import Bench.Vector.Algo.Quickhull  (quickhull)
-import Bench.Vector.Algo.Spectral   (spectral)
-import Bench.Vector.Algo.Tridiag    (tridiag)
-import Bench.Vector.Algo.FindIndexR (findIndexR, findIndexR_naive, findIndexR_manual)
+import Bench.Vector.Algo.MutableSet      (mutableSet)
+import Bench.Vector.Algo.ListRank        (listRank)
+import Bench.Vector.Algo.Rootfix         (rootfix)
+import Bench.Vector.Algo.Leaffix         (leaffix)
+import Bench.Vector.Algo.AwShCC          (awshcc)
+import Bench.Vector.Algo.HybCC           (hybcc)
+import Bench.Vector.Algo.Quickhull       (quickhull)
+import Bench.Vector.Algo.Spectral        (spectral)
+import Bench.Vector.Algo.Tridiag         (tridiag)
+import Bench.Vector.Algo.FindIndexR      (findIndexR, findIndexR_naive, findIndexR_manual)
+import Bench.Vector.Algo.NextPermutation (generatePermTests)
 
 import Bench.Vector.TestData.ParenTree (parenTree)
 import Bench.Vector.TestData.Graph     (randomGraph)
@@ -50,6 +51,7 @@ main = do
   !ds <- randomVector useSize
   !sp <- randomVector (floor $ sqrt $ fromIntegral useSize)
   vi <- MV.new useSize
+  permTests <- generatePermTests gen useSize
 
   defaultMainWithIngredients ingredients $ bgroup "All"
     [ bench "listRank"   $ whnf listRank useSize
@@ -66,4 +68,5 @@ main = do
     , bench "findIndexR_manual" $ whnf findIndexR_manual ((<indexFindThreshold), as)
     , bench "minimumOn"  $ whnf (U.minimumOn (\x -> x*x*x)) as
     , bench "maximumOn"  $ whnf (U.maximumOn (\x -> x*x*x)) as
+    , bgroup "(next|prev)Permutation" $ map (\(name, act) -> bench name $ whnfIO act) permTests
     ]

vector/changelog.md

@@ -7,6 +7,7 @@
      The implementation has also been algorithmically updated: in the previous implementation
      the full enumeration of all the permutations of `[1..n]` took Omega(n*n!), but it now takes O(n!).
    * Add tests for `{next,prev}Permutation`
+   * Add benchmarks for `{next,prev}Permutation`
 
 # Changes in version 0.13.1.0
 

vector/vector.cabal

@@ -286,6 +286,7 @@ library benchmarks-O2
         Bench.Vector.Algo.Spectral
         Bench.Vector.Algo.Tridiag
         Bench.Vector.Algo.FindIndexR
+        Bench.Vector.Algo.NextPermutation
         Bench.Vector.TestData.ParenTree
         Bench.Vector.TestData.Graph
         Bench.Vector.Tasty