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 e764370b..be31ab88 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -99,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 @@ -565,32 +565,35 @@ toUnfoldable m = unfoldr go (m : Nil) where Three left k1 v1 mid k2 v2 right -> Just $ Tuple (Tuple k1 v1) (singleton k2 v2 : left : mid : right : tl) --- | Convert a map to an unfoldable structure of key/value pairs where the keys are in ascending order -toAscUnfoldable :: forall f k v. Unfoldable f => Map k v -> f (Tuple k v) -toAscUnfoldable m = unfoldr go (m : Nil) where +-- | Internal, used for the various functions that produce Unfoldables. +toAscUnfoldableWith + :: forall f k v t + . Unfoldable f + => (k -> v -> t) -> Map k v -> f t +toAscUnfoldableWith f m = unfoldr go (m : Nil) where go Nil = Nothing go (hd : tl) = case hd of Leaf -> go tl Two Leaf k v Leaf -> - Just $ Tuple (Tuple k v) tl + Just $ Tuple (f k v) tl Two Leaf k v right -> - Just $ Tuple (Tuple k v) (right : tl) + Just $ Tuple (f k v) (right : tl) Two left k v right -> go $ left : singleton k v : right : tl 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 Leaf = Nil -keys (Two left k _ right) = keys left <> pure k <> keys right -keys (Three left k1 _ mid k2 _ right) = keys left <> pure k1 <> keys mid <> pure k2 <> keys right - --- | Get a list of the values contained in a map -values :: forall k v. Map k v -> List v -values Leaf = Nil -values (Two left _ v right) = values left <> pure v <> values right -values (Three left _ v1 mid _ v2 right) = values left <> pure v1 <> values mid <> pure v2 <> values right +-- | Convert a map to an unfoldable structure of key/value pairs where the keys are in ascending order +toAscUnfoldable :: forall f k v. Unfoldable f => Map k v -> f (Tuple k v) +toAscUnfoldable = toAscUnfoldableWith Tuple + +-- | Convert a map to an unfoldable structure of keys in ascending order. +keys :: forall f k v. Unfoldable f => Map k v -> f k +keys = toAscUnfoldableWith const + +-- | Convert a map to an unfoldable structure of values in ascending order of their corresponding keys. +values :: forall f k v. Unfoldable f => Map k v -> f v +values = toAscUnfoldableWith (flip const) -- | Compute the union of two maps, using the specified function -- | to combine values for duplicate keys. diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index bc38e615..42cf4870 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -15,7 +15,7 @@ import Data.Map as M import Data.Map.Gen (genMap) import Data.Maybe (Maybe(..), fromMaybe, maybe) import Data.NonEmpty ((:|)) -import Data.Tuple (Tuple(..), fst, uncurry) +import Data.Tuple (Tuple(..), fst, snd, uncurry) import Partial.Unsafe (unsafePartial) import Test.QuickCheck ((<?>), (===), quickCheck, quickCheck') import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary) @@ -181,6 +181,15 @@ mapTests = do ascList = M.toAscUnfoldable m in ascList === sortBy (compare `on` fst) list + log "keys output is sorted" + quickCheck $ \(TestMap (m :: M.Map Int Int)) -> + let ks = M.keys m + in ks == sort ks + + log "values output is sorted by associated key" + quickCheck $ \(TestMap (m :: M.Map Int Int)) -> + M.values m == (snd <$> sortBy (compare `on` fst) (M.toUnfoldable m)) + log "Lookup from union" quickCheck $ \(TestMap m1) (TestMap m2) k -> M.lookup (smallKey k) (M.union m1 m2) == (case M.lookup k m1 of @@ -221,53 +230,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 +302,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 +310,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) ->