{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}

-- | This modules provides a strict multiset implementation. To avoid collision with Prelude
-- functions, it is recommended to import this module qualified:
--
-- > import qualified Data.Multiset as Mset
--
-- All complexities below use /m/ for the number of distinct elements and /n/ for the total number
-- of elements.
module Data.Multiset (
  Multiset, Group,
  -- * Construction
  empty, singleton, replicate,
  fromList, fromGroupList,
  fromCountMap,
  -- * Tests and accessors
  null,
  size, distinctSize,
  member, notMember,
  isSubsetOf, isProperSubsetOf,
  count, (!),
  -- * Update
  insert, remove, removeAll, modify,
  -- * Maps and filters
  map, mapCounts, mapGroups,
  filter, filterGroups,
  -- * Combination
  max, min, difference, unionWith, intersectionWith,
  -- * Conversions
  toSet,
  toGroupList, toGrowingGroupList, toShrinkingGroupList,
  toCountMap,
  -- * Other
  elems, distinctElems,
  maxView, minView,
  mostCommon
) where

import Prelude hiding (filter, foldr, map, max, min, null, replicate)
import qualified Prelude as Prelude

import Data.Binary (Binary(..))
import Data.Data (Data, Typeable)
import Data.Foldable (foldl', foldr, toList)
import Data.List (groupBy, sortOn)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
#if !MIN_VERSION_base(4, 11, 0)
import Data.Semigroup (Semigroup, (<>))
#endif
import Data.Set (Set)
import qualified Data.Set as Set
import qualified GHC.Exts

-- | A strict implementation of a multiset. It is backed by a 'Data.Map.Strict.Map' and inherits
-- several of its properties and operation's complexities. In particular, the number of elements in
-- a multiset must not exceed @maxBound :: Int@.
data Multiset v = Multiset
  { Multiset v -> Map v Int
_toMap :: !(Map v Int)
  , Multiset v -> Int
_size :: !Int
  } deriving (
    Multiset v -> Multiset v -> Bool
(Multiset v -> Multiset v -> Bool)
-> (Multiset v -> Multiset v -> Bool) -> Eq (Multiset v)
forall v. Eq v => Multiset v -> Multiset v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Multiset v -> Multiset v -> Bool
$c/= :: forall v. Eq v => Multiset v -> Multiset v -> Bool
== :: Multiset v -> Multiset v -> Bool
$c== :: forall v. Eq v => Multiset v -> Multiset v -> Bool
Eq, Eq (Multiset v)
Eq (Multiset v)
-> (Multiset v -> Multiset v -> Ordering)
-> (Multiset v -> Multiset v -> Bool)
-> (Multiset v -> Multiset v -> Bool)
-> (Multiset v -> Multiset v -> Bool)
-> (Multiset v -> Multiset v -> Bool)
-> (Multiset v -> Multiset v -> Multiset v)
-> (Multiset v -> Multiset v -> Multiset v)
-> Ord (Multiset v)
Multiset v -> Multiset v -> Bool
Multiset v -> Multiset v -> Ordering
Multiset v -> Multiset v -> Multiset v
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall v. Ord v => Eq (Multiset v)
forall v. Ord v => Multiset v -> Multiset v -> Bool
forall v. Ord v => Multiset v -> Multiset v -> Ordering
forall v. Ord v => Multiset v -> Multiset v -> Multiset v
min :: Multiset v -> Multiset v -> Multiset v
$cmin :: forall v. Ord v => Multiset v -> Multiset v -> Multiset v
max :: Multiset v -> Multiset v -> Multiset v
$cmax :: forall v. Ord v => Multiset v -> Multiset v -> Multiset v
>= :: Multiset v -> Multiset v -> Bool
$c>= :: forall v. Ord v => Multiset v -> Multiset v -> Bool
> :: Multiset v -> Multiset v -> Bool
$c> :: forall v. Ord v => Multiset v -> Multiset v -> Bool
<= :: Multiset v -> Multiset v -> Bool
$c<= :: forall v. Ord v => Multiset v -> Multiset v -> Bool
< :: Multiset v -> Multiset v -> Bool
$c< :: forall v. Ord v => Multiset v -> Multiset v -> Bool
compare :: Multiset v -> Multiset v -> Ordering
$ccompare :: forall v. Ord v => Multiset v -> Multiset v -> Ordering
$cp1Ord :: forall v. Ord v => Eq (Multiset v)
Ord, ReadPrec [Multiset v]
ReadPrec (Multiset v)
Int -> ReadS (Multiset v)
ReadS [Multiset v]
(Int -> ReadS (Multiset v))
-> ReadS [Multiset v]
-> ReadPrec (Multiset v)
-> ReadPrec [Multiset v]
-> Read (Multiset v)
forall v. (Ord v, Read v) => ReadPrec [Multiset v]
forall v. (Ord v, Read v) => ReadPrec (Multiset v)
forall v. (Ord v, Read v) => Int -> ReadS (Multiset v)
forall v. (Ord v, Read v) => ReadS [Multiset v]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Multiset v]
$creadListPrec :: forall v. (Ord v, Read v) => ReadPrec [Multiset v]
readPrec :: ReadPrec (Multiset v)
$creadPrec :: forall v. (Ord v, Read v) => ReadPrec (Multiset v)
readList :: ReadS [Multiset v]
$creadList :: forall v. (Ord v, Read v) => ReadS [Multiset v]
readsPrec :: Int -> ReadS (Multiset v)
$creadsPrec :: forall v. (Ord v, Read v) => Int -> ReadS (Multiset v)
Read, Int -> Multiset v -> ShowS
[Multiset v] -> ShowS
Multiset v -> String
(Int -> Multiset v -> ShowS)
-> (Multiset v -> String)
-> ([Multiset v] -> ShowS)
-> Show (Multiset v)
forall v. Show v => Int -> Multiset v -> ShowS
forall v. Show v => [Multiset v] -> ShowS
forall v. Show v => Multiset v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Multiset v] -> ShowS
$cshowList :: forall v. Show v => [Multiset v] -> ShowS
show :: Multiset v -> String
$cshow :: forall v. Show v => Multiset v -> String
showsPrec :: Int -> Multiset v -> ShowS
$cshowsPrec :: forall v. Show v => Int -> Multiset v -> ShowS
Show,
    {-| @since 0.2.1.1 -} Data, {-| @since 0.2.1.1 -} Typeable
  )

