Use randomly structured Set and Map in benchmarks

Trees constructed from [1..n] have a specific structure of perfect
binary trees linked together. We shuffle the list so that the list
is generated from repeated insertions instead, which forms a random
structure that should be more representative of average use cases.

containers-tests/benchmarks/Map.hs

@@ -17,13 +17,15 @@ import Data.Coerce
 import Prelude hiding (lookup)
 
 import Utils.Fold (foldBenchmarks, foldWithKeyBenchmarks)
+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
+    let m = M.fromList elems :: M.Map Int Int
+        m_even = M.fromList elems_even :: M.Map Int Int
+        m_odd = M.fromList elems_odd :: M.Map Int Int
     evaluate $ rnf [m, m_even, m_odd]
-    evaluate $ rnf [elems_rev, elems_asc, elems_desc]
+    evaluate $ rnf
+      [elems_distinct_asc, elems_distinct_desc, elems_asc, elems_desc]
     defaultMain
         [ bench "lookup absent" $ whnf (lookup evens) m_odd
         , bench "lookup present" $ whnf (lookup evens) m_even
@@ -80,7 +82,7 @@ main = do
         , bench "updateLookupWithKey delete" $ whnf (upd' (const Nothing) evens) m
         , bench "mapMaybe" $ whnf (M.mapMaybe maybeDel) m
         , bench "mapMaybeWithKey" $ whnf (M.mapMaybeWithKey (const maybeDel)) m
-        , bench "lookupIndex" $ whnf (lookupIndex keys) m
+        , bench "lookupIndex" $ whnf (lookupIndex keys_distinct_asc) m
         , bench "union" $ whnf (M.union m_even) m_odd
         , bench "difference" $ whnf (M.difference m) m_even
         , bench "intersection" $ whnf (M.intersection m) m_even
@@ -93,9 +95,9 @@ main = do
         , bench "fromDescList" $ whnf M.fromDescList elems_desc
         , bench "fromDescListWithKey" $
             whnf (M.fromDescListWithKey sumkv) elems_desc
-        , bench "fromDistinctAscList" $ whnf M.fromDistinctAscList elems
+        , bench "fromDistinctAscList" $ whnf M.fromDistinctAscList elems_distinct_asc
         , bench "fromDistinctAscList:fusion" $ whnf (\n -> M.fromDistinctAscList [(i,i) | i <- [1..n]]) bound
-        , bench "fromDistinctDescList" $ whnf M.fromDistinctDescList elems_rev
+        , bench "fromDistinctDescList" $ whnf M.fromDistinctDescList elems_distinct_desc
         , bench "fromDistinctDescList:fusion" $ whnf (\n -> M.fromDistinctDescList [(i,i) | i <- [n,n-1..1]]) bound
         , bench "minView" $ whnf (\m' -> case M.minViewWithKey m' of {Nothing -> 0; Just ((k,v),m'') -> k+v+M.size m''}) (M.fromAscList $ zip [1..10::Int] [100..110::Int])
         , bench "eq" $ whnf (\m' -> m' == m') m -- worst case, compares everything
@@ -106,17 +108,18 @@ main = do
         ]
   where
     bound = 2^12
-    elems = zip keys values
+    elems = shuffle elems_distinct_asc
     elems_even = zip evens evens
     elems_odd = zip odds odds
-    elems_rev = reverse elems
+    elems_distinct_asc = zip keys_distinct_asc values
+    elems_distinct_desc = reverse elems_distinct_asc
     keys_asc = map (`div` 2) [1..bound] -- [0,1,1,2,2..]
     elems_asc = zip keys_asc values
     keys_desc = map (`div` 2) [bound,bound-1..1] -- [..2,2,1,1,0]
     elems_desc = zip keys_desc values
-    keys = [1..bound]
-    evens = [2,4..bound]
-    odds = [1,3..bound]
+    keys_distinct_asc = [1..bound]
+    evens = shuffle [2,4..bound]
+    odds = shuffle [1,3..bound]
     values = [1..bound]
     sumkv k v1 v2 = k + v1 + v2
     consPair k v xs = (k, v) : xs

containers-tests/benchmarks/Set.hs

@@ -9,14 +9,16 @@ import Data.List (foldl')
 import qualified Data.Set as S
 
 import Utils.Fold (foldBenchmarks)
+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
+    let s = S.fromList elems :: S.Set Int
+        s_even = S.fromList elems_even :: S.Set Int
+        s_odd = S.fromList 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_distinct_asc, elems_distinct_desc, elems_asc, elems_desc]
     defaultMain
         [ bench "member" $ whnf (member elems) s
         , bench "insert" $ whnf (ins elems) S.empty
@@ -35,10 +37,10 @@ main = do
         , bench "fromList" $ whnf S.fromList elems
         , bench "fromList-desc" $ whnf S.fromList elems_desc
         , bench "fromAscList" $ whnf S.fromAscList elems_asc
-        , bench "fromDistinctAscList" $ whnf S.fromDistinctAscList elems
+        , bench "fromDistinctAscList" $ whnf S.fromDistinctAscList elems_distinct_asc
         , bench "fromDistinctAscList:fusion" $ whnf (\n -> S.fromDistinctAscList [1..n]) bound
         , bench "fromDescList" $ whnf S.fromDescList elems_desc
-        , bench "fromDistinctDescList" $ whnf S.fromDistinctDescList elems_rev
+        , bench "fromDistinctDescList" $ whnf S.fromDistinctDescList elems_distinct_desc
         , bench "fromDistinctDescList:fusion" $ whnf (\n -> S.fromDistinctDescList [n,n-1..1]) bound
         , bench "disjoint:false" $ whnf (S.disjoint s) s_even
         , bench "disjoint:true" $ whnf (S.disjoint s_odd) s_even
@@ -61,10 +63,11 @@ main = do
         ]
   where
     bound = 2^12
-    elems = [1..bound]
-    elems_even = [2,4..bound]
-    elems_odd = [1,3..bound]
-    elems_rev = reverse elems
+    elems_distinct_asc = [1..bound]
+    elems_distinct_desc = reverse elems_distinct_asc
+    elems = shuffle elems_distinct_asc
+    elems_even = shuffle [2,4..bound]
+    elems_odd = shuffle [1,3..bound]
     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

containers-tests/benchmarks/Utils/Random.hs

@@ -0,0 +1,23 @@
+module Utils.Random
+  ( shuffle
+  ) where
+
+import Data.List (unfoldr)
+import qualified Data.Sequence as Seq
+import System.Random (StdGen, mkStdGen, randomR)
+
+-- O(n log n). Deterministic shuffle. Implements Fisher-Yates.
+shuffle :: [a] -> [a]
+shuffle xs0 = unfoldr f (gen, 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 #-}
+
+gen :: StdGen
+gen = mkStdGen 42

containers-tests/containers-tests.cabal

@@ -168,6 +168,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
 
   other-modules:
     Utils.Fold
@@ -197,7 +202,7 @@ benchmark sequence-benchmarks
   main-is:        Sequence.hs
   ghc-options:    -O2
   build-depends:
-      random            >=0       && <1.2
+      random >=1.0 && <1.3
     , transformers
 
   other-modules:
@@ -213,6 +218,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
 
   other-modules:
     Utils.Fold
@@ -228,7 +238,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