Skip to content
This repository was archived by the owner on Oct 4, 2020. It is now read-only.

Commit dd04c36

Browse files
matthewleonmatthewleon
committed
benchmarks for keys and values
1 parent 5754a85 commit dd04c36

File tree

3 files changed

+72
-36
lines changed

3 files changed

+72
-36
lines changed

‎bench/Bench/Data/Map.purs

Lines changed: 51 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -17,20 +17,32 @@ benchMap = do
1717

1818
log ""
1919

20+
log "keys"
21+
log "------------"
22+
benchKeys
23+
24+
log ""
25+
26+
log "values"
27+
log "------------"
28+
benchValues
29+
30+
log ""
31+
2032
log "fromFoldable"
2133
log "------------"
2234
benchFromFoldable
2335

2436
where
2537

26-
benchSize = do
27-
let nats = L.range 0 999999
28-
natPairs = (flip Tuple) unit <$> nats
29-
singletonMap = M.singleton 0 unit
30-
smallMap = M.fromFoldable $ L.take 100 natPairs
31-
midMap = M.fromFoldable $ L.take 10000 natPairs
32-
bigMap = M.fromFoldable $ natPairs
38+
nats = L.range 0 999999
39+
natPairs = (flip Tuple) unit <$> nats
40+
singletonMap = M.singleton 0 unit
41+
smallMap = M.fromFoldable $ L.take 100 natPairs
42+
midMap = M.fromFoldable $ L.take 10000 natPairs
43+
bigMap = M.fromFoldable $ natPairs
3344

45+
benchSize = do
3446
log "size: singleton map"
3547
bench \_ -> M.size singletonMap
3648

@@ -43,6 +55,38 @@ benchMap = do
4355
log $ "size: big map (" <> show (M.size bigMap) <> ")"
4456
benchWith 10 \_ -> M.size bigMap
4557

58+
benchKeys = do
59+
let keys :: forall k v. M.Map k v -> L.List k
60+
keys = M.keys
61+
62+
log "keys: singleton map"
63+
bench \_ -> keys singletonMap
64+
65+
log $ "keys: small map (" <> show (M.size smallMap) <> ")"
66+
bench \_ -> keys smallMap
67+
68+
log $ "keys: midsize map (" <> show (M.size midMap) <> ")"
69+
benchWith 100 \_ -> keys midMap
70+
71+
log $ "keys: big map (" <> show (M.size bigMap) <> ")"
72+
benchWith 10 \_ -> keys bigMap
73+
74+
benchValues = do
75+
let values :: forall k v. M.Map k v -> L.List v
76+
values = M.values
77+
78+
log "values: singleton map"
79+
bench \_ -> values singletonMap
80+
81+
log $ "values: small map (" <> show (M.size smallMap) <> ")"
82+
bench \_ -> values smallMap
83+
84+
log $ "values: midsize map (" <> show (M.size midMap) <> ")"
85+
benchWith 100 \_ -> values midMap
86+
87+
log $ "values: big map (" <> show (M.size bigMap) <> ")"
88+
benchWith 10 \_ -> values bigMap
89+
4690
benchFromFoldable = do
4791
let natStrs = show <$> L.range 0 99999
4892
natPairs = (flip Tuple) unit <$> natStrs

‎src/Data/Map.purs

Lines changed: 7 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -22,8 +22,6 @@ module Data.Map
2222
, fromFoldableWith
2323
, toUnfoldable
2424
, toAscUnfoldable
25-
, toAscUnfoldableKeys
26-
, toAscUnfoldableValues
2725
, delete
2826
, pop
2927
, member
@@ -101,9 +99,9 @@ instance functorWithIndexMap :: FunctorWithIndex k (Map k) where
10199
mapWithIndex f (Three left k1 v1 mid k2 v2 right) = Three (mapWithIndex f left) k1 (f k1 v1) (mapWithIndex f mid) k2 (f k2 v2) (mapWithIndex f right)
102100