-- | A group of values of a given size.
type Group v = (v, Int)

instance Ord v => Semigroup (Multiset v) where
  <> :: Multiset v -> Multiset v -> Multiset v
(<>) = (Int -> Int -> Int) -> Multiset v -> Multiset v -> Multiset v
forall v.
Ord v =>
(Int -> Int -> Int) -> Multiset v -> Multiset v -> Multiset v
unionWith' Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)

instance Ord v => Monoid (Multiset v) where
  mempty :: Multiset v
mempty = Multiset v
forall v. Multiset v
empty

instance Foldable Multiset where
  foldr :: (a -> b -> b) -> b -> Multiset a -> b
foldr a -> b -> b
f b
r0 (Multiset Map a Int
m Int
_) = (a -> Int -> b -> b) -> b -> Map a Int -> b
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey a -> Int -> b -> b
go b
r0 Map a Int
m where
    go :: a -> Int -> b -> b
go a
v Int
n b
r1 = (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> b -> b) -> b -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> b
f) b
r1 ([a] -> b) -> [a] -> b
forall a b. (a -> b) -> a -> b
$ Int -> a -> [a]
forall a. Int -> a -> [a]
Prelude.replicate Int
n a
v

-- | @since 0.2.1.0
instance Binary v => Binary (Multiset v) where
  put :: Multiset v -> Put
put (Multiset Map v Int
m Int
s) = Map v Int -> Put
forall t. Binary t => t -> Put
put Map v Int
m Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Int -> Put
forall t. Binary t => t -> Put
put Int
s
  get :: Get (Multiset v)
