Test and benchmark fromAscList and friends

Add property tests and benchmarks for fromAscList and related
functions for Set and Map.

Author: meooow25

containers-tests/benchmarks/Map.hs

@@ -21,7 +21,7 @@ main = do
         m_even = M.fromAscList elems_even :: M.Map Int Int
         m_odd = M.fromAscList elems_odd :: M.Map Int Int
     evaluate $ rnf [m, m_even, m_odd]
-    evaluate $ rnf elems_rev
+    evaluate $ rnf [elems_rev, elems_asc, elems_desc]
     defaultMain
         [ bench "lookup absent" $ whnf (lookup evens) m_odd
         , bench "lookup present" $ whnf (lookup evens) m_even
@@ -71,7 +71,7 @@ main = do
         , bench "insertLookupWithKey' present" $ whnf (insLookupWithKey' elems_even) m_even
         , bench "mapWithKey" $ whnf (M.mapWithKey (+)) m
         , bench "foldlWithKey" $ whnf (ins elems) m
-        , bench "foldlWithKey'" $ whnf (M.foldlWithKey' sum 0) m
+        , bench "foldlWithKey'" $ whnf (M.foldlWithKey' sumkv 0) m
         , bench "foldrWithKey" $ whnf (M.foldrWithKey consPair []) m
         , bench "foldrWithKey'" $ whnf (M.foldrWithKey' consPair []) m
         , bench "update absent" $ whnf (upd Just evens) m_odd
@@ -88,8 +88,13 @@ main = do
         , bench "intersection" $ whnf (M.intersection m) m_even
         , bench "split" $ whnf (M.split (bound `div` 2)) m
         , bench "fromList" $ whnf M.fromList elems
-        , bench "fromList-desc" $ whnf M.fromList (reverse elems)
-        , bench "fromAscList" $ whnf M.fromAscList elems
+        , bench "fromList-desc" $ whnf M.fromList elems_desc
+        , bench "fromAscList" $ whnf M.fromAscList elems_asc
+        , bench "fromAscListWithKey" $
+            whnf (M.fromAscListWithKey sumkv) elems_asc
+        , bench "fromDescList" $ whnf M.fromDescList elems_desc
+        , bench "fromDescListWithKey" $
+            whnf (M.fromDescListWithKey sumkv) elems_desc
         , bench "fromDistinctAscList" $ whnf M.fromDistinctAscList elems
         , bench "fromDistinctAscList:fusion" $ whnf (\n -> M.fromDistinctAscList [(i,i) | i <- [1..n]]) bound
         , bench "fromDistinctDescList" $ whnf M.fromDistinctDescList elems_rev
@@ -104,11 +109,15 @@ main = do
     elems_even = zip evens evens
     elems_odd = zip odds odds
     elems_rev = reverse elems
+    keys_asc = map (`div` 2) [1..bound] -- [0,1,1,2,2..]
+    elems_asc = zip keys_asc values
+    keys_desc = map (`div` 2) [bound,bound-1..1] -- [..2,2,1,1,0]
+    elems_desc = zip keys_desc values
     keys = [1..bound]
     evens = [2,4..bound]
     odds = [1,3..bound]
     values = [1..bound]
-    sum k v1 v2 = k + v1 + v2
+    sumkv k v1 v2 = k + v1 + v2
     consPair k v xs = (k, v) : xs
 
 add3 :: Int -> Int -> Int -> Int

containers-tests/benchmarks/Set.hs

@@ -14,7 +14,7 @@ main = do
         s_odd = S.fromAscList elems_odd :: S.Set Int
         strings_s = S.fromList strings
     evaluate $ rnf [s, s_even, s_odd]
-    evaluate $ rnf elems_rev
+    evaluate $ rnf [elems_rev, elems_asc, elems_desc]
     defaultMain
         [ bench "member" $ whnf (member elems) s
         , bench "insert" $ whnf (ins elems) S.empty
@@ -33,9 +33,10 @@ main = do
         , bench "intersection" $ whnf (S.intersection s) s_even
         , bench "fromList" $ whnf S.fromList elems
         , bench "fromList-desc" $ whnf S.fromList (reverse elems)
-        , bench "fromAscList" $ whnf S.fromAscList elems
+        , bench "fromAscList" $ whnf S.fromAscList elems_asc
         , bench "fromDistinctAscList" $ whnf S.fromDistinctAscList elems
         , bench "fromDistinctAscList:fusion" $ whnf (\n -> S.fromDistinctAscList [1..n]) bound
+        , bench "fromDescList" $ whnf S.fromDescList elems_desc
         , bench "fromDistinctDescList" $ whnf S.fromDistinctDescList elems_rev
         , bench "fromDistinctDescList:fusion" $ whnf (\n -> S.fromDistinctDescList [n,n-1..1]) bound
         , bench "disjoint:false" $ whnf (S.disjoint s) s_even
@@ -64,6 +65,8 @@ main = do
     elems_even = [2,4..bound]
     elems_odd = [1,3..bound]
     elems_rev = reverse elems
+    elems_asc = map (`div` 2) [1..bound] -- [0,1,1,2,2..]
+    elems_desc = map (`div` 2) [bound,bound-1..1] -- [..2,2,1,1,0]
     strings = map show elems
 
 member :: [Int] -> S.Set Int -> Int

containers-tests/tests/map-properties.hs

@@ -28,6 +28,8 @@ import qualified Prelude
 
 import Data.List (nub,sort)
 import qualified Data.List as List
+import Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.List.NonEmpty as NE
 import qualified Data.Set as Set
 import Test.Tasty
 import Test.Tasty.HUnit
@@ -185,9 +187,13 @@ main = defaultMain $ testGroup "map-properties"
          , testProperty "unionWithKeyMerge"   prop_unionWithKeyMerge
          , testProperty "mergeWithKey model"   prop_mergeWithKeyModel
          , testProperty "mergeA effects"       prop_mergeA_effects
-         , testProperty "fromAscList"          prop_ordered
+         , testProperty "fromAscList"          prop_fromAscList
+         , testProperty "fromAscListWith"      prop_fromAscListWith
+         , testProperty "fromAscListWithKey"   prop_fromAscListWithKey
          , testProperty "fromDistinctAscList"  prop_fromDistinctAscList
-         , testProperty "fromDescList"         prop_rev_ordered
+         , testProperty "fromDescList"         prop_fromDescList
+         , testProperty "fromDescListWith"     prop_fromDescListWith
+         , testProperty "fromDescListWithKey"  prop_fromDescListWithKey
          , testProperty "fromDistinctDescList" prop_fromDistinctDescList
          , testProperty "fromList then toList" prop_list
          , testProperty "toDescList"           prop_descList
@@ -1272,31 +1278,46 @@ instance Arbitrary WhenMatchedSpec where
 
 ----------------------------------------------------------------
 
-prop_ordered :: Property
-prop_ordered
-  = forAll (choose (5,100)) $ \n ->
-    let xs = [(x,()) | x <- [0..n::Int]]
-    in fromAscList xs == fromList xs
-
-prop_rev_ordered :: Property
-prop_rev_ordered
-  = forAll (choose (5,100)) $ \n ->
-    let xs = [(x,()) | x <- [0..n::Int]]
-    in fromDescList (reverse xs) == fromList xs
-
 prop_list :: [Int] -> Bool
 prop_list xs = (sort (nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])])
 
 prop_descList :: [Int] -> Bool
 prop_descList xs = (reverse (sort (nub xs)) == [x | (x,()) <- toDescList (fromList [(x,()) | x <- xs])])
 
+prop_fromDescList :: [(Int, A)] -> Property
+prop_fromDescList kxs =
+    valid t .&&.
+    t === fromList kxs
+  where
+    downSortedKxs = List.sortBy (comparing (Down . fst)) kxs
+    t = fromDescList downSortedKxs
+
+prop_fromDescListWith :: Fun (A, A) A -> [(Int, A)] -> Property
+prop_fromDescListWith f kxs =
+    valid t .&&.
+    t === fromListWith (apply2 f) downSortedKxs
+  where
+    downSortedKxs = List.sortBy (comparing (Down . fst)) kxs
+    t = fromDescListWith (apply2 f) downSortedKxs
+
+prop_fromDescListWithKey :: Fun (Int, A, A) A -> [(Int, A)] -> Property
+prop_fromDescListWithKey f kxs =
+    valid t .&&.
+    t === fromListWithKey (apply3 f) downSortedKxs
+  where
+    downSortedKxs = List.sortBy (comparing (Down . fst)) kxs
+    t = fromDescListWithKey (apply3 f) downSortedKxs
+
 prop_fromDistinctDescList :: [(Int, A)] -> Property
-prop_fromDistinctDescList xs =
+prop_fromDistinctDescList kxs =
     valid t .&&.
-    toList t === nub_sort_xs
+    toList t === reverse nubDownSortedKxs
   where
-    t = fromDistinctDescList (reverse nub_sort_xs)
-    nub_sort_xs = List.map List.head $ List.groupBy ((==) `on` fst) $ List.sortBy (comparing fst) xs
+    nubDownSortedKxs =
+      List.map NE.head $
+      NE.groupBy ((==) `on` fst) $
+      List.sortBy (comparing (Down . fst)) kxs
+    t = fromDistinctDescList nubDownSortedKxs
 
 prop_ascDescList :: [Int] -> Bool
 prop_ascDescList xs = toAscList m == reverse (toDescList m)
@@ -1309,13 +1330,40 @@ prop_fromList xs
            t == List.foldr (uncurry insert) empty (zip xs xs)
   where sort_xs = sort xs
 
+prop_fromAscList :: [(Int, A)] -> Property
+prop_fromAscList kxs =
+    valid t .&&.
+    t === fromList sortedKxs
+  where
+    sortedKxs = List.sortBy (comparing fst) kxs
+    t = fromAscList sortedKxs
+
+prop_fromAscListWith :: Fun (A, A) A -> [(Int, A)] -> Property
+prop_fromAscListWith f kxs =
+    valid t .&&.
+    t === fromListWith (apply2 f) sortedKxs
+  where
+    sortedKxs = List.sortBy (comparing fst) kxs
+    t = fromAscListWith (apply2 f) sortedKxs
+
+prop_fromAscListWithKey :: Fun (Int, A, A) A -> [(Int, A)] -> Property
+prop_fromAscListWithKey f kxs =
+    valid t .&&.
+    t === fromListWithKey (apply3 f) sortedKxs
+  where
+    sortedKxs = List.sortBy (comparing fst) kxs
+    t = fromAscListWithKey (apply3 f) sortedKxs
+
 prop_fromDistinctAscList :: [(Int, A)] -> Property
-prop_fromDistinctAscList xs =
+prop_fromDistinctAscList kxs =
     valid t .&&.
-    toList t === nub_sort_xs
+    toList t === nubSortedKxs
   where
-    t = fromDistinctAscList nub_sort_xs
-    nub_sort_xs = List.map List.head $ List.groupBy ((==) `on` fst) $ List.sortBy (comparing fst) xs
+    nubSortedKxs =
+      List.map NE.head $
+      NE.groupBy ((==) `on` fst) $
+      List.sortBy (comparing fst) kxs
+    t = fromDistinctAscList nubSortedKxs
 
 ----------------------------------------------------------------
 

containers-tests/tests/set-properties.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE CPP #-}
 import qualified Data.IntSet as IntSet
-import Data.List (nub,sort)
+import Data.List (nub, sort, sortBy)
 import qualified Data.List as List
 import Data.Monoid (mempty)
 import Data.Maybe
@@ -15,7 +15,9 @@ import Control.Monad.Trans.Class
 import Control.Monad (liftM, liftM3)
 import Data.Functor.Identity
 import Data.Foldable (all)
+import Data.Ord (Down(..), comparing)
 import Control.Applicative (liftA2)
+import qualified Data.List.NonEmpty as NE
 
 #if __GLASGOW_HASKELL__ >= 806
 import Utils.NoThunks (whnfHasNoThunks)
@@ -67,8 +69,9 @@ main = defaultMain $ testGroup "set-properties"
                    , testProperty "prop_DescList" prop_DescList
                    , testProperty "prop_AscDescList" prop_AscDescList
                    , testProperty "prop_fromList" prop_fromList
+                   , testProperty "prop_fromAscList" prop_fromAscList
                    , testProperty "prop_fromDistinctAscList" prop_fromDistinctAscList
-                   , testProperty "prop_fromListDesc" prop_fromListDesc
+                   , testProperty "prop_fromDescList" prop_fromDescList
                    , testProperty "prop_fromDistinctDescList" prop_fromDistinctDescList
                    , testProperty "prop_isProperSubsetOf" prop_isProperSubsetOf
                    , testProperty "prop_isProperSubsetOf2" prop_isProperSubsetOf2
@@ -528,35 +531,43 @@ prop_AscDescList xs = toAscList s == reverse (toDescList s)
 
 prop_fromList :: [Int] -> Property
 prop_fromList xs =
-           t === fromAscList sort_xs .&&.
+           valid t .&&.
            t === List.foldr insert empty xs
   where t = fromList xs
-        sort_xs = sort xs
+
+prop_fromAscList :: [Int] -> Property
+prop_fromAscList xs =
+    valid t .&&.
+    toList t === nubSortedXs
+  where
+    sortedXs = sort xs
+    nubSortedXs = List.map NE.head $ NE.group sortedXs
+    t = fromAscList sortedXs
 
 prop_fromDistinctAscList :: [Int] -> Property
 prop_fromDistinctAscList xs =
     valid t .&&.
-    toList t === nub_sort_xs
+    toList t === nubSortedXs
   where
-    t = fromDistinctAscList nub_sort_xs
-    nub_sort_xs = List.map List.head $ List.group $ sort xs
+    nubSortedXs = List.map NE.head $ NE.group $ sort xs
+    t = fromDistinctAscList nubSortedXs
 
-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
+prop_fromDescList :: [Int] -> Property
+prop_fromDescList xs =
+    valid t .&&.
+    toList t === reverse nubDownSortedXs
+  where
+    downSortedXs = sortBy (comparing Down) xs
+    nubDownSortedXs = List.map NE.head $ NE.group downSortedXs
+    t = fromDescList downSortedXs
 
 prop_fromDistinctDescList :: [Int] -> Property
 prop_fromDistinctDescList xs =
     valid t .&&.
-    toList t === nub_sort_xs
+    toList t === reverse nubDownSortedXs
   where
-    t = fromDistinctDescList (reverse nub_sort_xs)
-    nub_sort_xs = List.map List.head $ List.group $ sort xs
+    nubDownSortedXs = List.map NE.head $ NE.group $ sortBy (comparing Down) xs
+    t = fromDistinctDescList nubDownSortedXs
 
 {--------------------------------------------------------------------
   Set operations are like IntSet operations