Add fromDescList and fromDistinctDescList
authorDavid Feuer <David.Feuer@gmail.com>
Fri, 8 Jul 2016 18:08:49 +0000 (14:08 -0400)
committerDavid Feuer <David.Feuer@gmail.com>
Fri, 8 Jul 2016 18:41:45 +0000 (14:41 -0400)
The set versions are just like the map versions, pretty much.

Data/Set.hs
Data/Set/Base.hs
changelog.md
tests/set-properties.hs

index fd8c8b9..297cee2 100644 (file)
@@ -129,7 +129,9 @@ module Data.Set (
             , toAscList
             , toDescList
             , fromAscList
+            , fromDescList
             , fromDistinctAscList
+            , fromDistinctDescList
 
             -- * Debugging
             , showTree
index 92bfc1d..8aabd08 100644 (file)
@@ -181,6 +181,8 @@ module Data.Set.Base (
             , toDescList
             , fromAscList
             , fromDistinctAscList
+            , fromDescList
+            , fromDistinctDescList
 
             -- * Debugging
             , showTree
@@ -719,7 +721,7 @@ map f = fromList . List.map f . toList
 
 -- | /O(n)/. The
 --
--- @'mapMonotonic' f s == 'map' f s@, but works only when @f@ is monotonic.
+-- @'mapMonotonic' f s == 'map' f s@, but works only when @f@ is strictly increasing.
 -- /The precondition is not checked./
 -- Semi-formally, we have:
 --
@@ -904,24 +906,32 @@ fromList (x0 : xs0) | not_ordered x0 xs0 = fromList' (Bin 1 x0 Tip Tip) xs0
 -- | /O(n)/. Build a set from an ascending list in linear time.
 -- /The precondition (input list is ascending) is not checked./
 fromAscList :: Eq a => [a] -> Set a
-fromAscList xs
-  = fromDistinctAscList (combineEq xs)
-  where
-  -- [combineEq xs] combines equal elements with [const] in an ordered list [xs]
-  combineEq xs'
-    = case xs' of
-        []     -> []
-        [x]    -> [x]
-        (x:xx) -> combineEq' x xx
-
-  combineEq' z [] = [z]
-  combineEq' z (x:xs')
-    | z==x      =   combineEq' z xs'
-    | otherwise = z:combineEq' x xs'
+fromAscList xs = fromDistinctAscList (combineEq xs)
 #if __GLASGOW_HASKELL__
 {-# INLINABLE fromAscList #-}
 #endif
 
+-- | /O(n)/. Build a set from a descending list in linear time.
+-- /The precondition (input list is descending) is not checked./
+fromDescList :: Eq a => [a] -> Set a
+fromDescList xs = fromDistinctDescList (combineEq xs)
+#if __GLASGOW_HASKELL__
+{-# INLINABLE fromDescList #-}
+#endif
+
+-- [combineEq xs] combines equal elements with [const] in an ordered list [xs]
+--
+-- TODO: combineEq allocates an intermediate list. It *should* be better to
+-- make fromAscListBy and fromDescListBy the fundamental operations, and to
+-- implement the rest using those.
+combineEq :: Eq a => [a] -> [a]
+combineEq [] = []
+combineEq (x : xs) = combineEq' x xs
+  where
+    combineEq' z [] = [z]
+    combineEq' z (y:ys)
+      | z == y = combineEq' z ys
+      | otherwise = z : combineEq' y ys
 
 -- | /O(n)/. Build a set from an ascending list of distinct elements in linear time.
 -- /The precondition (input list is strictly ascending) is not checked./
@@ -934,15 +944,36 @@ fromDistinctAscList (x0 : xs0) = go (1::Int) (Bin 1 x0 Tip Tip) xs0
   where
     go !_ t [] = t
     go s l (x : xs) = case create s xs of
-                        (r, ys) -> go (s `shiftL` 1) (link x l r) ys
+                        (r :*: ys) -> go (s `shiftL` 1) (link x l r) ys
+
+    create !_ [] = (Tip :*: [])
+    create s xs@(x : xs')
+      | s == 1 = (Bin 1 x Tip Tip :*: xs')
+      | otherwise = case create (s `shiftR` 1) xs of
+                      res@(_ :*: []) -> res
+                      (l :*: (y:ys)) -> case create (s `shiftR` 1) ys of
+                        (r :*: zs) -> (link y l r :*: zs)
+
+-- | /O(n)/. Build a set from a descending list of distinct elements in linear time.
+-- /The precondition (input list is strictly descending) is not checked./
+
+-- For some reason, when 'singleton' is used in fromDistinctDescList or in
+-- create, it is not inlined, so we inline it manually.
+fromDistinctDescList :: [a] -> Set a
+fromDistinctDescList [] = Tip
+fromDistinctDescList (x0 : xs0) = go (1::Int) (Bin 1 x0 Tip Tip) xs0
+  where
+    go !_ t [] = t
+    go s r (x : xs) = case create s xs of
+                        (l :*: ys) -> go (s `shiftL` 1) (link x l r) ys
 
-    create !_ [] = (Tip, [])
+    create !_ [] = (Tip :*: [])
     create s xs@(x : xs')
-      | s == 1 = (Bin 1 x Tip Tip, xs')
+      | s == 1 = (Bin 1 x Tip Tip :*: xs')
       | otherwise = case create (s `shiftR` 1) xs of
-                      res@(_, []) -> res
-                      (l, y:ys) -> case create (s `shiftR` 1) ys of
-                        (r, zs) -> (link y l r, zs)
+                      res@(_ :*: []) -> res
+                      (r :*: (y:ys)) -> case create (s `shiftR` 1) ys of
+                        (l :*: zs) -> (link y l r :*: zs)
 
 {--------------------------------------------------------------------
   Eq converts the set to a list. In a lazy setting, this
index 79c926b..9f3913e 100644 (file)
@@ -28,6 +28,8 @@
   * Add `fromDescList`, `fromDescListWith`, `fromDescListWithKey`,
     and `fromDistinctDescList` to `Data.Map`.
 
+  * Add `fromDescList` and `fromDistinctDescList` to `Data.Set`.
+
   * Add `Empty`, `:<|`, and `:|>` pattern synonyms for `Data.Sequence`.
 
   * Add `adjust'`, `(!?)`, `lookup`, `chunksOf`, `cycleTaking`, `insertAt`, `deleteAt`, `intersperse`,
index 694437c..029110d 100644 (file)
@@ -42,10 +42,12 @@ main = defaultMain [ testCase "lookupLT" test_lookupLT
                    , testProperty "prop_IntValid" prop_IntValid
                    , testProperty "prop_Int" prop_Int
                    , testProperty "prop_Ordered" prop_Ordered
+                   , testProperty "prop_DescendingOrdered" prop_DescendingOrdered
                    , testProperty "prop_List" prop_List
                    , testProperty "prop_DescList" prop_DescList
                    , testProperty "prop_AscDescList" prop_AscDescList
                    , testProperty "prop_fromList" prop_fromList
+                   , testProperty "prop_fromListDesc" prop_fromListDesc
                    , testProperty "prop_isProperSubsetOf" prop_isProperSubsetOf
                    , testProperty "prop_isProperSubsetOf2" prop_isProperSubsetOf2
                    , testProperty "prop_isSubsetOf" prop_isSubsetOf
@@ -268,7 +270,12 @@ prop_Int xs ys = toAscList (intersection (fromList xs) (fromList ys))
 prop_Ordered :: Property
 prop_Ordered = forAll (choose (5,100)) $ \n ->
     let xs = [0..n::Int]
-    in fromAscList xs == fromList xs
+    in fromAscList xs === fromList xs
+
+prop_DescendingOrdered :: Property
+prop_DescendingOrdered = forAll (choose (5,100)) $ \n ->
+    let xs = [n,n-1..0::Int]
+    in fromDescList xs === fromList xs
 
 prop_List :: [Int] -> Bool
 prop_List xs = (sort (nub xs) == toList (fromList xs))
@@ -280,13 +287,22 @@ prop_AscDescList :: [Int] -> Bool
 prop_AscDescList xs = toAscList s == reverse (toDescList s)
   where s = fromList xs
 
-prop_fromList :: [Int] -> Bool
-prop_fromList xs
-  = case fromList xs of
-      t -> t == fromAscList sort_xs &&
-           t == fromDistinctAscList nub_sort_xs &&
-           t == List.foldr insert empty xs
-  where sort_xs = sort xs
+prop_fromList :: [Int] -> Property
+prop_fromList xs =
+           t === fromAscList sort_xs .&&.
+           t === fromDistinctAscList nub_sort_xs .&&.
+           t === List.foldr insert empty xs
+  where t = fromList xs
+        sort_xs = sort xs
+        nub_sort_xs = List.map List.head $ List.group sort_xs
+
+prop_fromListDesc :: [Int] -> Property
+prop_fromListDesc xs =
+           t === fromDescList sort_xs .&&.
+           t === fromDistinctDescList nub_sort_xs .&&.
+           t === List.foldr insert empty xs
+  where t = fromList xs
+        sort_xs = reverse (sort xs)
         nub_sort_xs = List.map List.head $ List.group sort_xs
 
 {--------------------------------------------------------------------