-- |
-- Copyright: © 2022–2023 Jonathan Knowles
-- License: Apache-2.0
--
-- A multiset type, implemented in terms of 'MonoidMap'.
--
-- See: https://en.wikipedia.org/wiki/Multiset
--
module Examples.MultiSet
    ( fromList
    , toList
    , null
    , member
    , multiplicity
    , root
    , cardinality
    , dimension
    , height
    , isSubsetOf
    , intersection
    , union
    , disjointUnion
    , add
    , subtract
    , subtractMaybe
    )
    where

import Prelude hiding
    ( null, subtract )

import Data.Function
    ( on )
import Data.Monoid
    ( Sum (..) )
import Data.Monoid.GCD
    ( DistributiveGCDMonoid
    , GCDMonoid
    , LeftDistributiveGCDMonoid
    , LeftGCDMonoid
    , OverlappingGCDMonoid
    , RightDistributiveGCDMonoid
    , RightGCDMonoid
    )
import Data.Monoid.LCM
    ( DistributiveLCMMonoid, LCMMonoid )
import Data.Monoid.Monus
    ( Monus ((<\>)) )
import Data.Monoid.Null
    ( MonoidNull, PositiveMonoid )
import Data.MonoidMap
    ( MonoidMap )
import Data.Semigroup.Cancellative
    ( Cancellative
    , Commutative
    , LeftCancellative
    , LeftReductive
    , Reductive ((</>))
    , RightCancellative
    , RightReductive
    )
import Data.Set
    ( Set )
import Numeric.Natural
    ( Natural )
import Text.Read
    ( Read (..) )

import qualified Data.Foldable as F
import qualified Data.MonoidMap as MonoidMap

