Merge pull request #79 from joshuahhh/master

Added toAscUnfoldable

Author: hdgarrood

src/Data/Map.purs

@@ -20,6 +20,7 @@ module Data.Map
   , fromFoldableWith
   , toList
   , toUnfoldable
+  , toAscUnfoldable
   , delete
   , pop
   , member
@@ -35,15 +36,13 @@ module Data.Map
   ) where
 
 import Prelude
-
 import Data.Foldable (foldl, foldMap, foldr, class Foldable)
 import Data.List (List(..), (:), length, nub)
 import Data.Maybe (Maybe(..), maybe, isJust, fromMaybe)
 import Data.Monoid (class Monoid)
 import Data.Traversable (traverse, class Traversable)
 import Data.Tuple (Tuple(Tuple), snd)
 import Data.Unfoldable (class Unfoldable, unfoldr)
-
 import Partial.Unsafe (unsafePartial)
 
 -- | `Map k v` represents maps from keys of type `k` to values of type `v`.
@@ -52,14 +51,18 @@ data Map k v
   | Two (Map k v) k v (Map k v)
   | Three (Map k v) k v (Map k v) k v (Map k v)
 
+-- Internal use
+toAscArray :: forall k v. Map k v -> Array (Tuple k v)
+toAscArray = toAscUnfoldable
+
 instance eqMap :: (Eq k, Eq v) => Eq (Map k v) where
-  eq m1 m2 = toList m1 == toList m2
+  eq m1 m2 = toAscArray m1 == toAscArray m2
 
 instance ordMap :: (Ord k, Ord v) => Ord (Map k v) where
-  compare m1 m2 = compare (toList m1) (toList m2)
+  compare m1 m2 = compare (toAscArray m1) (toAscArray m2)
 
 instance showMap :: (Show k, Show v) => Show (Map k v) where
-  show m = "(fromList " <> show (toList m) <> ")"
+  show m = "(fromFoldable " <> show (toAscArray m) <> ")"
 
 instance semigroupMap :: Ord k => Semigroup (Map k v) where
   append = union
