Skip to content

Commit

Permalink
For Map, test against fromList-like
Browse files Browse the repository at this point in the history
  • Loading branch information
meooow25 committed Aug 31, 2024
1 parent fa58574 commit cd76046
Showing 1 changed file with 20 additions and 50 deletions.
70 changes: 20 additions & 50 deletions containers-tests/tests/map-properties.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1278,76 +1278,54 @@ instance Arbitrary WhenMatchedSpec where

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

-- fromAscListWith, fromAscListWithKey, fromDescListWith, fromDescListWithKey
-- all effectively perform a left fold over adjacent elements in the input list
-- using some function as long as the keys are equal.
--
-- The property tests for these functions compare the result against the
-- sequence we would get if we used NE.groupBy instead. We use Magma to check
-- the fold direction (left, not right) and the order of arguments to the fold
-- function (new then old).

data Magma a
= Inj a
| Magma a :* Magma a
deriving (Eq, Show)

groupByK :: Eq k => [(k, a)] -> [(k, NonEmpty a)]
groupByK =
List.map (\ys -> (fst (NE.head ys), NE.map snd ys)) .
NE.groupBy ((==) `on` fst)

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])])

-- For a list with keys in decreasing order (downSortedKxs), the sequence we get from fromDescList
-- should be the same as the reverse of the sequence we get if we group by the key and take the last
-- key-value pair in each group.
prop_fromDescList :: [(Int, A)] -> Property
prop_fromDescList kxs =
valid t .&&.
toList t === reverse nubLastDownSortedXs
t === fromList kxs
where
downSortedKxs = List.sortBy (comparing (Down . fst)) kxs
nubLastDownSortedXs = [(k, NE.last xs) | (k,xs) <- groupByK downSortedKxs]
t = fromDescList downSortedKxs

-- For a list with keys in decreasing order (downSortedKxs), the sequence we get from
-- fromDescListWith f should be the same as the reverse of the sequence we get if we group by the
-- key and fold all the values for a key with f. fromDescListWith applies f as `f newv oldv`.
prop_fromDescListWith :: [(Int, A)] -> Property
prop_fromDescListWith kys =
valid t .&&.
toList t === reverse foldedDownSortedXs
t === fromListWith (:*) downSortedKxs
where
kxs = [(k, Inj y) | (k,y) <- kys]
downSortedKxs = List.sortBy (comparing (Down . fst)) kxs
foldedDownSortedXs = [(k, Foldable.foldl1 (flip (:*)) xs) | (k,xs) <- groupByK downSortedKxs]
t = fromDescListWith (:*) downSortedKxs

-- For a list with keys in decreasing order (downSortedKxs), the sequence we get from
-- fromDescListWithKey f should be the same as the reverse of the sequence we get if we group by the
-- key and fold all the values for a key with f. fromDescListWith applies f as `f key newv oldv`.
prop_fromDescListWithKey :: [(Int, A)] -> Property
prop_fromDescListWithKey kys =
valid t .&&.
toList t === reverse foldedDownSortedXs
t === fromListWithKey f downSortedKxs
where
kxs = [(k, Inj (Left y)) | (k,y) <- kys]
downSortedKxs = List.sortBy (comparing (Down . fst)) kxs
foldedDownSortedXs = [ (k, Foldable.foldl1 (\acc (Inj (Left x)) -> Inj (Right (k,x)) :* acc) xs)
| (k,xs) <- groupByK downSortedKxs ]
t = fromDescListWithKey (\k (Inj (Left x)) acc -> Inj (Right (k,x)) :* acc) downSortedKxs
f k (Inj (Left x)) acc = Inj (Right (k,x)) :* acc
f _ _ _ = error "prop_fromDescListWithKey"
t = fromDescListWithKey f downSortedKxs

prop_fromDistinctDescList :: [(Int, A)] -> Property
prop_fromDistinctDescList kxs =
valid t .&&.
toList t === reverse nubDownSortedKxs
where
nubDownSortedKxs = [(k, NE.head xs) | (k,xs) <- groupByK (List.sortBy (comparing (Down . fst)) kxs)]
nubDownSortedKxs =
List.map NE.head $
NE.groupBy ((==) `on` fst) $
List.sortBy (comparing (Down . fst)) kxs
t = fromDistinctDescList nubDownSortedKxs

prop_ascDescList :: [Int] -> Bool
Expand All @@ -1361,51 +1339,43 @@ prop_fromList xs
t == List.foldr (uncurry insert) empty (zip xs xs)
where sort_xs = sort xs

-- For a list with keys in increasing order (sortedKxs), the sequence we get from fromAscList
-- should be the same as the sequence we get if we group by the key and take the last key-value pair
-- in each group.
prop_fromAscList :: [(Int, A)] -> Property
prop_fromAscList kxs =
valid t .&&.
toList t === nubLastSortedXs
t === fromList sortedKxs
where
sortedKxs = List.sortBy (comparing fst) kxs
nubLastSortedXs = [(k, NE.last xs) | (k,xs) <- groupByK sortedKxs]
t = fromAscList sortedKxs

-- For a list with keys in increasing order (sortedKxs), the sequence we get from fromAscListWith f
-- should be the same as the the sequence we get if we group by the key and fold all the values for
-- a key with f. fromAscListWith applies f as `f newv oldv`.
prop_fromAscListWith :: [(Int, A)] -> Property
prop_fromAscListWith kys =
valid t .&&.
toList t === foldedSortedKxs
t === fromListWith (:*) sortedKxs
where
kxs = [(k, Inj y) | (k,y) <- kys]
sortedKxs = List.sortBy (comparing fst) kxs
foldedSortedKxs = [(k, Foldable.foldl1 (flip (:*)) x) | (k,x) <- groupByK sortedKxs]
t = fromAscListWith (:*) sortedKxs

-- For a list with keys in increasing order (sortedKxs), the sequence we get from
-- fromAscListWithKey f should be the same as the the sequence we get if we group by the key and
-- fold all the values for a key with f. fromAscListWithKey applies f as `f key newv oldv`.
prop_fromAscListWithKey :: [(Int, A)] -> Property
prop_fromAscListWithKey kys =
valid t .&&.
toList t === foldedSortedKxs
t === fromListWithKey f sortedKxs
where
kxs = [(k, Inj (Left y)) | (k,y) <- kys]
sortedKxs = List.sortBy (comparing fst) kxs
foldedSortedKxs = [ (k, Foldable.foldl1 (\acc (Inj (Left x)) -> Inj (Right (k,x)) :* acc) xs)
| (k,xs) <- groupByK sortedKxs ]
t = fromAscListWithKey (\k (Inj (Left x)) acc -> Inj (Right (k,x)) :* acc) sortedKxs
f k (Inj (Left x)) acc = Inj (Right (k,x)) :* acc
f _ _ _ = error "prop_fromAscListWithKey"
t = fromAscListWithKey f sortedKxs

prop_fromDistinctAscList :: [(Int, A)] -> Property
prop_fromDistinctAscList kxs =
valid t .&&.
toList t === nubSortedKxs
where
nubSortedKxs = [(k, NE.head xs) | (k,xs) <- groupByK (List.sortBy (comparing fst) kxs)]
nubSortedKxs =
List.map NE.head $
NE.groupBy ((==) `on` fst) $
List.sortBy (comparing fst) kxs
t = fromDistinctAscList nubSortedKxs

----------------------------------------------------------------
Expand Down

0 comments on commit cd76046

Please sign in to comment.