get = Map v Int -> Int -> Multiset v
forall v. Map v Int -> Int -> Multiset v
Multiset (Map v Int -> Int -> Multiset v)
-> Get (Map v Int) -> Get (Int -> Multiset v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Map v Int)
forall t. Binary t => Get t
get Get (Int -> Multiset v) -> Get Int -> Get (Multiset v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall t. Binary t => Get t
get

#if __GLASGOW_HASKELL__ >= 708
instance Ord v => GHC.Exts.IsList (Multiset v) where
  type Item (Multiset v) = v
  fromList :: [Item (Multiset v)] -> Multiset v
fromList = [Item (Multiset v)] -> Multiset v
forall v. Ord v => [v] -> Multiset v
fromList
  toList :: Multiset v -> [Item (Multiset v)]
toList = Multiset v -> [Item (Multiset v)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
#endif

-- | /O(1)/ Checks whether a multiset is empty.
null :: Multiset v -> Bool
null :: Multiset v -> Bool
null = Map v Int -> Bool
forall k a. Map k a -> Bool
Map.null (Map v Int -> Bool)
-> (Multiset v -> Map v Int) -> Multiset v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Multiset v -> Map v Int
forall v. Multiset v -> Map v Int
_toMap

-- | /O(1)/ Returns the total number of elements in the multiset. Note that this isn't the number of
-- /distinct/ elements, see 'distinctSize' for that.
size :: Multiset v -> Int
size :: Multiset v -> Int
size = Multiset v -> Int
forall a. Multiset a -> Int
_size

-- | /O(1)/ Returns the number of distinct elements in the multiset.
distinctSize :: Multiset v -> Int
distinctSize :: Multiset v -> Int
distinctSize = Map v Int -> Int
forall k a. Map k a -> Int
Map.size (Map v Int -> Int)
-> (Multiset v -> Map v Int) -> Multiset v -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Multiset v -> Map v Int
forall v. Multiset v -> Map v Int
_toMap

-- | /O(1)/ Returns an empty multiset.
empty :: Multiset v
empty :: Multiset v
empty = Map v Int -> Int -> Multiset v
forall v. Map v Int -> Int -> Multiset v
Multiset Map v Int
forall k a. Map k a
Map.empty Int
0

-- | /O(1)/ Returns a multiset with a single element.
singleton :: v -> Multiset v
singleton :: v -> Multiset v
singleton = Int -> v -> Multiset v
forall v. Int -> v -> Multiset v
replicate Int
1

-- | /O(1)/ Returns a multiset with the same element repeated. If n is zero or negative, 'replicate'
-- returns an empty multiset.
replicate :: Int -> v -> Multiset v
replicate :: Int -> v -> Multiset v
replicate Int
n v
v = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
  then Map v Int -> Int -> Multiset v
forall v. Map v Int -> Int -> Multiset v
Multiset (v -> Int -> Map v Int
forall k a. k -> a -> Map k a
Map.singleton v
v Int
n) Int
n
  else Multiset v
forall v. Multiset v
empty

-- | /O(m * log m)/ Builds a multiset from a map. Negative counts are ignored.
fromCountMap :: Ord v => Map v Int -> Multiset v
fromCountMap :: Map v Int -> Multiset v
fromCountMap = (Multiset v -> v -> Int -> Multiset v)
-> Multiset v -> Map v Int -> Multiset v
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Multiset v -> v -> Int -> Multiset v
forall v. Ord v => Multiset v -> v -> Int -> Multiset v
go Multiset v
forall v. Multiset v
empty where
  go :: Multiset v -> v -> Int -> Multiset v
go Multiset v
ms v
v Int
n = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
    then (Int -> Int) -> v -> Multiset v -> Multiset v
forall v. Ord v => (Int -> Int) -> v -> Multiset v -> Multiset v
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) v
v Multiset v
ms
    else Multiset v
ms

-- | /O(n * log n)/ Builds a multiset from values.
fromList :: Ord v => [v] -> Multiset v
fromList :: [v] -> Multiset v
fromList = (Multiset v -> v -> Multiset v) -> Multiset v -> [v] -> Multiset v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((v -> Multiset v -> Multiset v) -> Multiset v -> v -> Multiset v
forall a b c. (a -> b -> c) -> b -> a -> c
flip v -> Multiset v -> Multiset v
forall v. Ord v => v -> Multiset v -> Multiset v
insert) Multiset v
forall v. Multiset v
empty

-- | /O(m * log m)/ Builds a multiset from a list of groups. Counts of duplicate groups are added
-- together and elements with negative total count are omitted.
fromGroupList :: Ord v => [Group v] -> Multiset v
fromGroupList :: [Group v] -> Multiset v
fromGroupList = (Multiset v -> Group v -> Multiset v)
-> Multiset v -> [Group v] -> Multiset v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Multiset v -> Group v -> Multiset v
forall v. Ord v => Multiset v -> (v, Int) -> Multiset v
go Multiset v
forall v. Multiset v
empty where
  go :: Multiset v -> (v, Int) -> Multiset v
go Multiset v
ms (v
v,Int
n) = (Int -> Int) -> v -> Multiset v -> Multiset v
forall v. Ord v => (Int -> Int) -> v -> Multiset v -> Multiset v
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) v
v Multiset v
ms

