    {-# 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 :: forall g. StatefulGen g IO => g -> Int -> IO [(String, IO ())]
    generatePermTests g
    gen Int
    useSize = do
      let !k :: Int
    k = Int -> Int
    useSizeToPermLen Int
    useSize
      let !vasc :: Vector Int
    vasc = Int -> (Int -> Int) -> Vector Int
    forall a. Unbox a => Int -> (Int -> a) -> Vector a
    V.generate Int
    useSize Int -> Int
    forall a. a -> a
    id
          !vdesc :: Vector Int
    vdesc = Int -> (Int -> Int) -> Vector Int
    forall a. Unbox a => Int -> (Int -> a) -> Vector a
    V.generate Int
    useSize (Int
    useSizeInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    -)
      !vrnd <- g -> Int -> IO (Vector Int)
    forall g. StatefulGen g IO => g -> Int -> IO (Vector Int)
    randomPermutationWith g
    gen Int
    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 :: forall g. StatefulGen g IO => g -> Int -> IO (Vector Int)
    randomPermutationWith g
    gen Int
    n = do
      v <- Int -> (Int -> Int) -> IO (MVector (PrimState IO) Int)
    forall (m :: * -> *) a.
    (PrimMonad m, Unbox a) =>
    Int -> (Int -> a) -> m (MVector (PrimState m) a)
    M.generate Int
    n Int -> Int
    forall a. a -> a
    id
      V.forM_ (V.generate (n-1) id) $ \ !Int
    i -> do
        j <- (Int, Int) -> g -> IO Int
    forall a g (m :: * -> *).
    (UniformRange a, StatefulGen g m) =>
    (a, a) -> g -> m a
    forall g (m :: * -> *). StatefulGen g m => (Int, Int) -> g -> m Int
    uniformRM (Int
    i,Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) g
    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 :: Int -> Int
    useSizeToPermLen Int
    us = case (Int -> Bool) -> Vector Int -> Maybe Int
    forall a. Unbox a => (a -> Bool) -> Vector a -> Maybe Int
    V.findIndex (Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 Int
    us) (Vector Int -> Maybe Int) -> Vector Int -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ (Int -> Int -> Int) -> Int -> Vector Int -> Vector Int
    forall a b.
    (Unbox a, Unbox b) =>
    (a -> b -> a) -> a -> Vector b -> Vector a
    V.scanl' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (*) Int
    1 (Vector Int -> Vector Int) -> Vector Int -> Vector Int
    forall a b. (a -> b) -> a -> b
    $ Int -> (Int -> Int) -> Vector Int
    forall a. Unbox a => Int -> (Int -> a) -> Vector a
    V.generate Int
    12 (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) of
        Just Int
    i -> Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1
        Maybe Int
    Nothing -> Int
    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 :: forall (v :: * -> * -> *) a.
    (MVector v a, Ord a) =>
    v RealWorld a -> IO Bool
    nextPermutationBijective v RealWorld a
    v = do
      res <- v (PrimState IO) a -> IO Bool
    forall (m :: * -> *) e (v :: * -> * -> *).
    (PrimMonad m, Ord e, MVector v e) =>
    v (PrimState m) e -> m Bool
    G.nextPermutation v RealWorld a
    v (PrimState IO) a
    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 :: forall (v :: * -> * -> *) a.
    (MVector v a, Ord a) =>
    v RealWorld a -> IO Bool
    prevPermutationBijective v RealWorld a
    v = do
      res <- v (PrimState IO) a -> IO Bool
    forall (m :: * -> *) e (v :: * -> * -> *).
    (PrimMonad m, Ord e, MVector v e) =>
    v (PrimState m) e -> m Bool
    G.prevPermutation v RealWorld a
    v (PrimState IO) a
    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 :: Int -> IO ()
    loopPermutations Int
    n = do
      v <- Int -> (Int -> Int) -> IO (MVector (PrimState IO) Int)
    forall (m :: * -> *) a.
    (PrimMonad m, Unbox a) =>
    Int -> (Int -> a) -> m (MVector (PrimState m) a)
    M.generate Int
    n Int -> Int
    forall a. a -> a
    id
      let loop = do
            res <- MVector (PrimState IO) Int -> IO Bool
    forall (m :: * -> *) e.
    (PrimMonad m, Ord e, Unbox e) =>
    MVector (PrimState m) e -> m Bool
    M.nextPermutation MVector RealWorld Int
    MVector (PrimState IO) Int
    v
            if res then loop else return ()
      loop

    -- | Repeat @prevPermutation@ on @[n-1,n-2..0]@ until the end.
    loopRevPermutations :: Int -> IO ()
    loopRevPermutations :: Int -> IO ()
    loopRevPermutations Int
    n = do
      v <- Int -> (Int -> Int) -> IO (MVector (PrimState IO) Int)
    forall (m :: * -> *) a.
    (PrimMonad m, Unbox a) =>
    Int -> (Int -> a) -> m (MVector (PrimState m) a)
    M.generate Int
    n (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    -)
      let loop = do
            res <- MVector (PrimState IO) Int -> IO Bool
    forall (m :: * -> *) e.
    (PrimMonad m, Ord e, Unbox e) =>
    MVector (PrimState m) e -> m Bool
    M.prevPermutation MVector RealWorld Int
    MVector (PrimState IO) Int
    v
            if res then loop else return ()
      loop

    -- | Repeat @nextPermutationBijective@ on a given vector given times.
    repeatNextPermutation :: V.Vector Int -> Int -> IO ()
    repeatNextPermutation :: Vector Int -> Int -> IO ()
    repeatNextPermutation !Vector Int
    v !Int
    n = do
      !mv <- Vector Int -> IO (MVector (PrimState IO) Int)
    forall a (m :: * -> *).
    (Unbox a, PrimMonad m) =>
    Vector a -> m (MVector (PrimState m) a)
    V.thaw Vector Int
    v
      let loop !t
    i | t
    i t -> t -> Bool
    forall a. Ord a => a -> a -> Bool
    <= t
    0 = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          loop !t
    i = do
            _ <- MVector RealWorld Int -> IO Bool
    forall (v :: * -> * -> *) a.
    (MVector v a, Ord a) =>
    v RealWorld a -> IO Bool
    nextPermutationBijective MVector RealWorld Int
    mv
            loop (i-1)
      loop n

    -- | Repeat @prevPermutationBijective@ on a given vector given times.
    repeatPrevPermutation :: V.Vector Int -> Int -> IO ()
    repeatPrevPermutation :: Vector Int -> Int -> IO ()
    repeatPrevPermutation !Vector Int
    v !Int
    n = do
      !mv <- Vector Int -> IO (MVector (PrimState IO) Int)
    forall a (m :: * -> *).
    (Unbox a, PrimMonad m) =>
    Vector a -> m (MVector (PrimState m) a)
    V.thaw Vector Int
    v
      let loop !t
    i | t
    i t -> t -> Bool
    forall a. Ord a => a -> a -> Bool
    <= t
    0 = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          loop !t
    i = do
            _ <- MVector RealWorld Int -> IO Bool
    forall (v :: * -> * -> *) a.
    (MVector v a, Ord a) =>
    v RealWorld a -> IO Bool
    prevPermutationBijective MVector RealWorld Int
    mv
            loop (i-1)
      loop n