newtype MultiSet a = MultiSet
    { forall a. MultiSet a -> MonoidMap a (Sum Natural)
unMultiSet :: MonoidMap a (Sum Natural)
    }
    deriving newtype
        ( MultiSet a -> MultiSet a -> Bool
forall a. Eq a => MultiSet a -> MultiSet a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultiSet a -> MultiSet a -> Bool
$c/= :: forall a. Eq a => MultiSet a -> MultiSet a -> Bool
== :: MultiSet a -> MultiSet a -> Bool
$c== :: forall a. Eq a => MultiSet a -> MultiSet a -> Bool
Eq
        , NonEmpty (MultiSet a) -> MultiSet a
MultiSet a -> MultiSet a -> MultiSet a
forall b. Integral b => b -> MultiSet a -> MultiSet a
forall a. Ord a => NonEmpty (MultiSet a) -> MultiSet a
forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
forall a b. (Ord a, Integral b) => b -> MultiSet a -> MultiSet a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> MultiSet a -> MultiSet a
$cstimes :: forall a b. (Ord a, Integral b) => b -> MultiSet a -> MultiSet a
sconcat :: NonEmpty (MultiSet a) -> MultiSet a
$csconcat :: forall a. Ord a => NonEmpty (MultiSet a) -> MultiSet a
<> :: MultiSet a -> MultiSet a -> MultiSet a
$c<> :: forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
Semigroup
        , forall a. Ord a => Semigroup (MultiSet a)
forall g. Semigroup g -> Commutative g
Commutative
        , MultiSet a
[MultiSet a] -> MultiSet a
MultiSet a -> MultiSet a -> MultiSet a
forall a. Ord a => Semigroup (MultiSet a)
forall a. Ord a => MultiSet a
forall a. Ord a => [MultiSet a] -> MultiSet a
forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [MultiSet a] -> MultiSet a
$cmconcat :: forall a. Ord a => [MultiSet a] -> MultiSet a
mappend :: MultiSet a -> MultiSet a -> MultiSet a
$cmappend :: forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
mempty :: MultiSet a
$cmempty :: forall a. Ord a => MultiSet a
Monoid
        , MultiSet a -> Bool
forall a. Ord a => Monoid (MultiSet a)
forall a. Ord a => MultiSet a -> Bool
forall m. Monoid m -> (m -> Bool) -> MonoidNull m
null :: MultiSet a -> Bool
$cnull :: forall a. Ord a => MultiSet a -> Bool
MonoidNull
        , forall a. Ord a => MonoidNull (MultiSet a)
forall m. MonoidNull m -> PositiveMonoid m
PositiveMonoid
        , MultiSet a -> MultiSet a -> Bool
MultiSet a -> MultiSet a -> Maybe (MultiSet a)
forall a. Ord a => Semigroup (MultiSet a)
forall a. Ord a => MultiSet a -> MultiSet a -> Bool
forall a. Ord a => MultiSet a -> MultiSet a -> Maybe (MultiSet a)
forall m.
Semigroup m
-> (m -> m -> Bool) -> (m -> m -> Maybe m) -> LeftReductive m
stripPrefix :: MultiSet a -> MultiSet a -> Maybe (MultiSet a)
$cstripPrefix :: forall a. Ord a => MultiSet a -> MultiSet a -> Maybe (MultiSet a)
isPrefixOf :: MultiSet a -> MultiSet a -> Bool
$cisPrefixOf :: forall a. Ord a => MultiSet a -> MultiSet a -> Bool
LeftReductive
        , forall a. Ord a => LeftReductive (MultiSet a)
forall m. LeftReductive m -> LeftCancellative m
LeftCancellative
        , MultiSet a -> MultiSet a -> (MultiSet a, MultiSet a, MultiSet a)
MultiSet a -> MultiSet a -> MultiSet a
forall a. Ord a => Monoid (MultiSet a)
forall a. Ord a => LeftReductive (MultiSet a)
forall a.
Ord a =>
MultiSet a -> MultiSet a -> (MultiSet a, MultiSet a, MultiSet a)
forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
forall m.
Monoid m
-> LeftReductive m
-> (m -> m -> m)
-> (m -> m -> (m, m, m))
-> LeftGCDMonoid m
stripCommonPrefix :: MultiSet a -> MultiSet a -> (MultiSet a, MultiSet a, MultiSet a)
$cstripCommonPrefix :: forall a.
Ord a =>
MultiSet a -> MultiSet a -> (MultiSet a, MultiSet a, MultiSet a)
commonPrefix :: MultiSet a -> MultiSet a -> MultiSet a
$ccommonPrefix :: forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
LeftGCDMonoid
        , forall a. Ord a => LeftGCDMonoid (MultiSet a)
forall m. LeftGCDMonoid m -> LeftDistributiveGCDMonoid m
LeftDistributiveGCDMonoid
        , MultiSet a -> MultiSet a -> Bool
MultiSet a -> MultiSet a -> Maybe (MultiSet a)
forall a. Ord a => Semigroup (MultiSet a)
forall a. Ord a => MultiSet a -> MultiSet a -> Bool
forall a. Ord a => MultiSet a -> MultiSet a -> Maybe (MultiSet a)
forall m.
Semigroup m
-> (m -> m -> Bool) -> (m -> m -> Maybe m) -> RightReductive m
stripSuffix :: MultiSet a -> MultiSet a -> Maybe (MultiSet a)
$cstripSuffix :: forall a. Ord a => MultiSet a -> MultiSet a -> Maybe (MultiSet a)
isSuffixOf :: MultiSet a -> MultiSet a -> Bool
$cisSuffixOf :: forall a. Ord a => MultiSet a -> MultiSet a -> Bool
RightReductive
        , forall a. Ord a => RightReductive (MultiSet a)
forall m. RightReductive m -> RightCancellative m
RightCancellative
        , MultiSet a -> MultiSet a -> (MultiSet a, MultiSet a, MultiSet a)
MultiSet a -> MultiSet a -> MultiSet a
forall a. Ord a => Monoid (MultiSet a)
forall a. Ord a => RightReductive (MultiSet a)
forall a.
Ord a =>
MultiSet a -> MultiSet a -> (MultiSet a, MultiSet a, MultiSet a)
forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
forall m.
Monoid m
-> RightReductive m
-> (m -> m -> m)
-> (m -> m -> (m, m, m))
-> RightGCDMonoid m
stripCommonSuffix :: MultiSet a -> MultiSet a -> (MultiSet a, MultiSet a, MultiSet a)
$cstripCommonSuffix :: forall a.
Ord a =>
MultiSet a -> MultiSet a -> (MultiSet a, MultiSet a, MultiSet a)
commonSuffix :: MultiSet a -> MultiSet a -> MultiSet a
$ccommonSuffix :: forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
RightGCDMonoid
        , forall a. Ord a => RightGCDMonoid (MultiSet a)
forall m. RightGCDMonoid m -> RightDistributiveGCDMonoid m
RightDistributiveGCDMonoid
        , MultiSet a -> MultiSet a -> Maybe (MultiSet a)
forall a. Ord a => Commutative (MultiSet a)
forall a. Ord a => LeftReductive (MultiSet a)
forall a. Ord a => RightReductive (MultiSet a)
forall a. Ord a => MultiSet a -> MultiSet a -> Maybe (MultiSet a)
forall m.
Commutative m
-> LeftReductive m
-> RightReductive m
-> (m -> m -> Maybe m)
-> Reductive m
</> :: MultiSet a -> MultiSet a -> Maybe (MultiSet a)
$c</> :: forall a. Ord a => MultiSet a -> MultiSet a -> Maybe (MultiSet a)
Reductive
        , forall a. Ord a => Reductive (MultiSet a)
forall a. Ord a => LeftCancellative (MultiSet a)
forall a. Ord a => RightCancellative (MultiSet a)
forall m.
LeftCancellative m
-> RightCancellative m -> Reductive m -> Cancellative m
Cancellative
        , MultiSet a -> MultiSet a -> MultiSet a
forall a. Ord a => Monoid (MultiSet a)
forall a. Ord a => Commutative (MultiSet a)
forall a. Ord a => LeftGCDMonoid (MultiSet a)
forall a. Ord a => RightGCDMonoid (MultiSet a)
forall {a}. Ord a => OverlappingGCDMonoid (MultiSet a)
forall a. Ord a => Reductive (MultiSet a)
forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
forall m.
Monoid m
-> Commutative m
-> Reductive m
-> LeftGCDMonoid m
-> RightGCDMonoid m
-> OverlappingGCDMonoid m
-> (m -> m -> m)
-> GCDMonoid m
gcd :: MultiSet a -> MultiSet a -> MultiSet a
$cgcd :: forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
GCDMonoid
        , MultiSet a -> MultiSet a -> MultiSet a
forall a. Ord a => GCDMonoid (MultiSet a)
forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
forall m. GCDMonoid m -> (m -> m -> m) -> LCMMonoid m
lcm :: MultiSet a -> MultiSet a -> MultiSet a
$clcm :: forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
LCMMonoid
        , forall a. Ord a => GCDMonoid (MultiSet a)
forall a. Ord a => LeftDistributiveGCDMonoid (MultiSet a)
forall a. Ord a => RightDistributiveGCDMonoid (MultiSet a)
forall m.
LeftDistributiveGCDMonoid m
-> RightDistributiveGCDMonoid m
-> GCDMonoid m
-> DistributiveGCDMonoid m
DistributiveGCDMonoid
        , forall a. Ord a => LCMMonoid (MultiSet a)
forall a. Ord a => DistributiveGCDMonoid (MultiSet a)
forall m.
DistributiveGCDMonoid m -> LCMMonoid m -> DistributiveLCMMonoid m
DistributiveLCMMonoid
        , MultiSet a -> MultiSet a -> (MultiSet a, MultiSet a, MultiSet a)
MultiSet a -> MultiSet a -> MultiSet a
forall a. Ord a => Monoid (MultiSet a)
forall a. Ord a => LeftReductive (MultiSet a)
forall a. Ord a => RightReductive (MultiSet a)
forall a.
Ord a =>
MultiSet a -> MultiSet a -> (MultiSet a, MultiSet a, MultiSet a)
forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
forall m.
Monoid m
-> LeftReductive m
-> RightReductive m
-> (m -> m -> m)
-> (m -> m -> m)
-> (m -> m -> m)
-> (m -> m -> (m, m, m))
-> OverlappingGCDMonoid m
stripOverlap :: MultiSet a -> MultiSet a -> (MultiSet a, MultiSet a, MultiSet a)
$cstripOverlap :: forall a.
Ord a =>
MultiSet a -> MultiSet a -> (MultiSet a, MultiSet a, MultiSet a)
overlap :: MultiSet a -> MultiSet a -> MultiSet a
$coverlap :: forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
stripSuffixOverlap :: MultiSet a -> MultiSet a -> MultiSet a
$cstripSuffixOverlap :: forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
stripPrefixOverlap :: MultiSet a -> MultiSet a -> MultiSet a
$cstripPrefixOverlap :: forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
OverlappingGCDMonoid
        , MultiSet a -> MultiSet a -> MultiSet a
forall a. Ord a => Monoid (MultiSet a)
forall a. Ord a => Commutative (MultiSet a)
forall {a}. Ord a => OverlappingGCDMonoid (MultiSet a)
forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
forall m.
Commutative m
-> Monoid m -> OverlappingGCDMonoid m -> (m -> m -> m) -> Monus m
<\> :: MultiSet a -> MultiSet a -> MultiSet a
$c<\> :: forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
Monus
        )