-- Access

-- | /O(log m)/ Checks whether the element is present at least once.
member :: Ord v => v -> Multiset v -> Bool
member :: v -> Multiset v -> Bool
member v
v = v -> Map v Int -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member v
v (Map v Int -> Bool)
-> (Multiset v -> Map v Int) -> Multiset v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Multiset v -> Map v Int
forall v. Multiset v -> Map v Int
_toMap

-- | /O(log m)/ Checks whether the element is not present.
notMember :: Ord v => v -> Multiset v -> Bool
notMember :: v -> Multiset v -> Bool
notMember v
v = v -> Map v Int -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.notMember v
v (Map v Int -> Bool)
-> (Multiset v -> Map v Int) -> Multiset v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Multiset v -> Map v Int
forall v. Multiset v -> Map v Int
_toMap

-- | /O(log m)/ Returns the number of times the element is present in the multiset, or 0 if absent.
count :: Ord v => v -> Multiset v -> Int
count :: v -> Multiset v -> Int
count v
v = Int -> v -> Map v Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Int
0 v
v (Map v Int -> Int)
-> (Multiset v -> Map v Int) -> Multiset v -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Multiset v -> Map v Int
forall v. Multiset v -> Map v Int
_toMap

-- | /O(log m)/ Infix version of 'count'.
(!) :: Ord v => Multiset v -> v -> Int
(!) = (v -> Multiset v -> Int) -> Multiset v -> v -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip v -> Multiset v -> Int
forall v. Ord v => v -> Multiset v -> Int
count

-- | /O(log m)/ Modifies the count of an element. If the resulting element's count is zero or
-- negative, it will be removed.
modify :: Ord v => (Int -> Int) -> v -> Multiset v -> Multiset v
modify :: (Int -> Int) -> v -> Multiset v -> Multiset v
modify Int -> Int
f v
v ms :: Multiset v
ms@(Multiset Map v Int
m Int
s) = Map v Int -> Int -> Multiset v
forall v. Map v Int -> Int -> Multiset v
Multiset Map v Int
m' Int
s' where
  n :: Int
n = v -> Multiset v -> Int
forall v. Ord v => v -> Multiset v -> Int
count v
v Multiset v
ms
  n' :: Int
n' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
Prelude.max Int
0 (Int -> Int
f Int
n)
  m' :: Map v Int
m' = if Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then v -> Int -> Map v Int -> Map v Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert v
v Int
n' Map v Int
m else v -> Map v Int -> Map v Int
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete v
v Map v Int
m
  s' :: Int
s' = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n'

-- | /O(log m)/ Inserts an element.
insert :: Ord v => v -> Multiset v -> Multiset v
insert :: v -> Multiset v -> Multiset v
insert = (Int -> Int) -> v -> Multiset v -> Multiset v
forall v. Ord v => (Int -> Int) -> v -> Multiset v -> Multiset v
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

-- | /O(log m)/ Removes a single element. Does nothing if the element isn't present.
remove :: Ord v => v -> Multiset v -> Multiset v
remove :: v -> Multiset v -> Multiset v
remove = (Int -> Int) -> v -> Multiset v -> Multiset v
forall v. Ord v => (Int -> Int) -> v -> Multiset v -> Multiset v
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1)

-- | /O(log m)/ Removes all occurrences of a given element.
removeAll :: Ord v => v -> Multiset v -> Multiset v
removeAll :: v -> Multiset v -> Multiset v
removeAll = (Int -> Int) -> v -> Multiset v -> Multiset v
forall v. Ord v => (Int -> Int) -> v -> Multiset v -> Multiset v
modify (Int -> Int -> Int
forall a b. a -> b -> a
const Int
0)

-- | Filters a multiset by value.
filter :: Ord v => (v -> Bool) -> Multiset v -> Multiset v
filter :: (v -> Bool) -> Multiset v -> Multiset v
filter v -> Bool
f = (Group v -> Bool) -> Multiset v -> Multiset v
forall v. Ord v => (Group v -> Bool) -> Multiset v -> Multiset v
filterGroups (v -> Bool
f (v -> Bool) -> (Group v -> v) -> Group v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Group v -> v
forall a b. (a, b) -> a
fst)

