diff --git a/bench/Bench/Data/Map.purs b/bench/Bench/Data/Map.purs index a2197fc7..5b584b3b 100644 --- a/bench/Bench/Data/Map.purs +++ b/bench/Bench/Data/Map.purs @@ -17,20 +17,32 @@ benchMap = do log "" + log "keys" + log "------------" + benchKeys + + log "" + + log "values" + log "------------" + benchValues + + log "" + log "fromFoldable" log "------------" benchFromFoldable where - benchSize = do - let nats = L.range 0 999999 - natPairs = (flip Tuple) unit <$> nats - singletonMap = M.singleton 0 unit - smallMap = M.fromFoldable $ L.take 100 natPairs - midMap = M.fromFoldable $ L.take 10000 natPairs - bigMap = M.fromFoldable $ natPairs + nats = L.range 0 999999 + natPairs = (flip Tuple) unit <$> nats + singletonMap = M.singleton 0 unit + smallMap = M.fromFoldable $ L.take 100 natPairs + midMap = M.fromFoldable $ L.take 10000 natPairs + bigMap = M.fromFoldable $ natPairs + benchSize = do log "size: singleton map" bench \_ -> M.size singletonMap @@ -43,6 +55,38 @@ benchMap = do log $ "size: big map (" <> show (M.size bigMap) <> ")" benchWith 10 \_ -> M.size bigMap + benchKeys = do + let keys :: forall k v. M.Map k v -> L.List k + keys = M.keys + + log "keys: singleton map" + bench \_ -> keys singletonMap + + log $ "keys: small map (" <> show (M.size smallMap) <> ")" + bench \_ -> keys smallMap + + log $ "keys: midsize map (" <> show (M.size midMap) <> ")" + benchWith 100 \_ -> keys midMap + + log $ "keys: big map (" <> show (M.size bigMap) <> ")" + benchWith 10 \_ -> keys bigMap + + benchValues = do + let values :: forall k v. M.Map k v -> L.List v + values = M.values + + log "values: singleton map" + bench \_ -> values singletonMap + + log $ "values: small map (" <> show (M.size smallMap) <> ")" + bench \_ -> values smallMap + + log $ "values: midsize map (" <> show (M.size midMap) <> ")" + benchWith 100 \_ -> values midMap + + log $ "values: big map (" <> show (M.size bigMap) <> ")" + benchWith 10 \_ -> values bigMap + benchFromFoldable = do let natStrs = show <$> L.range 0 99999 natPairs = (flip Tuple) unit <$> natStrs diff --git a/src/Data/Map.purs b/src/Data/Map.purs index c05447ae..e29a4dcf 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -22,8 +22,6 @@ module Data.Map , fromFoldableWith , toUnfoldable , toAscUnfoldable - , toAscUnfoldableKeys - , toAscUnfoldableValues , delete , pop , member @@ -101,9 +99,9 @@ instance functorWithIndexMap :: FunctorWithIndex k (Map k) where 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) instance foldableMap :: Foldable (Map k) where - foldl f z m = foldl f z (values m) - foldr f z m = foldr f z (values m) - foldMap f m = foldMap f (values m) + foldl f z m = foldl f z ((values :: forall v. Map k v -> List v) m) + foldr f z m = foldr f z ((values :: forall v. Map k v -> List v) m) + foldMap f m = foldMap f ((values :: forall v. Map k v -> List v) m) instance foldableWithIndexMap :: FoldableWithIndex k (Map k) where foldlWithIndex f z m = foldl (uncurry <<< (flip f)) z $ asList $ toUnfoldable m @@ -583,8 +581,8 @@ toAscUnfoldable m = unfoldr go (m : Nil) where go $ left : singleton k1 v1 : mid : singleton k2 v2 : right : tl -- | Convert a map to an unfoldable structure of keys in ascending order. -toAscUnfoldableKeys :: forall f k v. Unfoldable f => Map k v -> f k -toAscUnfoldableKeys m = unfoldr go (m : Nil) where +keys :: forall f k v. Unfoldable f => Map k v -> f k +keys m = unfoldr go (m : Nil) where go Nil = Nothing go (hd : tl) = case hd of Leaf -> go tl @@ -597,13 +595,9 @@ toAscUnfoldableKeys m = unfoldr go (m : Nil) where Three left k1 v1 mid k2 v2 right -> go $ left : singleton k1 v1 : mid : singleton k2 v2 : right : tl --- | Get a list of the keys contained in a map -keys :: forall k v. Map k v -> List k -keys = toAscUnfoldableKeys - -- | Convert a map to an unfoldable structure of values in ascending order of their corresponding keys. -toAscUnfoldableValues :: forall f k. Unfoldable f => Map k ~> f -toAscUnfoldableValues m = unfoldr go (m : Nil) where +values :: forall f k v. Unfoldable f => Map k v -> f v +values m = unfoldr go (m : Nil) where go Nil = Nothing go (hd : tl) = case hd of Leaf -> go tl @@ -616,10 +610,6 @@ toAscUnfoldableValues m = unfoldr go (m : Nil) where Three left k1 v1 mid k2 v2 right -> go $ left : singleton k1 v1 : mid : singleton k2 v2 : right : tl --- | Get a list of the values contained in a map -values :: forall k. Map k ~> List -values = toAscUnfoldableValues - -- | Compute the union of two maps, using the specified function -- | to combine values for duplicate keys. unionWith :: forall k v. Ord k => (v -> v -> v) -> Map k v -> Map k v -> Map k v diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index bc38e615..2d00df5b 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -221,53 +221,55 @@ mapTests = do log "lookupLE result is correct" quickCheck $ \k (TestMap m) -> case M.lookupLE k (smallKeyToNumberMap m) of - Nothing -> all (_ > k) $ M.keys m + Nothing -> all (_ > k) (M.keys m :: Array SmallKey) Just { key: k1, value: v } -> let isCloserKey k2 = k1 < k2 && k2 < k isLTwhenEQexists = k1 < k && M.member k m in k1 <= k - && all (not <<< isCloserKey) (M.keys m) + && all (not <<< isCloserKey) (M.keys m :: Array SmallKey) && not isLTwhenEQexists && M.lookup k1 m == Just v log "lookupGE result is correct" quickCheck $ \k (TestMap m) -> case M.lookupGE k (smallKeyToNumberMap m) of - Nothing -> all (_ < k) $ M.keys m + Nothing -> all (_ < k) (M.keys m :: Array SmallKey) Just { key: k1, value: v } -> let isCloserKey k2 = k < k2 && k2 < k1 isGTwhenEQexists = k < k1 && M.member k m in k1 >= k - && all (not <<< isCloserKey) (M.keys m) + && all (not <<< isCloserKey) (M.keys m :: Array SmallKey) && not isGTwhenEQexists && M.lookup k1 m == Just v log "lookupLT result is correct" quickCheck $ \k (TestMap m) -> case M.lookupLT k (smallKeyToNumberMap m) of - Nothing -> all (_ >= k) $ M.keys m + Nothing -> all (_ >= k) (M.keys m :: Array SmallKey) Just { key: k1, value: v } -> let isCloserKey k2 = k1 < k2 && k2 < k in k1 < k - && all (not <<< isCloserKey) (M.keys m) + && all (not <<< isCloserKey) (M.keys m :: Array SmallKey) && M.lookup k1 m == Just v log "lookupGT result is correct" quickCheck $ \k (TestMap m) -> case M.lookupGT k (smallKeyToNumberMap m) of - Nothing -> all (_ <= k) $ M.keys m + Nothing -> all (_ <= k) (M.keys m :: Array SmallKey) Just { key: k1, value: v } -> let isCloserKey k2 = k < k2 && k2 < k1 in k1 > k - && all (not <<< isCloserKey) (M.keys m) + && all (not <<< isCloserKey) (M.keys m :: Array SmallKey) && M.lookup k1 m == Just v log "findMin result is correct" quickCheck $ \(TestMap m) -> case M.findMin (smallKeyToNumberMap m) of Nothing -> M.isEmpty m - Just { key: k, value: v } -> M.lookup k m == Just v && all (_ >= k) (M.keys m) + Just { key: k, value: v } -> + M.lookup k m == Just v && all (_ >= k) (M.keys m :: Array SmallKey) log "findMax result is correct" quickCheck $ \(TestMap m) -> case M.findMax (smallKeyToNumberMap m) of Nothing -> M.isEmpty m - Just { key: k, value: v } -> M.lookup k m == Just v && all (_ <= k) (M.keys m) + Just { key: k, value: v } -> + M.lookup k m == Just v && all (_ <= k) (M.keys m :: Array SmallKey) log "mapWithKey is correct" quickCheck $ \(TestMap m :: TestMap String Int) -> let @@ -291,7 +293,7 @@ mapTests = do log "filterKeys keeps those keys for which predicate is true" quickCheck $ \(TestMap s :: TestMap String Int) p -> - A.all p (M.keys (M.filterKeys p s)) + A.all p (M.keys (M.filterKeys p s) :: Array String) log "filter gives submap" quickCheck $ \(TestMap s :: TestMap String Int) p -> @@ -299,7 +301,7 @@ mapTests = do log "filter keeps those values for which predicate is true" quickCheck $ \(TestMap s :: TestMap String Int) p -> - A.all p (M.values (M.filter p s)) + A.all p (M.values (M.filter p s) :: Array Int) log "submap with no bounds = id" quickCheck \(TestMap m :: TestMap SmallKey Int) ->