103101
instance foldableMap :: Foldable (Map k) where
104-
foldl f z m = foldl f z (values m)
105-
foldr f z m = foldr f z (values m)
106-
foldMap f m = foldMap f (values m)
102+
foldl f z m = foldl f z ((values :: forall v. Map k v -> List v) m)
103+
foldr f z m = foldr f z ((values :: forall v. Map k v -> List v) m)
104+
foldMap f m = foldMap f ((values :: forall v. Map k v -> List v) m)
107105

108106
instance foldableWithIndexMap :: FoldableWithIndex k (Map k) where
109107
foldlWithIndex f z m = foldl (uncurry <<< (flip f)) z $ asList $ toUnfoldable m
@@ -583,8 +581,8 @@ toAscUnfoldable m = unfoldr go (m : Nil) where
583581
go $ left : singleton k1 v1 : mid : singleton k2 v2 : right : tl
584582

585583
-- | Convert a map to an unfoldable structure of keys in ascending order.
586-
toAscUnfoldableKeys :: forall f k v. Unfoldable f => Map k v -> f k
587-
toAscUnfoldableKeys m = unfoldr go (m : Nil) where
584+
keys :: forall f k v. Unfoldable f => Map k v -> f k
585+
keys m = unfoldr go (m : Nil) where
588586
go Nil = Nothing
589587
go (hd : tl) = case hd of
590588
Leaf -> go tl
@@ -597,13 +595,9 @@ toAscUnfoldableKeys m = unfoldr go (m : Nil) where
597595
Three left k1 v1 mid k2 v2 right ->
598596
go $ left : singleton k1 v1 : mid : singleton k2 v2 : right : tl
599597

600-
-- | Get a list of the keys contained in a map
601-
keys :: forall k v. Map k v -> List k
602-
keys = toAscUnfoldableKeys
603-
604598
-- | Convert a map to an unfoldable structure of values in ascending order of their corresponding keys.
605-
toAscUnfoldableValues :: forall f k. Unfoldable f => Map k ~> f
606-
toAscUnfoldableValues m = unfoldr go (m : Nil) where
599+
values :: forall f k v. Unfoldable f => Map k v -> f v
600+
values m = unfoldr go (m : Nil) where
607601
go Nil = Nothing
608602
go (hd : tl) = case hd of
609603
Leaf -> go tl
@@ -616,10 +610,6 @@ toAscUnfoldableValues m = unfoldr go (m : Nil) where
616610
Three left k1 v1 mid k2 v2 right ->
617611
go $ left : singleton k1 v1 : mid : singleton k2 v2 : right : tl
618612

619-
-- | Get a list of the values contained in a map
620-
values :: forall k. Map k ~> List
621-
values = toAscUnfoldableValues
622-
623613
-- | Compute the union of two maps, using the specified function
624614
-- | to combine values for duplicate keys.
625615
unionWith :: forall k v. Ord k => (v -> v -> v) -> Map k v -> Map k v -> Map k v

‎test/Test/Data/Map.purs

Lines changed: 14 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -221,53 +221,55 @@ mapTests = do
221221

222222
log "lookupLE result is correct"
223223
quickCheck $ \k (TestMap m) -> case M.lookupLE k (smallKeyToNumberMap m) of
224-
Nothing -> all (_ > k) $ M.keys m
224+
Nothing -> all (_ > k) (M.keys m :: Array SmallKey)
225225
Just { key: k1, value: v } -> let
226226
isCloserKey k2 = k1 < k2 && k2 < k
227227
isLTwhenEQexists = k1 < k && M.member k m
228228
in k1 <= k
229-
&& all (not <<< isCloserKey) (M.keys m)
229+
&& all (not <<< isCloserKey) (M.keys m :: Array SmallKey)
230230
&& not isLTwhenEQexists
231231
&& M.lookup k1 m == Just v
232232