-- | Filters a multiset by group.
filterGroups :: Ord v => (Group v -> Bool) -> Multiset v -> Multiset v
filterGroups :: (Group v -> Bool) -> Multiset v -> Multiset v
filterGroups Group v -> Bool
f (Multiset Map v Int
m Int
_) = (Multiset v -> v -> Int -> Multiset v)
-> Multiset v -> Map v Int -> Multiset v
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Multiset v -> v -> Int -> Multiset v
go Multiset v
forall v. Multiset v
empty Map v Int
m where
  go :: Multiset v -> v -> Int -> Multiset v
go Multiset v
ms v
v Int
n = if Group v -> Bool
f (v
v,Int
n)
    then (Int -> Int) -> v -> Multiset v -> Multiset v
forall v. Ord v => (Int -> Int) -> v -> Multiset v -> Multiset v
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) v
v Multiset v
ms
    else Multiset v
ms

-- | Maps on the multiset's values.
map :: (Ord v1, Ord v2) => (v1 -> v2) -> Multiset v1 -> Multiset v2
map :: (v1 -> v2) -> Multiset v1 -> Multiset v2
map v1 -> v2
f (Multiset Map v1 Int
m Int
s) = Map v2 Int -> Int -> Multiset v2
forall v. Map v Int -> Int -> Multiset v
Multiset ((Int -> Int -> Int) -> (v1 -> v2) -> Map v1 Int -> Map v2 Int
forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) v1 -> v2
f Map v1 Int
m) Int
s

-- | Maps on the multiset's counts. Groups with resulting non-positive counts will be removed from
-- the final multiset.
--
-- @since 0.2.2.0
mapCounts :: Ord v => (Int -> Int) -> Multiset v -> Multiset v
mapCounts :: (Int -> Int) -> Multiset v -> Multiset v
mapCounts Int -> Int
f = (Group v -> Group v) -> Multiset v -> Multiset v
forall v. Ord v => (Group v -> Group v) -> Multiset v -> Multiset v
mapGroups (\(v
v, Int
n) -> (v
v, Int -> Int
f Int
n))

