{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE TypeFamilies #-}

module Data.MultisetHash where

import qualified Data.Foldable as F
import Data.Monoid
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Vector.Unboxed as U
import System.Random

newtype MultisetHash = MultisetHash Int
    deriving (Int -> MultisetHash -> ShowS
[MultisetHash] -> ShowS
MultisetHash -> String
(Int -> MultisetHash -> ShowS)
-> (MultisetHash -> String)
-> ([MultisetHash] -> ShowS)
-> Show MultisetHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MultisetHash -> ShowS
showsPrec :: Int -> MultisetHash -> ShowS
$cshow :: MultisetHash -> String
show :: MultisetHash -> String
$cshowList :: [MultisetHash] -> ShowS
showList :: [MultisetHash] -> ShowS
Show)
    deriving newtype (MultisetHash -> MultisetHash -> Bool
(MultisetHash -> MultisetHash -> Bool)
-> (MultisetHash -> MultisetHash -> Bool) -> Eq MultisetHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MultisetHash -> MultisetHash -> Bool
== :: MultisetHash -> MultisetHash -> Bool
$c/= :: MultisetHash -> MultisetHash -> Bool
/= :: MultisetHash -> MultisetHash -> Bool
Eq, Eq MultisetHash
Eq MultisetHash =>
(MultisetHash -> MultisetHash -> Ordering)
-> (MultisetHash -> MultisetHash -> Bool)
-> (MultisetHash -> MultisetHash -> Bool)
-> (MultisetHash -> MultisetHash -> Bool)
-> (MultisetHash -> MultisetHash -> Bool)
-> (MultisetHash -> MultisetHash -> MultisetHash)
-> (MultisetHash -> MultisetHash -> MultisetHash)
-> Ord MultisetHash
MultisetHash -> MultisetHash -> Bool
MultisetHash -> MultisetHash -> Ordering
MultisetHash -> MultisetHash -> MultisetHash
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
$ccompare :: MultisetHash -> MultisetHash -> Ordering
compare :: MultisetHash -> MultisetHash -> Ordering
$c< :: MultisetHash -> MultisetHash -> Bool
< :: MultisetHash -> MultisetHash -> Bool
$c<= :: MultisetHash -> MultisetHash -> Bool
<= :: MultisetHash -> MultisetHash -> Bool
$c> :: MultisetHash -> MultisetHash -> Bool
> :: MultisetHash -> MultisetHash -> Bool
$c>= :: MultisetHash -> MultisetHash -> Bool
>= :: MultisetHash -> MultisetHash -> Bool
$cmax :: MultisetHash -> MultisetHash -> MultisetHash
max :: MultisetHash -> MultisetHash -> MultisetHash
$cmin :: MultisetHash -> MultisetHash -> MultisetHash
min :: MultisetHash -> MultisetHash -> MultisetHash
Ord, Integer -> MultisetHash
MultisetHash -> MultisetHash
MultisetHash -> MultisetHash -> MultisetHash
(MultisetHash -> MultisetHash -> MultisetHash)
-> (MultisetHash -> MultisetHash -> MultisetHash)
-> (MultisetHash -> MultisetHash -> MultisetHash)
-> (MultisetHash -> MultisetHash)
-> (MultisetHash -> MultisetHash)
-> (MultisetHash -> MultisetHash)
-> (Integer -> MultisetHash)
-> Num MultisetHash
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: MultisetHash -> MultisetHash -> MultisetHash
+ :: MultisetHash -> MultisetHash -> MultisetHash
$c- :: MultisetHash -> MultisetHash -> MultisetHash
- :: MultisetHash -> MultisetHash -> MultisetHash
$c* :: MultisetHash -> MultisetHash -> MultisetHash
* :: MultisetHash -> MultisetHash -> MultisetHash
$cnegate :: MultisetHash -> MultisetHash
negate :: MultisetHash -> MultisetHash
$cabs :: MultisetHash -> MultisetHash
abs :: MultisetHash -> MultisetHash
$csignum :: MultisetHash -> MultisetHash
signum :: MultisetHash -> MultisetHash
$cfromInteger :: Integer -> MultisetHash
fromInteger :: Integer -> MultisetHash
Num, (forall g.
 RandomGen g =>
 (MultisetHash, MultisetHash) -> g -> (MultisetHash, g))
-> (forall g. RandomGen g => g -> (MultisetHash, g))
-> (forall g.
    RandomGen g =>
    (MultisetHash, MultisetHash) -> g -> [MultisetHash])
-> (forall g. RandomGen g => g -> [MultisetHash])
-> Random MultisetHash
forall g. RandomGen g => g -> [MultisetHash]
forall g. RandomGen g => g -> (MultisetHash, g)
forall g.
RandomGen g =>
(MultisetHash, MultisetHash) -> g -> [MultisetHash]
forall g.
RandomGen g =>
(MultisetHash, MultisetHash) -> g -> (MultisetHash, g)
forall a.
(forall g. RandomGen g => (a, a) -> g -> (a, g))
-> (forall g. RandomGen g => g -> (a, g))
-> (forall g. RandomGen g => (a, a) -> g -> [a])
-> (forall g. RandomGen g => g -> [a])
-> Random a
$crandomR :: forall g.
RandomGen g =>
(MultisetHash, MultisetHash) -> g -> (MultisetHash, g)
randomR :: forall g.
RandomGen g =>
(MultisetHash, MultisetHash) -> g -> (MultisetHash, g)
$crandom :: forall g. RandomGen g => g -> (MultisetHash, g)
random :: forall g. RandomGen g => g -> (MultisetHash, g)
$crandomRs :: forall g.
RandomGen g =>
(MultisetHash, MultisetHash) -> g -> [MultisetHash]
randomRs :: forall g.
RandomGen g =>
(MultisetHash, MultisetHash) -> g -> [MultisetHash]
$crandoms :: forall g. RandomGen g => g -> [MultisetHash]
randoms :: forall g. RandomGen g => g -> [MultisetHash]
Random)
    deriving (NonEmpty MultisetHash -> MultisetHash
MultisetHash -> MultisetHash -> MultisetHash
(MultisetHash -> MultisetHash -> MultisetHash)
-> (NonEmpty MultisetHash -> MultisetHash)
-> (forall b. Integral b => b -> MultisetHash -> MultisetHash)
-> Semigroup MultisetHash
forall b. Integral b => b -> MultisetHash -> MultisetHash
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: MultisetHash -> MultisetHash -> MultisetHash
<> :: MultisetHash -> MultisetHash -> MultisetHash
$csconcat :: NonEmpty MultisetHash -> MultisetHash
sconcat :: NonEmpty MultisetHash -> MultisetHash
$cstimes :: forall b. Integral b => b -> MultisetHash -> MultisetHash
stimes :: forall b. Integral b => b -> MultisetHash -> MultisetHash
Semigroup, Semigroup MultisetHash
MultisetHash
Semigroup MultisetHash =>
MultisetHash
-> (MultisetHash -> MultisetHash -> MultisetHash)
-> ([MultisetHash] -> MultisetHash)
-> Monoid MultisetHash
[MultisetHash] -> MultisetHash
MultisetHash -> MultisetHash -> MultisetHash
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: MultisetHash
mempty :: MultisetHash
$cmappend :: MultisetHash -> MultisetHash -> MultisetHash
mappend :: MultisetHash -> MultisetHash -> MultisetHash
$cmconcat :: [MultisetHash] -> MultisetHash
mconcat :: [MultisetHash] -> MultisetHash
Monoid) via (Sum Int)

newtype instance U.MVector s MultisetHash = MV_MultisetHash (U.MVector s Int)
newtype instance U.Vector MultisetHash = V_MultisetHash (U.Vector Int)
deriving newtype instance GM.MVector U.MVector MultisetHash
deriving newtype instance G.Vector U.Vector MultisetHash
instance U.Unbox MultisetHash

nullMH :: MultisetHash -> Bool
nullMH :: MultisetHash -> Bool
nullMH = (MultisetHash -> MultisetHash -> Bool
forall a. Eq a => a -> a -> Bool
== MultisetHash
forall a. Monoid a => a
mempty)

emptyMH :: MultisetHash
emptyMH :: MultisetHash
emptyMH = MultisetHash
forall a. Monoid a => a
mempty

singletonMH :: (a -> MultisetHash) -> a -> MultisetHash
singletonMH :: forall a. (a -> MultisetHash) -> a -> MultisetHash
singletonMH = (a -> MultisetHash) -> a -> MultisetHash
forall a. a -> a
id

{- |
>>> hs = randoms (mkStdGen 123)
>>> fromListMH (hs!!) [1,2]
MultisetHash (-6020088438187520526)
>>> fromListMH (hs!!) [1,1,2]
MultisetHash (-9031158793612401624)
>>> insertMH (hs!!) 1 (fromListMH (hs!!) [1,2])
MultisetHash (-9031158793612401624)
>>> hash x = hs !! mod x 10
prop> \x xs -> fromListMH hash (x:xs) == insertMH hash x (fromListMH hash xs)
+++ OK, passed 100 tests.
-}
insertMH :: (a -> MultisetHash) -> a -> MultisetHash -> MultisetHash
insertMH :: forall a. (a -> MultisetHash) -> a -> MultisetHash -> MultisetHash
insertMH a -> MultisetHash
hash a
x MultisetHash
h = a -> MultisetHash
hash a
x MultisetHash -> MultisetHash -> MultisetHash
forall a. Num a => a -> a -> a
+ MultisetHash
h
{-# INLINE insertMH #-}

{- |
>>> hs = randoms (mkStdGen 123)
>>> fromListMH (hs!!) [1,2]
MultisetHash (-6020088438187520526)
>>> fromListMH (hs!!) [1,1,2]
MultisetHash (-9031158793612401624)
>>> deleteMH (hs!!) 1 (fromListMH (hs!!) [1,1,2])
MultisetHash (-6020088438187520526)
-}
deleteMH :: (a -> MultisetHash) -> a -> MultisetHash -> MultisetHash
deleteMH :: forall a. (a -> MultisetHash) -> a -> MultisetHash -> MultisetHash
deleteMH a -> MultisetHash
hash a
x MultisetHash
h = MultisetHash
h MultisetHash -> MultisetHash -> MultisetHash
forall a. Num a => a -> a -> a
- a -> MultisetHash
hash a
x
{-# INLINE deleteMH #-}

{- |
>>> hs = randoms (mkStdGen 123)
>>> unionMH (fromListMH (hs!!) [1,1,2]) (fromListMH (hs!!) [1,3])
MultisetHash 6625208473658164035
>>> fromListMH (hs!!) $ [1,1,2] <> [1,3]
MultisetHash 6625208473658164035
-}
unionMH :: MultisetHash -> MultisetHash -> MultisetHash
unionMH :: MultisetHash -> MultisetHash -> MultisetHash
unionMH = MultisetHash -> MultisetHash -> MultisetHash
forall a. Num a => a -> a -> a
(+)
{-# INLINE unionMH #-}

{- |
>>> hs = randoms (mkStdGen 123)
>>> differenceMH (fromListMH (hs!!) [1,1,2]) (fromListMH (hs!!) [1,2])
MultisetHash (-3011070355424881098)
>>> fromListMH (hs!!) [1]
MultisetHash (-3011070355424881098)
>>> differenceMH (fromListMH (hs!!) [1,1,2]) (fromListMH (hs!!) [1,3])
MultisetHash (-6240781987173415667)
-}
differenceMH :: MultisetHash -> MultisetHash -> MultisetHash
differenceMH :: MultisetHash -> MultisetHash -> MultisetHash
differenceMH = (-)
{-# INLINE differenceMH #-}

{- |
>>> hs = randoms (mkStdGen 123)
>>> fromListMH (hs !!) [1,1,1,2,2,3]
MultisetHash 3616190390895524607
>>> fromListMH (hs !!) [1,2,1,3,1,2]
MultisetHash 3616190390895524607
>>> map (fromListMH (hs!!)) [[1],[1,1],[1,1,1]]
[MultisetHash (-3011070355424881098),MultisetHash (-6022140710849762196),MultisetHash (-9033211066274643294)]
>>> hash x = hs !! mod x 10
prop> \xs ys -> fromListMH hash (xs ++ ys) == fromListMH hash xs <> fromListMH hash ys
+++ OK, passed 100 tests.
-}
fromListMH :: (a -> MultisetHash) -> [a] -> MultisetHash
fromListMH :: forall a. (a -> MultisetHash) -> [a] -> MultisetHash
fromListMH = (a -> MultisetHash) -> [a] -> MultisetHash
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap'
{-# INLINE fromListMH #-}