{-# OPTIONS_GHC -fplugin=GHC.TypeLits.KnownNat.Solver -fplugin=GHC.TypeLits.Normalise -fconstraint-solver-iterations=10 #-}
{-# LANGUAGE UndecidableInstances,TypeApplications #-}

-- | Various instances of statistical manifolds, with a focus on exponential
-- families. In the documentation we use \(X\) to indicate a random variable
-- with the distribution being documented.
module Goal.Probability.Distributions
    ( -- * Univariate
      Bernoulli
    , Binomial
    , Categorical
    , categoricalWeights
    , Poisson
    , VonMises
    -- * Multivariate
    , Dirichlet
    -- * LocationShape
    , LocationShape (LocationShape)
    ) where

-- Package --

import Goal.Core
import Goal.Probability.Statistical
import Goal.Probability.ExponentialFamily

import Goal.Geometry

import qualified Goal.Core.Vector.Storable as S
import qualified Goal.Core.Vector.Boxed as B
import qualified Goal.Core.Vector.Generic as G

import qualified Numeric.GSL.Special.Bessel as GSL
import qualified Numeric.GSL.Special.Gamma as GSL
import qualified Numeric.GSL.Special.Psi as GSL
import qualified System.Random.MWC as R
import qualified System.Random.MWC.Distributions as R

import Foreign.Storable

-- Location Shape --

-- | A 'LocationShape' 'Manifold' is a 'Product' of some location 'Manifold' and
-- some shape 'Manifold'.
newtype LocationShape l s = LocationShape (l,s)

deriving instance (Manifold l, Manifold s) => Manifold (LocationShape l s)
deriving instance (Manifold l, Manifold s) => Product (LocationShape l s)

-- Uniform --

-- Bernoulli Distribution --

-- | The Bernoulli family with 'Bool'ean 'SamplePoint's. (because why not). The source coordinate is \(P(X = True)\).
data Bernoulli

-- Binomial Distribution --

-- | A distribution over the sum of 'True' realizations of @n@ 'Bernoulli'
-- random variables. The 'Source' coordinate is the probability of \(P(X = True)\)
-- for each 'Bernoulli' random variable.
data Binomial (n :: Nat)

-- | Returns the number of trials used to define this binomial distribution.
binomialTrials :: forall c n. KnownNat n => Point c (Binomial n) -> Int
binomialTrials :: Point c (Binomial n) -> Int
binomialTrials Point c (Binomial n)
_ = Proxy n -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
natValInt (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)

-- | Returns the number of trials used to define this binomial distribution.
binomialSampleSpace :: forall n . KnownNat n => Proxy (Binomial n) -> Int
binomialSampleSpace :: Proxy (Binomial n) -> Int
binomialSampleSpace Proxy (Binomial n)
_ = Proxy n -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
natValInt (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)

-- Categorical Distribution --

-- | A 'Categorical' distribution where the probability of the first category
-- \(P(X = 0)\) is given by the normalization constraint.
data Categorical (n :: Nat)

-- | Takes a weighted list of elements representing a probability mass function, and
-- returns a sample from the Categorical distribution.
sampleCategorical :: KnownNat n => S.Vector n Double -> Random Int
sampleCategorical :: Vector n Double -> Random Int
sampleCategorical Vector n Double
ps = do
    let ps' :: Vector n Double
ps' = (Double -> Double -> Double)
-> Double -> Vector n Double -> Vector n Double
forall a b (n :: Nat).
(Storable a, Storable b) =>
(a -> b -> a) -> a -> Vector n b -> Vector n a
S.postscanl' Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) Double
0 Vector n Double
ps
    Double
p <- (forall s. Gen s -> ST s Double) -> Random Double
forall a. (forall s. Gen s -> ST s a) -> Random a
Random forall s. Gen s -> ST s Double
forall a (m :: Type -> Type).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
R.uniform
    let midx :: Maybe Int
midx = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Int) -> (Finite n -> Int) -> Finite n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Finite n -> Int
forall (n :: Nat). KnownNat n => Finite n -> Int
finiteInt (Finite n -> Int) -> Maybe (Finite n) -> Maybe Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Double -> Bool) -> Vector n Double -> Maybe (Finite n)
forall a (n :: Nat).
Storable a =>
(a -> Bool) -> Vector n a -> Maybe (Finite n)
S.findIndex (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
p) Vector n Double
ps'
    Int -> Random Int
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Int -> Random Int) -> Int -> Random Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
midx

-- | Returns the probabilities over the whole sample space \((0 \ldots n)\) of the
-- given categorical distribution.
categoricalWeights
    :: Transition c Source (Categorical n)
    => c # Categorical n
    -> S.Vector (n+1) Double
