Add random insert and delete benchmarks

Author: meooow25

containers-tests/benchmarks/Map.hs

@@ -15,13 +15,16 @@ import Data.Maybe (fromMaybe)
 import Data.Functor ((<$))
 import Data.Coerce
 import Prelude hiding (lookup)
+import System.Random (mkStdGen)
+import Utils.Random (shuffle)
 
 main = do
     let m = M.fromAscList elems :: M.Map Int Int
         m_even = M.fromAscList elems_even :: M.Map Int Int
         m_odd = M.fromAscList elems_odd :: M.Map Int Int
     evaluate $ rnf [m, m_even, m_odd]
-    evaluate $ rnf [elems_rev, elems_asc, elems_desc]
+    evaluate $ rnf [elems_rev, elems_asc, elems_desc, elems_random]
+    evaluate $ rnf keys_random
     defaultMain
         [ bench "lookup absent" $ whnf (lookup evens) m_odd
         , bench "lookup present" $ whnf (lookup evens) m_even
@@ -33,12 +36,16 @@ main = do
         , bench "alterF lookup present" $ whnf (atLookup evens) m_even
         , bench "alterF no rules lookup absent" $ whnf (atLookupNoRules evens) m_odd
         , bench "alterF no rules lookup present" $ whnf (atLookupNoRules evens) m_even
+        , bench "insert" $ whnf (ins elems) M.empty
+        , bench "insert random" $ whnf (ins elems_random) M.empty
         , bench "insert absent" $ whnf (ins elems_even) m_odd
         , bench "insert present" $ whnf (ins elems_even) m_even
         , bench "alterF insert absent" $ whnf (atIns elems_even) m_odd
         , bench "alterF insert present" $ whnf (atIns elems_even) m_even
         , bench "alterF no rules insert absent" $ whnf (atInsNoRules elems_even) m_odd
         , bench "alterF no rules insert present" $ whnf (atInsNoRules elems_even) m_even
+        , bench "delete" $ whnf (del keys) m
+        , bench "delete random" $ whnf (del keys_random) m
         , bench "delete absent" $ whnf (del evens) m_odd
         , bench "delete present" $ whnf (del evens) m
         , bench "alterF delete absent" $ whnf (atDel evens) m_odd
@@ -117,6 +124,9 @@ main = do
     evens = [2,4..bound]
     odds = [1,3..bound]
     values = [1..bound]
+    stdGen = mkStdGen 42
+    elems_random = shuffle stdGen elems
+    keys_random = map fst elems_random
     sumkv k v1 v2 = k + v1 + v2
     consPair k v xs = (k, v) : xs
 

containers-tests/benchmarks/Set.hs

@@ -7,21 +7,25 @@ import Control.Exception (evaluate)
 import Test.Tasty.Bench (bench, defaultMain, whnf)
 import Data.List (foldl')
 import qualified Data.Set as S
+import System.Random (mkStdGen)
+import Utils.Random (shuffle)
 
 main = do
     let s = S.fromAscList elems :: S.Set Int
         s_even = S.fromAscList elems_even :: S.Set Int
         s_odd = S.fromAscList elems_odd :: S.Set Int
         strings_s = S.fromList strings
     evaluate $ rnf [s, s_even, s_odd]
-    evaluate $ rnf [elems_rev, elems_asc, elems_desc]
+    evaluate $ rnf [elems_rev, elems_asc, elems_desc, elems_random]
     defaultMain
         [ bench "member" $ whnf (member elems) s
         , bench "insert" $ whnf (ins elems) S.empty
+        , bench "insert random" $ whnf (ins elems_random) S.empty
         , bench "map" $ whnf (S.map (+ 1)) s
         , bench "filter" $ whnf (S.filter ((== 0) . (`mod` 2))) s
         , bench "partition" $ whnf (S.partition ((== 0) . (`mod` 2))) s
         , bench "delete" $ whnf (del elems) s
+        , bench "delete random" $ whnf (del elems_random) s
         , bench "findMin" $ whnf S.findMin s
         , bench "findMax" $ whnf S.findMax s
         , bench "deleteMin" $ whnf S.deleteMin s
@@ -65,6 +69,8 @@ main = do
     elems_asc = map (`div` 2) [1..bound] -- [0,1,1,2,2..]
     elems_desc = map (`div` 2) [bound,bound-1..1] -- [..2,2,1,1,0]
     strings = map show elems
+    stdGen = mkStdGen 42
+    elems_random = shuffle stdGen elems
 
 member :: [Int] -> S.Set Int -> Int
 member xs s = foldl' (\n x -> if S.member x s then n + 1 else n) 0 xs

containers-tests/benchmarks/Utils/Random.hs

@@ -0,0 +1,20 @@
+module Utils.Random
+  ( shuffle
+  ) where
+
+import Data.List (unfoldr)
+import System.Random (RandomGen, randomR)
+import qualified Data.Sequence as Seq
+
+-- | O(n log n) Fisher-Yates shuffle.
+shuffle :: RandomGen g => g -> [a] -> [a]
+shuffle g0 xs0 = unfoldr f (g0, Seq.fromList xs0)
+  where
+    f (g, xs)
+      | Seq.null xs = Nothing
+      | otherwise = Just (x, (g', xs'))
+      where
+        (i, g') = randomR (0, Seq.length xs - 1) g
+        x = Seq.index xs i
+        xs' = Seq.deleteAt i xs
+{-# INLINABLE shuffle #-}

containers-tests/containers-tests.cabal

@@ -163,6 +163,11 @@ benchmark map-benchmarks
   hs-source-dirs: benchmarks
   main-is:        Map.hs
   ghc-options:    -O2
+  build-depends:
+      random            >=1.0     && <1.3
+
+  other-modules:
+    Utils.Random
 
 benchmark tree-benchmarks
   import: benchmark-deps, warnings
@@ -180,7 +185,7 @@ benchmark sequence-benchmarks
   main-is:        Sequence.hs
   ghc-options:    -O2
   build-depends:
-      random            >=0       && <1.2
+      random            >=1.0     && <1.3
     , transformers
 
 benchmark set-benchmarks
@@ -190,6 +195,11 @@ benchmark set-benchmarks
   hs-source-dirs: benchmarks
   main-is:        Set.hs
   ghc-options:    -O2
+  build-depends:
+      random            >=1.0     && <1.3
+
+  other-modules:
+    Utils.Random
 
 benchmark graph-benchmarks
   import: benchmark-deps, warnings
@@ -199,7 +209,7 @@ benchmark graph-benchmarks
   main-is:        Graph.hs
   ghc-options:    -O2
   build-depends:
-      random            >=0       && <1.2
+      random            >=1.0     && <1.3
 
 benchmark set-operations-intmap
   import: benchmark-deps, warnings