-- | Maps on the multiset's groups. Groups with resulting non-positive counts will be removed from
-- the final multiset.
mapGroups :: Ord v => (Group v -> Group v) -> Multiset v -> Multiset v
mapGroups :: (Group v -> Group v) -> Multiset v -> Multiset v
mapGroups Group v -> Group v
f Multiset v
ms = [Group v] -> Multiset v
forall v. Ord v => [Group v] -> Multiset v
fromGroupList ([Group v] -> Multiset v) -> [Group v] -> Multiset v
forall a b. (a -> b) -> a -> b
$ (Group v -> Group v) -> [Group v] -> [Group v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Group v -> Group v
f ([Group v] -> [Group v]) -> [Group v] -> [Group v]
forall a b. (a -> b) -> a -> b
$ Multiset v -> [Group v]
forall v. Multiset v -> [Group v]
toGroupList Multiset v
ms

-- | Combines two multisets, returning the max count of each element.
max :: Ord v => Multiset v -> Multiset v -> Multiset v
max :: Multiset v -> Multiset v -> Multiset v
max = (Int -> Int -> Int) -> Multiset v -> Multiset v -> Multiset v
forall v.
Ord v =>
(Int -> Int -> Int) -> Multiset v -> Multiset v -> Multiset v
unionWith' Int -> Int -> Int
forall a. Ord a => a -> a -> a
Prelude.max

-- | Combines two multisets, returning the minimum count of each element (or omitting it if the
-- element is present in only one of the two multisets).
min :: Ord v => Multiset v -> Multiset v -> Multiset v
min :: Multiset v -> Multiset v -> Multiset v
min = (Int -> Int -> Int) -> Multiset v -> Multiset v -> Multiset v
forall v.
Ord v =>
(Int -> Int -> Int) -> Multiset v -> Multiset v -> Multiset v
intersectionWith Int -> Int -> Int
forall a. Ord a => a -> a -> a
Prelude.min

-- | Unions two multisets with a generic function. The combining function will be called with a
-- count of 0 when an element is only present in one set.
unionWith :: Ord v => (Int -> Int -> Int) -> Multiset v -> Multiset v -> Multiset v
unionWith :: (Int -> Int -> Int) -> Multiset v -> Multiset v -> Multiset v
unionWith Int -> Int -> Int
f Multiset v
ms1 Multiset v
ms2 = [Group v] -> Multiset v
forall v. Ord v => [Group v] -> Multiset v
fromGroupList ([Group v] -> Multiset v) -> [Group v] -> Multiset v
forall a b. (a -> b) -> a -> b
$ (v -> Group v) -> [v] -> [Group v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> Group v
go ([v] -> [Group v]) -> [v] -> [Group v]
forall a b. (a -> b) -> a -> b
$ Set v -> [v]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set v
vs where
  vs :: Set v
vs = Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Multiset v -> Set v
forall v. Multiset v -> Set v
toSet Multiset v
ms1) (Multiset v -> Set v
forall v. Multiset v -> Set v
toSet Multiset v
ms2)
  go :: v -> Group v
go v
v = (v
v, (Int -> Int -> Int
f (v -> Multiset v -> Int
forall v. Ord v => v -> Multiset v -> Int
count v
v Multiset v
ms1) (v -> Multiset v -> Int
forall v. Ord v => v -> Multiset v -> Int
count v
v Multiset v
ms2)))

-- | Intersects two multisets with a generic function. The combining function is guaranteed to be
-- called only with positive counts.
intersectionWith :: Ord v => (Int -> Int -> Int) -> Multiset v -> Multiset v -> Multiset v
intersectionWith :: (Int -> Int -> Int) -> Multiset v -> Multiset v -> Multiset v
intersectionWith Int -> Int -> Int
f (Multiset Map v Int
m1 Int
_) (Multiset Map v Int
m2 Int
_) = Map v Int -> Multiset v
forall v. Ord v => Map v Int -> Multiset v
fromCountMap (Map v Int -> Multiset v) -> Map v Int -> Multiset v
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Map v Int -> Map v Int -> Map v Int
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith Int -> Int -> Int
f Map v Int
m1 Map v Int
m2

-- | /O(m * log m)/ Returns the first set minus the second. Resulting negative counts are ignored.
difference :: Ord v => Multiset v -> Multiset v -> Multiset v
difference :: Multiset v -> Multiset v -> Multiset v
difference (Multiset Map v Int
m1 Int
_) (Multiset Map v Int
m2 Int
_) = Map v Int -> Multiset v
forall v. Ord v => Map v Int -> Multiset v
fromCountMap (Map v Int -> Multiset v) -> Map v Int -> Multiset v
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Maybe Int) -> Map v Int -> Map v Int -> Map v Int
forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
Map.differenceWith Int -> Int -> Maybe Int
forall a. (Num a, Ord a) => a -> a -> Maybe a
go Map v Int
m1 Map v Int
m2 where
  go :: a -> a -> Maybe a
go a
n1 a
n2 = let n :: a
n = a
n1 a -> a -> a
forall a. Num a => a -> a -> a
- a
n2 in if a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 then a -> Maybe a
forall a. a -> Maybe a
Just a
n else Maybe a
forall a. Maybe a
Nothing

-- | /O(m * log m)/ Checks whether the first subset is a subset of the second (potentially equal to
-- it).
isSubsetOf :: Ord v => Multiset v -> Multiset v -> Bool
isSubsetOf :: Multiset v -> Multiset v -> Bool
isSubsetOf (Multiset Map v Int
m Int
_) Multiset v
ms = (v -> Int -> Bool -> Bool) -> Bool -> Map v Int -> Bool
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey v -> Int -> Bool -> Bool
go Bool
True Map v Int
m where
  go :: v -> Int -> Bool -> Bool
go v
v Int
n Bool
r = v -> Multiset v -> Int
forall v. Ord v => v -> Multiset v -> Int
count v
v Multiset v
ms Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n Bool -> Bool -> Bool
&& Bool
r

