packages feed

multisets (empty) → 0.1.0.0

raw patch · 16 files changed

+2313/−0 lines, 16 filesdep +QuickCheckdep +basedep +containers

Dependencies added: QuickCheck, base, containers, deepseq, multisets, tasty, tasty-quickcheck

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for multisets++## 0.1.0.0 -- 2026-09-15++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2026 Florian Ragwitz++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ multisets.cabal view
@@ -0,0 +1,53 @@+cabal-version:      3.0+name:               multisets+version:            0.1.0.0+synopsis: Multisets with arbitrary-precision Natural multiplicities+description:+  Finite multisets with arbitrary-precision 'Natural' multiplicities.++  A 'MultiSet' is like a 'Data.Set.Set', except that values may occur more than+  once. The number of occurrences of a value is its /multiplicity/.++  Unlike "Data.MultiSet", this package represents multiplicities using+  'Natural' rather than 'Int', allowing them to grow beyond the range of 'Int'+  while reflecting that multiplicities cannot be negative.++  The API is broadly similar to "Data.MultiSet", and many common uses are+  source-compatible after changing the module import.+homepage:           https://github.com/rafl/multisets+bug-reports:        https://github.com/rafl/multisets/issues+license:            MIT+license-file:       LICENSE+author:             Florian Ragwitz+maintainer:         florian.ragwitz@gmail.com+copyright:          (c) 2026 Florian Ragwitz+category:           Data+build-type:         Simple+extra-doc-files:    CHANGELOG.md++source-repository head+  type: git+  branch: main+  location: https://github.com/rafl/multisets++common warnings+    ghc-options: -Wall++library+    import:           warnings+    exposed-modules:  Data.MultiSet.Natural+    build-depends:    base >= 4.9 && < 4.24, containers >= 0.6.2.1 && < 0.9, deepseq >= 1.4 && < 1.6+    hs-source-dirs:   src+    default-language: Haskell2010++test-suite multisets-test+    import:           warnings+    default-language: Haskell2010+    other-modules: Test.Gen, Test.Valid, Test.ToFrom, Test.Queries, Test.Instances, Test.Effects, Test.Folds, Test.Transformations, Test.Updates, Test.Combining, Test.Extremes+    type:             exitcode-stdio-1.0+    hs-source-dirs:   test+    main-is:          Main.hs+    build-depends:+        base, containers, multisets, deepseq,+        tasty >= 1.2.3 && < 1.6, tasty-quickcheck >= 0.10.1.1 && < 0.12, QuickCheck >= 2.13.2 && < 2.19+    ghc-options: -Wall -threaded -rtsopts
+ src/Data/MultiSet/Natural.hs view
@@ -0,0 +1,652 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TupleSections #-}++{- |+  Module: Data.MultiSet.Natural+  Description: Multisets with arbitrary-precision Natural multiplicities+  Copyright: (c) 2026 Florian Ragwitz+  License: MIT++  Finite multisets with 'Natural' multiplicities.++  A 'MultiSet' is like a 'Data.Set.Set', except that values may occur more than+  once. The number of occurrences of a value is its /multiplicity/.++  In contrast to "Data.MultiSet", this module represents multiplicities by+  'Natural', allowing them to exceed the range of 'Int'. See+  [Comparison to Data.MultiSet]("Data.MultiSet.Natural#g:comparison")+  for more details on how the two modules differ.++  This module is intended to be imported qualified, to avoid name clashes with+  Prelude functions, e.g.++  > import Data.MultiSet.Natural (MultiSet)+  > import qualified Data.MultiSet.Natural as MS++  When distinct values compare equal under 'Ord', no guarantee is made about+  which value is retained as the representative.+-}+module Data.MultiSet.Natural (+    -- * Comparison to @Data.MultiSet@ #comparison#++    {- |++        This module is broadly similar to "Data.MultiSet". Many common uses are+        source-compatible after changing the module import, and migration is+        usually straightforward.++        The main difference is that this module represents multiplicities using+        'Natural' rather than 'Int', allowing them to grow beyond the range of+        'Int' while also reflecting that multiplicities cannot be negative.++        This module was also motivated in part by a number of longstanding+        issues in "Data.MultiSet", including correctness bugs, alongside+        relatively limited maintenance in recent years.++        The API is intentionally similar rather than identical. Some+        "Data.MultiSet" operations are omitted, this module provides some+        additional operations, and a few concepts are exposed under different+        names.++        If you're missing any particular functions from this module, please+        file a bug report!+    -}++    -- * Types+    MultiSet,+    MaxUnion (..),++    -- * Construction+    empty,+    singleton,+    singletonMany,+    fromMultiplicityList,+    fromList,+    fromSet,+    fromMap,++    -- * Conversion+    toMultiplicityList,+    toList,+    toSet,+    toDistinctList,+    toMap,++    -- * Query+    null,+    member,+    notMember,+    multiplicity,+    size,+    distinctSize,++    -- * Insertion and deletion+    insert,+    insertMany,+    delete,+    deleteMany,+    deleteAll,++    -- * Transformations+    alterMultiplicity,+    alterMultiplicityF,+    setMultiplicity,+    filter,+    filterWithMultiplicity,+    filterA,+    filterWithMultiplicityA,+    partition,+    partitionA,+    partitionWithMultiplicity,+    partitionWithMultiplicityA,+    map,+    mapWithMultiplicity,+    mapMultiplicities,+    mapMaybe,+    mapMaybeWithMultiplicity,+    concatMap,++    -- * Folds++    -- ** Lazy+    foldrWithMultiplicity,+    foldlWithMultiplicity,+    foldMapWithMultiplicity,++    -- ** Strict+    foldlWithMultiplicity',+    foldrWithMultiplicity',++    -- * Traversals+    traverse,+    traverseMaybe,+    traverseWithMultiplicity,+    traverseWithMultiplicity_,+    traverseMaybeWithMultiplicity,++    -- * Combining multisets+    union,+    unions,+    difference,+    symmetricDifference,+    intersection,+    intersections,+    maxUnion,+    cartesianProduct,++    -- * Relations+    isSubsetOf,+    isProperSubsetOf,+    disjoint,++    -- * Ordered queries+    lookupLT,+    lookupLE,+    lookupGT,+    lookupGE,++    -- * Minimum and maximum+    lookupMin,+    lookupMax,+    deleteMin,+    deleteMax,+    deleteMinAll,+    deleteMaxAll,+    minView,+    maxView,+    minViewWithMultiplicity,+    maxViewWithMultiplicity,++    -- * Splitting+    split,+) where++import Control.Applicative ((<|>))+import qualified Control.Applicative as A+import Control.DeepSeq (NFData (..))+import Control.Monad+import Data.Bifunctor+import Data.Bool+import Data.Coerce+import qualified Data.Foldable as F+import Data.List (genericReplicate)+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.Map.Strict as M+import Data.Maybe (fromMaybe)+import qualified Data.Semigroup as SG+import qualified Data.Set as S+import GHC.Natural+import Prelude hiding (concatMap, filter, map, null, traverse)+import qualified Prelude as P++type Tally a = M.Map a Natural++{-# INLINE lift #-}+lift :: (Tally a -> Tally b) -> MultiSet a -> MultiSet b+lift = coerce++{-# INLINE lift2 #-}+lift2 :: (Tally a -> Tally b -> Tally c) -> MultiSet a -> MultiSet b -> MultiSet c+lift2 = coerce++{-# INLINE with2 #-}+with2 :: (Tally a -> Tally b -> c) -> MultiSet a -> MultiSet b -> c+with2 = coerce++{- | A finite multiset of type @a@. Each value has a 'Natural' multiplicity,+  with multiplicity zero indicating that the value is absent.+-}+newtype MultiSet a = MS {unMS :: Tally a} -- invariant: n > 0+    deriving (Eq, NFData)++-- | Via 'union'.+instance (Ord a) => SG.Semigroup (MultiSet a) where+    (<>) = union++instance (Ord a) => Monoid (MultiSet a) where+    mempty = empty+    mappend = (SG.<>)++{- | Orders multisets as their sorted 'toList' expansions would be ordered,+  giving an ordering based on elements rather than the internal representation.+-}+instance (Ord a) => Ord (MultiSet a) where+    compare as bs = compareRuns (M.toAscList $ unMS as) (M.toAscList $ unMS bs)+      where+        compareRuns ((x, n) : xs) ((y, m) : ys) =+            compare x y SG.<> case compare n m of+                EQ -> compareRuns xs ys+                LT -> if P.null xs then LT else GT+                GT -> if P.null ys then GT else LT+        compareRuns xs ys = compare xs ys++instance (Show a) => Show (MultiSet a) where+    showsPrec d ms =+        showParen (d > 10) $+            showString "fromMultiplicityList "+                . shows (M.toAscList $ unMS ms)++instance (Ord a, Read a) => Read (MultiSet a) where+    readsPrec d =+        readParen (d > 10) $ \s -> do+            ("fromMultiplicityList", rest) <- lex s+            (xs, rest') <- reads rest+            pure (fromMultiplicityList xs, rest')++-- | Wrapper providing 'SG.Semigroup' and 'Monoid' using 'maxUnion' rather than 'union'.+newtype MaxUnion a = MaxUnion {getMaxUnion :: MultiSet a}+    deriving (Eq, Ord, Show, Read, NFData)++instance (Ord a) => SG.Semigroup (MaxUnion a) where+    (<>) = coerce maxUnion++instance (Ord a) => Monoid (MaxUnion a) where+    mempty = coerce empty+    mappend = (SG.<>)++-- | The empty 'MultiSet'.+empty :: MultiSet a+empty = MS M.empty++-- | The 'MultiSet' containing the given element with multiplicity 1.+singleton :: a -> MultiSet a+singleton = (`singletonMany` 1)++-- | The 'MultiSet' containing a single element with the given multiplicity.+singletonMany :: a -> Natural -> MultiSet a+singletonMany _ 0 = empty+singletonMany x n = MS $ M.singleton x n++{- | Construct a 'MultiSet' from a list.++For any 'Foldable', use @foldMap 'singleton'@.+-}+fromList :: (Ord a) => [a] -> MultiSet a+fromList = MS . M.fromListWith (+) . P.map (,1)++{- | Construct a 'MultiSet' from a list of pairs of elements and their multiplicity.++For any 'Foldable', use @foldMap (uncurry 'singletonMany')@.+-}+fromMultiplicityList :: (Ord a) => [(a, Natural)] -> MultiSet a+fromMultiplicityList = MS . M.fromListWith (+) . P.filter ((> 0) . snd)++-- | Construct a 'MultiSet' from a 'M.Map' of element multiplicities.+fromMap :: M.Map a Natural -> MultiSet a+fromMap = MS . M.filter (> 0)++-- | Construct a 'MultiSet' from a 'S.Set'.+fromSet :: (Ord a) => S.Set a -> MultiSet a+fromSet = MS . M.fromSet (const 1)++-- | Insert one occurrence of the given element.+insert :: (Ord a) => a -> MultiSet a -> MultiSet a+insert = (`insertMany` 1)++-- | Insert many occurrences of the given element.+insertMany :: (Ord a) => a -> Natural -> MultiSet a -> MultiSet a+insertMany _ 0 = id+insertMany x n = lift $ M.insertWith (+) x n++positive :: Maybe Natural -> Maybe Natural+positive = mfilter (> 0)++(-?) :: Natural -> Natural -> Maybe Natural+x -? y = positive $ x `minusNaturalMaybe` y++-- | Delete one occurrence of the given element.+delete :: (Ord a) => a -> MultiSet a -> MultiSet a+delete = (`deleteMany` 1)++-- | Delete many occurrences of the given element.+deleteMany :: (Ord a) => a -> Natural -> MultiSet a -> MultiSet a+deleteMany _ 0 = id -- not required to maintain invariant+deleteMany x n = lift $ M.update (-? n) x++-- | Delete all occurrences of the given element.+deleteAll :: (Ord a) => a -> MultiSet a -> MultiSet a+deleteAll x = lift $ M.delete x++-- | Delete all elements which don't satisfy the given predicate.+filter :: (a -> Bool) -> MultiSet a -> MultiSet a+filter = filterWithMultiplicity . (const .)++-- | Like 'filter', but the predicate receives the element multiplicity as well.+filterWithMultiplicity :: (a -> Natural -> Bool) -> MultiSet a -> MultiSet a+filterWithMultiplicity = lift . M.filterWithKey++-- | Like 'filter', but the predicate is effectful.+filterA :: (Applicative f) => (a -> f Bool) -> MultiSet a -> f (MultiSet a)+filterA = filterWithMultiplicityA . (const .)++-- | Like 'filterA', but the predicate receives the element multiplicity as well.+filterWithMultiplicityA ::+    (Applicative f) => (a -> Natural -> f Bool) -> MultiSet a -> f (MultiSet a)+filterWithMultiplicityA p =+    fmap MS . M.traverseMaybeWithKey (\x n -> (n <$) . guard <$> p x n) . unMS++{- | Split a `MultiSet` into a pair of `MultiSet`s, the elements of which do+  and do not satisfy the given predicate, respectively.+-}+partition :: (a -> Bool) -> MultiSet a -> (MultiSet a, MultiSet a)+partition = partitionWithMultiplicity . (const .)++-- | Like 'partition', but the predicate is effectful.+partitionA :: (Applicative f) => (a -> f Bool) -> MultiSet a -> f (MultiSet a, MultiSet a)+partitionA = partitionWithMultiplicityA . (const .)++-- | Like 'partition', but the predicate receives the element multiplicity as well.+partitionWithMultiplicity :: (a -> Natural -> Bool) -> MultiSet a -> (MultiSet a, MultiSet a)+partitionWithMultiplicity f = bimap MS MS . M.partitionWithKey f . unMS++-- | Like 'partitionWithMultiplicity', but the predicate is effectful.+partitionWithMultiplicityA ::+    (Applicative f) => (a -> Natural -> f Bool) -> MultiSet a -> f (MultiSet a, MultiSet a)+partitionWithMultiplicityA f =+    fmap (bimap wrap wrap) . M.foldrWithKey classify (pure ([], [])) . unMS+  where+    classify x n = A.liftA2 (\b -> bool second first b ((x, n) :)) (f x n)+    wrap = MS . M.fromDistinctAscList++{- | @'map' f s@ is the 'MultiSet' obtained from applying @f@ to each element+  of @s@. Multiplicities are added when multiple @a@s map to the same @b@,+  and preserved otherwise.+-}+map :: (Ord b) => (a -> b) -> MultiSet a -> MultiSet b+map f = lift $ M.mapKeysWith (+) f++{- | @'mapWithMultiplicity' f s ==+   'fromMultiplicityList' (fmap (uncurry f) ('toMultiplicityList' s))@.++  Multiplicities of equal resulting elements are added, and resulting zero+  multiplicities are discarded.+-}+mapWithMultiplicity :: (Ord b) => (a -> Natural -> (b, Natural)) -> MultiSet a -> MultiSet b+mapWithMultiplicity f = foldlWithMultiplicity' (\ms x n -> uncurry insertMany (f x n) ms) empty++{- | @'mapMultiplicities' f s@ is the 'MultiSet' obtained from applying @f@ to+  the multiplicity of each element of @s@. Zero multiplicities are removed.+-}+mapMultiplicities :: (Natural -> Natural) -> MultiSet a -> MultiSet a+mapMultiplicities f = lift $ M.mapMaybe (positive . Just . f)++-- | Like 'map', but elements can be removed by using 'Nothing' and kept using 'Just'.+mapMaybe :: (Ord b) => (a -> Maybe b) -> MultiSet a -> MultiSet b+mapMaybe f = mapMaybeWithMultiplicity (\x n -> (,n) <$> f x)++{- | Like 'mapWithMultiplicity', but elements can be removed using 'Nothing'+  and kept using 'Just'.+-}+mapMaybeWithMultiplicity ::+    (Ord b) => (a -> Natural -> Maybe (b, Natural)) -> MultiSet a -> MultiSet b+mapMaybeWithMultiplicity f =+    foldlWithMultiplicity' (\ms x n -> maybe ms (flip (uncurry insertMany) ms) (f x n)) empty++-- | @'concatMap' f s@ applies @f@ to each element of @s@, and 'unions' the resulting 'MultiSet's.+concatMap :: (Ord b) => (a -> MultiSet b) -> MultiSet a -> MultiSet b+concatMap f = foldlWithMultiplicity' (\ms x n -> union ms $ mapMultiplicities (* n) $ f x) empty++{- | @'alterMultiplicity' f x s@ sets the multiplicity of @x@ in @s@ to the+result of applying @f@ to its current multiplicity (which might be zero).+-}+alterMultiplicity :: (Ord a) => (Natural -> Natural) -> a -> MultiSet a -> MultiSet a+alterMultiplicity f = lift . M.alter (positive . Just . f . fromMaybe 0)++-- | Like 'alterMultiplicity', but the update function is effectful.+alterMultiplicityF ::+    (Functor f, Ord a) => (Natural -> f Natural) -> a -> MultiSet a -> f (MultiSet a)+alterMultiplicityF f x = fmap MS . M.alterF (fmap (positive . Just) . f . fromMaybe 0) x . unMS++-- | @'setMultiplicity' x n s@ sets the multiplicity of @x@ in @s@ to @n@.+setMultiplicity :: (Ord a) => a -> Natural -> MultiSet a -> MultiSet a+setMultiplicity x n = alterMultiplicity (const n) x++{- | Right-associatively fold the elements and their multiplicities of a+  'MultiSet' into a single value.+-}+foldrWithMultiplicity :: (a -> Natural -> r -> r) -> r -> MultiSet a -> r+foldrWithMultiplicity f r = M.foldrWithKey f r . unMS++-- | Strict version of 'foldrWithMultiplicity'.+foldrWithMultiplicity' :: (a -> Natural -> r -> r) -> r -> MultiSet a -> r+foldrWithMultiplicity' f r = M.foldrWithKey' f r . unMS++{- | Left-associatively fold the elements and their multiplicities of a+  'MultiSet' into a single value.+-}+foldlWithMultiplicity :: (r -> a -> Natural -> r) -> r -> MultiSet a -> r+foldlWithMultiplicity f r = M.foldlWithKey f r . unMS++-- | Strict version of 'foldlWithMultiplicity'.+foldlWithMultiplicity' :: (r -> a -> Natural -> r) -> r -> MultiSet a -> r+foldlWithMultiplicity' f r = M.foldlWithKey' f r . unMS++-- | Fold the elements and their multiplicities of a 'MultiSet' using the given 'Monoid'.+foldMapWithMultiplicity :: (Monoid m) => (a -> Natural -> m) -> MultiSet a -> m+foldMapWithMultiplicity f = M.foldMapWithKey f . unMS++-- | Like 'traverseWithMultiplicity', but preserves element multiplicities.+traverse :: (Applicative f, Ord b) => (a -> f b) -> MultiSet a -> f (MultiSet b)+traverse f = traverseWithMultiplicity (\x n -> (,n) <$> f x)++{- | Like 'traverse', but elements can be removed using 'Nothing' and kept+using 'Just'.+-}+traverseMaybe :: (Applicative f, Ord b) => (a -> f (Maybe b)) -> MultiSet a -> f (MultiSet b)+traverseMaybe f = traverseMaybeWithMultiplicity (\x n -> fmap (,n) <$> f x)++{- | @'traverseWithMultiplicity' f s@ applies the effect @f@ to each distinct+element of @s@ and its multiplicity in increasing order of elements. The+@(element, multiplicity)@ result pairs are used to construct the resulting+'MultiSet'.+-}+traverseWithMultiplicity ::+    (Applicative f, Ord b) => (a -> Natural -> f (b, Natural)) -> MultiSet a -> f (MultiSet b)+traverseWithMultiplicity f = traverseMaybeWithMultiplicity ((fmap Just .) . f)++{- | Like 'traverseWithMultiplicity', but elements can be removed using+'Nothing' and kept using 'Just'.+-}+traverseMaybeWithMultiplicity ::+    (Applicative f, Ord b) =>+    (a -> Natural -> f (Maybe (b, Natural))) ->+    MultiSet a ->+    f (MultiSet b)+traverseMaybeWithMultiplicity f =+    foldrWithMultiplicity (\x n -> A.liftA2 (maybe id (uncurry insertMany)) (f x n)) (pure empty)++{- | Like 'traverseWithMultiplicity', but discards the results of the effect+and doesn't build a resulting 'MultiSet'.+-}+traverseWithMultiplicity_ :: (Applicative f) => (a -> Natural -> f b) -> MultiSet a -> f ()+traverseWithMultiplicity_ f = foldrWithMultiplicity (\x n rest -> f x n *> rest) (pure ())++-- | Convert to a 'M.Map' from element to its multiplicity.+toMap :: MultiSet a -> M.Map a Natural+toMap = unMS++-- | Convert to a list of @(element, multiplicity)@ pairs.+toMultiplicityList :: MultiSet a -> [(a, Natural)]+toMultiplicityList = M.toAscList . unMS++-- | The set of distinct elements.+toSet :: MultiSet a -> S.Set a+toSet = M.keysSet . unMS++-- | The list of distinct elements.+toDistinctList :: MultiSet a -> [a]+toDistinctList = M.keys . unMS++-- | Convert to an ascending list, repeating each element according to its multiplicity.+toList :: MultiSet a -> [a]+toList = foldrWithMultiplicity (\x n -> (++) $ genericReplicate n x) []++-- | Is the 'MultiSet' empty?+null :: MultiSet a -> Bool+null = M.null . unMS++-- | Is the value a member of the 'MultiSet'?+member :: (Ord a) => a -> MultiSet a -> Bool+member x = M.member x . unMS++-- | Is the value not a member of the 'MultiSet'?+notMember :: (Ord a) => a -> MultiSet a -> Bool+notMember x = M.notMember x . unMS++-- | How many times is the element contained in the 'MultiSet'?+multiplicity :: (Ord a) => a -> MultiSet a -> Natural+multiplicity x = M.findWithDefault 0 x . unMS++-- | How many elements are in the 'MultiSet'? This is the sum of multiplicities.+size :: MultiSet a -> Natural+size = M.foldl' (+) 0 . unMS++-- | How many distinct elements are in the 'MultiSet'?+distinctSize :: MultiSet a -> Int+distinctSize = M.size . unMS++-- | The union two 'MultiSet's, adding multiplicities for elements present in both.+union :: (Ord a) => MultiSet a -> MultiSet a -> MultiSet a+union = lift2 $ M.unionWith (+)++{- | The union of a list of 'MultiSet's.++For any 'Foldable', use @foldMap id@.+-}+unions :: (Ord a) => [MultiSet a] -> MultiSet a+unions = MS . M.unionsWith (+) . P.map unMS++-- | The difference of two 'MultiSet's.+difference :: (Ord a) => MultiSet a -> MultiSet a -> MultiSet a+difference = lift2 $ M.differenceWith (-?)++{- | The symmetric difference of two 'MultiSet's, taking the absolute difference+  of multiplicities for elements present in both.+-}+symmetricDifference :: (Ord a) => MultiSet a -> MultiSet a -> MultiSet a+symmetricDifference = lift2 $ M.mergeWithKey (\_ m n -> m -? n <|> n -? m) id id++-- | The intersection of two 'MultiSet's.+intersection :: (Ord a) => MultiSet a -> MultiSet a -> MultiSet a+intersection = lift2 $ M.intersectionWith min++-- | The intersection of a series of 'MultiSet's.+intersections :: (Ord a) => NonEmpty (MultiSet a) -> MultiSet a+intersections (x :| xs) = F.foldl' intersection x xs++-- | The union of two 'MultiSet's, taking the maximum multiplicity of each element.+maxUnion :: (Ord a) => MultiSet a -> MultiSet a -> MultiSet a+maxUnion = lift2 $ M.unionWith max++{- | The cartesian product of two 'MultiSet's. Each pair @(x, y)@ appears with+  multiplicity equal to the multiplicity of @x@ in the first 'MultiSet'+  multiplied by the multiplicity of @y@ in the second.+-}+cartesianProduct :: (Ord a, Ord b) => MultiSet a -> MultiSet b -> MultiSet (a, b)+cartesianProduct xs = concatMap (\y -> map (,y) xs)++-- | Is the first 'MultiSet' contained in the second, respecting multiplicities?+isSubsetOf :: (Ord a) => MultiSet a -> MultiSet a -> Bool+isSubsetOf = with2 $ M.isSubmapOfBy (<=)++-- | Like 'isSubsetOf', but 'False' if the two 'MultiSet's are equal.+isProperSubsetOf :: (Ord a) => MultiSet a -> MultiSet a -> Bool+isProperSubsetOf x y = x /= y && isSubsetOf x y++-- | Do the two 'MultiSet's have no common elements?+disjoint :: (Ord a) => MultiSet a -> MultiSet a -> Bool+disjoint = with2 M.disjoint++{- | Find the largest element smaller than the given one and return the+  corresponding @(element, multiplicity)@ pair.+-}+lookupLT :: (Ord a) => a -> MultiSet a -> Maybe (a, Natural)+lookupLT x = M.lookupLT x . unMS++{- | Find the largest element smaller than or equal to the given one and return+  the corresponding @(element, multiplicity)@ pair.+-}+lookupLE :: (Ord a) => a -> MultiSet a -> Maybe (a, Natural)+lookupLE x = M.lookupLE x . unMS++{- | Find the smallest element greater than the given one and return the+  corresponding @(element, multiplicity)@ pair.+-}+lookupGT :: (Ord a) => a -> MultiSet a -> Maybe (a, Natural)+lookupGT x = M.lookupGT x . unMS++{- | Find the smallest element greater than or equal to the given one and+  return the corresponding @(element, multiplicity)@ pair.+-}+lookupGE :: (Ord a) => a -> MultiSet a -> Maybe (a, Natural)+lookupGE x = M.lookupGE x . unMS++-- | Find the smallest element of the 'MultiSet' and its multiplicity.+lookupMin :: MultiSet a -> Maybe (a, Natural)+lookupMin = M.lookupMin . unMS++-- | Find the largest element of the 'MultiSet' and its multiplicity.+lookupMax :: MultiSet a -> Maybe (a, Natural)+lookupMax = M.lookupMax . unMS++-- | Remove one occurrence of the smallest element of the 'MultiSet'.+deleteMin :: MultiSet a -> MultiSet a+deleteMin = lift $ M.updateMin (-? 1)++-- | Remove one occurrence of the largest element of the 'MultiSet'.+deleteMax :: MultiSet a -> MultiSet a+deleteMax = lift $ M.updateMax (-? 1)++-- | Remove all occurrences of the smallest element of the 'MultiSet'.+deleteMinAll :: MultiSet a -> MultiSet a+deleteMinAll = lift M.deleteMin++-- | Remove all occurrences of the largest element of the 'MultiSet'.+deleteMaxAll :: MultiSet a -> MultiSet a+deleteMaxAll = lift M.deleteMax++-- two traversals for both of these, but maybe we don't care for now?++{- | Return the least element and the remaining 'MultiSet' with one occurrence+  removed, or 'Nothing' if empty.+-}+minView :: (Ord a) => MultiSet a -> Maybe (a, MultiSet a)+minView ms = do+    ((x, n), xs) <- M.minViewWithKey $ unMS ms+    pure (x, insertMany x (n - 1) $ MS xs)++{- | Return the greatest element and the remaining 'MultiSet' with one+  occurrence removed, or 'Nothing' if empty.+-}+maxView :: (Ord a) => MultiSet a -> Maybe (a, MultiSet a)+maxView ms = do+    ((x, n), xs) <- M.maxViewWithKey $ unMS ms+    pure (x, insertMany x (n - 1) $ MS xs)++{- | Return the least element with its multiplicity, and the remaining+  'MultiSet', or 'Nothing' if empty.+-}+minViewWithMultiplicity :: MultiSet a -> Maybe ((a, Natural), MultiSet a)+minViewWithMultiplicity = fmap (second MS) . M.minViewWithKey . unMS++{- | Return the greatest element with its multiplicity, and the remaining+  'MultiSet', or 'Nothing' if empty.+-}+maxViewWithMultiplicity :: MultiSet a -> Maybe ((a, Natural), MultiSet a)+maxViewWithMultiplicity = fmap (second MS) . M.maxViewWithKey . unMS++{- | @'split' x s@ produces the tuple @(sl, nx, sg)@, where @nx@ is the+  multiplicity of @x@ in @s@, and @sl@ and @sg@ are 'MultiSet's containing+  the elements of @s@ which are less than and greater than @x@, respectively.++  @x@ is not required to be a 'member' of @s@, and @nx@ will be zero if it+  isn't.+-}+split :: (Ord a) => a -> MultiSet a -> (MultiSet a, Natural, MultiSet a)+split x = ret . M.splitLookup x . unMS+  where+    ret (ls, m, rs) = (MS ls, fromMaybe 0 m, MS rs)++-- TODO:+-- - mapMonotonic and other unsafe functions?+-- - Intersection wrapper with Semigroup instance?
+ test/Main.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE TypeApplications #-}++import Test.Tasty+import Test.Tasty.QuickCheck++import Test.Gen++import qualified Test.Combining+import qualified Test.Effects+import qualified Test.Extremes+import qualified Test.Folds+import qualified Test.Instances+import qualified Test.Queries+import qualified Test.ToFrom+import qualified Test.Transformations+import qualified Test.Updates+import qualified Test.Valid++main :: IO ()+main =+    defaultMain $+        testGroup+            "Data.MultiSet.Natural"+            [ testProperty "LNat large" prop_lnatLarge+            , Test.Valid.tests+            , Test.ToFrom.tests+            , Test.Queries.tests+            , Test.Instances.tests+            , Test.Effects.tests+            , Test.Folds.tests+            , Test.Transformations.tests+            , Test.Updates.tests+            , Test.Combining.tests+            , Test.Extremes.tests+            ]++prop_lnatLarge :: LNat -> Property+prop_lnatLarge (LNat n) = checkCoverage $ cover 20 big "> max Int" True+  where+    big = n > fromIntegral (maxBound @Int)
+ test/Test/Combining.hs view
@@ -0,0 +1,191 @@+module Test.Combining (+    tests,+) where++import Data.Foldable+import qualified Data.MultiSet.Natural as MS+import Numeric.Natural+import Test.Gen+import Test.Tasty+import Test.Tasty.QuickCheck++tests :: TestTree+tests =+    testGroup+        "combining"+        [ testProperty "union/empty" prop_unionEmpty+        , testProperty "union/commutative" prop_unionCommutative+        , testProperty "union/associative" prop_unionAssociative+        , testProperty "union/multiplicity" prop_unionMultiplicity+        , testProperty "union/size" prop_unionSize+        , testProperty "unions/fold" prop_unionsFold+        , testProperty "difference/empty" prop_differenceEmpty+        , testProperty "difference/self" prop_differenceSelf+        , testProperty "difference/subset" prop_differenceSubset+        , testProperty "difference/multiplicity" prop_differenceMultiplicity+        , testProperty "difference/undo union" prop_differenceUndoUnion+        , testProperty "symmetricDifference/empty" prop_symmetricDifferenceEmpty+        , testProperty "symmetricDifference/self" prop_symmetricDifferenceSelf+        , testProperty "symmetricDifference/commutative" prop_symmetricDifferenceCommutative+        , testProperty "symmetricDifference/multiplicity" prop_symmetricDifferenceMultiplicity+        , testProperty "symmetricDifference/differences" prop_symmetricDifferenceDifferences+        , testProperty "intersection/self" prop_intersectionSelf+        , testProperty "intersection/commutative" prop_intersectionCommutative+        , testProperty "intersection/associative" prop_intersectionAssociative+        , testProperty "intersection/subsets" prop_intersectionSubsets+        , testProperty "intersection/multiplicity" prop_intersectionMultiplicity+        , testProperty "intersections/multiplicity" prop_intersectionsMultiplicity+        , testProperty "intersections/subsets" prop_intersectionsSubsets+        , testProperty "maxUnion/empty" prop_maxUnionEmpty+        , testProperty "maxUnion/self" prop_maxUnionSelf+        , testProperty "maxUnion/commutative" prop_maxUnionCommutative+        , testProperty "maxUnion/associative" prop_maxUnionAssociative+        , testProperty "maxUnion/multiplicity" prop_maxUnionMultiplicity+        , testProperty "cartesianProduct/empty left" prop_cartesianProductEmptyLeft+        , testProperty "cartesianProduct/empty right" prop_cartesianProductEmptyRight+        , testProperty "cartesianProduct/multiplicity" prop_cartesianProductMultiplicity+        , testProperty "cartesianProduct/size" prop_cartesianProductSize+        , testProperty "cartesianProduct/distinctSize" prop_cartesianProductDistinctSize+        , testProperty "difference+intersection decomposition" prop_differenceIntersectionDecomposition+        ]++prop_unionEmpty :: AMS -> Property+prop_unionEmpty (AMS xs) = conjoin [MS.union MS.empty xs === xs, MS.union xs MS.empty === xs]++prop_unionCommutative :: AMS -> AMS -> Property+prop_unionCommutative (AMS xs) (AMS ys) = MS.union xs ys === MS.union ys xs++prop_unionAssociative :: AMS -> AMS -> AMS -> Property+prop_unionAssociative (AMS xs) (AMS ys) (AMS zs) =+    MS.union xs (MS.union ys zs) === MS.union (MS.union xs ys) zs++prop_unionMultiplicity :: AMSWithKey2 -> Property+prop_unionMultiplicity (AMSWithKey2 x xs ys) =+    MS.multiplicity x (MS.union xs ys) === MS.multiplicity x xs + MS.multiplicity x ys++prop_unionSize :: AMS -> AMS -> Property+prop_unionSize (AMS xs) (AMS ys) = MS.size (MS.union xs ys) === MS.size xs + MS.size ys++prop_unionsFold :: [AMS] -> Property+prop_unionsFold xss = MS.unions xs === foldr MS.union MS.empty xs+  where+    xs = getAMS <$> xss++prop_differenceEmpty :: AMS -> Property+prop_differenceEmpty (AMS xs) = MS.difference xs MS.empty === xs++prop_differenceSelf :: AMS -> Property+prop_differenceSelf (AMS xs) = MS.difference xs xs === MS.empty++prop_differenceSubset :: AMS -> AMS -> Property+prop_differenceSubset (AMS xs) (AMS ys) = property $ MS.difference xs ys `MS.isSubsetOf` xs++prop_differenceMultiplicity :: AMSWithKey2 -> Property+prop_differenceMultiplicity (AMSWithKey2 x xs ys) =+    MS.multiplicity x (MS.difference xs ys) === MS.multiplicity x xs `monus` MS.multiplicity x ys++prop_differenceUndoUnion :: AMS -> AMS -> Property+prop_differenceUndoUnion (AMS xs) (AMS ys) = MS.difference (MS.union xs ys) ys === xs++prop_symmetricDifferenceEmpty :: AMS -> Property+prop_symmetricDifferenceEmpty (AMS xs) =+    conjoin [MS.symmetricDifference xs MS.empty === xs, MS.symmetricDifference MS.empty xs === xs]++prop_symmetricDifferenceSelf :: AMS -> Property+prop_symmetricDifferenceSelf (AMS xs) = MS.symmetricDifference xs xs === MS.empty++prop_symmetricDifferenceCommutative :: AMS -> AMS -> Property+prop_symmetricDifferenceCommutative (AMS xs) (AMS ys) =+    MS.symmetricDifference xs ys === MS.symmetricDifference ys xs++prop_symmetricDifferenceMultiplicity :: AMSWithKey2 -> Property+prop_symmetricDifferenceMultiplicity (AMSWithKey2 x xs ys) =+    MS.multiplicity x (MS.symmetricDifference xs ys)+        === distance (MS.multiplicity x xs) (MS.multiplicity x ys)++prop_symmetricDifferenceDifferences :: AMS -> AMS -> Property+prop_symmetricDifferenceDifferences (AMS xs) (AMS ys) =+    MS.symmetricDifference xs ys === MS.union (MS.difference xs ys) (MS.difference ys xs)++prop_intersectionSelf :: AMS -> Property+prop_intersectionSelf (AMS xs) = MS.intersection xs xs === xs++prop_intersectionCommutative :: AMS -> AMS -> Property+prop_intersectionCommutative (AMS xs) (AMS ys) = MS.intersection xs ys === MS.intersection ys xs++prop_intersectionAssociative :: AMS -> AMS -> AMS -> Property+prop_intersectionAssociative (AMS xs) (AMS ys) (AMS zs) =+    MS.intersection xs (MS.intersection ys zs) === MS.intersection (MS.intersection xs ys) zs++prop_intersectionSubsets :: AMS -> AMS -> Property+prop_intersectionSubsets (AMS xs) (AMS ys) =+    conjoin+        [ property $ MS.intersection xs ys `MS.isSubsetOf` xs+        , property $ MS.intersection xs ys `MS.isSubsetOf` ys+        ]++prop_intersectionMultiplicity :: AMSWithKey2 -> Property+prop_intersectionMultiplicity (AMSWithKey2 x xs ys) =+    MS.multiplicity x (MS.intersection xs ys)+        === min (MS.multiplicity x xs) (MS.multiplicity x ys)++prop_intersectionsMultiplicity :: AMSsWithKey -> Property+prop_intersectionsMultiplicity (AMSsWithKey x xss) =+    MS.multiplicity x (MS.intersections xss) === minimum (MS.multiplicity x <$> xss)++prop_intersectionsSubsets :: AMSsWithKey -> Property+prop_intersectionsSubsets (AMSsWithKey _ xss) =+    conjoin $ (res `MS.isSubsetOf`) <$> toList xss+  where+    res = MS.intersections xss++prop_maxUnionEmpty :: AMS -> Property+prop_maxUnionEmpty (AMS xs) =+    conjoin [MS.maxUnion MS.empty xs === xs, MS.maxUnion xs MS.empty === xs]++prop_maxUnionSelf :: AMS -> Property+prop_maxUnionSelf (AMS xs) = MS.maxUnion xs xs === xs++prop_maxUnionCommutative :: AMS -> AMS -> Property+prop_maxUnionCommutative (AMS xs) (AMS ys) = MS.maxUnion xs ys === MS.maxUnion ys xs++prop_maxUnionAssociative :: AMS -> AMS -> AMS -> Property+prop_maxUnionAssociative (AMS xs) (AMS ys) (AMS zs) =+    MS.maxUnion xs (MS.maxUnion ys zs) === MS.maxUnion (MS.maxUnion xs ys) zs++prop_maxUnionMultiplicity :: AMSWithKey2 -> Property+prop_maxUnionMultiplicity (AMSWithKey2 x xs ys) =+    MS.multiplicity x (MS.maxUnion xs ys) === max (MS.multiplicity x xs) (MS.multiplicity x ys)++prop_cartesianProductEmptyLeft :: AMS -> Property+prop_cartesianProductEmptyLeft (AMS ys) =+    MS.cartesianProduct (MS.empty :: MS.MultiSet Int) ys === MS.empty++prop_cartesianProductEmptyRight :: AMS -> Property+prop_cartesianProductEmptyRight (AMS xs) =+    MS.cartesianProduct xs (MS.empty :: MS.MultiSet Int) === MS.empty++prop_cartesianProductMultiplicity :: AMSWithKey -> AMSWithKey -> Property+prop_cartesianProductMultiplicity (AMSWithKey x xs) (AMSWithKey y ys) =+    MS.multiplicity (x, y) (MS.cartesianProduct xs ys)+        === MS.multiplicity x xs * MS.multiplicity y ys++prop_cartesianProductSize :: AMS -> AMS -> Property+prop_cartesianProductSize (AMS xs) (AMS ys) =+    MS.size (MS.cartesianProduct xs ys) === MS.size xs * MS.size ys++prop_cartesianProductDistinctSize :: AMS -> AMS -> Property+prop_cartesianProductDistinctSize (AMS xs) (AMS ys) =+    MS.distinctSize (MS.cartesianProduct xs ys) === MS.distinctSize xs * MS.distinctSize ys++prop_differenceIntersectionDecomposition :: AMS -> AMS -> Property+prop_differenceIntersectionDecomposition (AMS xs) (AMS ys) =+    MS.union (MS.difference xs ys) (MS.intersection xs ys) === xs++monus :: Natural -> Natural -> Natural+monus x y+    | x >= y = x - y+    | otherwise = 0++distance :: Natural -> Natural -> Natural+distance x y = monus x y + monus y x
+ test/Test/Effects.hs view
@@ -0,0 +1,97 @@+module Test.Effects (+    tests,+) where++import Data.Coerce+import qualified Data.MultiSet.Natural as MS+import Numeric.Natural+import Test.Gen+import Test.Tasty+import Test.Tasty.QuickCheck++tests :: TestTree+tests =+    testGroup+        "effects"+        [ testProperty "filterA" prop_filterA+        , testProperty "filterWithMultiplicityA" prop_filterWithMultiplicityA+        , testProperty "partitionA" prop_partitionA+        , testProperty "partitionWithMultiplicityA" prop_partitionWithMultiplicityA+        , testProperty "traverse" prop_traverse+        , testProperty "traverseMaybe" prop_traverseMaybe+        , testProperty "traverseWithMultiplicity" prop_traverseWithMultiplicity+        , testProperty "traverseMaybeWithMultiplicity" prop_traverseMaybeWithMultiplicity+        , testProperty "traverseWithMultiplicity_" prop_traverseWithMultiplicity_+        , testProperty "alterMultiplicityF" prop_alterMultiplicityF+        ]++prop_filterA :: Fun Int Bool -> AMS -> Property+prop_filterA fun (AMS xs) =+    conjoin [seen === MS.toDistinctList xs, ys === MS.filter f xs]+  where+    f = applyFun fun+    (seen, ys) = MS.filterA (\x -> ([x], f x)) xs++prop_filterWithMultiplicityA :: Fun (Int, Natural') Bool -> AMS -> Property+prop_filterWithMultiplicityA fun (AMS xs) =+    conjoin [seen === MS.toMultiplicityList xs, ys === MS.filterWithMultiplicity (curry f) xs]+  where+    f = coerce $ applyFun fun+    (seen, ys) = MS.filterWithMultiplicityA (\x n -> ([(x, n)], f (x, n))) xs++prop_partitionA :: Fun Int Bool -> AMS -> Property+prop_partitionA fun (AMS xs) =+    conjoin [seen === MS.toDistinctList xs, ys === MS.partition f xs]+  where+    f = applyFun fun+    (seen, ys) = MS.partitionA (\x -> ([x], f x)) xs++prop_partitionWithMultiplicityA :: Fun (Int, Natural') Bool -> AMS -> Property+prop_partitionWithMultiplicityA fun (AMS xs) =+    conjoin [seen === MS.toMultiplicityList xs, ys === MS.partitionWithMultiplicity (curry f) xs]+  where+    f = coerce $ applyFun fun+    (seen, ys) = MS.partitionWithMultiplicityA (\x n -> ([(x, n)], f (x, n))) xs++prop_traverse :: Fun Int Int -> AMS -> Property+prop_traverse fun (AMS xs) =+    conjoin [seen === MS.toDistinctList xs, ys === MS.map f xs]+  where+    f = applyFun fun+    (seen, ys) = MS.traverse (\x -> ([x], f x)) xs++prop_traverseMaybe :: Fun Int (Maybe Int) -> AMS -> Property+prop_traverseMaybe fun (AMS xs) =+    conjoin [seen === MS.toDistinctList xs, ys === MS.mapMaybe f xs]+  where+    f = applyFun fun+    (seen, ys) = MS.traverseMaybe (\x -> ([x], f x)) xs++prop_traverseWithMultiplicity :: Fun (Int, Natural') (Int, Natural') -> AMS -> Property+prop_traverseWithMultiplicity fun (AMS xs) =+    conjoin [seen === MS.toMultiplicityList xs, ys === MS.mapWithMultiplicity (curry f) xs]+  where+    f :: (Int, Natural) -> (Int, Natural)+    f = coerce $ applyFun fun+    (seen, ys) = MS.traverseWithMultiplicity (\x n -> ([(x, n)], f (x, n))) xs++prop_traverseMaybeWithMultiplicity :: Fun (Int, Natural') (Maybe (Int, Natural')) -> AMS -> Property+prop_traverseMaybeWithMultiplicity fun (AMS xs) =+    conjoin [seen === MS.toMultiplicityList xs, ys === MS.mapMaybeWithMultiplicity (curry f) xs]+  where+    f :: (Int, Natural) -> Maybe (Int, Natural)+    f = coerce $ applyFun fun+    (seen, ys) = MS.traverseMaybeWithMultiplicity (\x n -> ([(x, n)], f (x, n))) xs++prop_traverseWithMultiplicity_ :: AMS -> Property+prop_traverseWithMultiplicity_ (AMS xs) =+    conjoin [seen === MS.toMultiplicityList xs, y === ()]+  where+    (seen, y) = MS.traverseWithMultiplicity_ (\x n -> ([(x, n)], ())) xs++prop_alterMultiplicityF :: Fun Natural' Natural' -> AMSWithKey -> Property+prop_alterMultiplicityF fun (AMSWithKey x xs) =+    conjoin [seen === [MS.multiplicity x xs], ys === MS.alterMultiplicity f x xs]+  where+    f = coerce $ applyFun fun+    (seen, ys) = MS.alterMultiplicityF (\n -> ([n], f n)) x xs
+ test/Test/Extremes.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE TupleSections #-}++module Test.Extremes (+    tests,+) where++import qualified Data.MultiSet.Natural as MS+import Test.Gen+import Test.Tasty+import Test.Tasty.QuickCheck++tests :: TestTree+tests =+    testGroup+        "extremes"+        [ testProperty "deleteMin/delete" prop_deleteMinDelete+        , testProperty "deleteMax/delete" prop_deleteMaxDelete+        , testProperty "deleteMinAll/deleteAll" prop_deleteMinAllDeleteAll+        , testProperty "deleteMaxAll/deleteAll" prop_deleteMaxAllDeleteAll+        , testProperty "minView/lookupMin + deleteMin" prop_minView+        , testProperty "maxView/lookupMax + deleteMax" prop_maxView+        , testProperty "minViewWithMultiplicity/lookupMin + deleteMinAll" prop_minViewWithMultiplicity+        , testProperty "maxViewWithMultiplicity/lookupMax + deleteMaxAll" prop_maxViewWithMultiplicity+        , testProperty "split/multiplicity" prop_splitMultiplicity+        , testProperty "split/bounds" prop_splitBounds+        , testProperty "split/reconstruct" prop_splitReconstruct+        ]++prop_deleteMinDelete :: AMS -> Property+prop_deleteMinDelete (AMS xs) =+    MS.deleteMin xs === maybe xs (\(x, _) -> MS.delete x xs) (MS.lookupMin xs)++prop_deleteMaxDelete :: AMS -> Property+prop_deleteMaxDelete (AMS xs) =+    MS.deleteMax xs === maybe xs (\(x, _) -> MS.delete x xs) (MS.lookupMax xs)++prop_deleteMinAllDeleteAll :: AMS -> Property+prop_deleteMinAllDeleteAll (AMS xs) =+    MS.deleteMinAll xs === maybe xs (\(x, _) -> MS.deleteAll x xs) (MS.lookupMin xs)++prop_deleteMaxAllDeleteAll :: AMS -> Property+prop_deleteMaxAllDeleteAll (AMS xs) =+    MS.deleteMaxAll xs === maybe xs (\(x, _) -> MS.deleteAll x xs) (MS.lookupMax xs)++prop_minView :: AMS -> Property+prop_minView (AMS xs) = MS.minView xs === fmap (\(x, _) -> (x, MS.deleteMin xs)) (MS.lookupMin xs)++prop_maxView :: AMS -> Property+prop_maxView (AMS xs) = MS.maxView xs === fmap (\(x, _) -> (x, MS.deleteMax xs)) (MS.lookupMax xs)++prop_minViewWithMultiplicity :: AMS -> Property+prop_minViewWithMultiplicity (AMS xs) =+    MS.minViewWithMultiplicity xs === fmap (,MS.deleteMinAll xs) (MS.lookupMin xs)++prop_maxViewWithMultiplicity :: AMS -> Property+prop_maxViewWithMultiplicity (AMS xs) =+    MS.maxViewWithMultiplicity xs === fmap (,MS.deleteMaxAll xs) (MS.lookupMax xs)++prop_splitMultiplicity :: AMSWithKey -> Property+prop_splitMultiplicity (AMSWithKey x xs) = n === MS.multiplicity x xs+  where+    (_, n, _) = MS.split x xs++prop_splitBounds :: AMSWithKey -> Property+prop_splitBounds (AMSWithKey x xs) =+    conjoin+        [ property $ all (< x) $ MS.toDistinctList lt+        , property $ all (> x) $ MS.toDistinctList gt+        ]+  where+    (lt, _, gt) = MS.split x xs++prop_splitReconstruct :: AMSWithKey -> Property+prop_splitReconstruct (AMSWithKey x xs) = MS.union lt (MS.insertMany x n gt) === xs+  where+    (lt, n, gt) = MS.split x xs
+ test/Test/Folds.hs view
@@ -0,0 +1,101 @@+module Test.Folds (+    tests,+) where++import Data.Coerce+import qualified Data.Foldable as F+import qualified Data.List as L+import qualified Data.MultiSet.Natural as MS+import Numeric.Natural+import Test.Gen+import Test.Tasty+import Test.Tasty.QuickCheck++tests :: TestTree+tests =+    testGroup+        "folds"+        [ testProperty "foldrWithMultiplicity/reconstruct" prop_foldrReconstruct+        , testProperty "foldrWithMultiplicity/reference" prop_foldrReference+        , testProperty "foldrWithMultiplicity'/reconstruct" prop_foldrStrictReconstruct+        , testProperty "foldrWithMultiplicity'/reference" prop_foldrStrictReference+        , testProperty "foldlWithMultiplicity/reconstruct" prop_foldlReconstruct+        , testProperty "foldlWithMultiplicity/reference" prop_foldlReference+        , testProperty "foldlWithMultiplicity'/reconstruct" prop_foldlStrictReconstruct+        , testProperty "foldlWithMultiplicity'/reference" prop_foldlStrictReference+        , testProperty "foldMapWithMultiplicity/reconstruct" prop_foldMapReconstruct+        , testProperty "foldMapWithMultiplicity/reference" prop_foldMapReference+        , testProperty "foldrWithMultiplicity'/agrees with lazy" prop_foldrStrictAgrees+        , testProperty "foldlWithMultiplicity'/agrees with lazy" prop_foldlStrictAgrees+        ]++prop_foldrReconstruct :: AMS -> Property+prop_foldrReconstruct (AMS xs) =+    MS.foldrWithMultiplicity (\x n -> ((x, n) :)) [] xs === MS.toMultiplicityList xs++prop_foldrReference :: Fun (Int, Natural', Int) Int -> Int -> AMS -> Property+prop_foldrReference fun z (AMS xs) =+    MS.foldrWithMultiplicity f z xs === foldr (\(x, n) acc -> f x n acc) z (MS.toMultiplicityList xs)+  where+    f :: Int -> Natural -> Int -> Int+    f x n acc = (coerce . applyFun) fun (x, n, acc)++prop_foldrStrictReconstruct :: AMS -> Property+prop_foldrStrictReconstruct (AMS xs) =+    MS.foldrWithMultiplicity' (\x n -> ((x, n) :)) [] xs === MS.toMultiplicityList xs++prop_foldrStrictReference :: Fun (Int, Natural', Int) Int -> Int -> AMS -> Property+prop_foldrStrictReference fun z (AMS xs) =+    MS.foldrWithMultiplicity' f z xs+        === F.foldr' (\(x, n) acc -> f x n acc) z (MS.toMultiplicityList xs)+  where+    f :: Int -> Natural -> Int -> Int+    f x n acc = (coerce . applyFun) fun (x, n, acc)++prop_foldlReconstruct :: AMS -> Property+prop_foldlReconstruct (AMS xs) =+    reverse (MS.foldlWithMultiplicity (\acc x n -> (x, n) : acc) [] xs) === MS.toMultiplicityList xs++prop_foldlReference :: Fun (Int, Int, Natural') Int -> Int -> AMS -> Property+prop_foldlReference fun z (AMS xs) =+    MS.foldlWithMultiplicity f z xs === foldl (\acc (x, n) -> f acc x n) z (MS.toMultiplicityList xs)+  where+    f :: Int -> Int -> Natural -> Int+    f acc x n = (coerce . applyFun) fun (acc, x, n)++prop_foldlStrictReconstruct :: AMS -> Property+prop_foldlStrictReconstruct (AMS xs) =+    reverse (MS.foldlWithMultiplicity' (\acc x n -> (x, n) : acc) [] xs) === MS.toMultiplicityList xs++prop_foldlStrictReference :: Fun (Int, Int, Natural') Int -> Int -> AMS -> Property+prop_foldlStrictReference fun z (AMS xs) =+    MS.foldlWithMultiplicity' f z xs+        === L.foldl' (\acc (x, n) -> f acc x n) z (MS.toMultiplicityList xs)+  where+    f :: Int -> Int -> Natural -> Int+    f acc x n = (coerce . applyFun) fun (acc, x, n)++prop_foldMapReconstruct :: AMS -> Property+prop_foldMapReconstruct (AMS xs) =+    MS.foldMapWithMultiplicity (\x n -> [(x, n)]) xs === MS.toMultiplicityList xs++prop_foldMapReference :: Fun (Int, Natural') [Int] -> AMS -> Property+prop_foldMapReference fun (AMS xs) =+    MS.foldMapWithMultiplicity (curry f) xs === foldMap f (MS.toMultiplicityList xs)+  where+    f :: (Int, Natural) -> [Int]+    f = coerce $ applyFun fun++prop_foldrStrictAgrees :: Fun (Int, Natural', Int) Int -> Int -> AMS -> Property+prop_foldrStrictAgrees fun z (AMS xs) =+    MS.foldrWithMultiplicity' f z xs === MS.foldrWithMultiplicity f z xs+  where+    f :: Int -> Natural -> Int -> Int+    f x n acc = (coerce . applyFun) fun (x, n, acc)++prop_foldlStrictAgrees :: Fun (Int, Int, Natural') Int -> Int -> AMS -> Property+prop_foldlStrictAgrees fun z (AMS xs) =+    MS.foldlWithMultiplicity' f z xs === MS.foldlWithMultiplicity f z xs+  where+    f :: Int -> Int -> Natural -> Int+    f acc x n = (coerce . applyFun) fun (acc, x, n)
+ test/Test/Gen.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TupleSections #-}++module Test.Gen (+    LNat (..),+    AMSOf (..),+    AMS,+    AMSWithKey (..),+    AMSWithKey2 (..),+    AMSsWithKey (..),+    Natural' (..),+) where++import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import qualified Data.MultiSet.Natural as MS+import Numeric.Natural+import Test.QuickCheck++newtype LNat = LNat {getLNat :: Natural}+    deriving (Eq, Ord, Show)++instance Arbitrary LNat where+    arbitrary = LNat <$> sized genNatural+      where+        genNatural s = do+            bits <- choose (0, 2 * s)+            fromInteger <$> choose (0, 2 ^ bits - 1)+    shrink (LNat n) = LNat <$> shrinkIntegral n++newtype AMSOf a = AMS {getAMS :: MS.MultiSet a}+    deriving (Eq, Show)++instance (Ord a, Arbitrary a) => Arbitrary (AMSOf a) where+    arbitrary =+        AMS . MS.fromMultiplicityList+            <$> listOf ((,) <$> arbitrary <*> (succ . getLNat <$> arbitrary))+    shrink (AMS ms) = AMS . MS.fromMultiplicityList <$> shrinkList f (MS.toMultiplicityList ms)+      where+        f (x, n) = map (,n) (shrink x) ++ map (x,) (filter (> 0) $ shrinkIntegral n)++type AMS = AMSOf Int++data AMSWithKey = AMSWithKey Int (MS.MultiSet Int)+    deriving (Eq, Show)++instance Arbitrary AMSWithKey where+    arbitrary = arbitrary >>= \(AMS xs) -> (`AMSWithKey` xs) <$> keyFor xs+      where+        keyFor xs+            | MS.null xs = arbitrary+            | otherwise =+                oneof+                    [ arbitrary `suchThat` (`MS.notMember` xs)+                    , elements (MS.toDistinctList xs)+                    ]+    shrink (AMSWithKey x xs) =+        [AMSWithKey x xs' | AMS xs' <- shrink (AMS xs), MS.member x xs' == present]+      where+        present = x `MS.member` xs++data AMSWithKey2 = AMSWithKey2 Int (MS.MultiSet Int) (MS.MultiSet Int)+    deriving (Eq, Show)++instance Arbitrary AMSWithKey2 where+    arbitrary = do+        (x, AMS xs, AMS ys) <- arbitrary+        (n, d) <- (,) <$> pos <*> pos+        (nx, ny) <- elements [(0, 0), (n, 0), (0, n), (n, n + d), (n, n), (n + d, n)]+        pure $ AMSWithKey2 x (MS.setMultiplicity x nx xs) (MS.setMultiplicity x ny ys)+      where+        pos = succ . getLNat <$> arbitrary+    shrink (AMSWithKey2 x xs ys) =+        [ AMSWithKey2 x xs' ys'+        | (AMS xs', AMS ys') <- shrink (AMS xs, AMS ys)+        , keyClass xs' ys' == keyClass xs ys+        ]+      where+        keyClass as bs = (na == 0, nb == 0, compare na nb)+          where+            (na, nb) = (MS.multiplicity x as, MS.multiplicity x bs)++data AMSsWithKey = AMSsWithKey Int (NonEmpty (MS.MultiSet Int))+    deriving (Show)++instance Arbitrary AMSsWithKey where+    arbitrary = do+        x <- arbitrary+        xss <- (:|) <$> arbitrary <*> listOf1 arbitrary+        AMSsWithKey x <$> traverse (withKey x) xss+      where+        withKey x (AMS xs) = do+            n <- succ . getLNat <$> arbitrary+            pure $ MS.setMultiplicity x n xs++    shrink (AMSsWithKey x xss) =+        [ AMSsWithKey x (getAMS <$> yss)+        | y : y' : ys <- shrinkList shrink $ NE.toList (AMS <$> xss)+        , let yss = y :| (y' : ys)+        , all (MS.member x . getAMS) yss+        ]++newtype Natural' = Natural' {getNatural :: Natural}+    deriving (Eq, Ord, Show, Num, Real, Enum, Integral)++instance Arbitrary Natural' where+    arbitrary = Natural' <$> arbitrarySizedNatural+    shrink (Natural' n) = Natural' <$> shrinkIntegral n++instance CoArbitrary Natural' where+    coarbitrary = coarbitraryIntegral . getNatural++instance Function Natural' where+    function = functionIntegral
+ test/Test/Instances.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE TypeApplications #-}++module Test.Instances (+    tests,+) where++import Control.DeepSeq+import Control.Exception+import Data.Either+import Data.List (sort)+import qualified Data.MultiSet.Natural as MS+import qualified Data.Semigroup as SG+import Test.Gen+import Test.Tasty+import Test.Tasty.QuickCheck++tests :: TestTree+tests =+    testGroup+        "instances"+        [ testProperty "Eq/semantics" prop_eqSemantics+        , testProperty "Ord/semantics" prop_ordSemantics+        , testProperty "Ord/EQ agrees with Eq" prop_ordEq+        , testProperty "Ord/shorter equal run" $+            compare+                (MS.fromMultiplicityList [(0 :: Int, 1)])+                (MS.fromMultiplicityList [(0, 2)])+                === LT+        , testProperty "Ord/shorter run with tail" $+            compare+                (MS.fromMultiplicityList [(0 :: Int, 1), (1, 1)])+                (MS.fromMultiplicityList [(0, 2)])+                === GT+        , testProperty "Ord/longer equal run" $+            compare+                (MS.fromMultiplicityList [(0 :: Int, 2)])+                (MS.fromMultiplicityList [(0, 1)])+                === GT+        , testProperty "Ord/longer run against tail" $+            compare+                (MS.fromMultiplicityList [(0 :: Int, 2)])+                (MS.fromMultiplicityList [(0, 1), (1, 1)])+                === LT+        , testProperty "Show/Read" prop_showRead+        , testProperty "Show/Read/precedence" prop_showReadPrec+        , testProperty "Semigroup/associative" prop_semigroupAssociative+        , testProperty "Monoid/left identity" prop_monoidLeftIdentity+        , testProperty "Monoid/right identity" prop_monoidRightIdentity+        , testProperty "MaxUnion/Show/Read" prop_maxUnionShowRead+        , testProperty "MaxUnion/Semigroup/associative" prop_maxUnionAssociative+        , testProperty "MaxUnion/Monoid/left identity" prop_maxUnionLeftIdentity+        , testProperty "MaxUnion/Monoid/right identity" prop_maxUnionRightIdentity+        , testProperty "MaxUnion/idempotent" prop_maxUnionIdempotent+        , testProperty "NFData/forces elements" $+            ioProperty $ do+                let xs = MS.singleton (NFKey 0 undefined)+                result <- try @SomeException $ evaluate $ rnf xs+                pure $ isLeft result+        , testProperty "MaxUnion/Ord/semantics" prop_maxUnionOrdSemantics+        , testProperty "MaxUnion/Ord/EQ agrees with Eq" prop_maxUnionOrdEq+        , testProperty "MaxUnion/NFData/defined" prop_maxUnionNFDataDefined+        , testProperty "MaxUnion/NFData/forces elements" $+            ioProperty $ do+                let xs = MS.MaxUnion $ MS.singleton (NFKey 0 undefined)+                result <- try @SomeException $ evaluate $ rnf xs+                pure $ isLeft result+        ]++prop_eqSemantics :: [Int] -> [Int] -> Property+prop_eqSemantics xs ys = (MS.fromList xs == MS.fromList ys) === (sort xs == sort ys)++prop_ordSemantics :: [Int] -> [Int] -> Property+prop_ordSemantics xs ys = compare (MS.fromList xs) (MS.fromList ys) === compare (sort xs) (sort ys)++prop_ordEq :: AMS -> AMS -> Property+prop_ordEq (AMS xs) (AMS ys) = isEQ (compare xs ys) === (xs == ys)++prop_showRead :: AMS -> Property+prop_showRead (AMS xs) = read (show xs) === xs++prop_showReadPrec :: AMS -> Property+prop_showReadPrec (AMS xs) = readsPrec 11 (showsPrec 11 xs "") === [(xs, "")]++prop_semigroupAssociative :: AMS -> AMS -> AMS -> Property+prop_semigroupAssociative (AMS xs) (AMS ys) (AMS zs) =+    (xs SG.<> ys) SG.<> zs === xs SG.<> (ys SG.<> zs)++prop_monoidLeftIdentity :: AMS -> Property+prop_monoidLeftIdentity (AMS xs) = mempty SG.<> xs === xs++prop_monoidRightIdentity :: AMS -> Property+prop_monoidRightIdentity (AMS xs) = xs SG.<> mempty === xs++prop_maxUnionShowRead :: AMS -> Property+prop_maxUnionShowRead = ((===) <$> read . show <*> id) . MS.MaxUnion . getAMS++prop_maxUnionAssociative :: AMS -> AMS -> AMS -> Property+prop_maxUnionAssociative (AMS xs) (AMS ys) (AMS zs) =+    (mx SG.<> my) SG.<> mz === mx SG.<> (my SG.<> mz)+  where+    mx = MS.MaxUnion xs+    my = MS.MaxUnion ys+    mz = MS.MaxUnion zs++prop_maxUnionLeftIdentity :: AMS -> Property+prop_maxUnionLeftIdentity (AMS xs) = mempty SG.<> MS.MaxUnion xs === MS.MaxUnion xs++prop_maxUnionRightIdentity :: AMS -> Property+prop_maxUnionRightIdentity (AMS xs) = MS.MaxUnion xs SG.<> mempty === MS.MaxUnion xs++prop_maxUnionIdempotent :: AMS -> Property+prop_maxUnionIdempotent (AMS xs) = mx SG.<> mx === mx+  where+    mx = MS.MaxUnion xs++data NFKey = NFKey Int Int++instance Eq NFKey where+    NFKey x _ == NFKey y _ = x == y++instance Ord NFKey where+    compare (NFKey x _) (NFKey y _) = compare x y++instance NFData NFKey where+    rnf (NFKey x y) = rnf x `seq` rnf y++prop_maxUnionOrdSemantics :: [Int] -> [Int] -> Property+prop_maxUnionOrdSemantics xs ys =+    compare (MS.MaxUnion $ MS.fromList xs) (MS.MaxUnion $ MS.fromList ys)+        === compare (sort xs) (sort ys)++prop_maxUnionOrdEq :: AMS -> AMS -> Property+prop_maxUnionOrdEq (AMS xs) (AMS ys) =+    isEQ (compare mx my) === (mx == my)+  where+    mx = MS.MaxUnion xs+    my = MS.MaxUnion ys++prop_maxUnionNFDataDefined :: AMS -> Property+prop_maxUnionNFDataDefined (AMS xs) = rnf (MS.MaxUnion xs) `seq` property True++isEQ :: Ordering -> Bool+isEQ = (== EQ)
+ test/Test/Queries.hs view
@@ -0,0 +1,128 @@+module Test.Queries (+    tests,+) where++import Data.List+import Data.Maybe+import qualified Data.MultiSet.Natural as MS+import Test.Gen+import Test.Tasty+import Test.Tasty.QuickCheck++tests :: TestTree+tests =+    testGroup+        "queries"+        [ testProperty "null" prop_null+        , testProperty "member" prop_member+        , testProperty "notMember" prop_notMember+        , testProperty "multiplicity" prop_multiplicity+        , testProperty "size" prop_size+        , testProperty "distinctSize" prop_distinctSize+        , testProperty "lookupLT" prop_lookupLT+        , testProperty "lookupLE" prop_lookupLE+        , testProperty "lookupGT" prop_lookupGT+        , testProperty "lookupGE" prop_lookupGE+        , testProperty "lookupMin" prop_lookupMin+        , testProperty "lookupMax" prop_lookupMax+        , testProperty "isSubsetOf/reflexive" prop_isSubsetOfReflexive+        , testProperty "isSubsetOf/constructed" prop_isSubsetOfConstructed+        , testProperty "isSubsetOf/difference" prop_isSubsetOfDifference+        , testProperty "isProperSubsetOf/implies subset" prop_isProperSubsetOfSubset+        , testProperty "isProperSubsetOf/irreflexive" prop_isProperSubsetOfIrreflexive+        , testProperty "isProperSubsetOf/definition" prop_isProperSubsetOfDefinition+        , testProperty "disjoint/symmetric" prop_disjointSymmetric+        , testProperty "disjoint/empty" prop_disjointEmpty+        , testProperty "disjoint/intersection" prop_disjointIntersection+        ]++prop_null :: AMS -> Property+prop_null (AMS xs) = MS.null xs === (MS.distinctSize xs == 0)++prop_member :: AMSWithKey -> Property+prop_member (AMSWithKey x xs) = MS.member x xs === (MS.multiplicity x xs > 0)++prop_notMember :: AMSWithKey -> Property+prop_notMember (AMSWithKey x xs) = MS.notMember x xs === not (MS.member x xs)++prop_multiplicity :: AMSWithKey -> Property+prop_multiplicity (AMSWithKey x xs) =+    MS.multiplicity x xs === maybe 0 snd (find ((== x) . fst) $ MS.toMultiplicityList xs)++prop_size :: AMS -> Property+prop_size (AMS xs) = MS.size xs === sum (map snd $ MS.toMultiplicityList xs)++prop_distinctSize :: AMS -> Property+prop_distinctSize (AMS xs) = MS.distinctSize xs === genericLength (MS.toDistinctList xs)++prop_lookupLT :: AMSWithKey -> Property+prop_lookupLT (AMSWithKey x xs) =+    MS.lookupLT x xs === lastMaybe (takeWhile ((< x) . fst) $ MS.toMultiplicityList xs)++prop_lookupLE :: AMSWithKey -> Property+prop_lookupLE (AMSWithKey x xs) =+    MS.lookupLE x xs === lastMaybe (takeWhile ((<= x) . fst) $ MS.toMultiplicityList xs)++prop_lookupGT :: AMSWithKey -> Property+prop_lookupGT (AMSWithKey x xs) = MS.lookupGT x xs === find ((> x) . fst) (MS.toMultiplicityList xs)++prop_lookupGE :: AMSWithKey -> Property+prop_lookupGE (AMSWithKey x xs) =+    MS.lookupGE x xs === find ((>= x) . fst) (MS.toMultiplicityList xs)++prop_lookupMin :: AMS -> Property+prop_lookupMin (AMS xs) = MS.lookupMin xs === listToMaybe (MS.toMultiplicityList xs)++prop_lookupMax :: AMS -> Property+prop_lookupMax (AMS xs) = MS.lookupMax xs === lastMaybe (MS.toMultiplicityList xs)++lastMaybe :: [a] -> Maybe a+lastMaybe = listToMaybe . reverse++prop_isSubsetOfReflexive :: AMS -> Property+prop_isSubsetOfReflexive (AMS xs) = property $ MS.isSubsetOf xs xs++prop_isSubsetOfConstructed :: AMS -> AMS -> AMS -> Property+prop_isSubsetOfConstructed (AMS xs) (AMS ys') (AMS zs') = property $ MS.isSubsetOf xs zs+  where+    ys = MS.union xs ys'+    zs = MS.union ys zs'++prop_isProperSubsetOfSubset :: Int -> AMS -> Property+prop_isProperSubsetOfSubset x (AMS xs) =+    conjoin+        [ property $ MS.isProperSubsetOf xs ys+        , property $ MS.isSubsetOf xs ys+        ]+  where+    ys = MS.insert x xs++prop_isProperSubsetOfIrreflexive :: AMS -> Property+prop_isProperSubsetOfIrreflexive (AMS xs) = property . not $ MS.isProperSubsetOf xs xs++prop_disjointSymmetric :: AMS -> AMS -> Property+prop_disjointSymmetric (AMS xs) (AMS ys) = MS.disjoint xs ys === MS.disjoint ys xs++prop_disjointEmpty :: AMS -> Property+prop_disjointEmpty (AMS xs) = property $ MS.disjoint xs MS.empty++prop_disjointIntersection :: AMS -> AMS -> Property+prop_disjointIntersection (AMS xs) (AMS ys) = MS.disjoint xs ys === MS.null (MS.intersection xs ys)++prop_isSubsetOfDifference :: Property+prop_isSubsetOfDifference =+    forAll genSubsetPair $ \(xs, ys) -> MS.isSubsetOf xs ys === MS.null (MS.difference xs ys)++prop_isProperSubsetOfDefinition :: Property+prop_isProperSubsetOfDefinition =+    forAll genSubsetPair $ \(xs, ys) ->+        MS.isProperSubsetOf xs ys === (MS.isSubsetOf xs ys && xs /= ys)++genSubsetPair :: Gen (MS.MultiSet Int, MS.MultiSet Int)+genSubsetPair =+    arbitrary >>= \(x, AMS xs, AMS ys) ->+        oneof+            [ pure (xs, xs)+            , pure (xs, MS.insert x xs)+            , pure (MS.setMultiplicity x (MS.multiplicity x ys + 1) xs, ys)+            ]
+ test/Test/ToFrom.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE TupleSections #-}++module Test.ToFrom (+    tests,+) where++import Data.List+import qualified Data.List.NonEmpty as NE+import qualified Data.Map.Strict as M+import qualified Data.MultiSet.Natural as MS+import qualified Data.Set as S+import Test.Gen+import Test.Tasty+import Test.Tasty.QuickCheck++tests :: TestTree+tests =+    testGroup+        "constructors"+        [ testProperty "empty" prop_empty+        , testProperty "singleton" prop_singleton+        , testProperty "singletonMany" prop_singletonMany+        , testProperty "fromMultiplicityList" prop_fromMultiplicityList+        , testProperty "fromMultiplicityList/zero" prop_fromMultiplicityListZero+        , testProperty "fromMultiplicityList/duplicates" prop_fromMultiplicityListDuplicates+        , testProperty "fromList" prop_fromList+        , testProperty "fromSet" prop_fromSet+        , testProperty "fromMap" prop_fromMap+        , testProperty "fromMultiplicityList . toMultiplicityList" prop_multiplicityListRoundtrip+        , testProperty "fromList . toList" prop_listRoundtrip+        , testProperty "fromMap . toMap" prop_mapRoundtrip+        , testProperty "toSet . fromSet" prop_setRoundtrip+        , testProperty "toDistinctList . fromList" prop_distinctList+        , testProperty "toMultiplicityList/ascending" prop_toMultiplicityListAscending+        , testProperty "toList/ascending" prop_toListAscending+        , testProperty "toDistinctList/ascending" prop_toDistinctListAscending+        , testProperty "toMultiplicityList/toDistinctList" prop_toMultiplicityListDistinct+        , testProperty "toMultiplicityList/toMap" prop_toMultiplicityListMap+        , testProperty "toDistinctList/toSet" prop_toDistinctListSet+        , testProperty "toMultiplicityList/distinctSize" prop_toMultiplicityListDistinctSize+        , testProperty "toDistinctList/distinctSize" prop_toDistinctListDistinctSize+        , testProperty "toList/toMultiplicityList" prop_toListMultiplicityList+        ]++prop_empty :: Property+prop_empty = MS.toMap (MS.empty :: MS.MultiSet Int) === M.empty++prop_singleton :: Int -> Property+prop_singleton x = MS.toMap (MS.singleton x) === M.singleton x 1++prop_singletonMany :: Int -> LNat -> Property+prop_singletonMany x (LNat n) =+    MS.toMap (MS.singletonMany x n) === if n == 0 then M.empty else M.singleton x n++prop_fromMultiplicityList :: [(Int, LNat)] -> Property+prop_fromMultiplicityList =+    ((===) <$> MS.toMap . MS.fromMultiplicityList <*> M.filter (> 0) . M.fromListWith (+))+        . fmap (fmap getLNat)++prop_fromMultiplicityListZero :: Int -> Property+prop_fromMultiplicityListZero x = MS.fromMultiplicityList [(x, 0)] === MS.empty++prop_fromMultiplicityListDuplicates :: Int -> LNat -> LNat -> Property+prop_fromMultiplicityListDuplicates x (LNat n) (LNat m) =+    MS.toMap (MS.fromMultiplicityList [(x, n), (x, m)])+        === if n + m == 0 then M.empty else M.singleton x (n + m)++prop_fromList :: [Int] -> Property+prop_fromList = (===) <$> MS.toMap . MS.fromList <*> M.fromListWith (+) . fmap (,1)++prop_fromSet :: S.Set Int -> Property+prop_fromSet xs = MS.toMap (MS.fromSet xs) === M.fromSet (const 1) xs++prop_fromMap :: M.Map Int LNat -> Property+prop_fromMap xs = MS.toMap (MS.fromMap ys) === M.filter (> 0) ys+  where+    ys = getLNat <$> xs++prop_multiplicityListRoundtrip :: AMS -> Property+prop_multiplicityListRoundtrip (AMS xs) = MS.fromMultiplicityList (MS.toMultiplicityList xs) === xs++prop_mapRoundtrip :: AMS -> Property+prop_mapRoundtrip (AMS xs) = MS.fromMap (MS.toMap xs) === xs++-- not based on AMS to avoid the explosion of toList with AMS+prop_listRoundtrip :: [Int] -> Property+prop_listRoundtrip = (===) <$> MS.toList . MS.fromList <*> sort++prop_setRoundtrip :: S.Set Int -> Property+prop_setRoundtrip xs = MS.toSet (MS.fromSet xs) === xs++prop_distinctList :: [Int] -> Property+prop_distinctList = (===) <$> MS.toDistinctList . MS.fromList <*> S.toAscList . S.fromList++prop_toMultiplicityListAscending :: AMS -> Property+prop_toMultiplicityListAscending (AMS xs) =+    property $ strictlyAscending $ map fst $ MS.toMultiplicityList xs++prop_toListAscending :: [Int] -> Property+prop_toListAscending = ((===) <$> MS.toList <*> sort . MS.toList) . MS.fromList++prop_toDistinctListAscending :: AMS -> Property+prop_toDistinctListAscending (AMS xs) = property $ strictlyAscending $ MS.toDistinctList xs++prop_toMultiplicityListDistinct :: AMS -> Property+prop_toMultiplicityListDistinct (AMS xs) =+    map fst (MS.toMultiplicityList xs) === MS.toDistinctList xs++prop_toMultiplicityListMap :: AMS -> Property+prop_toMultiplicityListMap (AMS xs) = MS.toMultiplicityList xs === M.toAscList (MS.toMap xs)++prop_toDistinctListSet :: AMS -> Property+prop_toDistinctListSet (AMS xs) = MS.toDistinctList xs === S.toAscList (MS.toSet xs)++prop_toMultiplicityListDistinctSize :: AMS -> Property+prop_toMultiplicityListDistinctSize (AMS xs) =+    length (MS.toMultiplicityList xs) === MS.distinctSize xs++prop_toDistinctListDistinctSize :: AMS -> Property+prop_toDistinctListDistinctSize (AMS xs) = length (MS.toDistinctList xs) === MS.distinctSize xs++prop_toListMultiplicityList :: [Int] -> Property+prop_toListMultiplicityList = ((===) <$> MS.toMultiplicityList <*> counts . MS.toList) . MS.fromList+  where+    counts = map ((,) <$> NE.head <*> fromIntegral . length) . NE.group++strictlyAscending :: (Ord a) => [a] -> Bool+strictlyAscending xs = and $ zipWith (<) xs (drop 1 xs)
+ test/Test/Transformations.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}++module Test.Transformations (+    tests,+) where++import Control.Monad ((>=>))+import Data.Coerce+import qualified Data.MultiSet.Natural as MS+import Numeric.Natural+import Test.Gen+import Test.Tasty+import Test.Tasty.QuickCheck++tests :: TestTree+tests =+    testGroup+        "transformations"+        [ testProperty "filter/true" prop_filterTrue+        , testProperty "filter/false" prop_filterFalse+        , testProperty "filter/composition" prop_filterComposition+        , testProperty "filterWithMultiplicity/bridge" prop_filterWithMultiplicityBridge+        , testProperty "filterWithMultiplicity/composition" prop_filterWithMultiplicityComposition+        , testProperty "partition/reconstruct" prop_partitionReconstruct+        , testProperty "partition/filter" prop_partitionFilter+        , testProperty "partitionWithMultiplicity/reconstruct" prop_partitionWithMultiplicityReconstruct+        , testProperty "partitionWithMultiplicity/filter" prop_partitionWithMultiplicityFilter+        , testProperty "partitionWithMultiplicity/bridge" prop_partitionWithMultiplicityBridge+        , testProperty "map/identity" prop_mapIdentity+        , testProperty "map/composition" prop_mapComposition+        , testProperty "map/union" prop_mapUnion+        , testProperty "mapWithMultiplicity/identity" prop_mapWithMultiplicityIdentity+        , testProperty "mapWithMultiplicity/decompose" prop_mapWithMultiplicityDecompose+        , testProperty "mapMultiplicities/identity" prop_mapMultiplicitiesIdentity+        , testProperty "mapMultiplicities/zero" prop_mapMultiplicitiesZero+        , testProperty "mapMultiplicities/composition" prop_mapMultiplicitiesComposition+        , testProperty "mapMaybe/identity" prop_mapMaybeIdentity+        , testProperty "mapMaybe/nothing" prop_mapMaybeNothing+        , testProperty "mapMaybe/composition" prop_mapMaybeComposition+        , testProperty "mapMaybe/map" prop_mapMaybeMap+        , testProperty "mapMaybeWithMultiplicity/identity" prop_mapMaybeWithMultiplicityIdentity+        , testProperty "mapMaybeWithMultiplicity/nothing" prop_mapMaybeWithMultiplicityNothing+        , testProperty "mapMaybeWithMultiplicity/mapMaybe" prop_mapMaybeWithMultiplicityMapMaybe+        , testProperty+            "mapMaybeWithMultiplicity/mapWithMultiplicity"+            prop_mapMaybeWithMultiplicityMapWithMultiplicity+        , testProperty "concatMap/left identity" prop_concatMapLeftIdentity+        , testProperty "concatMap/right identity" prop_concatMapRightIdentity+        , testProperty "concatMap/associativity" prop_concatMapAssociativity+        , testProperty "concatMap/map" prop_concatMapMap+        , testProperty "concatMap/scaling" prop_concatMapScaling+        ]++prop_filterTrue :: AMS -> Property+prop_filterTrue (AMS xs) = MS.filter (const True) xs === xs++prop_filterFalse :: AMS -> Property+prop_filterFalse (AMS xs) = MS.filter (const False) xs === MS.empty++prop_filterComposition :: Fun Int Bool -> Fun Int Bool -> AMS -> Property+prop_filterComposition pFun qFun (AMS xs) =+    MS.filter p (MS.filter q xs) === MS.filter (\x -> p x && q x) xs+  where+    p = applyFun pFun+    q = applyFun qFun++prop_filterWithMultiplicityBridge :: Fun Int Bool -> AMS -> Property+prop_filterWithMultiplicityBridge fun (AMS xs) =+    MS.filterWithMultiplicity (\x _ -> f x) xs === MS.filter f xs+  where+    f = applyFun fun++prop_filterWithMultiplicityComposition ::+    Fun (Int, Natural') Bool -> Fun (Int, Natural') Bool -> AMS -> Property+prop_filterWithMultiplicityComposition pFun qFun (AMS xs) =+    MS.filterWithMultiplicity p (MS.filterWithMultiplicity q xs)+        === MS.filterWithMultiplicity (\x n -> p x n && q x n) xs+  where+    p = curry . coerce $ applyFun pFun+    q = curry . coerce $ applyFun qFun++prop_partitionReconstruct :: Fun Int Bool -> AMS -> Property+prop_partitionReconstruct fun (AMS xs) =+    conjoin+        [ MS.union yes no === xs+        , property $ MS.disjoint yes no+        ]+  where+    (yes, no) = MS.partition (applyFun fun) xs++prop_partitionFilter :: Fun Int Bool -> AMS -> Property+prop_partitionFilter fun (AMS xs) =+    MS.partition p xs === (MS.filter p xs, MS.filter (not . p) xs)+  where+    p = applyFun fun++prop_partitionWithMultiplicityReconstruct :: Fun (Int, Natural') Bool -> AMS -> Property+prop_partitionWithMultiplicityReconstruct fun (AMS xs) =+    conjoin+        [ MS.union yes no === xs+        , property $ MS.disjoint yes no+        ]+  where+    (yes, no) = MS.partitionWithMultiplicity (curry . coerce $ applyFun fun) xs++prop_partitionWithMultiplicityFilter :: Fun (Int, Natural') Bool -> AMS -> Property+prop_partitionWithMultiplicityFilter fun (AMS xs) =+    MS.partitionWithMultiplicity p xs+        === (MS.filterWithMultiplicity p xs, MS.filterWithMultiplicity (\x n -> not $ p x n) xs)+  where+    p = curry . coerce $ applyFun fun++prop_partitionWithMultiplicityBridge :: Fun Int Bool -> AMS -> Property+prop_partitionWithMultiplicityBridge fun (AMS xs) =+    MS.partitionWithMultiplicity (\x _ -> p x) xs === MS.partition p xs+  where+    p = applyFun fun++prop_mapIdentity :: AMS -> Property+prop_mapIdentity (AMS xs) = MS.map id xs === xs++prop_mapComposition :: Fun Int Int -> Fun Int Int -> AMS -> Property+prop_mapComposition fFun gFun (AMS xs) =+    MS.map f (MS.map g xs) === MS.map (f . g) xs+  where+    f = applyFun fFun+    g = applyFun gFun++prop_mapUnion :: Fun Int Int -> AMS -> AMS -> Property+prop_mapUnion (Fun _ f) (AMS xs) (AMS ys) =+    MS.map f (MS.union xs ys) === MS.union (MS.map f xs) (MS.map f ys)++prop_mapWithMultiplicityIdentity :: AMS -> Property+prop_mapWithMultiplicityIdentity (AMS xs) = MS.mapWithMultiplicity (,) xs === xs++prop_mapWithMultiplicityDecompose :: Fun Int Int -> Fun Natural' Natural' -> AMS -> Property+prop_mapWithMultiplicityDecompose fFun gFun (AMS xs) =+    MS.mapWithMultiplicity (\x n -> (f x, g n)) xs === MS.map f (MS.mapMultiplicities g xs)+  where+    f = applyFun fFun+    g = coerce $ applyFun gFun++prop_mapMultiplicitiesIdentity :: AMS -> Property+prop_mapMultiplicitiesIdentity (AMS xs) = MS.mapMultiplicities id xs === xs++prop_mapMultiplicitiesZero :: AMS -> Property+prop_mapMultiplicitiesZero (AMS xs) = MS.mapMultiplicities (const 0) xs === MS.empty++prop_mapMultiplicitiesComposition ::+    Fun Natural' Natural' -> Fun Natural' Natural' -> AMS -> Property+prop_mapMultiplicitiesComposition fFun gFun (AMS xs) =+    MS.mapMultiplicities f (MS.mapMultiplicities g xs) === MS.mapMultiplicities (f . g) xs+  where+    f = zeroPreserving fFun+    g = zeroPreserving gFun++    zeroPreserving _ 0 = 0+    zeroPreserving fun n = coerce (applyFun fun) n++prop_mapMaybeIdentity :: AMS -> Property+prop_mapMaybeIdentity (AMS xs) = MS.mapMaybe Just xs === xs++prop_mapMaybeNothing :: AMS -> Property+prop_mapMaybeNothing (AMS xs) = MS.mapMaybe @Int (const Nothing) xs === MS.empty++prop_mapMaybeComposition :: Fun Int (Maybe Int) -> Fun Int (Maybe Int) -> AMS -> Property+prop_mapMaybeComposition fFun gFun (AMS xs) =+    MS.mapMaybe f (MS.mapMaybe g xs) === MS.mapMaybe (g >=> f) xs+  where+    f = applyFun fFun+    g = applyFun gFun++prop_mapMaybeMap :: Fun Int Int -> AMS -> Property+prop_mapMaybeMap fun (AMS xs) = MS.mapMaybe (Just . f) xs === MS.map f xs+  where+    f = applyFun fun++prop_mapMaybeWithMultiplicityIdentity :: AMS -> Property+prop_mapMaybeWithMultiplicityIdentity (AMS xs) =+    MS.mapMaybeWithMultiplicity (curry Just) xs === xs++prop_mapMaybeWithMultiplicityNothing :: AMS -> Property+prop_mapMaybeWithMultiplicityNothing (AMS xs) =+    MS.mapMaybeWithMultiplicity @Int (\_ _ -> Nothing) xs === MS.empty++prop_mapMaybeWithMultiplicityMapMaybe :: Fun Int (Maybe Int) -> AMS -> Property+prop_mapMaybeWithMultiplicityMapMaybe fun (AMS xs) =+    MS.mapMaybeWithMultiplicity (\x n -> (,n) <$> f x) xs === MS.mapMaybe f xs+  where+    f = applyFun fun++prop_mapMaybeWithMultiplicityMapWithMultiplicity ::+    Fun (Int, Natural') (Int, Natural') -> AMS -> Property+prop_mapMaybeWithMultiplicityMapWithMultiplicity fun (AMS xs) =+    MS.mapMaybeWithMultiplicity (\x n -> Just $ f x n) xs === MS.mapWithMultiplicity f xs+  where+    f :: Int -> Natural -> (Int, Natural)+    f = curry . coerce $ applyFun fun++prop_concatMapLeftIdentity :: Int -> Fun Int AMS -> Property+prop_concatMapLeftIdentity x fun = MS.concatMap f (MS.singleton x) === f x+  where+    f = getAMS . applyFun fun++prop_concatMapRightIdentity :: AMS -> Property+prop_concatMapRightIdentity (AMS xs) = MS.concatMap MS.singleton xs === xs++prop_concatMapAssociativity :: Fun Int AMS -> Fun Int AMS -> AMS -> Property+prop_concatMapAssociativity fFun gFun (AMS xs) =+    MS.concatMap f (MS.concatMap g xs) === MS.concatMap (MS.concatMap f . g) xs+  where+    f = getAMS . applyFun fFun+    g = getAMS . applyFun gFun++prop_concatMapMap :: Fun Int Int -> AMS -> Property+prop_concatMapMap fun (AMS xs) = MS.concatMap (MS.singleton . f) xs === MS.map f xs+  where+    f = applyFun fun++prop_concatMapScaling :: Fun Int AMS -> Int -> LNat -> Property+prop_concatMapScaling (Fun _ f) x (LNat n) =+    MS.concatMap (getAMS . f) (MS.singletonMany x n) === MS.mapMultiplicities (* n) (getAMS $ f x)
+ test/Test/Updates.hs view
@@ -0,0 +1,142 @@+module Test.Updates (+    tests,+) where++import Data.Coerce+import Data.Functor.Identity+import qualified Data.MultiSet.Natural as MS+import Numeric.Natural+import Test.Gen+import Test.Tasty+import Test.Tasty.QuickCheck++tests :: TestTree+tests =+    testGroup+        "updates"+        [ testProperty "insert/insertMany" prop_insertInsertMany+        , testProperty "insert/multiplicity" prop_insertMultiplicity+        , testProperty "insert/preserves others" prop_insertPreservesOthers+        , testProperty "insertMany/zero" prop_insertManyZero+        , testProperty "insertMany/multiplicity" prop_insertManyMultiplicity+        , testProperty "insertMany/preserves others" prop_insertManyPreservesOthers+        , testProperty "delete/deleteMany" prop_deleteDeleteMany+        , testProperty "delete/multiplicity" prop_deleteMultiplicity+        , testProperty "delete/preserves others" prop_deletePreservesOthers+        , testProperty "deleteMany/zero" prop_deleteManyZero+        , testProperty "deleteMany/multiplicity" prop_deleteManyMultiplicity+        , testProperty "deleteMany/preserves others" prop_deleteManyPreservesOthers+        , testProperty "deleteMany/undo insertMany" prop_deleteManyUndoInsertMany+        , testProperty "deleteAll/multiplicity" prop_deleteAllMultiplicity+        , testProperty "deleteAll/idempotent" prop_deleteAllIdempotent+        , testProperty "deleteAll/preserves others" prop_deleteAllPreservesOthers+        , testProperty "setMultiplicity/multiplicity" prop_setMultiplicityMultiplicity+        , testProperty "setMultiplicity/zero" prop_setMultiplicityZero+        , testProperty "setMultiplicity/preserves others" prop_setMultiplicityPreservesOthers+        , testProperty "setMultiplicity/alterMultiplicity" prop_setMultiplicityAlterMultiplicity+        , testProperty "alterMultiplicity/identity" prop_alterMultiplicityIdentity+        , testProperty "alterMultiplicity/multiplicity" prop_alterMultiplicityMultiplicity+        , testProperty "alterMultiplicity/preserves others" prop_alterMultiplicityPreservesOthers+        , testProperty "alterMultiplicityF/Identity" prop_alterMultiplicityFIdentity+        ]++prop_insertInsertMany :: AMSWithKey -> Property+prop_insertInsertMany (AMSWithKey x xs) = MS.insert x xs === MS.insertMany x 1 xs++prop_insertMultiplicity :: AMSWithKey -> Property+prop_insertMultiplicity (AMSWithKey x xs) =+    MS.multiplicity x (MS.insert x xs) === MS.multiplicity x xs + 1++prop_insertPreservesOthers :: AMSWithKey -> Property+prop_insertPreservesOthers (AMSWithKey x xs) = MS.deleteAll x (MS.insert x xs) === MS.deleteAll x xs++prop_insertManyZero :: AMSWithKey -> Property+prop_insertManyZero (AMSWithKey x xs) = MS.insertMany x 0 xs === xs++prop_insertManyMultiplicity :: LNat -> AMSWithKey -> Property+prop_insertManyMultiplicity (LNat n) (AMSWithKey x xs) =+    MS.multiplicity x (MS.insertMany x n xs) === MS.multiplicity x xs + n++prop_insertManyPreservesOthers :: LNat -> AMSWithKey -> Property+prop_insertManyPreservesOthers (LNat n) (AMSWithKey x xs) =+    MS.deleteAll x (MS.insertMany x n xs) === MS.deleteAll x xs++prop_deleteDeleteMany :: AMSWithKey -> Property+prop_deleteDeleteMany (AMSWithKey x xs) = MS.delete x xs === MS.deleteMany x 1 xs++prop_deleteMultiplicity :: AMSWithKey -> Property+prop_deleteMultiplicity (AMSWithKey x xs) =+    MS.multiplicity x (MS.delete x xs) === MS.multiplicity x xs `monus` 1++prop_deletePreservesOthers :: AMSWithKey -> Property+prop_deletePreservesOthers (AMSWithKey x xs) = MS.deleteAll x (MS.delete x xs) === MS.deleteAll x xs++prop_deleteManyZero :: AMSWithKey -> Property+prop_deleteManyZero (AMSWithKey x xs) = MS.deleteMany x 0 xs === xs++prop_deleteManyMultiplicity :: LNat -> AMSWithKey -> Property+prop_deleteManyMultiplicity (LNat n) (AMSWithKey x xs) =+    MS.multiplicity x (MS.deleteMany x n xs) === MS.multiplicity x xs `monus` n++prop_deleteManyPreservesOthers :: LNat -> AMSWithKey -> Property+prop_deleteManyPreservesOthers (LNat n) (AMSWithKey x xs) =+    MS.deleteAll x (MS.deleteMany x n xs) === MS.deleteAll x xs++prop_deleteManyUndoInsertMany :: LNat -> AMSWithKey -> Property+prop_deleteManyUndoInsertMany (LNat n) (AMSWithKey x xs) =+    MS.deleteMany x n (MS.insertMany x n xs) === xs++prop_deleteAllMultiplicity :: AMSWithKey -> Property+prop_deleteAllMultiplicity (AMSWithKey x xs) = MS.multiplicity x (MS.deleteAll x xs) === 0++prop_deleteAllIdempotent :: AMSWithKey -> Property+prop_deleteAllIdempotent (AMSWithKey x xs) =+    MS.deleteAll x (MS.deleteAll x xs) === MS.deleteAll x xs++prop_deleteAllPreservesOthers :: LNat -> AMSWithKey -> Property+prop_deleteAllPreservesOthers (LNat n) (AMSWithKey x xs) =+    MS.deleteAll x (MS.insertMany x n xs) === MS.deleteAll x xs++prop_setMultiplicityMultiplicity :: LNat -> AMSWithKey -> Property+prop_setMultiplicityMultiplicity (LNat n) (AMSWithKey x xs) =+    MS.multiplicity x (MS.setMultiplicity x n xs) === n++prop_setMultiplicityZero :: AMSWithKey -> Property+prop_setMultiplicityZero (AMSWithKey x xs) = MS.setMultiplicity x 0 xs === MS.deleteAll x xs++prop_setMultiplicityPreservesOthers :: LNat -> AMSWithKey -> Property+prop_setMultiplicityPreservesOthers (LNat n) (AMSWithKey x xs) =+    MS.deleteAll x (MS.setMultiplicity x n xs) === MS.deleteAll x xs++prop_setMultiplicityAlterMultiplicity :: LNat -> AMSWithKey -> Property+prop_setMultiplicityAlterMultiplicity (LNat n) (AMSWithKey x xs) =+    MS.setMultiplicity x n xs === MS.alterMultiplicity (const n) x xs++prop_alterMultiplicityIdentity :: AMSWithKey -> Property+prop_alterMultiplicityIdentity (AMSWithKey x xs) = MS.alterMultiplicity id x xs === xs++prop_alterMultiplicityMultiplicity :: Fun Natural' Natural' -> AMSWithKey -> Property+prop_alterMultiplicityMultiplicity fun (AMSWithKey x xs) =+    MS.multiplicity x (MS.alterMultiplicity f x xs) === f (MS.multiplicity x xs)+  where+    f :: Natural -> Natural+    f = coerce $ applyFun fun++prop_alterMultiplicityPreservesOthers :: Fun Natural' Natural' -> AMSWithKey -> Property+prop_alterMultiplicityPreservesOthers fun (AMSWithKey x xs) =+    MS.deleteAll x (MS.alterMultiplicity f x xs) === MS.deleteAll x xs+  where+    f :: Natural -> Natural+    f = coerce $ applyFun fun++prop_alterMultiplicityFIdentity :: Fun Natural' Natural' -> AMSWithKey -> Property+prop_alterMultiplicityFIdentity fun (AMSWithKey x xs) =+    runIdentity (MS.alterMultiplicityF (Identity . f) x xs) === MS.alterMultiplicity f x xs+  where+    f :: Natural -> Natural+    f = coerce $ applyFun fun++monus :: Natural -> Natural -> Natural+monus x y+    | x >= y = x - y+    | otherwise = 0
+ test/Test/Valid.hs view
@@ -0,0 +1,200 @@+{-# LANGUAGE TypeApplications #-}++module Test.Valid (+    tests,+) where++import Data.Bifunctor+import Data.Coerce+import Data.Functor.Identity+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.Map as M+import qualified Data.MultiSet.Natural as MS+import qualified Data.Set as S+import Test.Gen+import Test.Tasty+import Test.Tasty.QuickCheck++valid :: (Ord a) => MS.MultiSet a -> Bool+valid = (&&) <$> M.valid . MS.toMap <*> all (> 0) . MS.toMap++tests :: TestTree+tests =+    testGroup+        "validity"+        [ constructs @() @Int "empty" $+            const MS.empty+        , constructs @Int+            "singleton"+            MS.singleton+        , constructs @(Int, LNat) "singletonMany" $+            \(x, LNat n) -> MS.singletonMany x n+        , constructs @[(Int, LNat)] "fromMultiplicityList" $+            MS.fromMultiplicityList . map (second getLNat)+        , constructs @[Int]+            "fromList"+            MS.fromList+        , constructs @(S.Set Int)+            "fromSet"+            MS.fromSet+        , constructs @(M.Map Int LNat) "fromMap" $+            MS.fromMap . fmap getLNat+        , preserves "deleteMin" MS.deleteMin+        , preserves "deleteMax" MS.deleteMax+        , preserves "deleteMinAll" MS.deleteMinAll+        , preserves "deleteMaxAll" MS.deleteMaxAll+        , preserves1 "insert" MS.insert+        , preserves1 "delete" MS.delete+        , preserves1 "deleteAll" MS.deleteAll+        , preserves1 "union" $+            \(AMS xs) -> (`MS.union` xs)+        , preserves1 "unions" $+            \xss ms -> MS.unions $ ms : (getAMS <$> xss)+        , preserves1 "difference" $+            \(AMS xs) -> (`MS.difference` xs)+        , preserves1 "symmetricDifference" $+            \(AMS xs) -> (`MS.symmetricDifference` xs)+        , preserves1 "intersection" $+            \(AMS xs) -> (`MS.intersection` xs)+        , preserves1 "intersections" $+            \xss ms -> MS.intersections $ ms :| (getAMS <$> xss)+        , preserves1 "maxUnion" $+            \(AMS xs) -> (`MS.maxUnion` xs)+        , preserves1 @AMS "cartesianProduct" $+            \(AMS xs) -> (`MS.cartesianProduct` xs)+        , preserves2 "insertMany" $+            \x (LNat n) -> MS.insertMany x n+        , preserves2 "deleteMany" $+            \x (LNat n) -> MS.deleteMany x n+        , preserves2 "setMultiplicity" $+            \x (LNat n) -> MS.setMultiplicity x n+        , preservesFun "filter" MS.filter+        , preservesFun @(Int, Natural') @Bool "filterWithMultiplicity" $+            coerce (MS.filterWithMultiplicity . curry)+        , preservesFun "filterA" $+            \f -> runIdentity . MS.filterA (Identity . f)+        , preservesFun @(Int, Natural') @Bool "filterWithMultiplicityA" $+            coerce $+                \f -> runIdentity . MS.filterWithMultiplicityA ((Identity .) . curry f)+        , preservesFun @Int @Int "map" MS.map+        , preservesFun @(Int, Natural') @(Char, Natural') @Char "mapWithMultiplicity" $+            coerce (MS.mapWithMultiplicity . curry)+        , preservesFun @Natural' @Natural' "mapMultiplicities" $+            coerce MS.mapMultiplicities+        , preservesFun @Int @(Maybe Int) "mapMaybe" MS.mapMaybe+        , preservesFun @(Int, Natural') @(Maybe (Integer, Natural')) @Integer "mapMaybeWithMultiplicity" $+            coerce (MS.mapMaybeWithMultiplicity . curry)+        , preservesFun @Int @AMS "concatMap" $+            \f -> MS.concatMap (getAMS . f)+        , preservesFun @Int @String "traverse" $+            \f -> runIdentity . MS.traverse (Identity . f)+        , preservesFun @Int @(Maybe Float) "traverseMaybe" $+            \f -> runIdentity . MS.traverseMaybe (Identity . f)+        , preservesFun @(Int, Natural') @(Bool, Natural') @Bool "traverseWithMultiplicity" $+            coerce $+                \f -> runIdentity . MS.traverseWithMultiplicity (\x n -> Identity $ f (x, n))+        , preservesFun @(Int, Natural') @(Maybe (Word, Natural')) @Word "traverseMaybeWithMultiplicity" $+            coerce $+                \f -> runIdentity . MS.traverseMaybeWithMultiplicity (\x n -> Identity $ f (x, n))+        , preservesAllFun "partition" $+            \f -> pair . MS.partition f+        , preservesAllFun @(Int, Natural') @Bool @[] "partitionWithMultiplicity" $+            coerce $+                \f -> pair . MS.partitionWithMultiplicity (curry f)+        , preservesAllFun "partitionA" $+            \f -> pair . runIdentity . MS.partitionA (Identity . f)+        , preservesAllFun @(Int, Natural') @Bool @[] "partitionWithMultiplicityA" $+            coerce $ \f ->+                pair+                    . runIdentity+                    . MS.partitionWithMultiplicityA ((Identity .) . curry f)+        , preservesAll "minView" $+            fmap snd . MS.minView+        , preservesAll "maxView" $+            fmap snd . MS.maxView+        , preservesAll "minViewWithMultiplicity" $+            fmap snd . MS.minViewWithMultiplicity+        , preservesAll "maxViewWithMultiplicity" $+            fmap snd . MS.maxViewWithMultiplicity+        , preservesAll1 "split" $+            \x ms -> let (lt, _, gt) = MS.split x ms in [lt, gt]+        , preservesFun1 @Natural' @Natural' @Int "alterMultiplicity" $+            coerce MS.alterMultiplicity+        , preservesFun1 @Natural' @Natural' @Int "alterMultiplicityF" $+            coerce $+                \f x -> runIdentity . MS.alterMultiplicityF (Identity . f) x+        ]++constructs :: (Arbitrary a, Show a, Ord b) => String -> (a -> MS.MultiSet b) -> TestTree+constructs name = testProperty name . (valid .)++preserves :: (Ord b) => String -> (MS.MultiSet Int -> MS.MultiSet b) -> TestTree+preserves name f = testProperty name $ \(AMS ms) -> valid $ f ms++preserves1 ::+    (Arbitrary a, Show a, Ord b) => String -> (a -> MS.MultiSet Int -> MS.MultiSet b) -> TestTree+preserves1 name f = testProperty name $ \x (AMS ms) -> valid $ f x ms++preserves2 ::+    (Arbitrary a, Show a, Arbitrary b, Show b, Ord c) =>+    String -> (a -> b -> MS.MultiSet Int -> MS.MultiSet c) -> TestTree+preserves2 name f = testProperty name $ \x y (AMS ms) -> valid $ f x y ms++preservesFun ::+    ( Function a+    , CoArbitrary a+    , Show a+    , Arbitrary b+    , Show b+    , Ord c+    ) =>+    String ->+    ((a -> b) -> MS.MultiSet Int -> MS.MultiSet c) ->+    TestTree+preservesFun name f = testProperty name $ \fun (AMS ms) -> valid $ f (applyFun fun) ms++preservesAllFun ::+    ( Function a+    , CoArbitrary a+    , Show a+    , Arbitrary b+    , Show b+    , Foldable t+    , Ord c+    ) =>+    String ->+    ((a -> b) -> MS.MultiSet Int -> t (MS.MultiSet c)) ->+    TestTree+preservesAllFun name f = testProperty name $ \fun (AMS ms) -> all valid $ f (applyFun fun) ms++pair :: (a, a) -> [a]+pair (x, y) = [x, y]++preservesAll ::+    (Foldable t, Ord b) =>+    String ->+    (MS.MultiSet Int -> t (MS.MultiSet b)) ->+    TestTree+preservesAll name f = testProperty name $ \(AMS ms) -> all valid $ f ms++preservesAll1 ::+    (Arbitrary a, Show a, Foldable t, Ord b) =>+    String ->+    (a -> MS.MultiSet Int -> t (MS.MultiSet b)) ->+    TestTree+preservesAll1 name f = testProperty name $ \x (AMS ms) -> all valid $ f x ms++preservesFun1 ::+    ( Function a+    , CoArbitrary a+    , Show a+    , Arbitrary b+    , Show b+    , Arbitrary c+    , Show c+    , Ord d+    ) =>+    String ->+    ((a -> b) -> c -> MS.MultiSet Int -> MS.MultiSet d) ->+    TestTree+preservesFun1 name f = testProperty name $ \fun x (AMS ms) -> valid $ f (applyFun fun) x ms