instance (Ord a, Read a) => Read (MultiSet a) where
    readPrec :: ReadPrec (MultiSet a)
readPrec = forall a. Ord a => [(a, Natural)] -> MultiSet a
fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => ReadPrec a
readPrec

instance Show a => Show (MultiSet a) where
    show :: MultiSet a -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MultiSet a -> [(a, Natural)]
toList

fromList :: Ord a => [(a, Natural)] -> MultiSet a
fromList :: forall a. Ord a => [(a, Natural)] -> MultiSet a
fromList = forall a. MonoidMap a (Sum Natural) -> MultiSet a
MultiSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Ord k, MonoidNull v) => [(k, v)] -> MonoidMap k v
MonoidMap.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Sum a
Sum)

toList :: MultiSet a -> [(a, Natural)]
toList :: forall a. MultiSet a -> [(a, Natural)]
toList = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Sum a -> a
getSum) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. MonoidMap k v -> [(k, v)]
MonoidMap.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MultiSet a -> MonoidMap a (Sum Natural)
unMultiSet

null :: MultiSet a -> Bool
null :: forall a. MultiSet a -> Bool
null = forall k v. MonoidMap k v -> Bool
MonoidMap.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MultiSet a -> MonoidMap a (Sum Natural)
unMultiSet

member :: Ord a => a -> MultiSet a -> Bool
member :: forall a. Ord a => a -> MultiSet a -> Bool
member a
a = forall k v. Ord k => k -> MonoidMap k v -> Bool
MonoidMap.nonNullKey a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MultiSet a -> MonoidMap a (Sum Natural)
unMultiSet