-- | /O(m * log m)/ Checks whether the first subset is a strict subset of the second.
isProperSubsetOf :: Ord v => Multiset v -> Multiset v -> Bool
isProperSubsetOf :: Multiset v -> Multiset v -> Bool
isProperSubsetOf Multiset v
ms1 Multiset v
ms2 = Multiset v -> Int
forall a. Multiset a -> Int
size Multiset v
ms1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Multiset v -> Int
forall a. Multiset a -> Int
size Multiset v
ms2 Bool -> Bool -> Bool
&& Multiset v
ms1 Multiset v -> Multiset v -> Bool
forall v. Ord v => Multiset v -> Multiset v -> Bool
`isSubsetOf` Multiset v
ms2

-- | /O(1)/ Converts the multiset to a map of (positive) counts.
toCountMap :: Multiset v -> Map v Int
toCountMap :: Multiset v -> Map v Int
toCountMap = Multiset v -> Map v Int
forall v. Multiset v -> Map v Int
_toMap

-- | /O(m)/ Returns the 'Set' of all distinct elements in the multiset.
toSet :: Multiset v -> Set v
toSet :: Multiset v -> Set v
toSet = Map v Int -> Set v
forall k a. Map k a -> Set k
Map.keysSet (Map v Int -> Set v)
-> (Multiset v -> Map v Int) -> Multiset v -> Set v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Multiset v -> Map v Int
forall v. Multiset v -> Map v Int
_toMap

