Skip to content

Commit

Permalink
Test and benchmark fromAscList and friends
Browse files Browse the repository at this point in the history 
Add property tests and benchmarks for fromAscList and related
functions for Set and Map.
  • Loading branch information
@meooow25
meooow25 committed Sep 11, 2024
1 parent e3bd02d commit b4ea836
Show file tree
Hide file tree
Showing 4 changed files with 118 additions and 47 deletions.
19 changes: 14 additions & 5 deletions containers-tests/benchmarks/Map.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down
7 changes: 5 additions & 2 deletions containers-tests/benchmarks/Set.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down
92 changes: 70 additions & 22 deletions containers-tests/tests/map-properties.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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

----------------------------------------------------------------

Expand Down
47 changes: 29 additions & 18 deletions containers-tests/tests/set-properties.hs
View file
Original file line number Diff line number Diff line change
@@ -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
Expand All @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit b4ea836

Please sign in to comment.