Skip to content

Commit 585b257

Browse files
jeltschjeltsch
authored
Merge pull request #599 from IntersectMBO/jeltsch/general-index-benchmarks
Add general index benchmarks
2 parents 86704e0 + b635b2c commit 585b257

File tree

5 files changed

+153
-20
lines changed

5 files changed

+153
-20
lines changed

‎bench/micro/Bench/Database/LSMTree/Internal/Index.hs‎

Lines changed: 123 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,123 @@
1+
{-# LANGUAGE CPP #-}
2+
3+
module Bench.Database.LSMTree.Internal.Index (benchmarks) where
4+
5+
import Control.Category ((>>>))
6+
import Control.DeepSeq (rnf)
7+
import Control.Monad.ST.Strict (runST)
8+
import Criterion.Main (Benchmark, Benchmarkable, bench, bgroup, env,
9+
whnf)
10+
#if __GLASGOW_HASKELL__ < 910
11+
import Data.List (foldl')
12+
#endif
13+
import Database.LSMTree.Extras.Generators (getKeyForIndexCompact,
14+
mkPages, toAppends)
15+
-- also for @Arbitrary@ instantiation of @SerialisedKey@
16+
import Database.LSMTree.Extras.Index (Append, append)
17+
import Database.LSMTree.Internal.Index (Index,
18+
IndexType (Compact, Ordinary), newWithDefaults, search,
19+
unsafeEnd)
20+
import Database.LSMTree.Internal.Serialise
21+
(SerialisedKey (SerialisedKey))
22+
import Test.QuickCheck (choose, vector)
23+
import Test.QuickCheck.Gen (Gen (MkGen))
24+
import Test.QuickCheck.Random (mkQCGen)
25+
26+
-- * Benchmarks
27+
28+
benchmarks :: Benchmark
29+
benchmarks = bgroup "Bench.Database.LSMTree.Internal.Index" $
30+
map (uncurry benchmarksForSingleType) $
31+
[("Compact", Compact), ("Ordinary", Ordinary)]
32+
where
33+
34+
benchmarksForSingleType :: String -> IndexType -> Benchmark
35+
benchmarksForSingleType indexTypeName indexType
36+
= bgroup (indexTypeName ++ " index") $
37+
[
38+
-- Search
39+
env (return $ searchIndex indexType 10000) $ \ index ->
40+
env (return $ searchKeys 1000) $ \ keys ->
41+
bench "Search" $
42+
searchBenchmarkable index keys,
43+
44+
-- Incremental construction
45+
env (return $ incrementalConstructionAppends 10000) $ \ appends ->
46+
bench "Incremental construction" $
47+
incrementalConstructionBenchmarkable indexType appends
48+
]
49+
50+
-- * Utilities
51+
52+
-- | Deterministically constructs a value using a QuickCheck generator.
53+
generated :: Gen a -> a
54+
generated (MkGen exec) = exec (mkQCGen 411) 30
55+
56+
{-|
57+
Constructs serialised keys that conform to the key size constraint of
58+
compact indexes.
59+
-}
60+
keysForIndexCompact :: Int -- ^ Number of keys
61+
-> [SerialisedKey] -- ^ Constructed keys
62+
keysForIndexCompact = vector >>>
63+
generated >>>
64+
map (getKeyForIndexCompact >>> SerialisedKey)
65+
66+
{-|
67+
Constructs append operations whose serialised keys conform to the key size
68+
constraint of compact indexes.
69+
-}
70+
appendsForIndexCompact :: Int -- ^ Number of keys used in the construction
71+
-> [Append] -- ^ Constructed append operations
72+
appendsForIndexCompact = keysForIndexCompact >>>
73+
mkPages 0.03 (choose (0, 16)) 0.01 >>>
74+
generated >>>
75+
toAppends
76+
{-
77+
The arguments used for 'mkPages' are the same as the ones used for
78+
'genPages' in the instantiation of 'Arbitrary' for 'LogicalPageSummaries' at
79+
the time of writing.
80+
-}
81+
82+
{-|
83+
Constructs an index by applying append operations to an initially empty
84+
index.
85+
-}
86+
indexFromAppends :: IndexType -> [Append] -> Index
87+
indexFromAppends indexType appends = runST $ do
88+
indexAcc <- newWithDefaults indexType
89+
mapM_ (flip append indexAcc) appends
90+
snd <$> unsafeEnd indexAcc
91+
92+
-- * Benchmark ingredients
93+
94+
-- ** Search
95+
96+
-- | Constructs an index to be searched.
97+
searchIndex :: IndexType -- ^ Type of index to construct
98+
-> Int -- ^ Number of keys used in the construction
99+
-> Index -- ^ Constructed index
100+
searchIndex indexType keyCount
101+
= indexFromAppends indexType (appendsForIndexCompact keyCount)
102+
103+
-- | Constructs a list of keys to search for.
104+
searchKeys :: Int -- ^ Number of searches
105+
-> [SerialisedKey] -- ^ Constructed search keys
106+
searchKeys = keysForIndexCompact
107+
108+
-- | The action to be performed by a search benchmark.
109+
searchBenchmarkable :: Index -> [SerialisedKey] -> Benchmarkable
110+
searchBenchmarkable index = whnf $ foldl' (\ _ key -> rnf (search key index)) ()
111+
112+
-- ** Incremental construction
113+
114+
-- | Constructs append operations to be used in index construction.
115+
incrementalConstructionAppends
116+
:: Int -- ^ Number of keys used in the construction
117+
-> [Append] -- ^ Constructed append operations
118+
incrementalConstructionAppends = appendsForIndexCompact
119+
120+
-- | The action to be performed by an incremental-construction benchmark.
121+
incrementalConstructionBenchmarkable :: IndexType -> [Append] -> Benchmarkable
122+
incrementalConstructionBenchmarkable indexType appends
123+
= whnf (indexFromAppends indexType) appends

‎bench/micro/Main.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@
44
module Main (main) where
55

66
import qualified Bench.Database.LSMTree.Internal.BloomFilter
7+
import qualified Bench.Database.LSMTree.Internal.Index
78
import qualified Bench.Database.LSMTree.Internal.Index.Compact
89
import qualified Bench.Database.LSMTree.Internal.Lookup
910
import qualified Bench.Database.LSMTree.Internal.Merge
@@ -21,6 +22,7 @@ main = do
2122
#endif
2223
defaultMain [
2324
Bench.Database.LSMTree.Internal.BloomFilter.benchmarks
25+
, Bench.Database.LSMTree.Internal.Index.benchmarks
2426
, Bench.Database.LSMTree.Internal.Index.Compact.benchmarks
2527
, Bench.Database.LSMTree.Internal.Lookup.benchmarks
2628
, Bench.Database.LSMTree.Internal.Merge.benchmarks

‎lsm-tree.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -476,6 +476,7 @@ benchmark lsm-tree-micro-bench
476476
main-is: Main.hs
477477
other-modules:
478478
Bench.Database.LSMTree.Internal.BloomFilter
479+
Bench.Database.LSMTree.Internal.Index
479480
Bench.Database.LSMTree.Internal.Index.Compact
480481
Bench.Database.LSMTree.Internal.Lookup
481482
Bench.Database.LSMTree.Internal.Merge

‎src/Database/LSMTree/Internal/Index/Ordinary.hs‎

Lines changed: 26 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -89,26 +89,32 @@ search key (IndexOrdinary lastKeys) = assert (pageCount > 0) result where
8989
!pageCount = length lastKeys
9090

9191
result :: PageSpan
92-
!result | protoStart < pageCount
93-
= let
94-
95-
end :: Int
96-
!end = maybe (pred pageCount) (+ protoStart) $
97-
findIndex (/= lastKeys ! protoStart) $
98-
drop (succ protoStart) lastKeys
99-
100-
in PageSpan (PageNo $ protoStart)
101-
(PageNo $ end)
102-
| otherwise
103-
= let
104-
105-
start :: Int
106-
!start = maybe 0 succ $
107-
findIndexR (/= last lastKeys) $
108-
lastKeys
109-
110-
in PageSpan (PageNo $ start)
111-
(PageNo $ pred pageCount)
92+
result | protoStart < pageCount
93+
= let
94+
95+
resultKey :: SerialisedKey
96+
!resultKey = lastKeys ! protoStart
97+
98+
end :: Int
99+
!end = maybe (pred pageCount) (+ protoStart) $
100+
findIndex (/= resultKey) $
101+
drop (succ protoStart) lastKeys
102+
103+
in PageSpan (PageNo $ protoStart)
104+
(PageNo $ end)
105+
| otherwise
106+
= let
107+
108+
resultKey :: SerialisedKey
109+
!resultKey = last lastKeys
110+
111+
start :: Int
112+
!start = maybe 0 succ $
113+
findIndexR (/= resultKey) $
114+
lastKeys
115+
116+
in PageSpan (PageNo $ start)
117+
(PageNo $ pred pageCount)
112118

113119
{-|
114120
For a specification of this operation, see the documentation of [its

‎src/Database/LSMTree/Internal/Vector.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -94,6 +94,7 @@ forMStrict xs f = V.forM xs (f >=> (pure $!))
9494
-}
9595
binarySearchL :: Ord a => V.Vector a -> a -> Int
9696
binarySearchL vec val = runST $ V.unsafeThaw vec >>= flip VA.binarySearchL val
97+
{-# INLINE binarySearchL #-}
9798

9899
{-# INLINE unsafeInsertWithMStrict #-}
99100
-- | Insert (in a broad sense) an entry in a mutable vector at a given index,

0 commit comments

Comments
 (0)