233233
log "lookupGE result is correct"
234234
quickCheck $ \k (TestMap m) -> case M.lookupGE k (smallKeyToNumberMap m) of
235-
Nothing -> all (_ < k) $ M.keys m
235+
Nothing -> all (_ < k) (M.keys m :: Array SmallKey)
236236
Just { key: k1, value: v } -> let
237237
isCloserKey k2 = k < k2 && k2 < k1
238238
isGTwhenEQexists = k < k1 && M.member k m
239239
in k1 >= k
240-
&& all (not <<< isCloserKey) (M.keys m)
240+
&& all (not <<< isCloserKey) (M.keys m :: Array SmallKey)
241241
&& not isGTwhenEQexists
242242
&& M.lookup k1 m == Just v
243243

244244
log "lookupLT result is correct"
245245
quickCheck $ \k (TestMap m) -> case M.lookupLT k (smallKeyToNumberMap m) of
246-
Nothing -> all (_ >= k) $ M.keys m
246+
Nothing -> all (_ >= k) (M.keys m :: Array SmallKey)
247247
Just { key: k1, value: v } -> let
248248
isCloserKey k2 = k1 < k2 && k2 < k
249249
in k1 < k
250-
&& all (not <<< isCloserKey) (M.keys m)
250+
&& all (not <<< isCloserKey) (M.keys m :: Array SmallKey)
251251
&& M.lookup k1 m == Just v
252252

253253
log "lookupGT result is correct"
254254
quickCheck $ \k (TestMap m) -> case M.lookupGT k (smallKeyToNumberMap m) of
255-
Nothing -> all (_ <= k) $ M.keys m
255+
Nothing -> all (_ <= k) (M.keys m :: Array SmallKey)
256256
Just { key: k1, value: v } -> let
257257
isCloserKey k2 = k < k2 && k2 < k1
258258
in k1 > k
259-
&& all (not <<< isCloserKey) (M.keys m)
259+
&& all (not <<< isCloserKey) (M.keys m :: Array SmallKey)
260260
&& M.lookup k1 m == Just v
261261

262262
log "findMin result is correct"
263263
quickCheck $ \(TestMap m) -> case M.findMin (smallKeyToNumberMap m) of
264264
Nothing -> M.isEmpty m
265-
Just { key: k, value: v } -> M.lookup k m == Just v && all (_ >= k) (M.keys m)
265+
Just { key: k, value: v } ->
266+
M.lookup k m == Just v && all (_ >= k) (M.keys m :: Array SmallKey)
266267

267268
log "findMax result is correct"
268269
quickCheck $ \(TestMap m) -> case M.findMax (smallKeyToNumberMap m) of
269270
Nothing -> M.isEmpty m
270-
Just { key: k, value: v } -> M.lookup k m == Just v && all (_ <= k) (M.keys m)
271+
Just { key: k, value: v } ->
272+
M.lookup k m == Just v && all (_ <= k) (M.keys m :: Array SmallKey)
271273

272274
log "mapWithKey is correct"
273275
quickCheck $ \(TestMap m :: TestMap String Int) -> let
@@ -291,15 +293,15 @@ mapTests = do
291293

292294
log "filterKeys keeps those keys for which predicate is true"
293295
quickCheck $ \(TestMap s :: TestMap String Int) p ->
294-
A.all p (M.keys (M.filterKeys p s))
296+
A.all p (M.keys (M.filterKeys p s) :: Array String)
295297

296298
log "filter gives submap"
297299
quickCheck $ \(TestMap s :: TestMap String Int) p ->
298300
M.isSubmap (M.filter p s) s
299301

300302
log "filter keeps those values for which predicate is true"
301303
quickCheck $ \(TestMap s :: TestMap String Int) p ->
302-
A.all p (M.values (M.filter p s))
304+
A.all p (M.values (M.filter p s) :: Array Int)
303305

304306
log "submap with no bounds = id"
305307
quickCheck \(TestMap m :: TestMap SmallKey Int) ->

0 commit comments

Comments
 (0)