multiplicity :: Ord a => a -> MultiSet a -> Natural
multiplicity :: forall a. Ord a => a -> MultiSet a -> Natural
multiplicity a
a = forall a. Sum a -> a
getSum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Ord k, Monoid v) => k -> MonoidMap k v -> v
MonoidMap.get a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MultiSet a -> MonoidMap a (Sum Natural)
unMultiSet

root :: Ord a => MultiSet a -> Set a
root :: forall a. Ord a => MultiSet a -> Set a
root = forall k v. MonoidMap k v -> Set k
MonoidMap.nonNullKeys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MultiSet a -> MonoidMap a (Sum Natural)
unMultiSet

cardinality :: MultiSet a -> Natural
cardinality :: forall a. MultiSet a -> Natural
cardinality = forall a. Sum a -> a
getSum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MultiSet a -> MonoidMap a (Sum Natural)
unMultiSet

dimension :: MultiSet a -> Natural
dimension :: forall a. MultiSet a -> Natural
dimension = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. MonoidMap k v -> Int
MonoidMap.nonNullCount forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MultiSet a -> MonoidMap a (Sum Natural)
unMultiSet

height :: Ord a => MultiSet a -> Natural
height :: forall a. Ord a => MultiSet a -> Natural
height MultiSet a
s
    | forall a. MultiSet a -> Bool
