{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
--------------------------------------------------------------------
-- |
-- Copyright :  (c) Edward Kmett 2013
-- License   :  BSD3
-- Maintainer:  Edward Kmett <ekmett@gmail.com>
-- Stability :  experimental
-- Portability: non-portable
--
--------------------------------------------------------------------
module Data.Approximate.Mass
  ( Mass(..)
  , (|?), (&?), (^?)
  ) where

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Control.Comonad
import Control.DeepSeq
import Control.Monad
import Data.Binary as Binary
import Data.Bytes.Serial as Bytes
import Data.Copointed
import Data.Data
#if __GLASGOW_HASKELL__ < 710
import Data.Foldable
#endif
import Data.Functor.Bind
import Data.Functor.Extend
import Data.Hashable (Hashable(..))
import Data.Hashable.Lifted (Hashable1(..))
import Data.Pointed
import Data.SafeCopy
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup
#endif
import Data.Serialize as Serialize
#if __GLASGOW_HASKELL__ < 710
import Data.Traversable
#endif
import Data.Vector.Generic as G
import Data.Vector.Generic.Mutable as M
import Data.Vector.Unboxed as U
import GHC.Generics
import Numeric.Log

-- $setup
-- >>> import Control.Monad (replicateM)

-- | A quantity with a lower-bound on its probability mass. This represents
-- a 'probable value' as a 'Monad' that you can use to calculate progressively
-- less likely consequences.
--
-- /NB:/ These probabilities are all stored in the log domain. This enables us
-- to retain accuracy despite very long multiplication chains. We never add
-- these probabilities so the additional overhead of working in the log domain
-- is never incurred, except on transitioning in and out.
--
-- This is most useful for discrete types, such as
-- small 'Integral' instances or a 'Bounded' 'Enum' like
-- 'Bool'.
--
-- Also note that @('&?')@ and @('|?')@ are able to use knowledge about the
-- function to get better precision on their results than naively using
-- @'liftA2' ('&&')@
--
-- >>> let z = Mass 0.875 'z'
-- >>> replicateM 3 z
-- Mass 0.669921875 "zzz"
--
data Mass a = Mass {-# UNPACK #-} !(Log Double) a
  deriving (Mass a -> Mass a -> Bool
(Mass a -> Mass a -> Bool)
-> (Mass a -> Mass a -> Bool) -> Eq (Mass a)
forall a. Eq a => Mass a -> Mass a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mass a -> Mass a -> Bool
$c/= :: forall a. Eq a => Mass a -> Mass a -> Bool
== :: Mass a -> Mass a -> Bool
$c== :: forall a. Eq a => Mass a -> Mass a -> Bool
Eq,Eq (Mass a)
Eq (Mass a)
-> (Mass a -> Mass a -> Ordering)
-> (Mass a -> Mass a -> Bool)
-> (Mass a -> Mass a -> Bool)
-> (Mass a -> Mass a -> Bool)
-> (Mass a -> Mass a -> Bool)
-> (Mass a -> Mass a -> Mass a)
-> (Mass a -> Mass a -> Mass a)
-> Ord (Mass a)
Mass a -> Mass a -> Bool
Mass a -> Mass a -> Ordering
Mass a -> Mass a -> Mass a
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 a. Ord a => Eq (Mass a)
forall a. Ord a => Mass a -> Mass a -> Bool
forall a. Ord a => Mass a -> Mass a -> Ordering
forall a. Ord a => Mass a -> Mass a -> Mass a
min :: Mass a -> Mass a -> Mass a
$cmin :: forall a. Ord a => Mass a -> Mass a -> Mass a
max :: Mass a -> Mass a -> Mass a
$cmax :: forall a. Ord a => Mass a -> Mass a -> Mass a
>= :: Mass a -> Mass a -> Bool
$c>= :: forall a. Ord a => Mass a -> Mass a -> Bool
> :: Mass a -> Mass a -> Bool
$c> :: forall a. Ord a => Mass a -> Mass a -> Bool
<= :: Mass a -> Mass a -> Bool
$c<= :: forall a. Ord a => Mass a -> Mass a -> Bool
< :: Mass a -> Mass a -> Bool
$c< :: forall a. Ord a => Mass a -> Mass a -> Bool
compare :: Mass a -> Mass a -> Ordering
$ccompare :: forall a. Ord a => Mass a -> Mass a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Mass a)
Ord,Int -> Mass a -> ShowS
[Mass a] -> ShowS
Mass a -> String
(Int -> Mass a -> ShowS)
-> (Mass a -> String) -> ([Mass a] -> ShowS) -> Show (Mass a)
forall a. Show a => Int -> Mass a -> ShowS
forall a. Show a => [Mass a] -> ShowS
forall a. Show a => Mass a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mass a] -> ShowS
$cshowList :: forall a. Show a => [Mass a] -> ShowS
show :: Mass a -> String
$cshow :: forall a. Show a => Mass a -> String
showsPrec :: Int -> Mass a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Mass a -> ShowS
Show,ReadPrec [Mass a]
ReadPrec (Mass a)
Int -> ReadS (Mass a)
ReadS [Mass a]
(Int -> ReadS (Mass a))
-> ReadS [Mass a]
-> ReadPrec (Mass a)
-> ReadPrec [Mass a]
-> Read (Mass a)
forall a. Read a => ReadPrec [Mass a]
forall a. Read a => ReadPrec (Mass a)
forall a. Read a => Int -> ReadS (Mass a)
forall a. Read a => ReadS [Mass a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Mass a]
$creadListPrec :: forall a. Read a => ReadPrec [Mass a]
readPrec :: ReadPrec (Mass a)
$creadPrec :: forall a. Read a => ReadPrec (Mass a)
readList :: ReadS [Mass a]
$creadList :: forall a. Read a => ReadS [Mass a]
readsPrec :: Int -> ReadS (Mass a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Mass a)
Read,Typeable,Typeable (Mass a)
DataType
Constr
Typeable (Mass a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Mass a -> c (Mass a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Mass a))
-> (Mass a -> Constr)
-> (Mass a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Mass a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Mass a)))
-> ((forall b. Data b => b -> b) -> Mass a -> Mass a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Mass a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Mass a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Mass a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Mass a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Mass a -> m (Mass a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Mass a -> m (Mass a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Mass a -> m (Mass a))
-> Data (Mass a)
Mass a -> DataType
Mass a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Mass a))
(forall b. Data b => b -> b) -> Mass a -> Mass a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mass a -> c (Mass a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Mass a)
forall a. Data a => Typeable (Mass a)
forall a. Data a => Mass a -> DataType
forall a. Data a => Mass a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> Mass a -> Mass a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Mass a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> Mass a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mass a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mass a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Mass a -> m (Mass a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Mass a -> m (Mass a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Mass a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mass a -> c (Mass a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Mass a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Mass a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Mass a -> u
forall u. (forall d. Data d => d -> u) -> Mass a -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mass a -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mass a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Mass a -> m (Mass a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mass a -> m (Mass a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Mass a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mass a -> c (Mass a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Mass a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Mass a))
$cMass :: Constr
$tMass :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Mass a -> m (Mass a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Mass a -> m (Mass a)
gmapMp :: (forall d. Data d => d -> m d) -> Mass a -> m (Mass a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Mass a -> m (Mass a)
gmapM :: (forall d. Data d => d -> m d) -> Mass a -> m (Mass a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Mass a -> m (Mass a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Mass a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Mass a -> u
gmapQ :: (forall d. Data d => d -> u) -> Mass a -> [u]
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Mass a -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mass a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mass a -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mass a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mass a -> r
gmapT :: (forall b. Data b => b -> b) -> Mass a -> Mass a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Mass a -> Mass a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Mass a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Mass a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Mass a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Mass a))
dataTypeOf :: Mass a -> DataType
$cdataTypeOf :: forall a. Data a => Mass a -> DataType
toConstr :: Mass a -> Constr
$ctoConstr :: forall a. Data a => Mass a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Mass a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Mass a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mass a -> c (Mass a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mass a -> c (Mass a)
$cp1Data :: forall a. Data a => Typeable (Mass a)
Data,(forall x. Mass a -> Rep (Mass a) x)
-> (forall x. Rep (Mass a) x -> Mass a) -> Generic (Mass a)
forall x. Rep (Mass a) x -> Mass a
forall x. Mass a -> Rep (Mass a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Mass a) x -> Mass a
forall a x. Mass a -> Rep (Mass a) x
$cto :: forall a x. Rep (Mass a) x -> Mass a
$cfrom :: forall a x. Mass a -> Rep (Mass a) x
Generic)

instance Binary a => Binary (Mass a) where
  put :: Mass a -> Put
put (Mass Log Double
p a
a) = Log Double -> Put
forall t. Binary t => t -> Put
Binary.put Log Double
p Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Put
forall t. Binary t => t -> Put
Binary.put a
a
  get :: Get (Mass a)
get = Log Double -> a -> Mass a
forall a. Log Double -> a -> Mass a
Mass (Log Double -> a -> Mass a)
-> Get (Log Double) -> Get (a -> Mass a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Log Double)
forall t. Binary t => Get t
Binary.get Get (a -> Mass a) -> Get a -> Get (Mass a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get a
forall t. Binary t => Get t
Binary.get

instance Serialize a => Serialize (Mass a) where
  put :: Putter (Mass a)
put (Mass Log Double
p a
a) = Putter (Log Double)
forall t. Serialize t => Putter t
Serialize.put Log Double
p PutM () -> PutM () -> PutM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter a
forall t. Serialize t => Putter t
Serialize.put a
a
  get :: Get (Mass a)
get = Log Double -> a -> Mass a
forall a. Log Double -> a -> Mass a
Mass (Log Double -> a -> Mass a)
-> Get (Log Double) -> Get (a -> Mass a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Log Double)
forall t. Serialize t => Get t
Serialize.get Get (a -> Mass a) -> Get a -> Get (Mass a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get a
forall t. Serialize t => Get t
Serialize.get

instance Serialize a => SafeCopy (Mass a) where
  -- safecopy-0.10.0 changed its default implementations for these methods.
  -- The implementations below are copied from the pre-0.10.0 defaults.
  errorTypeName :: Proxy (Mass a) -> String
errorTypeName Proxy (Mass a)
_ = String
"<unknown type>"
  getCopy :: Contained (Get (Mass a))
getCopy = Get (Mass a) -> Contained (Get (Mass a))
forall a. a -> Contained a
contain Get (Mass a)
forall t. Serialize t => Get t
Serialize.get
  putCopy :: Mass a -> Contained (PutM ())
putCopy = PutM () -> Contained (PutM ())
forall a. a -> Contained a
contain (PutM () -> Contained (PutM ()))
-> (Mass a -> PutM ()) -> Mass a -> Contained (PutM ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mass a -> PutM ()
forall t. Serialize t => Putter t
Serialize.put

instance Hashable a => Hashable (Mass a)
instance Hashable1 Mass where
    liftHashWithSalt :: (Int -> a -> Int) -> Int -> Mass a -> Int
liftHashWithSalt Int -> a -> Int
h Int
s (Mass Log Double
m a
x) = Int -> Log Double -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s Log Double
m Int -> a -> Int
`h` a
x

instance Serial1 Mass where
  serializeWith :: (a -> m ()) -> Mass a -> m ()
serializeWith a -> m ()
f (Mass Log Double
p a
a) = Log Double -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Log Double
p m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m ()
f a
a
  deserializeWith :: m a -> m (Mass a)
deserializeWith m a
m = Log Double -> a -> Mass a
forall a. Log Double -> a -> Mass a
Mass (Log Double -> a -> Mass a) -> m (Log Double) -> m (a -> Mass a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Log Double)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize m (a -> Mass a) -> m a -> m (Mass a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a
m

instance Serial a => Serial (Mass a) where
  serialize :: Mass a -> m ()
serialize (Mass Log Double
p a
a) = Log Double -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Log Double
p m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize a
a
  deserialize :: m (Mass a)
deserialize = Log Double -> a -> Mass a
forall a. Log Double -> a -> Mass a
Mass (Log Double -> a -> Mass a) -> m (Log Double) -> m (a -> Mass a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Log Double)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize m (a -> Mass a) -> m a -> m (Mass a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Functor Mass where
  fmap :: (a -> b) -> Mass a -> Mass b
fmap a -> b
f (Mass Log Double
p a
a) = Log Double -> b -> Mass b
forall a. Log Double -> a -> Mass a
Mass Log Double
p (a -> b
f a
a)
  {-# INLINE fmap #-}

instance Foldable Mass where
  foldMap :: (a -> m) -> Mass a -> m
foldMap a -> m
f (Mass Log Double
_ a
a) = a -> m
f a
a
  {-# INLINE foldMap #-}

newtype instance U.MVector s (Mass a) = MV_Mass (U.MVector s (Log Double,a))
newtype instance U.Vector (Mass a) = V_Mass (U.Vector (Log Double,a))

instance Unbox a => M.MVector U.MVector (Mass a) where
  basicLength :: MVector s (Mass a) -> Int
basicLength (MV_Mass v) = MVector s (Log Double, a) -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
M.basicLength MVector s (Log Double, a)
v
  {-# INLINE basicLength #-}
  basicUnsafeSlice :: Int -> Int -> MVector s (Mass a) -> MVector s (Mass a)
basicUnsafeSlice Int
i Int
n (MV_Mass v) = MVector s (Log Double, a) -> MVector s (Mass a)
forall s a. MVector s (Log Double, a) -> MVector s (Mass a)
MV_Mass (MVector s (Log Double, a) -> MVector s (Mass a))
-> MVector s (Log Double, a) -> MVector s (Mass a)
forall a b. (a -> b) -> a -> b
$ Int
-> Int -> MVector s (Log Double, a) -> MVector s (Log Double, a)
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
M.basicUnsafeSlice Int
i Int
n MVector s (Log Double, a)
v
  {-# INLINE basicUnsafeSlice #-}
  basicOverlaps :: MVector s (Mass a) -> MVector s (Mass a) -> Bool
basicOverlaps (MV_Mass v1) (MV_Mass v2) = MVector s (Log Double, a) -> MVector s (Log Double, a) -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
M.basicOverlaps MVector s (Log Double, a)
v1 MVector s (Log Double, a)
v2
  {-# INLINE basicOverlaps #-}
  basicUnsafeNew :: Int -> m (MVector (PrimState m) (Mass a))
basicUnsafeNew Int
n = MVector (PrimState m) (Log Double, a)
-> MVector (PrimState m) (Mass a)
forall s a. MVector s (Log Double, a) -> MVector s (Mass a)
MV_Mass (MVector (PrimState m) (Log Double, a)
 -> MVector (PrimState m) (Mass a))
-> m (MVector (PrimState m) (Log Double, a))
-> m (MVector (PrimState m) (Mass a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Int -> m (MVector (PrimState m) (Log Double, a))
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
M.basicUnsafeNew Int
n
  {-# INLINE basicUnsafeNew #-}
  basicUnsafeReplicate :: Int -> Mass a -> m (MVector (PrimState m) (Mass a))
basicUnsafeReplicate Int
n (Mass Log Double
p a
a) = MVector (PrimState m) (Log Double, a)
-> MVector (PrimState m) (Mass a)
forall s a. MVector s (Log Double, a) -> MVector s (Mass a)
MV_Mass (MVector (PrimState m) (Log Double, a)
 -> MVector (PrimState m) (Mass a))
-> m (MVector (PrimState m) (Log Double, a))
-> m (MVector (PrimState m) (Mass a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Int -> (Log Double, a) -> m (MVector (PrimState m) (Log Double, a))
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
M.basicUnsafeReplicate Int
n (Log Double
p,a
a)
  {-# INLINE basicUnsafeReplicate #-}
  basicUnsafeRead :: MVector (PrimState m) (Mass a) -> Int -> m (Mass a)
basicUnsafeRead (MV_Mass v) Int
i = (Log Double -> a -> Mass a) -> (Log Double, a) -> Mass a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Log Double -> a -> Mass a
forall a. Log Double -> a -> Mass a
Mass ((Log Double, a) -> Mass a) -> m (Log Double, a) -> m (Mass a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) (Log Double, a) -> Int -> m (Log Double, a)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
M.basicUnsafeRead MVector (PrimState m) (Log Double, a)
v Int
i
  {-# INLINE basicUnsafeRead #-}
  basicUnsafeWrite :: MVector (PrimState m) (Mass a) -> Int -> Mass a -> m ()
basicUnsafeWrite (MV_Mass v) Int
i (Mass Log Double
p a
a) = MVector (PrimState m) (Log Double, a)
-> Int -> (Log Double, a) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
M.basicUnsafeWrite MVector (PrimState m) (Log Double, a)
v Int
i (Log Double
p,a
a)
  {-# INLINE basicUnsafeWrite #-}
  basicClear :: MVector (PrimState m) (Mass a) -> m ()
basicClear (MV_Mass v) = MVector (PrimState m) (Log Double, a) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
M.basicClear MVector (PrimState m) (Log Double, a)
v
  {-# INLINE basicClear #-}
  basicSet :: MVector (PrimState m) (Mass a) -> Mass a -> m ()
basicSet (MV_Mass v) (Mass Log Double
p a
a) = MVector (PrimState m) (Log Double, a) -> (Log Double, a) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
M.basicSet MVector (PrimState m) (Log Double, a)
v (Log Double
p,a
a)
  {-# INLINE basicSet #-}
  basicUnsafeCopy :: MVector (PrimState m) (Mass a)
-> MVector (PrimState m) (Mass a) -> m ()
basicUnsafeCopy (MV_Mass v1) (MV_Mass v2) = MVector (PrimState m) (Log Double, a)
-> MVector (PrimState m) (Log Double, a) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
M.basicUnsafeCopy MVector (PrimState m) (Log Double, a)
v1 MVector (PrimState m) (Log Double, a)
v2
  {-# INLINE basicUnsafeCopy #-}
  basicUnsafeMove :: MVector (PrimState m) (Mass a)
-> MVector (PrimState m) (Mass a) -> m ()
basicUnsafeMove (MV_Mass v1) (MV_Mass v2) = MVector (PrimState m) (Log Double, a)
-> MVector (PrimState m) (Log Double, a) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
M.basicUnsafeMove MVector (PrimState m) (Log Double, a)
v1 MVector (PrimState m) (Log Double, a)
v2
  {-# INLINE basicUnsafeMove #-}
  basicUnsafeGrow :: MVector (PrimState m) (Mass a)
-> Int -> m (MVector (PrimState m) (Mass a))
basicUnsafeGrow (MV_Mass v) Int
n = MVector (PrimState m) (Log Double, a)
-> MVector (PrimState m) (Mass a)
forall s a. MVector s (Log Double, a) -> MVector s (Mass a)
MV_Mass (MVector (PrimState m) (Log Double, a)
 -> MVector (PrimState m) (Mass a))
-> m (MVector (PrimState m) (Log Double, a))
-> m (MVector (PrimState m) (Mass a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) (Log Double, a)
-> Int -> m (MVector (PrimState m) (Log Double, a))
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
M.basicUnsafeGrow MVector (PrimState m) (Log Double, a)
v Int
n
  {-# INLINE basicUnsafeGrow #-}
#if MIN_VERSION_vector(0,11,0)
  basicInitialize :: MVector (PrimState m) (Mass a) -> m ()
basicInitialize (MV_Mass v) = MVector (PrimState m) (Log Double, a) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
M.basicInitialize MVector (PrimState m) (Log Double, a)
v
  {-# INLINE basicInitialize #-}
#endif

instance Unbox a => G.Vector U.Vector (Mass a) where
  basicUnsafeFreeze :: Mutable Vector (PrimState m) (Mass a) -> m (Vector (Mass a))
basicUnsafeFreeze (MV_Mass v) = Vector (Log Double, a) -> Vector (Mass a)
forall a. Vector (Log Double, a) -> Vector (Mass a)
V_Mass (Vector (Log Double, a) -> Vector (Mass a))
-> m (Vector (Log Double, a)) -> m (Vector (Mass a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Mutable Vector (PrimState m) (Log Double, a)
-> m (Vector (Log Double, a))
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
G.basicUnsafeFreeze MVector (PrimState m) (Log Double, a)
Mutable Vector (PrimState m) (Log Double, a)
v
  {-# INLINE basicUnsafeFreeze #-}
  basicUnsafeThaw :: Vector (Mass a) -> m (Mutable Vector (PrimState m) (Mass a))
basicUnsafeThaw (V_Mass v) = MVector (PrimState m) (Log Double, a)
-> MVector (PrimState m) (Mass a)
forall s a. MVector s (Log Double, a) -> MVector s (Mass a)
MV_Mass (MVector (PrimState m) (Log Double, a)
 -> MVector (PrimState m) (Mass a))
-> m (MVector (PrimState m) (Log Double, a))
-> m (MVector (PrimState m) (Mass a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Vector (Log Double, a)
-> m (Mutable Vector (PrimState m) (Log Double, a))
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
G.basicUnsafeThaw Vector (Log Double, a)
v
  {-# INLINE basicUnsafeThaw #-}
  basicLength :: Vector (Mass a) -> Int
basicLength (V_Mass v) = Vector (Log Double, a) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.basicLength Vector (Log Double, a)
v
  {-# INLINE basicLength #-}
  basicUnsafeSlice :: Int -> Int -> Vector (Mass a) -> Vector (Mass a)
basicUnsafeSlice Int
i Int
n (V_Mass v) = Vector (Log Double, a) -> Vector (Mass a)
forall a. Vector (Log Double, a) -> Vector (Mass a)
V_Mass (Vector (Log Double, a) -> Vector (Mass a))
-> Vector (Log Double, a) -> Vector (Mass a)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector (Log Double, a) -> Vector (Log Double, a)
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
G.basicUnsafeSlice Int
i Int
n Vector (Log Double, a)
v
  {-# INLINE basicUnsafeSlice #-}
  basicUnsafeIndexM :: Vector (Mass a) -> Int -> m (Mass a)
basicUnsafeIndexM (V_Mass v) Int
i
                = (Log Double -> a -> Mass a) -> (Log Double, a) -> Mass a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Log Double -> a -> Mass a
forall a. Log Double -> a -> Mass a
Mass ((Log Double, a) -> Mass a) -> m (Log Double, a) -> m (Mass a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Vector (Log Double, a) -> Int -> m (Log Double, a)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
G.basicUnsafeIndexM Vector (Log Double, a)
v Int
i
  {-# INLINE basicUnsafeIndexM #-}
  basicUnsafeCopy :: Mutable Vector (PrimState m) (Mass a) -> Vector (Mass a) -> m ()
basicUnsafeCopy (MV_Mass mv) (V_Mass v) = Mutable Vector (PrimState m) (Log Double, a)
-> Vector (Log Double, a) -> m ()
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
G.basicUnsafeCopy MVector (PrimState m) (Log Double, a)
Mutable Vector (PrimState m) (Log Double, a)
mv Vector (Log Double, a)
v
  {-# INLINE basicUnsafeCopy #-}
  elemseq :: Vector (Mass a) -> Mass a -> b -> b
elemseq Vector (Mass a)
_ (Mass Log Double
p a
a) b
z
     = Vector (Log Double) -> Log Double -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (Vector (Log Double)
forall a. HasCallStack => a
undefined :: U.Vector (Log Double)) Log Double
p
     (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Vector a -> a -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (forall a. Vector a
forall a. HasCallStack => a
undefined :: U.Vector a) a
a b
z
  {-# INLINE elemseq #-}

instance NFData a => NFData (Mass a) where
  rnf :: Mass a -> ()
rnf (Mass Log Double
_ a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
`seq` ()
  {-# INLINE rnf #-}

instance Traversable Mass where
  traverse :: (a -> f b) -> Mass a -> f (Mass b)
traverse a -> f b
f (Mass Log Double
p a
a) = Log Double -> b -> Mass b
forall a. Log Double -> a -> Mass a
Mass Log Double
p (b -> Mass b) -> f b -> f (Mass b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
  {-# INLINE traverse #-}

instance Apply Mass where
  <.> :: Mass (a -> b) -> Mass a -> Mass b
(<.>) = Mass (a -> b) -> Mass a -> Mass b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
  {-# INLINE (<.>) #-}

instance Pointed Mass where
  point :: a -> Mass a
point = Log Double -> a -> Mass a
forall a. Log Double -> a -> Mass a
Mass Log Double
1
  {-# INLINE point #-}

instance Copointed Mass where
  copoint :: Mass a -> a
copoint (Mass Log Double
_ a
a) = a
a
  {-# INLINE copoint #-}

instance Applicative Mass where
  pure :: a -> Mass a
pure = Log Double -> a -> Mass a
forall a. Log Double -> a -> Mass a
Mass Log Double
1
  {-# INLINE pure #-}
  Mass Log Double
p a -> b
f <*> :: Mass (a -> b) -> Mass a -> Mass b
<*> Mass Log Double
q a
a = Log Double -> b -> Mass b
forall a. Log Double -> a -> Mass a
Mass (Log Double
p Log Double -> Log Double -> Log Double
forall a. Num a => a -> a -> a
* Log Double
q) (a -> b
f a
a)
  {-# INLINE (<*>) #-}

instance Monoid a => Monoid (Mass a) where
  mempty :: Mass a
mempty = Log Double -> a -> Mass a
forall a. Log Double -> a -> Mass a
Mass Log Double
1 a
forall a. Monoid a => a
mempty
  {-# INLINE mempty #-}
  mappend :: Mass a -> Mass a -> Mass a
mappend (Mass Log Double
p a
a) (Mass Log Double
q a
b) = Log Double -> a -> Mass a
forall a. Log Double -> a -> Mass a
Mass (Log Double
p Log Double -> Log Double -> Log Double
forall a. Num a => a -> a -> a
* Log Double
q) (a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
a a
b)
  {-# INLINE mappend #-}

instance Semigroup a => Semigroup (Mass a) where
  Mass Log Double
p a
a <> :: Mass a -> Mass a -> Mass a
<> Mass Log Double
q a
b = Log Double -> a -> Mass a
forall a. Log Double -> a -> Mass a
Mass (Log Double
p Log Double -> Log Double -> Log Double
forall a. Num a => a -> a -> a
* Log Double
q) (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)
  {-# INLINE (<>) #-}

instance Bind Mass where
  Mass Log Double
p a
a >>- :: Mass a -> (a -> Mass b) -> Mass b
>>- a -> Mass b
f = case a -> Mass b
f a
a of
    Mass Log Double
q b
b -> Log Double -> b -> Mass b
forall a. Log Double -> a -> Mass a
Mass (Log Double
p Log Double -> Log Double -> Log Double
forall a. Num a => a -> a -> a
* Log Double
q) b
b
  {-# INLINE (>>-) #-}

instance Monad Mass where
  return :: a -> Mass a
return = a -> Mass a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE return #-}
  Mass Log Double
p a
a >>= :: Mass a -> (a -> Mass b) -> Mass b
>>= a -> Mass b
f = case a -> Mass b
f a
a of
    Mass Log Double
q b
b -> Log Double -> b -> Mass b
forall a. Log Double -> a -> Mass a
Mass (Log Double
p Log Double -> Log Double -> Log Double
forall a. Num a => a -> a -> a
* Log Double
q) b
b
  {-# INLINE (>>=) #-}

instance Extend Mass where
  duplicated :: Mass a -> Mass (Mass a)
duplicated (Mass Log Double
n a
a) = Log Double -> Mass a -> Mass (Mass a)
forall a. Log Double -> a -> Mass a
Mass Log Double
n (Log Double -> a -> Mass a
forall a. Log Double -> a -> Mass a
Mass Log Double
n a
a)
  {-# INLINE duplicated #-}
  extended :: (Mass a -> b) -> Mass a -> Mass b
extended Mass a -> b
f w :: Mass a
w@(Mass Log Double
n a
_) = Log Double -> b -> Mass b
forall a. Log Double -> a -> Mass a
Mass Log Double
n (Mass a -> b
f Mass a
w)
  {-# INLINE extended #-}

instance Comonad Mass where
  extract :: Mass a -> a
extract (Mass Log Double
_ a
a) = a
a
  {-# INLINE extract #-}
  duplicate :: Mass a -> Mass (Mass a)
duplicate (Mass Log Double
n a
a) = Log Double -> Mass a -> Mass (Mass a)
forall a. Log Double -> a -> Mass a
Mass Log Double
n (Log Double -> a -> Mass a
forall a. Log Double -> a -> Mass a
Mass Log Double
n a
a)
  {-# INLINE duplicate #-}
  extend :: (Mass a -> b) -> Mass a -> Mass b
extend Mass a -> b
f w :: Mass a
w@(Mass Log Double
n a
_) = Log Double -> b -> Mass b
forall a. Log Double -> a -> Mass a
Mass Log Double
n (Mass a -> b
f Mass a
w)
  {-# INLINE extend #-}

instance ComonadApply Mass where
  <@> :: Mass (a -> b) -> Mass a -> Mass b
(<@>)  = Mass (a -> b) -> Mass a -> Mass b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
  {-# INLINE (<@>) #-}

infixl 6 ^?
infixr 3 &?
infixr 2 |?

-- | Calculate the logical @and@ of two booleans with confidence lower bounds.
(&?) :: Mass Bool -> Mass Bool -> Mass Bool
Mass Log Double
p Bool
False &? :: Mass Bool -> Mass Bool -> Mass Bool
&? Mass Log Double
q Bool
False = Log Double -> Bool -> Mass Bool
forall a. Log Double -> a -> Mass a
Mass (Log Double -> Log Double -> Log Double
forall a. Ord a => a -> a -> a
max Log Double
p Log Double
q) Bool
False
Mass Log Double
p Bool
False &? Mass Log Double
_ Bool
True  = Log Double -> Bool -> Mass Bool
forall a. Log Double -> a -> Mass a
Mass Log Double
p Bool
False
Mass Log Double
_ Bool
True  &? Mass Log Double
q Bool
False = Log Double -> Bool -> Mass Bool
forall a. Log Double -> a -> Mass a
Mass Log Double
q Bool
False
Mass Log Double
p Bool
True  &? Mass Log Double
q Bool
True  = Log Double -> Bool -> Mass Bool
forall a. Log Double -> a -> Mass a
Mass (Log Double
p Log Double -> Log Double -> Log Double
forall a. Num a => a -> a -> a
* Log Double
q) Bool
True
{-# INLINE (&?) #-}

-- | Calculate the logical @or@ of two booleans with confidence lower bounds.
(|?) :: Mass Bool -> Mass Bool -> Mass Bool
Mass Log Double
p Bool
False |? :: Mass Bool -> Mass Bool -> Mass Bool
|? Mass Log Double
q Bool
False = Log Double -> Bool -> Mass Bool
forall a. Log Double -> a -> Mass a
Mass (Log Double
p Log Double -> Log Double -> Log Double
forall a. Num a => a -> a -> a
* Log Double
q) Bool
False
Mass Log Double
_ Bool
False |? Mass Log Double
q Bool
True  = Log Double -> Bool -> Mass Bool
forall a. Log Double -> a -> Mass a
Mass Log Double
q Bool
True
Mass Log Double
p Bool
True  |? Mass Log Double
_ Bool
False = Log Double -> Bool -> Mass Bool
forall a. Log Double -> a -> Mass a
Mass Log Double
p Bool
True
Mass Log Double
p Bool
True  |? Mass Log Double
q Bool
True  = Log Double -> Bool -> Mass Bool
forall a. Log Double -> a -> Mass a
Mass (Log Double -> Log Double -> Log Double
forall a. Ord a => a -> a -> a
max Log Double
p Log Double
q) Bool
True
{-# INLINE (|?) #-}

-- | Calculate the exclusive @or@ of two booleans with confidence lower bounds.
(^?) :: Mass Bool -> Mass Bool -> Mass Bool
Mass Log Double
p Bool
a ^? :: Mass Bool -> Mass Bool -> Mass Bool
^? Mass Log Double
q Bool
b = Log Double -> Bool -> Mass Bool
forall a. Log Double -> a -> Mass a
Mass (Log Double
p Log Double -> Log Double -> Log Double
forall a. Num a => a -> a -> a
* Log Double
q) (Bool -> Bool -> Bool
xor Bool
a Bool
b) where
  xor :: Bool -> Bool -> Bool
xor Bool
True  Bool
True  = Bool
False
  xor Bool
False Bool
True  = Bool
True
  xor Bool
True  Bool
False = Bool
True
  xor Bool
False Bool
False = Bool
False
  {-# INLINE xor #-}
{-# INLINE (^?) #-}