tail-recursive keys and values

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

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.

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,15 +302,15 @@ 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 ->
                  M.isSubmap (M.filter p s) s
 
   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) ->