-- | /O(m)/ Converts the multiset to a list of values and associated counts. The groups are in
-- undefined order; see 'toGrowingGroupList' and 'toShrinkingGroupList' for sorted versions.
toGroupList :: Multiset v -> [Group v]
toGroupList :: Multiset v -> [Group v]
toGroupList = Map v Int -> [Group v]
forall k a. Map k a -> [(k, a)]
Map.toList (Map v Int -> [Group v])
-> (Multiset v -> Map v Int) -> Multiset v -> [Group v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Multiset v -> Map v Int
forall v. Multiset v -> Map v Int
_toMap

-- | /O(m * log m)/ Converts the multiset into a list of values and counts, from least common to
-- most.
toGrowingGroupList :: Multiset v -> [Group v]
toGrowingGroupList :: Multiset v -> [Group v]
toGrowingGroupList = (Group v -> Int) -> [Group v] -> [Group v]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Group v -> Int
forall a b. (a, b) -> b
snd ([Group v] -> [Group v])
-> (Multiset v -> [Group v]) -> Multiset v -> [Group v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Multiset v -> [Group v]
forall v. Multiset v -> [Group v]
toGroupList

-- | /O(m * log m)/ Converts the multiset into a list of values and counts, from most common to
-- least.
toShrinkingGroupList :: Multiset v -> [Group v]
toShrinkingGroupList :: Multiset v -> [Group v]
toShrinkingGroupList = (Group v -> Int) -> [Group v] -> [Group v]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> (Group v -> Int) -> Group v -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Group v -> Int
forall a b. (a, b) -> b
snd) ([Group v] -> [Group v])
-> (Multiset v -> [Group v]) -> Multiset v -> [Group v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Multiset v -> [Group v]
forall v. Multiset v -> [Group v]
toGroupList

-- Other

-- | /O(n)/ Returns the multiset's elements as a list where each element is repeated as many times
-- as its number of occurrences. This is a synonym for 'toList'.
--
-- @since 0.2.2.0
elems :: Multiset v -> [v]
elems :: Multiset v -> [v]
elems = Multiset v -> [v]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- | /O(m)/ Returns a list of the distinct elements in the multiset.
--
-- @since 0.2.2.0
distinctElems :: Multiset v -> [v]
distinctElems :: Multiset v -> [v]
distinctElems = Map v Int -> [v]
forall k a. Map k a -> [k]
Map.keys (Map v Int -> [v])
-> (Multiset v -> Map v Int) -> Multiset v -> [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Multiset v -> Map v Int
forall v. Multiset v -> Map v Int
_toMap

view :: Ord v => (Map v Int -> Maybe ((v, Int), Map v Int)) -> Multiset v -> Maybe (v, Multiset v)
view :: (Map v Int -> Maybe ((v, Int), Map v Int))
-> Multiset v -> Maybe (v, Multiset v)
view Map v Int -> Maybe ((v, Int), Map v Int)
mapView (Multiset Map v Int
m Int
s) = case Map v Int -> Maybe ((v, Int), Map v Int)
mapView Map v Int
m of
  Maybe ((v, Int), Map v Int)
Nothing -> Maybe (v, Multiset v)
forall a. Maybe a
Nothing
  Just ((v
v, Int
n), Map v Int
m') ->
    let
      s' :: Int
s' = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      ms :: Multiset v
ms = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Map v Int -> Int -> Multiset v
forall v. Map v Int -> Int -> Multiset v
Multiset Map v Int
m' Int
s' else Map v Int -> Int -> Multiset v
forall v. Map v Int -> Int -> Multiset v
Multiset (v -> Int -> Map v Int -> Map v Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert v
v (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Map v Int
m') Int
s'
    in (v, Multiset v) -> Maybe (v, Multiset v)
forall a. a -> Maybe a
Just (v
v, Multiset v
ms)

-- | /O(log m)/ Takes an element of maximum value from the multiset and the remaining multiset, or
-- 'Nothing' if the multiset was already empty.
--
-- @since 0.2.1.2
maxView :: Ord v => Multiset v -> Maybe (v, Multiset v)
maxView :: Multiset v -> Maybe (v, Multiset v)
maxView = (Map v Int -> Maybe ((v, Int), Map v Int))
-> Multiset v -> Maybe (v, Multiset v)
forall v.
Ord v =>
(Map v Int -> Maybe ((v, Int), Map v Int))
-> Multiset v -> Maybe (v, Multiset v)
view Map v Int -> Maybe ((v, Int), Map v Int)
forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.maxViewWithKey

-- | /O(log m)/ Takes an element of minimum value from the multiset and the remaining multiset, or
-- 'Nothing' if the multiset was already empty.
--
-- @since 0.2.1.2
minView :: Ord v => Multiset v -> Maybe (v, Multiset v)
minView :: Multiset v -> Maybe (v, Multiset v)
minView = (Map v Int -> Maybe ((v, Int), Map v Int))
-> Multiset v -> Maybe (v, Multiset v)
forall v.
Ord v =>
(Map v Int -> Maybe ((v, Int), Map v Int))
-> Multiset v -> Maybe (v, Multiset v)
view Map v Int -> Maybe ((v, Int), Map v Int)
forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey

-- | /O(m)/ Returns the multiset's elements grouped by count, most common first.
mostCommon :: Multiset v -> [(Int, [v])]
mostCommon :: Multiset v -> [(Int, [v])]
mostCommon = ([(v, Int)] -> (Int, [v])) -> [[(v, Int)]] -> [(Int, [v])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(v, Int)] -> (Int, [v])
forall b b. [(b, b)] -> (b, [b])
go ([[(v, Int)]] -> [(Int, [v])])
-> (Multiset v -> [[(v, Int)]]) -> Multiset v -> [(Int, [v])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((v, Int) -> (v, Int) -> Bool) -> [(v, Int)] -> [[(v, Int)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\(v, Int)
e1 (v, Int)
e2 -> (v, Int) -> Int
forall a b. (a, b) -> b
snd (v, Int)
e1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (v, Int) -> Int
forall a b. (a, b) -> b
snd (v, Int)
e2) ([(v, Int)] -> [[(v, Int)]])
-> (Multiset v -> [(v, Int)]) -> Multiset v -> [[(v, Int)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Multiset v -> [(v, Int)]
forall v. Multiset v -> [Group v]
toShrinkingGroupList where
  go :: [(b, b)] -> (b, [b])
go ((b
v, b
n) : [(b, b)]
groups) = (b
n, b
v b -> [b] -> [b]
forall a. a -> [a] -> [a]
: ((b, b) -> b) -> [(b, b)] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, b) -> b
forall a b. (a, b) -> a
fst [(b, b)]
groups)
  go [(b, b)]
_ = String -> (b, [b])
forall a. HasCallStack => String -> a
error String
"unreachable"

-- Internal

unionWith' :: Ord v => (Int -> Int -> Int) -> Multiset v -> Multiset v -> Multiset v
unionWith' :: (Int -> Int -> Int) -> Multiset v -> Multiset v -> Multiset v
unionWith' Int -> Int -> Int
f (Multiset Map v Int
m1 Int
_) (Multiset Map v Int
m2 Int
_) = Map v Int -> Multiset v
forall v. Ord v => Map v Int -> Multiset v
fromCountMap (Map v Int -> Multiset v) -> Map v Int -> Multiset v
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Map v Int -> Map v Int -> Map v Int
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Int -> Int -> Int
f Map v Int
m1 Map v Int
m2