Use randomly structured Set and Map in benchmarks (#1075)

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

Most benchmarks show an increase in measured times, the amount varying
from 10% to 70%. This is expected because the trees are more unbalanced
now. A handful of benchmarks show larger increases. These were previously
measuring best-case scenarios, which no longer occur with random trees.

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/SetOperations/SetOperations-Map.hs

@@ -3,8 +3,10 @@ module Main where
 import Data.Map as C
 import SetOperations
 
+import Utils.Random (shuffle)
+
 main :: IO ()
-main = benchmark (\xs -> fromList [(x, x) | x <- xs]) True
+main = benchmark (\xs -> fromList [(x, x) | x <- shuffle xs]) True
   [ ("union", C.union)
   , ("difference", C.difference)
   , ("intersection", C.intersection)

containers-tests/benchmarks/SetOperations/SetOperations-Set.hs

@@ -3,8 +3,10 @@ module Main where
 import Data.Set as C
 import SetOperations
 
+import Utils.Random (shuffle)
+
 main :: IO ()
-main = benchmark fromList True
+main = benchmark (fromList . shuffle) True
   [ ("union", C.union)
   , ("difference", C.difference)
   , ("intersection", C.intersection)

containers-tests/benchmarks/Utils/Random.hs

@@ -0,0 +1,22 @@
+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
+
+gen :: StdGen
+gen = mkStdGen 42

containers-tests/containers-tests.cabal

@@ -167,6 +167,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
@@ -196,7 +201,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:
@@ -212,6 +217,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
@@ -227,7 +237,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
@@ -251,19 +261,33 @@ benchmark set-operations-map
   import: benchmark-deps, warnings
   default-language: Haskell2010
   type:           exitcode-stdio-1.0
-  hs-source-dirs: benchmarks/SetOperations
+  hs-source-dirs:
+      benchmarks/SetOperations
+      benchmarks
   main-is:        SetOperations-Map.hs
   other-modules:  SetOperations
   ghc-options:    -O2
+  build-depends:
+      random >=1.0 && <1.3
+
+  other-modules:
+      Utils.Random
 
 benchmark set-operations-set
   import: benchmark-deps, warnings
   default-language: Haskell2010
   type:           exitcode-stdio-1.0
-  hs-source-dirs: benchmarks/SetOperations
+  hs-source-dirs:
+      benchmarks/SetOperations
+      benchmarks
   main-is:        SetOperations-Set.hs
   other-modules:  SetOperations
   ghc-options:    -O2
+  build-depends:
+      random >=1.0 && <1.3
+
+  other-modules:
+      Utils.Random
 
 benchmark lookupge-intmap
   import: benchmark-deps, warnings