Skip to content

Commit d2a508a

Browse files
meooow25meooow25
authored
Test and benchmark fromAscList and friends (#962)
Add property tests and benchmarks for fromAscList and related functions for Set and Map.
1 parent 2333665 commit d2a508a

File tree

4 files changed

+118
-48
lines changed

4 files changed

+118
-48
lines changed

‎containers-tests/benchmarks/Map.hs‎

Lines changed: 14 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,7 @@ main = do
2121
m_even = M.fromAscList elems_even :: M.Map Int Int
2222
m_odd = M.fromAscList elems_odd :: M.Map Int Int
2323
evaluate $ rnf [m, m_even, m_odd]
24-
evaluate $ rnf elems_rev
24+
evaluate $ rnf [elems_rev, elems_asc, elems_desc]
2525
defaultMain
2626
[ bench "lookup absent" $ whnf (lookup evens) m_odd
2727
, bench "lookup present" $ whnf (lookup evens) m_even
@@ -71,7 +71,7 @@ main = do
7171
, bench "insertLookupWithKey' present" $ whnf (insLookupWithKey' elems_even) m_even
7272
, bench "mapWithKey" $ whnf (M.mapWithKey (+)) m
7373
, bench "foldlWithKey" $ whnf (ins elems) m
74-
, bench "foldlWithKey'" $ whnf (M.foldlWithKey' sum 0) m
74+
, bench "foldlWithKey'" $ whnf (M.foldlWithKey' sumkv 0) m
7575
, bench "foldrWithKey" $ whnf (M.foldrWithKey consPair []) m
7676
, bench "foldrWithKey'" $ whnf (M.foldrWithKey' consPair []) m
7777
, bench "update absent" $ whnf (upd Just evens) m_odd
@@ -88,8 +88,13 @@ main = do
8888
, bench "intersection" $ whnf (M.intersection m) m_even
8989
, bench "split" $ whnf (M.split (bound `div` 2)) m
9090
, bench "fromList" $ whnf M.fromList elems
91-
, bench "fromList-desc" $ whnf M.fromList (reverse elems)
92-
, bench "fromAscList" $ whnf M.fromAscList elems
91+
, bench "fromList-desc" $ whnf M.fromList elems_desc
92+
, bench "fromAscList" $ whnf M.fromAscList elems_asc
93+
, bench "fromAscListWithKey" $
94+
whnf (M.fromAscListWithKey sumkv) elems_asc
95+
, bench "fromDescList" $ whnf M.fromDescList elems_desc
96+
, bench "fromDescListWithKey" $
97+
whnf (M.fromDescListWithKey sumkv) elems_desc
9398
, bench "fromDistinctAscList" $ whnf M.fromDistinctAscList elems
9499
, bench "fromDistinctAscList:fusion" $ whnf (\n -> M.fromDistinctAscList [(i,i) | i <- [1..n]]) bound
95100
, bench "fromDistinctDescList" $ whnf M.fromDistinctDescList elems_rev
@@ -104,11 +109,15 @@ main = do
104109
elems_even = zip evens evens
105110
elems_odd = zip odds odds
106111
elems_rev = reverse elems
112+
keys_asc = map (`div` 2) [1..bound] -- [0,1,1,2,2..]
113+
elems_asc = zip keys_asc values
114+
keys_desc = map (`div` 2) [bound,bound-1..1] -- [..2,2,1,1,0]
115+
elems_desc = zip keys_desc values
107116
keys = [1..bound]
108117
evens = [2,4..bound]
109118
odds = [1,3..bound]
110119
values = [1..bound]
111-
sum k v1 v2 = k + v1 + v2
120+
sumkv k v1 v2 = k + v1 + v2
112121
consPair k v xs = (k, v) : xs
113122

114123
add3 :: Int -> Int -> Int -> Int

‎containers-tests/benchmarks/Set.hs‎

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@ main = do
1414
s_odd = S.fromAscList elems_odd :: S.Set Int
1515
strings_s = S.fromList strings
1616
evaluate $ rnf [s, s_even, s_odd]
17-
evaluate $ rnf elems_rev
17+
evaluate $ rnf [elems_rev, elems_asc, elems_desc]
1818
defaultMain
1919
[ bench "member" $ whnf (member elems) s
2020
, bench "insert" $ whnf (ins elems) S.empty
@@ -31,10 +31,11 @@ main = do
3131
, bench "difference" $ whnf (S.difference s) s_even
3232
, bench "intersection" $ whnf (S.intersection s) s_even
3333
, bench "fromList" $ whnf S.fromList elems
34-
, bench "fromList-desc" $ whnf S.fromList (reverse elems)
35-
, bench "fromAscList" $ whnf S.fromAscList elems
34+
, bench "fromList-desc" $ whnf S.fromList elems_desc
35+
, bench "fromAscList" $ whnf S.fromAscList elems_asc
3636
, bench "fromDistinctAscList" $ whnf S.fromDistinctAscList elems
3737
, bench "fromDistinctAscList:fusion" $ whnf (\n -> S.fromDistinctAscList [1..n]) bound
38+
, bench "fromDescList" $ whnf S.fromDescList elems_desc
3839
, bench "fromDistinctDescList" $ whnf S.fromDistinctDescList elems_rev
3940
, bench "fromDistinctDescList:fusion" $ whnf (\n -> S.fromDistinctDescList [n,n-1..1]) bound
4041
, bench "disjoint:false" $ whnf (S.disjoint s) s_even
@@ -61,6 +62,8 @@ main = do
6162
elems_even = [2,4..bound]
6263
elems_odd = [1,3..bound]
6364
elems_rev = reverse elems
65+
elems_asc = map (`div` 2) [1..bound] -- [0,1,1,2,2..]
66+
elems_desc = map (`div` 2) [bound,bound-1..1] -- [..2,2,1,1,0]
6467
strings = map show elems
6568

6669
member :: [Int] -> S.Set Int -> Int

‎containers-tests/tests/map-properties.hs‎

Lines changed: 70 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,8 @@ import qualified Prelude
2828

2929
import Data.List (nub,sort)
3030
import qualified Data.List as List
31+
import Data.List.NonEmpty (NonEmpty(..))
32+
import qualified Data.List.NonEmpty as NE
3133
import qualified Data.Set as Set
3234
import Test.Tasty
3335
import Test.Tasty.HUnit
@@ -185,9 +187,13 @@ main = defaultMain $ testGroup "map-properties"
185187
, testProperty "unionWithKeyMerge" prop_unionWithKeyMerge
186188
, testProperty "mergeWithKey model" prop_mergeWithKeyModel
187189
, testProperty "mergeA effects" prop_mergeA_effects
188-
, testProperty "fromAscList" prop_ordered
190+
, testProperty "fromAscList" prop_fromAscList
191+
, testProperty "fromAscListWith" prop_fromAscListWith
192+
, testProperty "fromAscListWithKey" prop_fromAscListWithKey
189193
, testProperty "fromDistinctAscList" prop_fromDistinctAscList
190-
, testProperty "fromDescList" prop_rev_ordered
194+
, testProperty "fromDescList" prop_fromDescList
195+
, testProperty "fromDescListWith" prop_fromDescListWith
196+
, testProperty "fromDescListWithKey" prop_fromDescListWithKey
191197
, testProperty "fromDistinctDescList" prop_fromDistinctDescList
192198
, testProperty "fromList then toList" prop_list
193199
, testProperty "toDescList" prop_descList
@@ -1271,31 +1277,46 @@ instance Arbitrary WhenMatchedSpec where
12711277

12721278
----------------------------------------------------------------
12731279

1274-
prop_ordered :: Property
1275-
prop_ordered
1276-
= forAll (choose (5,100)) $ \n ->
1277-
let xs = [(x,()) | x <- [0..n::Int]]
1278-
in fromAscList xs == fromList xs
1279-
1280-
prop_rev_ordered :: Property
1281-
prop_rev_ordered
1282-
= forAll (choose (5,100)) $ \n ->
1283-
let xs = [(x,()) | x <- [0..n::Int]]
1284-
in fromDescList (reverse xs) == fromList xs
1285-
12861280
prop_list :: [Int] -> Bool
12871281
prop_list xs = (sort (nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])])
12881282

12891283
prop_descList :: [Int] -> Bool
12901284
prop_descList xs = (reverse (sort (nub xs)) == [x | (x,()) <- toDescList (fromList [(x,()) | x <- xs])])
12911285

1286+
prop_fromDescList :: [(Int, A)] -> Property
1287+
prop_fromDescList kxs =
1288+
valid t .&&.
1289+
t === fromList kxs
1290+
where
1291+
downSortedKxs = List.sortBy (comparing (Down . fst)) kxs
1292+
t = fromDescList downSortedKxs
1293+
1294+
prop_fromDescListWith :: Fun (A, A) A -> [(Int, A)] -> Property
1295+
prop_fromDescListWith f kxs =
1296+
valid t .&&.
1297+
t === fromListWith (apply2 f) downSortedKxs
1298+
where
1299+
downSortedKxs = List.sortBy (comparing (Down . fst)) kxs
1300+
t = fromDescListWith (apply2 f) downSortedKxs
1301+
1302+
prop_fromDescListWithKey :: Fun (Int, A, A) A -> [(Int, A)] -> Property
1303+
prop_fromDescListWithKey f kxs =
1304+
valid t .&&.
1305+
t === fromListWithKey (apply3 f) downSortedKxs
1306+
where
1307+
downSortedKxs = List.sortBy (comparing (Down . fst)) kxs
1308+
t = fromDescListWithKey (apply3 f) downSortedKxs
1309+
12921310
prop_fromDistinctDescList :: [(Int, A)] -> Property
1293-
prop_fromDistinctDescList xs =
1311+
prop_fromDistinctDescList kxs =
12941312
valid t .&&.
1295-
toList t === nub_sort_xs
1313+
toList t === reverse nubDownSortedKxs
12961314
where
1297-
t = fromDistinctDescList (reverse nub_sort_xs)
1298-
nub_sort_xs = List.map List.head $ List.groupBy ((==) `on` fst) $ List.sortBy (comparing fst) xs
1315+
nubDownSortedKxs =
1316+
List.map NE.head $
1317+
NE.groupBy ((==) `on` fst) $
1318+
List.sortBy (comparing (Down . fst)) kxs
1319+
t = fromDistinctDescList nubDownSortedKxs
12991320

13001321
prop_ascDescList :: [Int] -> Bool
13011322
prop_ascDescList xs = toAscList m == reverse (toDescList m)
@@ -1308,13 +1329,40 @@ prop_fromList xs
13081329
t == List.foldr (uncurry insert) empty (zip xs xs)
13091330
where sort_xs = sort xs
13101331

1332+
prop_fromAscList :: [(Int, A)] -> Property
1333+
prop_fromAscList kxs =
1334+
valid t .&&.
1335+
t === fromList sortedKxs
1336+
where
1337+
sortedKxs = List.sortBy (comparing fst) kxs
1338+
t = fromAscList sortedKxs
1339+
1340+
prop_fromAscListWith :: Fun (A, A) A -> [(Int, A)] -> Property
1341+
prop_fromAscListWith f kxs =
1342+
valid t .&&.
1343+
t === fromListWith (apply2 f) sortedKxs
1344+
where
1345+
sortedKxs = List.sortBy (comparing fst) kxs
1346+
t = fromAscListWith (apply2 f) sortedKxs
1347+
1348+
prop_fromAscListWithKey :: Fun (Int, A, A) A -> [(Int, A)] -> Property
1349+
prop_fromAscListWithKey f kxs =
1350+
valid t .&&.
1351+
t === fromListWithKey (apply3 f) sortedKxs
1352+
where
1353+
sortedKxs = List.sortBy (comparing fst) kxs
1354+
t = fromAscListWithKey (apply3 f) sortedKxs
1355+
13111356
prop_fromDistinctAscList :: [(Int, A)] -> Property
1312-
prop_fromDistinctAscList xs =
1357+
prop_fromDistinctAscList kxs =
13131358
valid t .&&.
1314-
toList t === nub_sort_xs
1359+
toList t === nubSortedKxs
13151360
where
1316-
t = fromDistinctAscList nub_sort_xs
1317-
nub_sort_xs = List.map List.head $ List.groupBy ((==) `on` fst) $ List.sortBy (comparing fst) xs
1361+
nubSortedKxs =
1362+
List.map NE.head $
1363+
NE.groupBy ((==) `on` fst) $
1364+
List.sortBy (comparing fst) kxs
1365+
t = fromDistinctAscList nubSortedKxs
13181366

13191367
----------------------------------------------------------------
13201368

‎containers-tests/tests/set-properties.hs‎

Lines changed: 28 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
{-# LANGUAGE CPP #-}
22
import qualified Data.IntSet as IntSet
3-
import Data.List (nub,sort)
3+
import Data.List (nub, sort, sortBy)
44
import qualified Data.List as List
55
import Data.Monoid (mempty)
66
import Data.Maybe
@@ -15,6 +15,7 @@ import Control.Monad.Trans.Class
1515
import Control.Monad (liftM, liftM3)
1616
import Data.Functor.Identity
1717
import Data.Foldable (all)
18+
import Data.Ord (Down(..), comparing)
1819
import Control.Applicative (liftA2)
1920
import Data.List.NonEmpty (NonEmpty(..))
2021
import qualified Data.List.NonEmpty as NE
@@ -69,8 +70,9 @@ main = defaultMain $ testGroup "set-properties"
6970
, testProperty "prop_DescList" prop_DescList
7071
, testProperty "prop_AscDescList" prop_AscDescList
7172
, testProperty "prop_fromList" prop_fromList
73+
, testProperty "prop_fromAscList" prop_fromAscList
7274
, testProperty "prop_fromDistinctAscList" prop_fromDistinctAscList
73-
, testProperty "prop_fromListDesc" prop_fromListDesc
75+
, testProperty "prop_fromDescList" prop_fromDescList
7476
, testProperty "prop_fromDistinctDescList" prop_fromDistinctDescList
7577
, testProperty "prop_isProperSubsetOf" prop_isProperSubsetOf
7678
, testProperty "prop_isProperSubsetOf2" prop_isProperSubsetOf2
@@ -532,35 +534,43 @@ prop_AscDescList xs = toAscList s == reverse (toDescList s)
532534

533535
prop_fromList :: [Int] -> Property
534536
prop_fromList xs =
535-
t === fromAscList sort_xs .&&.
537+
valid t .&&.
536538
t === List.foldr insert empty xs
537539
where t = fromList xs
538-
sort_xs = sort xs
540+
541+
prop_fromAscList :: [Int] -> Property
542+
prop_fromAscList xs =
543+
valid t .&&.
544+
toList t === nubSortedXs
545+
where
546+
sortedXs = sort xs
547+
nubSortedXs = List.map NE.head $ NE.group sortedXs
548+
t = fromAscList sortedXs
539549

540550
prop_fromDistinctAscList :: [Int] -> Property
541551
prop_fromDistinctAscList xs =
542552
valid t .&&.
543-
toList t === nub_sort_xs
553+
toList t === nubSortedXs
544554
where
545-
t = fromDistinctAscList nub_sort_xs
546-
nub_sort_xs = List.map List.head $ List.group $ sort xs
555+
nubSortedXs = List.map NE.head $ NE.group $ sort xs
556+
t = fromDistinctAscList nubSortedXs
547557

548-
prop_fromListDesc :: [Int] -> Property
549-
prop_fromListDesc xs =
550-
t === fromDescList sort_xs .&&.
551-
t === fromDistinctDescList nub_sort_xs .&&.
552-
t === List.foldr insert empty xs
553-
where t = fromList xs
554-
sort_xs = reverse (sort xs)
555-
nub_sort_xs = List.map List.head $ List.group sort_xs
558+
prop_fromDescList :: [Int] -> Property
559+
prop_fromDescList xs =
560+
valid t .&&.
561+
toList t === reverse nubDownSortedXs
562+
where
563+
downSortedXs = sortBy (comparing Down) xs
564+
nubDownSortedXs = List.map NE.head $ NE.group downSortedXs
565+
t = fromDescList downSortedXs
556566

557567
prop_fromDistinctDescList :: [Int] -> Property
558568
prop_fromDistinctDescList xs =
559569
valid t .&&.
560-
toList t === nub_sort_xs
570+
toList t === reverse nubDownSortedXs
561571
where
562-
t = fromDistinctDescList (reverse nub_sort_xs)
563-
nub_sort_xs = List.map List.head $ List.group $ sort xs
572+
nubDownSortedXs = List.map NE.head $ NE.group $ sortBy (comparing Down) xs
573+
t = fromDistinctDescList nubDownSortedXs
564574

565575
{--------------------------------------------------------------------
566576
Set operations are like IntSet operations

0 commit comments

Comments
 (0)