categoricalWeights :: (c # Categorical n) -> Vector (n + 1) Double
categoricalWeights c # Categorical n
wghts0 =
    let wghts :: Vector (Dimension (Categorical n)) Double
wghts = Point Source (Categorical n)
-> Vector (Dimension (Categorical n)) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates (Point Source (Categorical n)
 -> Vector (Dimension (Categorical n)) Double)
-> Point Source (Categorical n)
-> Vector (Dimension (Categorical n)) Double
forall a b. (a -> b) -> a -> b
$ (c # Categorical n) -> Point Source (Categorical n)
forall c x. Transition c Source x => (c # x) -> Source # x
toSource c # Categorical n
wghts0
     in Double -> Vector n Double -> Vector (1 + n) Double
forall (n :: Nat) a.
Storable a =>
a -> Vector n a -> Vector (1 + n) a
S.cons (Double
1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Vector n Double -> Double
forall a (n :: Nat). (Storable a, Num a) => Vector n a -> a
S.sum Vector n Double
Vector (Dimension (Categorical n)) Double
wghts) Vector n Double
Vector (Dimension (Categorical n)) Double
wghts

-- | A 'Dirichlet' manifold contains distributions over weights of a
-- 'Categorical' distribution.
data Dirichlet (k :: Nat)

-- Poisson Distribution --

-- | Returns a sample from a Poisson distribution with the given rate.
samplePoisson :: Double -> Random Int
samplePoisson :: Double -> Random Int
samplePoisson Double
lmda = (forall s. Gen s -> ST s Double) -> Random Double
forall a. (forall s. Gen s -> ST s a) -> Random a
Random forall s. Gen s -> ST s Double
forall a (m :: Type -> Type).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
R.uniform Random Double -> (Double -> Random Int) -> Random Int
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Double -> Random Int
renew Int
0
    where l :: Double
l = Double -> Double
forall a. Floating a => a -> a
exp (-Double
lmda)
          renew :: Int -> Double -> Random Int
renew Int
k Double
p
            | Double
p Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
l = Int -> Random Int
forall (m :: Type -> Type) a. Monad m => a -> m a
return Int
k
            | Bool
otherwise = do
                Double
u <- (forall s. Gen s -> ST s Double) -> Random Double
forall a. (forall s. Gen s -> ST s a) -> Random a
Random forall s. Gen s -> ST s Double
forall a (m :: Type -> Type).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
R.uniform
                Int -> Double -> Random Int
renew (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Double
pDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
u)

-- | The 'Manifold' of 'Poisson' distributions. The 'Source' coordinate is the
-- rate of the Poisson distribution.
data Poisson

-- von Mises --

-- | The 'Manifold' of 'VonMises' distributions. The 'Source' coordinates are
-- the mean and concentration.
data VonMises


--- Internal ---


binomialLogBaseMeasure0 :: (KnownNat n) => Proxy n -> Proxy (Binomial n) -> Int -> Double
binomialLogBaseMeasure0 :: Proxy n -> Proxy (Binomial n) -> Int -> Double
binomialLogBaseMeasure0 Proxy n
prxyn Proxy (Binomial n)
_ = Int -> Int -> Double
logChoose (Proxy n -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
natValInt Proxy n
prxyn)


--- Instances ---


-- Bernoulli Distribution --

instance Manifold Bernoulli where
    type Dimension Bernoulli = 1

instance Statistical Bernoulli where
    type (SamplePoint Bernoulli) = Bool

instance Discrete Bernoulli where
    type Cardinality Bernoulli = 2
    sampleSpace :: Proxy Bernoulli -> Sample Bernoulli
sampleSpace Proxy Bernoulli
_ = [Bool
SamplePoint Bernoulli
True,Bool
SamplePoint Bernoulli
False]

instance ExponentialFamily Bernoulli where
    logBaseMeasure :: Proxy Bernoulli -> SamplePoint Bernoulli -> Double
logBaseMeasure Proxy Bernoulli
_ SamplePoint Bernoulli
_ = Double
0
    sufficientStatistic :: SamplePoint Bernoulli -> Mean # Bernoulli
sufficientStatistic SamplePoint Bernoulli
True = Vector (Dimension Bernoulli) Double -> Mean # Bernoulli
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector (Dimension Bernoulli) Double -> Mean # Bernoulli)
-> Vector (Dimension Bernoulli) Double -> Mean # Bernoulli
forall a b. (a -> b) -> a -> b
$ Double -> Vector 1 Double
forall a. Storable a => a -> Vector 1 a
S.singleton Double
1
    sufficientStatistic SamplePoint Bernoulli
False = Vector (Dimension Bernoulli) Double -> Mean # Bernoulli
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector (Dimension Bernoulli) Double -> Mean # Bernoulli)
-> Vector (Dimension Bernoulli) Double -> Mean # Bernoulli
forall a b. (a -> b) -> a -> b
$ Double -> Vector 1 Double
forall a. Storable a => a -> Vector 1 a
S.singleton Double
0

type instance PotentialCoordinates Bernoulli = Natural

instance Legendre Bernoulli where
    potential :: (PotentialCoordinates Bernoulli # Bernoulli) -> Double
potential PotentialCoordinates Bernoulli # Bernoulli
p = Double -> Double
forall a. Floating a => a -> a
log (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. Floating a => a -> a
exp (Vector (1 + 0) Double -> Double
forall (n :: Nat) a. Storable a => Vector (1 + n) a -> a
S.head (Vector (1 + 0) Double -> Double)
-> Vector (1 + 0) Double -> Double
forall a b. (a -> b) -> a -> b
$ Point Natural Bernoulli -> Vector (Dimension Bernoulli) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates PotentialCoordinates Bernoulli # Bernoulli
Point Natural Bernoulli
p)

--instance {-# OVERLAPS #-} KnownNat k => Legendre (Replicated k Bernoulli) where
--    potential p = S.sum . S.map (log . (1 +) .  exp) $ coordinates p

instance Transition Natural Mean Bernoulli where
    transition :: Point Natural Bernoulli -> Mean # Bernoulli
transition = Vector 1 Double -> Mean # Bernoulli
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector 1 Double -> Mean # Bernoulli)
-> (Point Natural Bernoulli -> Vector 1 Double)
-> Point Natural Bernoulli
-> Mean # Bernoulli
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double) -> Vector 1 Double -> Vector 1 Double
forall a b (n :: Nat).
(Storable a, Storable b) =>
(a -> b) -> Vector n a -> Vector n b
S.map Double -> Double
forall a. Floating a => a -> a
logistic (Vector 1 Double -> Vector 1 Double)
-> (Point Natural Bernoulli -> Vector 1 Double)
-> Point Natural Bernoulli
-> Vector 1 Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Natural Bernoulli -> Vector 1 Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates

instance DuallyFlat Bernoulli where
    dualPotential :: (PotentialCoordinates Bernoulli #* Bernoulli) -> Double
dualPotential PotentialCoordinates Bernoulli #* Bernoulli
p =
        let eta :: Double
eta = Vector (1 + 0) Double -> Double
forall (n :: Nat) a. Storable a => Vector (1 + n) a -> a
S.head (Vector (1 + 0) Double -> Double)
-> Vector (1 + 0) Double -> Double
forall a b. (a -> b) -> a -> b
$ (Mean # Bernoulli) -> Vector (Dimension Bernoulli) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates PotentialCoordinates Bernoulli #* Bernoulli
Mean # Bernoulli
p
         in Double -> Double
forall a. Floating a => a -> a
logit Double
eta Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
eta Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
forall a. Floating a => a -> a
log (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
eta))

instance Transition Mean Natural Bernoulli where
    transition :: (Mean # Bernoulli) -> Point Natural Bernoulli
transition = Vector 1 Double -> Point Natural Bernoulli
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector 1 Double -> Point Natural Bernoulli)
-> ((Mean # Bernoulli) -> Vector 1 Double)
-> (Mean # Bernoulli)
-> Point Natural Bernoulli
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double) -> Vector 1 Double -> Vector 1 Double
forall a b (n :: Nat).
(Storable a, Storable b) =>
(a -> b) -> Vector n a -> Vector n b
S.map Double -> Double
forall a. Floating a => a -> a
logit (Vector 1 Double -> Vector 1 Double)
-> ((Mean # Bernoulli) -> Vector 1 Double)
-> (Mean # Bernoulli)
-> Vector 1 Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mean # Bernoulli) -> Vector 1 Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates

instance Riemannian Natural Bernoulli where
    metric :: Point Natural Bernoulli -> Natural #* Tensor Bernoulli Bernoulli
metric Point Natural Bernoulli
p =
        let stht :: Double
stht = Double -> Double
forall a. Floating a => a -> a
logistic (Double -> Double)
-> (Vector 1 Double -> Double) -> Vector 1 Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector 1 Double -> Double
forall (n :: Nat) a. Storable a => Vector (1 + n) a -> a
S.head (Vector 1 Double -> Double) -> Vector 1 Double -> Double
forall a b. (a -> b) -> a -> b
$ Point Natural Bernoulli -> Vector (Dimension Bernoulli) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates Point Natural Bernoulli
p
         in Vector 1 Double -> Point Mean (Tensor Bernoulli Bernoulli)
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector 1 Double -> Point Mean (Tensor Bernoulli Bernoulli))
-> (Double -> Vector 1 Double)
-> Double
-> Point Mean (Tensor Bernoulli Bernoulli)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Vector 1 Double
forall a. Storable a => a -> Vector 1 a
S.singleton (Double -> Point Mean (Tensor Bernoulli Bernoulli))
-> Double -> Point Mean (Tensor Bernoulli Bernoulli)
forall a b. (a -> b) -> a -> b
$ Double
stht Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
stht)
    flat :: Point Natural Bernoulli
-> Point Natural Bernoulli -> Natural #* Bernoulli
flat Point Natural Bernoulli
p Point Natural Bernoulli
p' =
        let stht :: Double
stht = Double -> Double
forall a. Floating a => a -> a
logistic (Double -> Double)
-> (Vector 1 Double -> Double) -> Vector 1 Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector 1 Double -> Double
forall (n :: Nat) a. Storable a => Vector (1 + n) a -> a
S.head (Vector 1 Double -> Double) -> Vector 1 Double -> Double
forall a b. (a -> b) -> a -> b
$ Point Natural Bernoulli -> Vector (Dimension Bernoulli) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates Point Natural Bernoulli
p
         in Point Natural Bernoulli -> Mean # Bernoulli
forall x y c d. (Dimension x ~ Dimension y) => (c # x) -> Point d y
breakPoint (Point Natural Bernoulli -> Mean # Bernoulli)
-> Point Natural Bernoulli -> Mean # Bernoulli
forall a b. (a -> b) -> a -> b
$ (Double
stht Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
stht)) Double -> Point Natural Bernoulli -> Point Natural Bernoulli
forall c x. Double -> (c # x) -> c # x
.> Point Natural Bernoulli
p'

instance {-# OVERLAPS #-} KnownNat k => Riemannian Natural (Replicated k Bernoulli) where
    metric :: (Natural # Replicated k Bernoulli)
-> Natural
   #* Tensor (Replicated k Bernoulli) (Replicated k Bernoulli)
metric = [Char]
-> (Natural # Replicated k Bernoulli)
-> Point
     Mean (Tensor (Replicated k Bernoulli) (Replicated k Bernoulli))
forall a. HasCallStack => [Char] -> a
error [Char]
"Do not call metric on a replicated manifold"
    flat :: (Natural # Replicated k Bernoulli)
-> (Natural # Replicated k Bernoulli)
-> Natural #* Replicated k Bernoulli
flat Natural # Replicated k Bernoulli
p Natural # Replicated k Bernoulli
p' =
        let sthts :: Vector k Double
sthts = (Double -> Double) -> Vector k Double -> Vector k Double
forall a b (n :: Nat).
(Storable a, Storable b) =>
(a -> b) -> Vector n a -> Vector n b
S.map ((\Double
stht -> Double
stht Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
stht)) (Double -> Double) -> (Double -> Double) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
logistic) (Vector k Double -> Vector k Double)
-> Vector k Double -> Vector k Double
forall a b. (a -> b) -> a -> b
$ (Natural # Replicated k Bernoulli)
-> Vector (Dimension (Replicated k Bernoulli)) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates Natural # Replicated k Bernoulli
p
            dp :: Vector k Double
dp = (Double -> Double -> Double)
-> Vector k Double -> Vector k Double -> Vector k Double
forall a b c (n :: Nat).
(Storable a, Storable b, Storable c) =>
(a -> b -> c) -> Vector n a -> Vector n b -> Vector n c
S.zipWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(*) Vector k Double
sthts (Vector k Double -> Vector k Double)
-> Vector k Double -> Vector k Double
forall a b. (a -> b) -> a -> b
$ (Natural # Replicated k Bernoulli)
-> Vector (Dimension (Replicated k Bernoulli)) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates Natural # Replicated k Bernoulli
p'
         in Vector (Dimension (Replicated k Bernoulli)) Double
-> Point Mean (Replicated k Bernoulli)
forall c x. Vector (Dimension x) Double -> Point c x
Point Vector k Double
Vector (Dimension (Replicated k Bernoulli)) Double
dp

instance {-# OVERLAPS #-} KnownNat k => Riemannian Mean (Replicated k Bernoulli) where
    metric :: (Mean # Replicated k Bernoulli)
-> Mean #* Tensor (Replicated k Bernoulli) (Replicated k Bernoulli)
metric = [Char]
-> (Mean # Replicated k Bernoulli)
-> Point
     Natural (Tensor (Replicated k Bernoulli) (Replicated k Bernoulli))
forall a. HasCallStack => [Char] -> a
error [Char]
"Do not call metric on a replicated manifold"
    sharp :: (Mean # Replicated k Bernoulli)
-> (Mean #* Replicated k Bernoulli)
-> Mean # Replicated k Bernoulli
sharp Mean # Replicated k Bernoulli
p Mean #* Replicated k Bernoulli
dp =
        let sthts' :: Vector k Double
sthts' = (Double -> Double) -> Vector k Double -> Vector k Double
forall a b (n :: Nat).
(Storable a, Storable b) =>
(a -> b) -> Vector n a -> Vector n b
S.map (\Double
stht -> Double
stht Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
stht)) (Vector k Double -> Vector k Double)
-> Vector k Double -> Vector k Double
forall a b. (a -> b) -> a -> b
$ (Mean # Replicated k Bernoulli)
-> Vector (Dimension (Replicated k Bernoulli)) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates Mean # Replicated k Bernoulli
p
            p' :: Vector k Double
p' = (Double -> Double -> Double)
-> Vector k Double -> Vector k Double -> Vector k Double
forall a b c (n :: Nat).
(Storable a, Storable b, Storable c) =>
(a -> b -> c) -> Vector n a -> Vector n b -> Vector n c
S.zipWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(*) Vector k Double
sthts' (Vector k Double -> Vector k Double)
-> Vector k Double -> Vector k Double
forall a b. (a -> b) -> a -> b
$ Point Natural (Replicated k Bernoulli)
-> Vector (Dimension (Replicated k Bernoulli)) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates Mean #* Replicated k Bernoulli
Point Natural (Replicated k Bernoulli)
dp
         in Vector (Dimension (Replicated k Bernoulli)) Double
-> Mean # Replicated k Bernoulli
forall c x. Vector (Dimension x) Double -> Point c x
Point Vector k Double
Vector (Dimension (Replicated k Bernoulli)) Double
p'

instance Transition Source Mean Bernoulli where
    transition :: (Source # Bernoulli) -> Mean # Bernoulli
transition = (Source # Bernoulli) -> Mean # Bernoulli
forall x y c d. (Dimension x ~ Dimension y) => (c # x) -> Point d y
breakPoint

instance Transition Mean Source Bernoulli where
    transition :: (Mean # Bernoulli) -> Source # Bernoulli
transition = (Mean # Bernoulli) -> Source # Bernoulli
forall x y c d. (Dimension x ~ Dimension y) => (c # x) -> Point d y
breakPoint

instance Transition Source Natural Bernoulli where
    transition :: (Source # Bernoulli) -> Point Natural Bernoulli
transition = (Mean # Bernoulli) -> Point Natural Bernoulli
forall c d x. Transition c d x => (c # x) -> d # x
transition ((Mean # Bernoulli) -> Point Natural Bernoulli)
-> ((Source # Bernoulli) -> Mean # Bernoulli)
-> (Source # Bernoulli)
-> Point Natural Bernoulli
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Source # Bernoulli) -> Mean # Bernoulli
forall c x. Transition c Mean x => (c # x) -> Mean # x
toMean

instance Transition Natural Source Bernoulli where
    transition :: Point Natural Bernoulli -> Source # Bernoulli
transition = (Mean # Bernoulli) -> Source # Bernoulli
forall c d x. Transition c d x => (c # x) -> d # x
transition ((Mean # Bernoulli) -> Source # Bernoulli)
-> (Point Natural Bernoulli -> Mean # Bernoulli)
-> Point Natural Bernoulli
-> Source # Bernoulli
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Natural Bernoulli -> Mean # Bernoulli
forall c x. Transition c Mean x => (c # x) -> Mean # x
toMean

instance (Transition c Source Bernoulli) => Generative c Bernoulli where
    samplePoint :: Point c Bernoulli -> Random (SamplePoint Bernoulli)
samplePoint Point c Bernoulli
p = (forall s. Gen s -> ST s Bool) -> Random Bool
forall a. (forall s. Gen s -> ST s a) -> Random a
Random (Double -> Gen s -> ST s Bool
forall g (m :: Type -> Type).
StatefulGen g m =>
Double -> g -> m Bool
R.bernoulli (Double -> Gen s -> ST s Bool)
-> ((Source # Bernoulli) -> Double)
-> (Source # Bernoulli)
-> Gen s
-> ST s Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector 1 Double -> Double
forall (n :: Nat) a. Storable a => Vector (1 + n) a -> a
S.head (Vector 1 Double -> Double)
-> ((Source # Bernoulli) -> Vector 1 Double)
-> (Source # Bernoulli)
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Source # Bernoulli) -> Vector 1 Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates ((Source # Bernoulli) -> Gen s -> ST s Bool)
-> (Source # Bernoulli) -> Gen s -> ST s Bool
forall a b. (a -> b) -> a -> b
$ Point c Bernoulli -> Source # Bernoulli
forall c x. Transition c Source x => (c # x) -> Source # x
toSource Point c Bernoulli
p)

instance Transition Mean c Bernoulli => MaximumLikelihood c Bernoulli where
    mle :: Sample Bernoulli -> c # Bernoulli
mle = (Mean # Bernoulli) -> c # Bernoulli
forall c d x. Transition c d x => (c # x) -> d # x
transition ((Mean # Bernoulli) -> c # Bernoulli)
-> ([Bool] -> Mean # Bernoulli) -> [Bool] -> c # Bernoulli
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> Mean # Bernoulli
forall x. ExponentialFamily x => Sample x -> Mean # x
averageSufficientStatistic

instance LogLikelihood Natural Bernoulli Bool where
    logLikelihood :: [Bool] -> Point Natural Bernoulli -> Double
logLikelihood = [Bool] -> Point Natural Bernoulli -> Double
forall x.
LegendreExponentialFamily x =>
Sample x -> (Natural # x) -> Double
exponentialFamilyLogLikelihood
    logLikelihoodDifferential :: [Bool] -> Point Natural Bernoulli -> Natural #* Bernoulli
logLikelihoodDifferential = [Bool] -> Point Natural Bernoulli -> Natural #* Bernoulli
forall x.
LegendreExponentialFamily x =>
Sample x -> (Natural # x) -> Mean # x
exponentialFamilyLogLikelihoodDifferential

instance AbsolutelyContinuous Source Bernoulli where
    densities :: (Source # Bernoulli) -> Sample Bernoulli -> [Double]
densities Source # Bernoulli
sb Sample Bernoulli
bs =
        let p :: Double
p = Vector (1 + 0) Double -> Double
forall (n :: Nat) a. Storable a => Vector (1 + n) a -> a
S.head (Vector (1 + 0) Double -> Double)
-> Vector (1 + 0) Double -> Double
forall a b. (a -> b) -> a -> b
$ (Source # Bernoulli) -> Vector (Dimension Bernoulli) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates Source # Bernoulli
sb
         in [ if Bool
b then Double
p else Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
p | Bool
b <- [Bool]
Sample Bernoulli
bs ]

instance AbsolutelyContinuous Mean Bernoulli where
    densities :: (Mean # Bernoulli) -> Sample Bernoulli -> [Double]
densities = (Source # Bernoulli) -> [Bool] -> [Double]
forall c x.
AbsolutelyContinuous c x =>
Point c x -> Sample x -> [Double]
densities ((Source # Bernoulli) -> [Bool] -> [Double])
-> ((Mean # Bernoulli) -> Source # Bernoulli)
-> (Mean # Bernoulli)
-> [Bool]
-> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mean # Bernoulli) -> Source # Bernoulli
forall c x. Transition c Source x => (c # x) -> Source # x
toSource

instance AbsolutelyContinuous Natural Bernoulli where
    logDensities :: Point Natural Bernoulli -> Sample Bernoulli -> [Double]
logDensities = Point Natural Bernoulli -> Sample Bernoulli -> [Double]
forall x.
(ExponentialFamily x, Legendre x,
 PotentialCoordinates x ~ Natural) =>
(Natural # x) -> Sample x -> [Double]
exponentialFamilyLogDensities

-- Binomial Distribution --

instance KnownNat n => Manifold (Binomial n) where
    type Dimension (Binomial n) = 1

instance KnownNat n => Statistical (Binomial n) where
    type SamplePoint (Binomial n) = Int

instance KnownNat n => Discrete (Binomial n) where
    type Cardinality (Binomial n) = n + 1
    sampleSpace :: Proxy (Binomial n) -> Sample (Binomial n)
sampleSpace Proxy (Binomial n)
prx = [SamplePoint (Binomial n)
0..Proxy (Binomial n) -> Int
forall (n :: Nat). KnownNat n => Proxy (Binomial n) -> Int
binomialSampleSpace Proxy (Binomial n)
prx]

instance KnownNat n => ExponentialFamily (Binomial n) where
    logBaseMeasure :: Proxy (Binomial n) -> SamplePoint (Binomial n) -> Double
logBaseMeasure = Proxy n -> Proxy (Binomial n) -> Int -> Double
forall (n :: Nat).
KnownNat n =>
Proxy n -> Proxy (Binomial n) -> Int -> Double
binomialLogBaseMeasure0 Proxy n
forall k (t :: k). Proxy t
Proxy
    sufficientStatistic :: SamplePoint (Binomial n) -> Mean # Binomial n
sufficientStatistic = Vector 1 Double -> Mean # Binomial n
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector 1 Double -> Mean # Binomial n)
-> (Int -> Vector 1 Double) -> Int -> Mean # Binomial n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Vector 1 Double
forall a. Storable a => a -> Vector 1 a
S.singleton (Double -> Vector 1 Double)
-> (Int -> Double) -> Int -> Vector 1 Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

type instance PotentialCoordinates (Binomial n) = Natural

instance KnownNat n => Legendre (Binomial n) where
    potential :: (PotentialCoordinates (Binomial n) # Binomial n) -> Double
potential PotentialCoordinates (Binomial n) # Binomial n
p =
        let n :: Double
n = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Point Natural (Binomial n) -> Int
forall c (n :: Nat). KnownNat n => Point c (Binomial n) -> Int
binomialTrials PotentialCoordinates (Binomial n) # Binomial n
Point Natural (Binomial n)
p
            tht :: Double
tht = Vector (1 + 0) Double -> Double
forall (n :: Nat) a. Storable a => Vector (1 + n) a -> a
S.head (Vector (1 + 0) Double -> Double)
-> Vector (1 + 0) Double -> Double
forall a b. (a -> b) -> a -> b
$ Point Natural (Binomial n)
-> Vector (Dimension (Binomial n)) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates PotentialCoordinates (Binomial n) # Binomial n
Point Natural (Binomial n)
p
         in Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
log (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. Floating a => a -> a
exp Double
tht)

instance KnownNat n => Transition Natural Mean (Binomial n) where
    transition :: (Natural # Binomial n) -> Mean # Binomial n
transition Natural # Binomial n
p =
        let n :: Double
n = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ (Natural # Binomial n) -> Int
forall c (n :: Nat). KnownNat n => Point c (Binomial n) -> Int
binomialTrials Natural # Binomial n
p
         in Vector 1 Double -> Mean # Binomial n
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector 1 Double -> Mean # Binomial n)
-> (Double -> Vector 1 Double) -> Double -> Mean # Binomial n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Vector 1 Double
forall a. Storable a => a -> Vector 1 a
S.singleton (Double -> Mean # Binomial n) -> Double -> Mean # Binomial n
forall a b. (a -> b) -> a -> b
$ Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
logistic (Vector (1 + 0) Double -> Double
forall (n :: Nat) a. Storable a => Vector (1 + n) a -> a
S.head (Vector (1 + 0) Double -> Double)
-> Vector (1 + 0) Double -> Double
forall a b. (a -> b) -> a -> b
$ (Natural # Binomial n) -> Vector (Dimension (Binomial n)) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates Natural # Binomial n
p)

instance KnownNat n => DuallyFlat (Binomial n) where
    dualPotential :: (PotentialCoordinates (Binomial n) #* Binomial n) -> Double
dualPotential PotentialCoordinates (Binomial n) #* Binomial n
p =
        let n :: Double
n = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Point Mean (Binomial n) -> Int
forall c (n :: Nat). KnownNat n => Point c (Binomial n) -> Int
binomialTrials PotentialCoordinates (Binomial n) #* Binomial n
Point Mean (Binomial n)
p
            eta :: Double
eta = Vector (1 + 0) Double -> Double
forall (n :: Nat) a. Storable a => Vector (1 + n) a -> a
S.head (Vector (1 + 0) Double -> Double)
-> Vector (1 + 0) Double -> Double
forall a b. (a -> b) -> a -> b
$ Point Mean (Binomial n) -> Vector (Dimension (Binomial n)) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates PotentialCoordinates (Binomial n) #* Binomial n
Point Mean (Binomial n)
p
        in Double
eta Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
log (Double
eta Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
eta)) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
log (Double
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
eta))

instance KnownNat n => Transition Mean Natural (Binomial n) where
    transition :: (Mean # Binomial n) -> Natural # Binomial n
transition Mean # Binomial n
p =
        let n :: Double
n = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ (Mean # Binomial n) -> Int
forall c (n :: Nat). KnownNat n => Point c (Binomial n) -> Int
binomialTrials Mean # Binomial n
p
            eta :: Double
eta = Vector (1 + 0) Double -> Double
forall (n :: Nat) a. Storable a => Vector (1 + n) a -> a
S.head (Vector (1 + 0) Double -> Double)
-> Vector (1 + 0) Double -> Double
forall a b. (a -> b) -> a -> b
$ (Mean # Binomial n) -> Vector (Dimension (Binomial n)) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates Mean # Binomial n
p
         in Vector 1 Double -> Natural # Binomial n
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector 1 Double -> Natural # Binomial n)
-> (Double -> Vector 1 Double) -> Double -> Natural # Binomial n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Vector 1 Double
forall a. Storable a => a -> Vector 1 a
S.singleton (Double -> Vector 1 Double)
-> (Double -> Double) -> Double -> Vector 1 Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
log (Double -> Natural # Binomial n) -> Double -> Natural # Binomial n
forall a b. (a -> b) -> a -> b
$ Double
eta Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
eta)

instance KnownNat n => Transition Source Natural (Binomial n) where
    transition :: (Source # Binomial n) -> Natural # Binomial n
transition = (Mean # Binomial n) -> Natural # Binomial n
forall c d x. Transition c d x => (c # x) -> d # x
transition ((Mean # Binomial n) -> Natural # Binomial n)
-> ((Source # Binomial n) -> Mean # Binomial n)
-> (Source # Binomial n)
-> Natural # Binomial n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Source # Binomial n) -> Mean # Binomial n
forall c x. Transition c Mean x => (c # x) -> Mean # x
toMean

instance KnownNat n => Transition Natural Source (Binomial n) where
    transition :: (Natural # Binomial n) -> Source # Binomial n
transition = (Mean # Binomial n) -> Source # Binomial n
forall c d x. Transition c d x => (c # x) -> d # x
transition ((Mean # Binomial n) -> Source # Binomial n)
-> ((Natural # Binomial n) -> Mean # Binomial n)
-> (Natural # Binomial n)
-> Source # Binomial n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural # Binomial n) -> Mean # Binomial n
forall c x. Transition c Mean x => (c # x) -> Mean # x
toMean

instance KnownNat n => Transition Source Mean (Binomial n) where
    transition :: (Source # Binomial n) -> Mean # Binomial n
transition Source # Binomial n
p =
        let n :: Double
n = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ (Source # Binomial n) -> Int
forall c (n :: Nat). KnownNat n => Point c (Binomial n) -> Int
binomialTrials Source # Binomial n
p
         in (Source # Binomial n) -> Mean # Binomial n
forall x y c d. (Dimension x ~ Dimension y) => (c # x) -> Point d y
breakPoint ((Source # Binomial n) -> Mean # Binomial n)
-> (Source # Binomial n) -> Mean # Binomial n
forall a b. (a -> b) -> a -> b
$ Double
n Double -> (Source # Binomial n) -> Source # Binomial n
forall c x. Double -> (c # x) -> c # x
.> Source # Binomial n
p

instance KnownNat n => Transition Mean Source (Binomial n) where
    transition :: (Mean # Binomial n) -> Source # Binomial n
transition Mean # Binomial n
p =
        let n :: Double
n = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ (Mean # Binomial n) -> Int
forall c (n :: Nat). KnownNat n => Point c (Binomial n) -> Int
binomialTrials Mean # Binomial n
p
         in (Mean # Binomial n) -> Source # Binomial n
forall x y c d. (Dimension x ~ Dimension y) => (c # x) -> Point d y
breakPoint ((Mean # Binomial n) -> Source # Binomial n)
-> (Mean # Binomial n) -> Source # Binomial n
forall a b. (a -> b) -> a -> b
$ Double
n Double -> (Mean # Binomial n) -> Mean # Binomial n
forall c x. Double -> (c # x) -> c # x
/> Mean # Binomial n
p

instance (KnownNat n, Transition c Source (Binomial n)) => Generative c (Binomial n) where
    samplePoint :: Point c (Binomial n) -> Random (SamplePoint (Binomial n))
samplePoint Point c (Binomial n)
p0 = do
        let p :: Source # Binomial n
p = Point c (Binomial n) -> Source # Binomial n
forall c x. Transition c Source x => (c # x) -> Source # x
toSource Point c (Binomial n)
p0
            n :: Int
n = (Source # Binomial n) -> Int
forall c (n :: Nat). KnownNat n => Point c (Binomial n) -> Int
binomialTrials Source # Binomial n
p
            rb :: Random Bool
rb = (forall s. Gen s -> ST s Bool) -> Random Bool
forall a. (forall s. Gen s -> ST s a) -> Random a
Random (Double -> Gen s -> ST s Bool
forall g (m :: Type -> Type).
StatefulGen g m =>
Double -> g -> m Bool
R.bernoulli (Double -> Gen s -> ST s Bool)
-> (Vector 1 Double -> Double)
-> Vector 1 Double
-> Gen s
-> ST s Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector 1 Double -> Double
forall (n :: Nat) a. Storable a => Vector (1 + n) a -> a
S.head (Vector 1 Double -> Gen s -> ST s Bool)
-> Vector 1 Double -> Gen s -> ST s Bool
forall a b. (a -> b) -> a -> b
$ (Source # Binomial n) -> Vector (Dimension (Binomial n)) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates Source # Binomial n
p)
        [Bool]
bls <- Int -> Random Bool -> Random [Bool]
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n Random Bool
rb
        Int -> Random Int
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Int -> Random Int) -> Int -> Random Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
sum [ if Bool
bl then Int
1 else Int
0 | Bool
bl <- [Bool]
bls ]

instance KnownNat n => AbsolutelyContinuous Source (Binomial n) where
    densities :: Point Source (Binomial n) -> Sample (Binomial n) -> [Double]
densities Point Source (Binomial n)
p Sample (Binomial n)
ks =
        let n :: Int
n = Point Source (Binomial n) -> Int
forall c (n :: Nat). KnownNat n => Point c (Binomial n) -> Int
binomialTrials Point Source (Binomial n)
p
            c :: Double
c = Vector (1 + 0) Double -> Double
forall (n :: Nat) a. Storable a => Vector (1 + n) a -> a
S.head (Vector (1 + 0) Double -> Double)
-> Vector (1 + 0) Double -> Double
forall a b. (a -> b) -> a -> b
$ Point Source (Binomial n) -> Vector (Dimension (Binomial n)) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates Point Source (Binomial n)
p
         in [ Int -> Int -> Double
choose Int
n Int
k Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
cDouble -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Int
k Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
c)Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k) | Int
k <- [Int]
Sample (Binomial n)
ks ]

instance KnownNat n => AbsolutelyContinuous Mean (Binomial n) where
    densities :: Point Mean (Binomial n) -> Sample (Binomial n) -> [Double]
densities = Point Source (Binomial n) -> [Int] -> [Double]
forall c x.
AbsolutelyContinuous c x =>
Point c x -> Sample x -> [Double]
densities (Point Source (Binomial n) -> [Int] -> [Double])
-> (Point Mean (Binomial n) -> Point Source (Binomial n))
-> Point Mean (Binomial n)
-> [Int]
-> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Mean (Binomial n) -> Point Source (Binomial n)
forall c x. Transition c Source x => (c # x) -> Source # x
toSource

instance KnownNat n => AbsolutelyContinuous Natural (Binomial n) where
    logDensities :: Point Natural (Binomial n) -> Sample (Binomial n) -> [Double]
logDensities = Point Natural (Binomial n) -> Sample (Binomial n) -> [Double]
forall x.
(ExponentialFamily x, Legendre x,
 PotentialCoordinates x ~ Natural) =>
(Natural # x) -> Sample x -> [Double]
exponentialFamilyLogDensities

instance (KnownNat n, Transition Mean c (Binomial n)) => MaximumLikelihood c (Binomial n) where
    mle :: Sample (Binomial n) -> c # Binomial n
mle = (Mean # Binomial n) -> c # Binomial n
forall c d x. Transition c d x => (c # x) -> d # x
transition ((Mean # Binomial n) -> c # Binomial n)
-> ([Int] -> Mean # Binomial n) -> [Int] -> c # Binomial n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Mean # Binomial n
forall x. ExponentialFamily x => Sample x -> Mean # x
averageSufficientStatistic

instance KnownNat n => LogLikelihood Natural (Binomial n) Int where
    logLikelihood :: [Int] -> (Natural # Binomial n) -> Double
logLikelihood = [Int] -> (Natural # Binomial n) -> Double
forall x.
LegendreExponentialFamily x =>
Sample x -> (Natural # x) -> Double
exponentialFamilyLogLikelihood
    logLikelihoodDifferential :: [Int] -> (Natural # Binomial n) -> Natural #* Binomial n
logLikelihoodDifferential = [Int] -> (Natural # Binomial n) -> Natural #* Binomial n
forall x.
LegendreExponentialFamily x =>
Sample x -> (Natural # x) -> Mean # x
exponentialFamilyLogLikelihoodDifferential


-- Categorical Distribution --

instance KnownNat n => Manifold (Categorical n) where
    type Dimension (Categorical n) = n

instance KnownNat n => Statistical (Categorical n) where
    type SamplePoint (Categorical n) = Int

instance KnownNat n => Discrete (Categorical n) where
    type Cardinality (Categorical n) = n
    sampleSpace :: Proxy (Categorical n) -> Sample (Categorical n)
sampleSpace Proxy (Categorical n)
prx = [SamplePoint (Categorical n)
0..Proxy (Categorical n) -> Int
forall x. Manifold x => Proxy x -> Int
dimension Proxy (Categorical n)
prx]

instance KnownNat n => ExponentialFamily (Categorical n) where
    logBaseMeasure :: Proxy (Categorical n) -> SamplePoint (Categorical n) -> Double
logBaseMeasure Proxy (Categorical n)
_ SamplePoint (Categorical n)
_ = Double
0
    sufficientStatistic :: SamplePoint (Categorical n) -> Mean # Categorical n
sufficientStatistic SamplePoint (Categorical n)
e = Vector (Dimension (Categorical n)) Double -> Mean # Categorical n
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector (Dimension (Categorical n)) Double -> Mean # Categorical n)
-> Vector (Dimension (Categorical n)) Double
-> Mean # Categorical n
forall a b. (a -> b) -> a -> b
$ (Finite n -> Double) -> Vector n Double
forall (n :: Nat) a.
(KnownNat n, Storable a) =>
(Finite n -> a) -> Vector n a
S.generate (\Finite n
i -> if Finite n -> Int
forall (n :: Nat). KnownNat n => Finite n -> Int
finiteInt Finite n
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int -> Int
forall a. Enum a => a -> Int
fromEnum Int
SamplePoint (Categorical n)
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) then Double
1 else Double
0)

type instance (PotentialCoordinates (Categorical n)) = Natural

instance KnownNat n => Legendre (Categorical n) where
    --potential (Point cs) = log $ 1 + S.sum (S.map exp cs)
    potential :: (PotentialCoordinates (Categorical n) # Categorical n) -> Double
potential = Vector Vector (1 + n) Double -> Double
forall x (f :: Type -> Type).
(Ord x, Floating x, Traversable f) =>
f x -> x
logSumExp (Vector Vector (1 + n) Double -> Double)
-> ((Natural # Categorical n) -> Vector Vector (1 + n) Double)
-> (Natural # Categorical n)
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Vector n Double -> Vector Vector (1 + n) Double
forall (n :: Nat) a. a -> Vector n a -> Vector (1 + n) a
B.cons Double
0 (Vector n Double -> Vector Vector (1 + n) Double)
-> ((Natural # Categorical n) -> Vector n Double)
-> (Natural # Categorical n)
-> Vector Vector (1 + n) Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural # Categorical n) -> Vector n Double
forall c x. (c # x) -> Vector (Dimension x) Double
boxCoordinates

instance KnownNat n => Transition Natural Mean (Categorical n) where
    transition :: (Natural # Categorical n) -> Mean # Categorical n
transition Natural # Categorical n
p =
        let exps :: Vector n Double
exps = (Double -> Double) -> Vector n Double -> Vector n Double
forall a b (n :: Nat).
(Storable a, Storable b) =>
(a -> b) -> Vector n a -> Vector n b
S.map Double -> Double
forall a. Floating a => a -> a
exp (Vector n Double -> Vector n Double)
-> Vector n Double -> Vector n Double
forall a b. (a -> b) -> a -> b
$ (Natural # Categorical n)
-> Vector (Dimension (Categorical n)) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates Natural # Categorical n
p
            nrm :: Double
nrm = Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Vector n Double -> Double
forall a (n :: Nat). (Storable a, Num a) => Vector n a -> a
S.sum Vector n Double
exps
         in Double
nrm Double -> (Mean # Categorical n) -> Mean # Categorical n
forall c x. Double -> (c # x) -> c # x
/> Vector (Dimension (Categorical n)) Double -> Mean # Categorical n
forall c x. Vector (Dimension x) Double -> Point c x
Point Vector n Double
Vector (Dimension (Categorical n)) Double
exps

instance KnownNat n => DuallyFlat (Categorical n) where
    dualPotential :: (PotentialCoordinates (Categorical n) #* Categorical n) -> Double
dualPotential (Point Vector (Dimension (Categorical n)) Double
cs) =
        let sc :: Double
sc = Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Vector n Double -> Double
forall a (n :: Nat). (Storable a, Num a) => Vector n a -> a
S.sum Vector n Double
Vector (Dimension (Categorical n)) Double
cs
         in Vector n Double -> Double
forall a (n :: Nat). (Storable a, Num a) => Vector n a -> a
S.sum ((Double -> Double) -> Vector n Double -> Vector n Double
forall a b (n :: Nat).
(Storable a, Storable b) =>
(a -> b) -> Vector n a -> Vector n b
S.map Double -> Double
forall p. (Eq p, Floating p) => p -> p
entropyFun Vector n Double
Vector (Dimension (Categorical n)) Double
cs) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall p. (Eq p, Floating p) => p -> p
entropyFun Double
sc
        where entropyFun :: p -> p
entropyFun p
0 = p
0
              entropyFun p
x = p
x p -> p -> p
forall a. Num a => a -> a -> a
* p -> p
forall a. Floating a => a -> a
log p
x

instance KnownNat n => Transition Mean Natural (Categorical n) where
    transition :: (Mean # Categorical n) -> Natural # Categorical n
transition (Point Vector (Dimension (Categorical n)) Double
xs) =
        let nrm :: Double
nrm = Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Vector n Double -> Double
forall a (n :: Nat). (Storable a, Num a) => Vector n a -> a
S.sum Vector n Double
Vector (Dimension (Categorical n)) Double
xs
         in  Vector n Double -> Natural # Categorical n
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector n Double -> Natural # Categorical n)
-> (Vector n Double -> Vector n Double)
-> Vector n Double
-> Natural # Categorical n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector n Double -> Vector n Double
forall a. Floating a => a -> a
log (Vector n Double -> Natural # Categorical n)
-> Vector n Double -> Natural # Categorical n
forall a b. (a -> b) -> a -> b
$ (Double -> Double) -> Vector n Double -> Vector n Double
forall a b (n :: Nat).
(Storable a, Storable b) =>
(a -> b) -> Vector n a -> Vector n b
S.map (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
nrm) Vector n Double
Vector (Dimension (Categorical n)) Double
xs

instance Transition Source Mean (Categorical n) where
    transition :: (Source # Categorical n) -> Mean # Categorical n
transition = (Source # Categorical n) -> Mean # Categorical n
forall x y c d. (Dimension x ~ Dimension y) => (c # x) -> Point d y
breakPoint

instance Transition Mean Source (Categorical n) where
    transition :: (Mean # Categorical n) -> Source # Categorical n
transition = (Mean # Categorical n) -> Source # Categorical n
forall x y c d. (Dimension x ~ Dimension y) => (c # x) -> Point d y
breakPoint

instance KnownNat n => Transition Source Natural (Categorical n) where
    transition :: (Source # Categorical n) -> Natural # Categorical n
transition = (Mean # Categorical n) -> Natural # Categorical n
forall c d x. Transition c d x => (c # x) -> d # x
transition ((Mean # Categorical n) -> Natural # Categorical n)
-> ((Source # Categorical n) -> Mean # Categorical n)
-> (Source # Categorical n)
-> Natural # Categorical n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Source # Categorical n) -> Mean # Categorical n
forall c x. Transition c Mean x => (c # x) -> Mean # x
toMean

instance KnownNat n => Transition Natural Source (Categorical n) where
    transition :: (Natural # Categorical n) -> Source # Categorical n
transition = (Mean # Categorical n) -> Source # Categorical n
forall c d x. Transition c d x => (c # x) -> d # x
transition ((Mean # Categorical n) -> Source # Categorical n)
-> ((Natural # Categorical n) -> Mean # Categorical n)
-> (Natural # Categorical n)
-> Source # Categorical n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural # Categorical n) -> Mean # Categorical n
forall c x. Transition c Mean x => (c # x) -> Mean # x
toMean

instance (KnownNat n, Transition c Source (Categorical n))
  => Generative c (Categorical n) where
    samplePoint :: Point c (Categorical n) -> Random (SamplePoint (Categorical n))
samplePoint Point c (Categorical n)
p0 =
        let p :: Source # Categorical n
p = Point c (Categorical n) -> Source # Categorical n
forall c x. Transition c Source x => (c # x) -> Source # x
toSource Point c (Categorical n)
p0
         in Vector n Double -> Random Int
forall (n :: Nat). KnownNat n => Vector n Double -> Random Int
sampleCategorical (Vector n Double -> Random Int) -> Vector n Double -> Random Int
forall a b. (a -> b) -> a -> b
$ (Source # Categorical n)
-> Vector (Dimension (Categorical n)) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates Source # Categorical n
p

instance (KnownNat n, Transition Mean c (Categorical n))
  => MaximumLikelihood c (Categorical n) where
    mle :: Sample (Categorical n) -> c # Categorical n
mle = (Mean # Categorical n) -> c # Categorical n
forall c d x. Transition c d x => (c # x) -> d # x
transition ((Mean # Categorical n) -> c # Categorical n)
-> ([Int] -> Mean # Categorical n) -> [Int] -> c # Categorical n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Mean # Categorical n
forall x. ExponentialFamily x => Sample x -> Mean # x
averageSufficientStatistic

instance KnownNat n => LogLikelihood Natural (Categorical n) Int where
    logLikelihood :: [Int] -> (Natural # Categorical n) -> Double
logLikelihood = [Int] -> (Natural # Categorical n) -> Double
forall x.
LegendreExponentialFamily x =>
Sample x -> (Natural # x) -> Double
exponentialFamilyLogLikelihood
    logLikelihoodDifferential :: [Int] -> (Natural # Categorical n) -> Natural #* Categorical n
logLikelihoodDifferential = [Int] -> (Natural # Categorical n) -> Natural #* Categorical n
forall x.
LegendreExponentialFamily x =>
Sample x -> (Natural # x) -> Mean # x
exponentialFamilyLogLikelihoodDifferential


instance KnownNat n => AbsolutelyContinuous Source (Categorical n) where
    densities :: Point Source (Categorical n) -> Sample (Categorical n) -> [Double]
densities (Point Vector (Dimension (Categorical n)) Double
ps) Sample (Categorical n)
es = do
        Int
e <- [Int]
Sample (Categorical n)
es
        let ek :: Int
ek = Int -> Int
forall a. Enum a => a -> Int
fromEnum Int
e
            p0 :: Double
p0 = Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Vector n Double -> Double
forall a (n :: Nat). (Storable a, Num a) => Vector n a -> a
S.sum Vector n Double
Vector (Dimension (Categorical n)) Double
ps
        Double -> [Double]
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Double -> [Double]) -> Double -> [Double]
forall a b. (a -> b) -> a -> b
$ if Int
ek Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                    then Double
p0
                    else Vector n Double -> Int -> Double
forall (n :: Nat) a. Storable a => Vector n a -> Int -> a
S.unsafeIndex Vector n Double
Vector (Dimension (Categorical n)) Double
ps (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Int
ek Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

instance KnownNat n => AbsolutelyContinuous Mean (Categorical n) where
    densities :: Point Mean (Categorical n) -> Sample (Categorical n) -> [Double]
densities = Point Source (Categorical n) -> [Int] -> [Double]
forall c x.
AbsolutelyContinuous c x =>
Point c x -> Sample x -> [Double]
densities (Point Source (Categorical n) -> [Int] -> [Double])
-> (Point Mean (Categorical n) -> Point Source (Categorical n))
-> Point Mean (Categorical n)
-> [Int]
-> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Mean (Categorical n) -> Point Source (Categorical n)
forall c x. Transition c Source x => (c # x) -> Source # x
toSource

instance KnownNat n => AbsolutelyContinuous Natural (Categorical n) where
    logDensities :: Point Natural (Categorical n) -> Sample (Categorical n) -> [Double]
logDensities = Point Natural (Categorical n) -> Sample (Categorical n) -> [Double]
forall x.
(ExponentialFamily x, Legendre x,
 PotentialCoordinates x ~ Natural) =>
(Natural # x) -> Sample x -> [Double]
exponentialFamilyLogDensities

-- Dirichlet Distribution --

instance KnownNat k => Manifold (Dirichlet k) where
    type Dimension (Dirichlet k) = k

instance KnownNat k => Statistical (Dirichlet k) where
    type SamplePoint (Dirichlet k) = S.Vector k Double

instance (KnownNat k, Transition c Source (Dirichlet k))
  => Generative c (Dirichlet k) where
    samplePoint :: Point c (Dirichlet k) -> Random (SamplePoint (Dirichlet k))
samplePoint Point c (Dirichlet k)
p0 = do
        let alphs :: Vector (Dimension (Dirichlet k)) Double
alphs = (Source # Dirichlet k) -> Vector (Dimension (Dirichlet k)) Double
forall c x. (c # x) -> Vector (Dimension x) Double
boxCoordinates ((Source # Dirichlet k) -> Vector (Dimension (Dirichlet k)) Double)
-> (Source # Dirichlet k)
-> Vector (Dimension (Dirichlet k)) Double
forall a b. (a -> b) -> a -> b
$ Point c (Dirichlet k) -> Source # Dirichlet k
forall c x. Transition c Source x => (c # x) -> Source # x
toSource Point c (Dirichlet k)
p0
        Vector Vector k Double -> Vector Vector k Double
forall (v :: Type -> Type) a (w :: Type -> Type) (n :: Nat).
(Vector v a, Vector w a) =>
Vector v n a -> Vector w n a
G.convert (Vector Vector k Double -> Vector Vector k Double)
-> Random (Vector Vector k Double)
-> Random (Vector Vector k Double)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s. Gen s -> ST s (Vector Vector k Double))
-> Random (Vector Vector k Double)
forall a. (forall s. Gen s -> ST s a) -> Random a
Random (Vector Vector k Double -> Gen s -> ST s (Vector Vector k Double)
forall g (m :: Type -> Type) (t :: Type -> Type).
(StatefulGen g m, Traversable t) =>
t Double -> g -> m (t Double)
R.dirichlet Vector Vector k Double
Vector (Dimension (Dirichlet k)) Double
alphs)

instance KnownNat k => ExponentialFamily (Dirichlet k) where
    logBaseMeasure :: Proxy (Dirichlet k) -> SamplePoint (Dirichlet k) -> Double
logBaseMeasure Proxy (Dirichlet k)
_ = Double -> Double
forall a. Num a => a -> a
negate (Double -> Double)
-> (Vector k Double -> Double) -> Vector k Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector k Double -> Double
forall a (n :: Nat). (Storable a, Num a) => Vector n a -> a
S.sum
    sufficientStatistic :: SamplePoint (Dirichlet k) -> Mean # Dirichlet k
sufficientStatistic SamplePoint (Dirichlet k)
xs = Vector (Dimension (Dirichlet k)) Double -> Mean # Dirichlet k
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector (Dimension (Dirichlet k)) Double -> Mean # Dirichlet k)
-> Vector (Dimension (Dirichlet k)) Double -> Mean # Dirichlet k
forall a b. (a -> b) -> a -> b
$ (Double -> Double) -> Vector k Double -> Vector k Double
forall a b (n :: Nat).
(Storable a, Storable b) =>
(a -> b) -> Vector n a -> Vector n b
S.map Double -> Double
forall a. Floating a => a -> a
log Vector k Double
SamplePoint (Dirichlet k)
xs

logMultiBeta :: KnownNat k => S.Vector k Double -> Double
logMultiBeta :: Vector k Double -> Double
logMultiBeta Vector k Double
alphs =
    Vector k Double -> Double
forall a (n :: Nat). (Storable a, Num a) => Vector n a -> a
S.sum ((Double -> Double) -> Vector k Double -> Vector k Double
forall a b (n :: Nat).
(Storable a, Storable b) =>
(a -> b) -> Vector n a -> Vector n b
S.map Double -> Double
GSL.lngamma Vector k Double
alphs) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
GSL.lngamma (Vector k Double -> Double
forall a (n :: Nat). (Storable a, Num a) => Vector n a -> a
S.sum Vector k Double
alphs)

logMultiBetaDifferential :: KnownNat k => S.Vector k Double -> S.Vector k Double
logMultiBetaDifferential :: Vector k Double -> Vector k Double
logMultiBetaDifferential Vector k Double
alphs =
    (Double -> Double) -> Vector k Double -> Vector k Double
forall a b (n :: Nat).
(Storable a, Storable b) =>
(a -> b) -> Vector n a -> Vector n b
S.map (Double -> Double -> Double
forall a. Num a => a -> a -> a
subtract (Double -> Double
GSL.psi (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Vector k Double -> Double
forall a (n :: Nat). (Storable a, Num a) => Vector n a -> a
S.sum Vector k Double
alphs) (Double -> Double) -> (Double -> Double) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
GSL.psi) Vector k Double
alphs

type instance PotentialCoordinates (Dirichlet k) = Natural

instance KnownNat k => Legendre (Dirichlet k) where
    potential :: (PotentialCoordinates (Dirichlet k) # Dirichlet k) -> Double
potential = Vector k Double -> Double
forall (k :: Nat). KnownNat k => Vector k Double -> Double
logMultiBeta (Vector k Double -> Double)
-> (Point Natural (Dirichlet k) -> Vector k Double)
-> Point Natural (Dirichlet k)
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Natural (Dirichlet k) -> Vector k Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates

instance KnownNat k => Transition Natural Mean (Dirichlet k) where
    transition :: (Natural # Dirichlet k) -> Mean # Dirichlet k
transition = Vector Vector k Double -> Mean # Dirichlet k
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector Vector k Double -> Mean # Dirichlet k)
-> ((Natural # Dirichlet k) -> Vector Vector k Double)
-> (Natural # Dirichlet k)
-> Mean # Dirichlet k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Vector k Double -> Vector Vector k Double
forall (k :: Nat). KnownNat k => Vector k Double -> Vector k Double
logMultiBetaDifferential (Vector Vector k Double -> Vector Vector k Double)
-> ((Natural # Dirichlet k) -> Vector Vector k Double)
-> (Natural # Dirichlet k)
-> Vector Vector k Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural # Dirichlet k) -> Vector Vector k Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates

instance KnownNat k => AbsolutelyContinuous Source (Dirichlet k) where
    densities :: Point Source (Dirichlet k) -> Sample (Dirichlet k) -> [Double]
densities Point Source (Dirichlet k)
p Sample (Dirichlet k)
xss = do
        Vector k Double
xs <- [Vector k Double]
Sample (Dirichlet k)
xss
        let alphs :: Vector (Dimension (Dirichlet k)) Double
alphs = Point Source (Dirichlet k)
-> Vector (Dimension (Dirichlet k)) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates Point Source (Dirichlet k)
p
            prds :: Double
prds = Vector k Double -> Double
forall a (n :: Nat). (Storable a, Num a) => Vector n a -> a
S.product (Vector k Double -> Double) -> Vector k Double -> Double
forall a b. (a -> b) -> a -> b
$ (Double -> Double -> Double)
-> Vector k Double -> Vector k Double -> Vector k Double
forall a b c (n :: Nat).
(Storable a, Storable b, Storable c) =>
(a -> b -> c) -> Vector n a -> Vector n b -> Vector n c
S.zipWith Double -> Double -> Double
forall a. Floating a => a -> a -> a
(**) Vector k Double
xs (Vector k Double -> Vector k Double)
-> Vector k Double -> Vector k Double
forall a b. (a -> b) -> a -> b
$ (Double -> Double) -> Vector k Double -> Vector k Double
forall a b (n :: Nat).
(Storable a, Storable b) =>
(a -> b) -> Vector n a -> Vector n b
S.map (Double -> Double -> Double
forall a. Num a => a -> a -> a
subtract Double
1) Vector k Double
Vector (Dimension (Dirichlet k)) Double
alphs
        Double -> [Double]
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Double -> [Double]) -> Double -> [Double]
forall a b. (a -> b) -> a -> b
$ Double
prds Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double
forall a. Floating a => a -> a
exp (Vector k Double -> Double
forall (k :: Nat). KnownNat k => Vector k Double -> Double
logMultiBeta Vector k Double
Vector (Dimension (Dirichlet k)) Double
alphs)

instance KnownNat k => AbsolutelyContinuous Natural (Dirichlet k) where
    logDensities :: Point Natural (Dirichlet k) -> Sample (Dirichlet k) -> [Double]
logDensities = Point Natural (Dirichlet k) -> Sample (Dirichlet k) -> [Double]
forall x.
(ExponentialFamily x, Legendre x,
 PotentialCoordinates x ~ Natural) =>
(Natural # x) -> Sample x -> [Double]
exponentialFamilyLogDensities

instance KnownNat k => LogLikelihood Natural (Dirichlet k) (S.Vector k Double) where
    logLikelihood :: [Vector k Double] -> (Natural # Dirichlet k) -> Double
logLikelihood = [Vector k Double] -> (Natural # Dirichlet k) -> Double
forall x.
LegendreExponentialFamily x =>
Sample x -> (Natural # x) -> Double
exponentialFamilyLogLikelihood
    logLikelihoodDifferential :: [Vector k Double]
-> (Natural # Dirichlet k) -> Natural #* Dirichlet k
logLikelihoodDifferential = [Vector k Double]
-> (Natural # Dirichlet k) -> Natural #* Dirichlet k
forall x.
LegendreExponentialFamily x =>
Sample x -> (Natural # x) -> Mean # x
exponentialFamilyLogLikelihoodDifferential

instance KnownNat k => Transition Source Natural (Dirichlet k) where
    transition :: (Source # Dirichlet k) -> Natural # Dirichlet k
transition = (Source # Dirichlet k) -> Natural # Dirichlet k
forall x y c d. (Dimension x ~ Dimension y) => (c # x) -> Point d y
breakPoint

instance KnownNat k => Transition Natural Source (Dirichlet k) where
    transition :: (Natural # Dirichlet k) -> Source # Dirichlet k
transition = (Natural # Dirichlet k) -> Source # Dirichlet k
forall x y c d. (Dimension x ~ Dimension y) => (c # x) -> Point d y
breakPoint

-- Poisson Distribution --

instance Manifold Poisson where
    type Dimension Poisson = 1

instance Statistical Poisson where
    type SamplePoint Poisson = Int

instance ExponentialFamily Poisson where
    sufficientStatistic :: SamplePoint Poisson -> Mean # Poisson
sufficientStatistic = Vector 1 Double -> Mean # Poisson
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector 1 Double -> Mean # Poisson)
-> (Int -> Vector 1 Double) -> Int -> Mean # Poisson
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Vector 1 Double
forall a. Storable a => a -> Vector 1 a
S.singleton (Double -> Vector 1 Double)
-> (Int -> Double) -> Int -> Vector 1 Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    logBaseMeasure :: Proxy Poisson -> SamplePoint Poisson -> Double
logBaseMeasure Proxy Poisson
_ SamplePoint Poisson
k = Double -> Double
forall a. Num a => a -> a
negate (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a. Integral a => a -> Double
logFactorial Int
SamplePoint Poisson
k

type instance PotentialCoordinates Poisson = Natural

instance Legendre Poisson where
    potential :: (PotentialCoordinates Poisson # Poisson) -> Double
potential = Double -> Double
forall a. Floating a => a -> a
exp (Double -> Double)
-> (Point Natural Poisson -> Double)
-> Point Natural Poisson
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector 1 Double -> Double
forall (n :: Nat) a. Storable a => Vector (1 + n) a -> a
S.head (Vector 1 Double -> Double)
-> (Point Natural Poisson -> Vector 1 Double)
-> Point Natural Poisson
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Natural Poisson -> Vector 1 Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates

instance Transition Natural Mean Poisson where
    transition :: Point Natural Poisson -> Mean # Poisson
transition = Vector 1 Double -> Mean # Poisson
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector 1 Double -> Mean # Poisson)
-> (Point Natural Poisson -> Vector 1 Double)
-> Point Natural Poisson
-> Mean # Poisson
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector 1 Double -> Vector 1 Double
forall a. Floating a => a -> a
exp (Vector 1 Double -> Vector 1 Double)
-> (Point Natural Poisson -> Vector 1 Double)
-> Point Natural Poisson
-> Vector 1 Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Natural Poisson -> Vector 1 Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates

instance DuallyFlat Poisson where
    dualPotential :: (PotentialCoordinates Poisson #* Poisson) -> Double
dualPotential (Point Vector (Dimension Poisson) Double
xs) =
        let eta :: Double
eta = Vector (1 + 0) Double -> Double
forall (n :: Nat) a. Storable a => Vector (1 + n) a -> a
S.head Vector (1 + 0) Double
Vector (Dimension Poisson) Double
xs
         in Double
eta Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
log Double
eta Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
eta

instance Transition Mean Natural Poisson where
    transition :: (Mean # Poisson) -> Point Natural Poisson
transition = Vector 1 Double -> Point Natural Poisson
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector 1 Double -> Point Natural Poisson)
-> ((Mean # Poisson) -> Vector 1 Double)
-> (Mean # Poisson)
-> Point Natural Poisson
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector 1 Double -> Vector 1 Double
forall a. Floating a => a -> a
log (Vector 1 Double -> Vector 1 Double)
-> ((Mean # Poisson) -> Vector 1 Double)
-> (Mean # Poisson)
-> Vector 1 Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mean # Poisson) -> Vector 1 Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates

instance Transition Source Natural Poisson where
    transition :: (Source # Poisson) -> Point Natural Poisson
transition = (Mean # Poisson) -> Point Natural Poisson
forall c d x. Transition c d x => (c # x) -> d # x
transition ((Mean # Poisson) -> Point Natural Poisson)
-> ((Source # Poisson) -> Mean # Poisson)
-> (Source # Poisson)
-> Point Natural Poisson
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Source # Poisson) -> Mean # Poisson
forall c x. Transition c Mean x => (c # x) -> Mean # x
toMean

instance Transition Natural Source Poisson where
    transition :: Point Natural Poisson -> Source # Poisson
transition = (Mean # Poisson) -> Source # Poisson
forall c d x. Transition c d x => (c # x) -> d # x
transition ((Mean # Poisson) -> Source # Poisson)
-> (Point Natural Poisson -> Mean # Poisson)
-> Point Natural Poisson
-> Source # Poisson
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Natural Poisson -> Mean # Poisson
forall c x. Transition c Mean x => (c # x) -> Mean # x
toMean

instance Transition Source Mean Poisson where
    transition :: (Source # Poisson) -> Mean # Poisson
transition = (Source # Poisson) -> Mean # Poisson
forall x y c d. (Dimension x ~ Dimension y) => (c # x) -> Point d y
breakPoint

instance Transition Mean Source Poisson where
    transition :: (Mean # Poisson) -> Source # Poisson
transition = (Mean # Poisson) -> Source # Poisson
forall x y c d. (Dimension x ~ Dimension y) => (c # x) -> Point d y
breakPoint

instance (Transition c Source Poisson) => Generative c Poisson where
    samplePoint :: Point c Poisson -> Random (SamplePoint Poisson)
samplePoint = Double -> Random Int
samplePoisson (Double -> Random Int)
-> (Point c Poisson -> Double) -> Point c Poisson -> Random Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector 1 Double -> Double
forall (n :: Nat) a. Storable a => Vector (1 + n) a -> a
S.head (Vector 1 Double -> Double)
-> (Point c Poisson -> Vector 1 Double)
-> Point c Poisson
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Source # Poisson) -> Vector 1 Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates ((Source # Poisson) -> Vector 1 Double)
-> (Point c Poisson -> Source # Poisson)
-> Point c Poisson
-> Vector 1 Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point c Poisson -> Source # Poisson
forall c x. Transition c Source x => (c # x) -> Source # x
toSource

instance AbsolutelyContinuous Source Poisson where
    densities :: (Source # Poisson) -> Sample Poisson -> [Double]
densities (Point Vector (Dimension Poisson) Double
xs) Sample Poisson
ks = do
        Int
k <- [Int]
Sample Poisson
ks
        let lmda :: Double
lmda = Vector (1 + 0) Double -> Double
forall (n :: Nat) a. Storable a => Vector (1 + n) a -> a
S.head Vector (1 + 0) Double
Vector (Dimension Poisson) Double
xs
        Double -> [Double]
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Double -> [Double]) -> Double -> [Double]
forall a b. (a -> b) -> a -> b
$ Double
lmdaDouble -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Int
k Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
factorial Int
k Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
exp (-Double
lmda)

instance AbsolutelyContinuous Mean Poisson where
    densities :: (Mean # Poisson) -> Sample Poisson -> [Double]
densities = (Source # Poisson) -> [Int] -> [Double]
forall c x.
AbsolutelyContinuous c x =>
Point c x -> Sample x -> [Double]
densities ((Source # Poisson) -> [Int] -> [Double])
-> ((Mean # Poisson) -> Source # Poisson)
-> (Mean # Poisson)
-> [Int]
-> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mean # Poisson) -> Source # Poisson
forall c x. Transition c Source x => (c # x) -> Source # x
toSource

instance AbsolutelyContinuous Natural Poisson where
    logDensities :: Point Natural Poisson -> Sample Poisson -> [Double]
logDensities = Point Natural Poisson -> Sample Poisson -> [Double]
forall x.
(ExponentialFamily x, Legendre x,
 PotentialCoordinates x ~ Natural) =>
(Natural # x) -> Sample x -> [Double]
exponentialFamilyLogDensities

instance Transition Mean c Poisson => MaximumLikelihood c Poisson where
    mle :: Sample Poisson -> c # Poisson
mle = (Mean # Poisson) -> c # Poisson
forall c d x. Transition c d x => (c # x) -> d # x
transition ((Mean # Poisson) -> c # Poisson)
-> ([Int] -> Mean # Poisson) -> [Int] -> c # Poisson
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Mean # Poisson
forall x. ExponentialFamily x => Sample x -> Mean # x
averageSufficientStatistic

instance LogLikelihood Natural Poisson Int where
    logLikelihood :: [Int] -> Point Natural Poisson -> Double
logLikelihood = [Int] -> Point Natural Poisson -> Double
forall x.
LegendreExponentialFamily x =>
Sample x -> (Natural # x) -> Double
exponentialFamilyLogLikelihood
    logLikelihoodDifferential :: [Int] -> Point Natural Poisson -> Natural #* Poisson
logLikelihoodDifferential = [Int] -> Point Natural Poisson -> Natural #* Poisson
forall x.
LegendreExponentialFamily x =>
Sample x -> (Natural # x) -> Mean # x
exponentialFamilyLogLikelihoodDifferential

-- VonMises --

instance Manifold VonMises where
    type Dimension VonMises = 2

instance Statistical VonMises where
    type SamplePoint VonMises = Double

instance Generative Source VonMises where
    samplePoint :: Point Source VonMises -> Random (SamplePoint VonMises)
samplePoint p :: Point Source VonMises
p@(Point Vector (Dimension VonMises) Double
cs) = do
        let (Double
mu,Double
kap0) = Vector 2 Double -> (Double, Double)
forall x. Storable x => Vector 2 x -> (x, x)
S.toPair Vector 2 Double
Vector (Dimension VonMises) Double
cs
            kap :: Double
kap = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
kap0 Double
1e-5
            tau :: Double
tau = Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. Floating a => a -> a
sqrt (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
square Double
kap)
            rho :: Double
rho = (Double
tau Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
forall a. Floating a => a -> a
sqrt (Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
tau))Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/(Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
kap)
            r :: Double
r = (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. Floating a => a -> a
square Double
rho) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
rho)
        Double
u1 <- (forall s. Gen s -> ST s Double) -> Random Double
forall a. (forall s. Gen s -> ST s a) -> Random a
Random forall s. Gen s -> ST s Double
forall a (m :: Type -> Type).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
R.uniform
        Double
u2 <- (forall s. Gen s -> ST s Double) -> Random Double
forall a. (forall s. Gen s -> ST s a) -> Random a
Random forall s. Gen s -> ST s Double
forall a (m :: Type -> Type).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
R.uniform
        Double
u3 <- (forall s. Gen s -> ST s Double) -> Random Double
forall a. (forall s. Gen s -> ST s a) -> Random a
Random forall s. Gen s -> ST s Double
forall a (m :: Type -> Type).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
R.uniform
        let z :: Double
z = Double -> Double
forall a. Floating a => a -> a
cos (Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
u1)
            f :: Double
f = (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
z)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/(Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
z)
            c :: Double
c = Double
kap Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
f)
        if Double -> Double
forall a. Floating a => a -> a
log (Double
c Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
u2) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
c Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0
           then Point Source VonMises -> Random (SamplePoint VonMises)
forall c x. Generative c x => Point c x -> Random (SamplePoint x)
samplePoint Point Source VonMises
p
           else Double -> Random Double
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Double -> Random Double)
-> (Double -> Double) -> Double -> Random Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall x. RealFloat x => x -> x
toPi (Double -> Random Double) -> Double -> Random Double
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Num a => a -> a
signum (Double
u3 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.5) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
acos Double
f Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
mu

instance AbsolutelyContinuous Source VonMises where
    densities :: Point Source VonMises -> Sample VonMises -> [Double]
densities Point Source VonMises
p Sample VonMises
xs = do
        let (Double
mu,Double
kp) = Vector 2 Double -> (Double, Double)
forall x. Storable x => Vector 2 x -> (x, x)
S.toPair (Vector 2 Double -> (Double, Double))
-> Vector 2 Double -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ Point Source VonMises -> Vector (Dimension VonMises) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates Point Source VonMises
p
        Double
x <- [Double]
Sample VonMises
xs
        Double -> [Double]
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Double -> [Double]) -> Double -> [Double]
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Floating a => a -> a
exp (Double
kp Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
mu)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
GSL.bessel_I0 Double
kp)

instance LogLikelihood Natural VonMises Double where
    logLikelihood :: [Double] -> (Natural # VonMises) -> Double
logLikelihood = [Double] -> (Natural # VonMises) -> Double
forall x.
LegendreExponentialFamily x =>
Sample x -> (Natural # x) -> Double
exponentialFamilyLogLikelihood
    logLikelihoodDifferential :: [Double] -> (Natural # VonMises) -> Natural #* VonMises
logLikelihoodDifferential = [Double] -> (Natural # VonMises) -> Natural #* VonMises
forall x.
LegendreExponentialFamily x =>
Sample x -> (Natural # x) -> Mean # x
exponentialFamilyLogLikelihoodDifferential

type instance PotentialCoordinates VonMises = Natural

instance Legendre VonMises where
    potential :: (PotentialCoordinates VonMises # VonMises) -> Double
potential PotentialCoordinates VonMises # VonMises
p =
        let kp :: Double
kp = (Double, Double) -> Double
forall a b. (a, b) -> b
snd ((Double, Double) -> Double)
-> (Point Source VonMises -> (Double, Double))
-> Point Source VonMises
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector 2 Double -> (Double, Double)
forall x. Storable x => Vector 2 x -> (x, x)
S.toPair (Vector 2 Double -> (Double, Double))
-> (Point Source VonMises -> Vector 2 Double)
-> Point Source VonMises
-> (Double, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Source VonMises -> Vector 2 Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates (Point Source VonMises -> Double)
-> Point Source VonMises -> Double
forall a b. (a -> b) -> a -> b
$ (Natural # VonMises) -> Point Source VonMises
forall c x. Transition c Source x => (c # x) -> Source # x
toSource PotentialCoordinates VonMises # VonMises
Natural # VonMises
p
         in Double -> Double
forall a. Floating a => a -> a
log (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Double
GSL.bessel_I0 Double
kp

instance Transition Natural Mean VonMises where
    transition :: (Natural # VonMises) -> Mean # VonMises
transition Natural # VonMises
p =
        let kp :: Double
kp = (Double, Double) -> Double
forall a b. (a, b) -> b
snd ((Double, Double) -> Double)
-> (Point Source VonMises -> (Double, Double))
-> Point Source VonMises
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector 2 Double -> (Double, Double)
forall x. Storable x => Vector 2 x -> (x, x)
S.toPair (Vector 2 Double -> (Double, Double))
-> (Point Source VonMises -> Vector 2 Double)
-> Point Source VonMises
-> (Double, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Source VonMises -> Vector 2 Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates (Point Source VonMises -> Double)
-> Point Source VonMises -> Double
forall a b. (a -> b) -> a -> b
$ (Natural # VonMises) -> Point Source VonMises
forall c x. Transition c Source x => (c # x) -> Source # x
toSource Natural # VonMises
p
         in (Natural # VonMises) -> Mean # VonMises
forall x y c d. (Dimension x ~ Dimension y) => (c # x) -> Point d y
breakPoint ((Natural # VonMises) -> Mean # VonMises)
-> (Natural # VonMises) -> Mean # VonMises
forall a b. (a -> b) -> a -> b
$ (Double -> Double
GSL.bessel_I1 Double
kp Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double -> Double
GSL.bessel_I0 Double
kp Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
kp)) Double -> (Natural # VonMises) -> Natural # VonMises
forall c x. Double -> (c # x) -> c # x
.> Natural # VonMises
p

instance AbsolutelyContinuous Natural VonMises where
    logDensities :: (Natural # VonMises) -> Sample VonMises -> [Double]
logDensities = (Natural # VonMises) -> Sample VonMises -> [Double]
forall x.
(ExponentialFamily x, Legendre x,
 PotentialCoordinates x ~ Natural) =>
(Natural # x) -> Sample x -> [Double]
exponentialFamilyLogDensities

instance Generative Natural VonMises where
    samplePoint :: (Natural # VonMises) -> Random (SamplePoint VonMises)
samplePoint = Point Source VonMises -> Random Double
forall c x. Generative c x => Point c x -> Random (SamplePoint x)
samplePoint (Point Source VonMises -> Random Double)
-> ((Natural # VonMises) -> Point Source VonMises)
-> (Natural # VonMises)
-> Random Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural # VonMises) -> Point Source VonMises
forall c x. Transition c Source x => (c # x) -> Source # x
toSource

instance ExponentialFamily VonMises where
    sufficientStatistic :: SamplePoint VonMises -> Mean # VonMises
sufficientStatistic SamplePoint VonMises
tht = Vector (Dimension VonMises) Double -> Mean # VonMises
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector (Dimension VonMises) Double -> Mean # VonMises)
-> Vector (Dimension VonMises) Double -> Mean # VonMises
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Vector 2 Double
forall x. Storable x => x -> x -> Vector 2 x
S.doubleton (Double -> Double
forall a. Floating a => a -> a
cos Double
SamplePoint VonMises
tht) (Double -> Double
forall a. Floating a => a -> a
sin Double
SamplePoint VonMises
tht)
    logBaseMeasure :: Proxy VonMises -> SamplePoint VonMises -> Double
logBaseMeasure Proxy VonMises
_ SamplePoint VonMises
_ = -Double -> Double
forall a. Floating a => a -> a
log(Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi)

instance Transition Source Natural VonMises where
    transition :: Point Source VonMises -> Natural # VonMises
transition (Point Vector (Dimension VonMises) Double
cs) =
        let (Double
mu,Double
kap) = Vector 2 Double -> (Double, Double)
forall x. Storable x => Vector 2 x -> (x, x)
S.toPair Vector 2 Double
Vector (Dimension VonMises) Double
cs
         in Vector (Dimension VonMises) Double -> Natural # VonMises
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector (Dimension VonMises) Double -> Natural # VonMises)
-> Vector (Dimension VonMises) Double -> Natural # VonMises
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Vector 2 Double
forall x. Storable x => x -> x -> Vector 2 x
S.doubleton (Double
kap Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos Double
mu) (Double
kap Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sin Double
mu)

instance Transition Natural Source VonMises where
    transition :: (Natural # VonMises) -> Point Source VonMises
transition (Point Vector (Dimension VonMises) Double
cs) =
        let (Double
tht0,Double
tht1) = Vector 2 Double -> (Double, Double)
forall x. Storable x => Vector 2 x -> (x, x)
S.toPair Vector 2 Double
Vector (Dimension VonMises) Double
cs
         in Vector (Dimension VonMises) Double -> Point Source VonMises
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector (Dimension VonMises) Double -> Point Source VonMises)
-> Vector (Dimension VonMises) Double -> Point Source VonMises
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Vector 2 Double
forall x. Storable x => x -> x -> Vector 2 x
S.doubleton (Double -> Double
forall x. RealFloat x => x -> x
toPi (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. RealFloat a => a -> a -> a
atan2 Double
tht1 Double
tht0) (Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Floating a => a -> a
square Double
tht0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. Floating a => a -> a
square Double
tht1)

instance Transition Source Mean VonMises where
    transition :: Point Source VonMises -> Mean # VonMises
transition = (Natural # VonMises) -> Mean # VonMises
forall c x. Transition c Mean x => (c # x) -> Mean # x
toMean ((Natural # VonMises) -> Mean # VonMises)
-> (Point Source VonMises -> Natural # VonMises)
-> Point Source VonMises
-> Mean # VonMises
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Source VonMises -> Natural # VonMises
forall c x. Transition c Natural x => (c # x) -> Natural # x
toNatural


--- Location Shape ---

instance (Statistical l, Manifold s) => Statistical (LocationShape l s) where
    type SamplePoint (LocationShape l s) = SamplePoint l

instance (Manifold l, Manifold s) => Translation (LocationShape l s) l where
    >+> :: (c # LocationShape l s) -> (c # l) -> c # LocationShape l s
(>+>) c # LocationShape l s
yz c # l
y' =
        let (c # l
y,c # s
z) = (c # LocationShape l s)
-> (c # First (LocationShape l s), c # Second (LocationShape l s))
forall z c. Product z => (c # z) -> (c # First z, c # Second z)
split c # LocationShape l s
yz
         in (c # First (LocationShape l s))
-> (c # Second (LocationShape l s)) -> c # LocationShape l s
forall z c. Product z => (c # First z) -> (c # Second z) -> c # z
join (c # l
y (c # l) -> (c # l) -> c # l
forall a. Num a => a -> a -> a
+ c # l
y') c # s
c # Second (LocationShape l s)
z
    anchor :: (c # LocationShape l s) -> c # l
anchor = (c # l, c # s) -> c # l
forall a b. (a, b) -> a
fst ((c # l, c # s) -> c # l)
-> ((c # LocationShape l s) -> (c # l, c # s))
-> (c # LocationShape l s)
-> c # l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c # LocationShape l s) -> (c # l, c # s)
forall z c. Product z => (c # z) -> (c # First z, c # Second z)
split

type instance PotentialCoordinates (LocationShape l s) = Natural

instance ( Statistical l, Statistical s , Product (LocationShape l s)
         , Storable (SamplePoint s), SamplePoint l ~ SamplePoint s
         , AbsolutelyContinuous c (LocationShape l s), KnownNat n)
  => AbsolutelyContinuous c (LocationShape (Replicated n l) (Replicated n s)) where
      logDensities :: Point c (LocationShape (Replicated n l) (Replicated n s))
-> Sample (LocationShape (Replicated n l) (Replicated n s))
-> [Double]
logDensities Point c (LocationShape (Replicated n l) (Replicated n s))
lss Sample (LocationShape (Replicated n l) (Replicated n s))
xs =
          let (c # Replicated n l
l,c # Replicated n s
s) = Point c (LocationShape (Replicated n l) (Replicated n s))
-> (c # First (LocationShape (Replicated n l) (Replicated n s)),
    c # Second (LocationShape (Replicated n l) (Replicated n s)))
forall z c. Product z => (c # z) -> (c # First z, c # Second z)
split Point c (LocationShape (Replicated n l) (Replicated n s))
lss
              ls :: Vector n (c # l)
ls = (c # Replicated n l) -> Vector n (c # l)
forall (k :: Nat) x c.
(KnownNat k, Manifold x) =>
(c # Replicated k x) -> Vector k (c # x)
splitReplicated c # Replicated n l
l
              ss :: Vector n (c # s)
ss = (c # Replicated n s) -> Vector n (c # s)
forall (k :: Nat) x c.
(KnownNat k, Manifold x) =>
(c # Replicated k x) -> Vector k (c # x)
splitReplicated c # Replicated n s
s
              lss' :: c # Replicated n (LocationShape l s)
              lss' :: c # Replicated n (LocationShape l s)
lss' = Vector n (c # LocationShape l s)
-> c # Replicated n (LocationShape l s)
forall (k :: Nat) x c.
(KnownNat k, Manifold x) =>
Vector k (c # x) -> c # Replicated k x
joinReplicated (Vector n (c # LocationShape l s)
 -> c # Replicated n (LocationShape l s))
-> Vector n (c # LocationShape l s)
-> c # Replicated n (LocationShape l s)
forall a b. (a -> b) -> a -> b
$ ((c # l) -> (c # s) -> c # LocationShape l s)
-> Vector n (c # l)
-> Vector n (c # s)
-> Vector n (c # LocationShape l s)
forall a b c (n :: Nat).
(Storable a, Storable b, Storable c) =>
(a -> b -> c) -> Vector n a -> Vector n b -> Vector n c
S.zipWith (c # l) -> (c # s) -> c # LocationShape l s
forall z c. Product z => (c # First z) -> (c # Second z) -> c # z
join Vector n (c # l)
ls Vector n (c # s)
ss
           in (c # Replicated n (LocationShape l s))
-> Sample (Replicated n (LocationShape l s)) -> [Double]
forall c x.
AbsolutelyContinuous c x =>
Point c x -> Sample x -> [Double]
logDensities c # Replicated n (LocationShape l s)
lss' Sample (Replicated n (LocationShape l s))
Sample (LocationShape (Replicated n l) (Replicated n s))
xs


instance (KnownNat n, Manifold l, Manifold s)
  => Translation (Replicated n (LocationShape l s)) (Replicated n l) where
      {-# INLINE (>+>) #-}
      >+> :: (c # Replicated n (LocationShape l s))
-> (c # Replicated n l) -> c # Replicated n (LocationShape l s)
(>+>) c # Replicated n (LocationShape l s)
w c # Replicated n l
z =
          let ws :: Vector n (c # LocationShape l s)
ws = (c # Replicated n (LocationShape l s))
-> Vector n (c # LocationShape l s)
forall (k :: Nat) x c.
(KnownNat k, Manifold x) =>
(c # Replicated k x) -> Vector k (c # x)
splitReplicated c # Replicated n (LocationShape l s)
w
              zs :: Vector n (c # l)
zs = (c # Replicated n l) -> Vector n (c # l)
forall (k :: Nat) x c.
(KnownNat k, Manifold x) =>
(c # Replicated k x) -> Vector k (c # x)
splitReplicated c # Replicated n l
z
           in Vector n (c # LocationShape l s)
-> c # Replicated n (LocationShape l s)
forall (k :: Nat) x c.
(KnownNat k, Manifold x) =>
Vector k (c # x) -> c # Replicated k x
joinReplicated (Vector n (c # LocationShape l s)
 -> c # Replicated n (LocationShape l s))
-> Vector n (c # LocationShape l s)
-> c # Replicated n (LocationShape l s)
forall a b. (a -> b) -> a -> b
$ ((c # LocationShape l s) -> (c # l) -> c # LocationShape l s)
-> Vector n (c # LocationShape l s)
-> Vector n (c # l)
-> Vector n (c # LocationShape l s)
forall a b c (n :: Nat).
(Storable a, Storable b, Storable c) =>
(a -> b -> c) -> Vector n a -> Vector n b -> Vector n c
S.zipWith (c # LocationShape l s) -> (c # l) -> c # LocationShape l s
forall z y c. Translation z y => (c # z) -> (c # y) -> c # z
(>+>) Vector n (c # LocationShape l s)
ws Vector n (c # l)
zs
      {-# INLINE anchor #-}
      anchor :: (c # Replicated n (LocationShape l s)) -> c # Replicated n l
anchor = ((c # LocationShape l s) -> Point c l)
-> (c # Replicated n (LocationShape l s)) -> c # Replicated n l
forall (k :: Nat) x y c d.
(KnownNat k, Manifold x, Manifold y) =>
((c # x) -> Point d y)
-> (c # Replicated k x) -> Point d (Replicated k y)
mapReplicatedPoint (c # LocationShape l s) -> Point c l
forall z y c. Translation z y => (c # z) -> c # y
anchor