{-# 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

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
import Data.Functor.Bind
import Data.Functor.Classes
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
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as M
import qualified Data.Vector.Unboxed as U
import Data.Vector.Unboxed (Unbox)
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 (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, Typeable 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 Eq1 Mass where
    liftEq :: (a -> b -> Bool) -> Mass a -> Mass b -> Bool
liftEq a -> b -> Bool
eq (Mass Log Double
p a
a) (Mass Log Double
q b
b) = Log Double
p Log Double -> Log Double -> Bool
forall a. Eq a => a -> a -> Bool
== Log Double
q Bool -> Bool -> Bool
&& a -> b -> Bool
eq a
a b
b

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 #-}
  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 #-}

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 #-}
#if !(MIN_VERSION_base(4,11,0))
  mappend (Mass p a) (Mass q b) = Mass (p * q) (mappend a b)
  {-# INLINE mappend #-}
#endif

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 (^?) #-}