From b4ea836c52d3eb8e5035eeeed5dff0df7cbd0071 Mon Sep 17 00:00:00 2001 From: meooow25 Date: Wed, 12 Jul 2023 21:51:51 +0530 Subject: [PATCH] Test and benchmark fromAscList and friends Add property tests and benchmarks for fromAscList and related functions for Set and Map. --- containers-tests/benchmarks/Map.hs | 19 +++-- containers-tests/benchmarks/Set.hs | 7 +- containers-tests/tests/map-properties.hs | 92 ++++++++++++++++++------ containers-tests/tests/set-properties.hs | 47 +++++++----- 4 files changed, 118 insertions(+), 47 deletions(-) diff --git a/containers-tests/benchmarks/Map.hs b/containers-tests/benchmarks/Map.hs index 0e324e556..67944277f 100644 --- a/containers-tests/benchmarks/Map.hs +++ b/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 diff --git a/containers-tests/benchmarks/Set.hs b/containers-tests/benchmarks/Set.hs index 265117e9c..e99b94531 100644 --- a/containers-tests/benchmarks/Set.hs +++ b/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 diff --git a/containers-tests/tests/map-properties.hs b/containers-tests/tests/map-properties.hs index b6d873c44..384938215 100644 --- a/containers-tests/tests/map-properties.hs +++ b/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 ---------------------------------------------------------------- diff --git a/containers-tests/tests/set-properties.hs b/containers-tests/tests/set-properties.hs index 82d30f0c6..c4ef088e3 100644 --- a/containers-tests/tests/set-properties.hs +++ b/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