null MultiSet a
s = Natural
0
    | Bool
otherwise = forall a. Sum a -> a
getSum forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
F.maximum forall a b. (a -> b) -> a -> b
$ forall a. MultiSet a -> MonoidMap a (Sum Natural)
unMultiSet MultiSet a
s

isSubsetOf :: Ord a => MultiSet a -> MultiSet a -> Bool
isSubsetOf :: forall a. Ord a => MultiSet a -> MultiSet a -> Bool
isSubsetOf = forall k v.
(Ord k, Monoid v, Reductive v) =>
MonoidMap k v -> MonoidMap k v -> Bool
MonoidMap.isSubmapOf forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. MultiSet a -> MonoidMap a (Sum Natural)
unMultiSet

intersection :: Ord a => MultiSet a -> MultiSet a -> MultiSet a
intersection :: forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
intersection (MultiSet MonoidMap a (Sum Natural)
s1) (MultiSet MonoidMap a (Sum Natural)
s2) =
    forall a. MonoidMap a (Sum Natural) -> MultiSet a
MultiSet (forall k v.
(Ord k, MonoidNull v, GCDMonoid v) =>
MonoidMap k v -> MonoidMap k v -> MonoidMap k v
MonoidMap.intersection MonoidMap a (Sum Natural)
s1 MonoidMap a (Sum Natural)
s2)

union :: Ord a => MultiSet a -> MultiSet a -> MultiSet a
union :: forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
union (MultiSet MonoidMap a (Sum Natural)
s1) (MultiSet MonoidMap a (Sum Natural)
s2) =
    forall a. MonoidMap a (Sum Natural) -> MultiSet a
MultiSet (forall k v.
(Ord k, MonoidNull v, LCMMonoid v) =>
MonoidMap k v -> MonoidMap k v -> MonoidMap k v
MonoidMap.union MonoidMap a (Sum Natural)
s1 MonoidMap a (Sum Natural)
s2)

disjointUnion :: Ord a => MultiSet a -> MultiSet a -> MultiSet a
disjointUnion :: forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
disjointUnion MultiSet a
m1 MultiSet a
m2 = (MultiSet a
m1 forall m. Monus m => m -> m -> m
<\> MultiSet a
m2) forall a. Semigroup a => a -> a -> a
<> (MultiSet a
m2 forall m. Monus m => m -> m -> m
<\> MultiSet a
m1)

add :: Ord a => MultiSet a -> MultiSet a -> MultiSet a
add :: forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
add = forall a. Semigroup a => a -> a -> a
(<>)

subtract :: Ord a => MultiSet a -> MultiSet a -> MultiSet a
subtract :: forall a. Ord a => MultiSet a -> MultiSet a -> MultiSet a
subtract = forall m. Monus m => m -> m -> m
(<\>)

subtractMaybe :: Ord a => MultiSet a -> MultiSet a -> Maybe (MultiSet a)
subtractMaybe :: forall a. Ord a => MultiSet a -> MultiSet a -> Maybe (MultiSet a)
subtractMaybe = forall m. Reductive m => m -> m -> Maybe m
(</>)