@@ -378,11 +381,10 @@ fromFoldableWith f = foldl (\m (Tuple k v) -> alter (combine v) k m) empty where
   combine v (Just v') = Just $ f v v'
   combine v Nothing = Just v
 
--- | Convert a map to a list of key/value pairs
+-- | Convert a map to a list of key/value pairs.
+-- | DEPRECATED: use toUnfoldable or toAscUnfoldable instead.
 toList :: forall k v. Map k v -> List (Tuple k v)
-toList Leaf = Nil
-toList (Two left k v right) = toList left <> Tuple k v : toList right
-toList (Three left k1 v1 mid k2 v2 right) = toList left <> Tuple k1 v1 : toList mid <> Tuple k2 v2 : toList right
+toList = toAscUnfoldable
 
 -- | Convert a map to an unfoldable structure of key/value pairs
 toUnfoldable :: forall f k v. Unfoldable f => Map k v -> f (Tuple k v)
@@ -395,6 +397,21 @@ 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
+  go Nil = Nothing
+  go (hd : tl) = case hd of
+    Leaf -> go tl
+    Two Leaf k v Leaf ->
+      Just $ Tuple (Tuple k v) tl
+    Two Leaf k v right ->
+      Just $ Tuple (Tuple 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

test/Test/Data/Map.purs

@@ -1,23 +1,19 @@
 module Test.Data.Map where
 
 import Prelude
-
+import Data.List.NonEmpty as NEL
+import Data.Map as M
 import Control.Alt ((<|>))
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (log, CONSOLE)
 import Control.Monad.Eff.Exception (EXCEPTION)
 import Control.Monad.Eff.Random (RANDOM)
-
 import Data.Foldable (foldl, for_, all)
 import Data.Function (on)
-import Data.List (List(..), groupBy, length, nubBy, sortBy, singleton)
-import Data.List.NonEmpty as NEL
-import Data.Map as M
+import Data.List (List(Cons), groupBy, length, nubBy, singleton, sort, sortBy)
 import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Tuple (Tuple(..), fst)
-
 import Partial.Unsafe (unsafePartial)
-
 import Test.QuickCheck ((<?>), (===), quickCheck, quickCheck')
 import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary)
 
@@ -170,7 +166,7 @@ mapTests = do
     in M.lookup k tree == Just v <?> ("instrs:\n  " <> show instrs <> "\nk:\n  " <> show k <> "\nv:\n  " <> show v)
 
   log "Singleton to list"
-  quickCheck $ \k v -> M.toList (M.singleton k v :: M.Map SmallKey Int) == singleton (Tuple k v)
+  quickCheck $ \k v -> M.toUnfoldable (M.singleton k v :: M.Map SmallKey Int) == singleton (Tuple k v)
 
   log "fromFoldable [] = empty"
   quickCheck (M.fromFoldable [] == (M.empty :: M.Map Unit Unit)
@@ -194,21 +190,21 @@ mapTests = do
     quickCheck (M.lookup 1 nums == Just 2  <?> "invalid lookup - 1")
     quickCheck (M.lookup 2 nums == Nothing <?> "invalid lookup - 2")
 
-  log "toList . fromFoldable = id"
-  quickCheck $ \arr -> let f x = M.toList (M.fromFoldable x)
-                       in f (f arr) == f (arr :: List (Tuple SmallKey Int)) <?> show arr
-
-  log "fromFoldable . toList = id"
-  quickCheck $ \(TestMap m) -> let f m' = M.fromFoldable (M.toList m') in
-                     M.toList (f m) == M.toList (m :: M.Map SmallKey Int) <?> show m
+  log "sort . toUnfoldable . fromFoldable = sort (on lists without key-duplicates)"
+  quickCheck $ \(list :: List (Tuple SmallKey Int)) ->
+    let nubbedList = nubBy ((==) `on` fst) list
+        f x = M.toUnfoldable (M.fromFoldable x)
+    in sort (f nubbedList) == sort nubbedList <?> show nubbedList
 
   log "fromFoldable . toUnfoldable = id"
-  quickCheck $ \(TestMap m) -> let f m' = M.fromFoldable (M.toUnfoldable m' :: List (Tuple SmallKey Int)) in
-                     f m == (m :: M.Map SmallKey Int) <?> show m
+  quickCheck $ \(TestMap (m :: M.Map SmallKey Int)) ->
+    let f m' = M.fromFoldable (M.toUnfoldable m' :: List (Tuple SmallKey Int))
+    in f m == m <?> show m
 
   log "fromFoldableWith const = fromFoldable"
-  quickCheck $ \arr -> M.fromFoldableWith const arr ==
-                       M.fromFoldable (arr :: List (Tuple SmallKey Int)) <?> show arr
+  quickCheck $ \arr ->
+    M.fromFoldableWith const arr ==
+    M.fromFoldable (arr :: List (Tuple SmallKey Int)) <?> show arr
 
   log "fromFoldableWith (<>) = fromFoldable . collapse with (<>) . group on fst"
   quickCheck $ \arr ->
@@ -218,6 +214,12 @@ mapTests = do
             groupBy ((==) `on` fst) <<< sortBy (compare `on` fst) in
     M.fromFoldableWith (<>) arr === f (arr :: List (Tuple String String))
 
+  log "toAscUnfoldable is sorted version of toUnfoldable"
+  quickCheck $ \(TestMap m) ->
+    let list = M.toUnfoldable (m :: M.Map SmallKey Int)
+        ascList = M.toAscUnfoldable m
+    in ascList === sortBy (compare `on` fst) list
+
   log "Lookup from union"
   quickCheck $ \(TestMap m1) (TestMap m2) k ->
     M.lookup (smallKey k) (M.union m1 m2) == (case M.lookup k m1 of
@@ -310,5 +312,6 @@ mapTests = do
   quickCheck $ \(TestMap m :: TestMap String Int) -> let
     f k v = k <> show v
     resultViaMapWithKey = m # M.mapWithKey f
-    resultViaLists = m # M.toList # map (\(Tuple k v) → Tuple k (f k v)) # M.fromFoldable
+    toList = M.toUnfoldable :: forall k v. M.Map k v -> List (Tuple k v)
+    resultViaLists = m # toList # map (\(Tuple k v) → Tuple k (f k v)) # M.fromFoldable
     in resultViaMapWithKey === resultViaLists