{-# LANGUAGE UndecidableInstances #-}

-- | Core types, classes, and functions for working with manifolds of
-- probability distributions.
module Goal.Probability.Statistical
    ( -- * Random
      Random (Random)
    , Statistical (SamplePoint)
    , Sample
    , realize
    -- * Initializiation
    , initialize
    , uniformInitialize
    , uniformInitialize'
    -- * Properties of Distributions
    , Generative (sample,samplePoint)
    , AbsolutelyContinuous (densities,logDensities)
    , density
    , logDensity
    , Discrete (Cardinality,sampleSpace)
    , pointSampleSpace
    , expectation
    -- ** Maximum Likelihood Estimation
    , MaximumLikelihood (mle)
    , LogLikelihood (logLikelihood,logLikelihoodDifferential)
    ) where


--- Imports ---


-- Package --

import Goal.Core
import Goal.Geometry

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

-- Qualified --

import qualified Data.List as L
import qualified System.Random.MWC as R

import Foreign.Storable


--- Probability Theory ---


-- | A 'Manifold' is 'Statistical' if it is a set of probability distributions
-- over a particular sample space, where the sample space is a set of the
-- specified 'SamplePoint's.
class Manifold x => Statistical x where
    type SamplePoint x :: Type

-- | A 'Sample' is a list of 'SamplePoint's.
type Sample x = [SamplePoint x]

-- | A random variable.
newtype Random a = Random (forall s. R.Gen s -> ST s a)

-- | Turn a random variable into an IO action.
realize :: Random a -> IO a
realize :: Random a -> IO a
realize (Random forall s. Gen s -> ST s a
rv) = (forall s. Gen s -> ST s a) -> IO a
forall a. (forall s. Gen s -> ST s a) -> IO a
R.withSystemRandomST forall s. Gen s -> ST s a
rv

-- | Probability distributions for which the sample space is countable. This
-- affords brute force computation of expectations.
class KnownNat (Cardinality x) => Discrete x where
    type Cardinality x :: Nat
    sampleSpace :: Proxy x -> Sample x

-- | Convenience function for getting the sample space of a 'Discrete'
-- probability distribution.
pointSampleSpace :: forall c x . Discrete x => c # x -> Sample x
pointSampleSpace :: (c # x) -> Sample x
pointSampleSpace c # x
_ = Proxy x -> Sample x
forall x. Discrete x => Proxy x -> Sample x
sampleSpace (Proxy x
forall k (t :: k). Proxy t
Proxy :: Proxy x)

-- | A distribution is 'Generative' if we can 'sample' from it. Generation is
-- powered by @mwc-random@.
class Statistical x => Generative c x where
    samplePoint :: Point c x -> Random (SamplePoint x)
    samplePoint = ([SamplePoint x] -> SamplePoint x)
-> Random [SamplePoint x] -> Random (SamplePoint x)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [SamplePoint x] -> SamplePoint x
forall a. [a] -> a
head (Random [SamplePoint x] -> Random (SamplePoint x))
-> (Point c x -> Random [SamplePoint x])
-> Point c x
-> Random (SamplePoint x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Point c x -> Random [SamplePoint x]
forall c x.
Generative c x =>
Int -> Point c x -> Random [SamplePoint x]
sample Int
1
    sample :: Int -> Point c x -> Random (Sample x)
    sample Int
n = Int -> Random (SamplePoint x) -> Random [SamplePoint x]
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Random (SamplePoint x) -> Random [SamplePoint x])
-> (Point c x -> Random (SamplePoint x))
-> Point c x
-> Random [SamplePoint x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point c x -> Random (SamplePoint x)
forall c x. Generative c x => Point c x -> Random (SamplePoint x)
samplePoint


-- | The distributions \(P \in \mathcal M\) in a 'Statistical' 'Manifold'
-- \(\mathcal M\) are 'AbsolutelyContinuous' if there is a reference measure
-- \(\mu\) and a function \(p\) such that
-- \(P(A) = \int_A p d\mu\). We refer to \(p(x)\) as the 'density' of the
-- probability distribution.
class Statistical x => AbsolutelyContinuous c x where
    logDensities :: Point c x -> Sample x -> [Double]
    logDensities Point c x
p = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Double
forall a. Floating a => a -> a
log ([Double] -> [Double])
-> (Sample x -> [Double]) -> Sample x -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point c x -> Sample x -> [Double]
forall c x.
AbsolutelyContinuous c x =>
Point c x -> Sample x -> [Double]
densities Point c x
p

    densities :: Point c x -> Sample x -> [Double]
    densities Point c x
p = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Double
forall a. Floating a => a -> a
exp ([Double] -> [Double])
-> (Sample x -> [Double]) -> Sample x -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point c x -> Sample x -> [Double]
forall c x.
AbsolutelyContinuous c x =>
Point c x -> Sample x -> [Double]
logDensities Point c x
p

logDensity :: AbsolutelyContinuous c x => Point c x -> SamplePoint x -> Double
logDensity :: Point c x -> SamplePoint x -> Double
logDensity Point c x
p = [Double] -> Double
forall a. [a] -> a
head ([Double] -> Double)
-> (SamplePoint x -> [Double]) -> SamplePoint x -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point c x -> Sample x -> [Double]
forall c x.
AbsolutelyContinuous c x =>
Point c x -> Sample x -> [Double]
logDensities Point c x
p (Sample x -> [Double])
-> (SamplePoint x -> Sample x) -> SamplePoint x -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SamplePoint x -> Sample x -> Sample x
forall a. a -> [a] -> [a]
:[])

density :: AbsolutelyContinuous c x => Point c x -> SamplePoint x -> Double
density :: Point c x -> SamplePoint x -> Double
density Point c x
p = Double -> Double
forall a. Floating a => a -> a
exp (Double -> Double)
-> (SamplePoint x -> Double) -> SamplePoint x -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point c x -> SamplePoint x -> Double
forall c x.
AbsolutelyContinuous c x =>
Point c x -> SamplePoint x -> Double
logDensity Point c x
p

-- | 'expectation' computes the brute force expected value of a 'Finite' set
-- given an appropriate 'density'.
expectation
    :: forall c x . (AbsolutelyContinuous c x, Discrete x)
    => Point c x
    -> (SamplePoint x -> Double)
    -> Double
expectation :: Point c x -> (SamplePoint x -> Double) -> Double
expectation Point c x
p SamplePoint x -> Double
f =
    let xs :: Sample x
xs = Proxy x -> Sample x
forall x. Discrete x => Proxy x -> Sample x
sampleSpace (Proxy x
forall k (t :: k). Proxy t
Proxy :: Proxy x)
     in [Double] -> Double
forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ (Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(*) (SamplePoint x -> Double
f (SamplePoint x -> Double) -> Sample x -> [Double]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Sample x
xs) (Point c x -> Sample x -> [Double]
forall c x.
AbsolutelyContinuous c x =>
Point c x -> Sample x -> [Double]
densities Point c x
p Sample x
xs)

-- Maximum Likelihood Estimation

-- | 'mle' computes the 'MaximumLikelihood' estimator.
class Statistical x => MaximumLikelihood c x where
    mle :: Sample x -> c # x

-- | Average log-likelihood and the differential for gradient ascent.
class Manifold x => LogLikelihood c x s where
    logLikelihood :: [s] -> c # x -> Double
    --logLikelihood xs p = average $ log <$> densities p xs
    logLikelihoodDifferential :: [s] -> c # x -> c #* x


--- Construction ---


-- | Generates a random point on the target 'Manifold' by generating random
-- samples from the given distribution.
initialize
    :: (Manifold x, Generative d y, SamplePoint y ~ Double)
    => d # y
    -> Random (c # x)
initialize :: (d # y) -> Random (c # x)
initialize d # y
q = Vector Vector (Dimension x) Double -> c # x
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector Vector (Dimension x) Double -> c # x)
-> Random (Vector Vector (Dimension x) Double) -> Random (c # x)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Random Double -> Random (Vector Vector (Dimension x) Double)
forall (n :: Nat) (m :: Type -> Type) a.
(KnownNat n, Storable a, Monad m) =>
m a -> m (Vector n a)
S.replicateM ((d # y) -> Random (SamplePoint y)
forall c x. Generative c x => Point c x -> Random (SamplePoint x)
samplePoint d # y
q)

-- | Generates an initial point on the target 'Manifold' by generating uniform
-- samples from the given vector of bounds.
uniformInitialize' :: Manifold x => B.Vector (Dimension x) (Double,Double) -> Random (Point c x)
uniformInitialize' :: Vector (Dimension x) (Double, Double) -> Random (Point c x)
uniformInitialize' Vector (Dimension x) (Double, Double)
bnds =
    (forall s. Gen s -> ST s (Point c x)) -> Random (Point c x)
forall a. (forall s. Gen s -> ST s a) -> Random a
Random ((forall s. Gen s -> ST s (Point c x)) -> Random (Point c x))
-> (forall s. Gen s -> ST s (Point c x)) -> Random (Point c x)
forall a b. (a -> b) -> a -> b
$ \Gen s
gn -> Vector Vector (Dimension x) Double -> Point c x
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector Vector (Dimension x) Double -> Point c x)
-> (Vector Vector (Dimension x) Double
    -> Vector Vector (Dimension x) Double)
-> Vector Vector (Dimension x) Double
-> Point c x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Vector (Dimension x) Double
-> Vector Vector (Dimension x) 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 (Dimension x) Double -> Point c x)
-> ST s (Vector Vector (Dimension x) Double) -> ST s (Point c x)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Double, Double) -> ST s Double)
-> Vector (Dimension x) (Double, Double)
-> ST s (Vector Vector (Dimension x) Double)
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Double, Double) -> Gen (PrimState (ST s)) -> ST s Double
forall a (m :: Type -> Type).
(Variate a, PrimMonad m) =>
(a, a) -> Gen (PrimState m) -> m a
`R.uniformR` Gen s
Gen (PrimState (ST s))
gn) Vector (Dimension x) (Double, Double)
bnds

-- | Generates an initial point on the target 'Manifold' by generating uniform
-- samples from the given vector of bounds.
uniformInitialize :: Manifold x => (Double,Double) -> Random (Point c x)
uniformInitialize :: (Double, Double) -> Random (Point c x)
uniformInitialize (Double, Double)
bnds =
    (forall s. Gen s -> ST s (Point c x)) -> Random (Point c x)
forall a. (forall s. Gen s -> ST s a) -> Random a
Random ((forall s. Gen s -> ST s (Point c x)) -> Random (Point c x))
-> (forall s. Gen s -> ST s (Point c x)) -> Random (Point c x)
forall a b. (a -> b) -> a -> b
$ \Gen s
gn -> Vector Vector (Dimension x) Double -> Point c x
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector Vector (Dimension x) Double -> Point c x)
-> ST s (Vector Vector (Dimension x) Double) -> ST s (Point c x)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ST s Double -> ST s (Vector Vector (Dimension x) Double)
forall (n :: Nat) (m :: Type -> Type) a.
(KnownNat n, Storable a, Monad m) =>
m a -> m (Vector n a)
S.replicateM ((Double, Double) -> Gen (PrimState (ST s)) -> ST s Double
forall a (m :: Type -> Type).
(Variate a, PrimMonad m) =>
(a, a) -> Gen (PrimState m) -> m a
R.uniformR (Double, Double)
bnds Gen s
Gen (PrimState (ST s))
gn)


--- Instances ---


-- Random --

instance Functor Random where
    fmap :: (a -> b) -> Random a -> Random b
fmap a -> b
f (Random forall s. Gen s -> ST s a
rx) =
        (forall s. Gen s -> ST s b) -> Random b
forall a. (forall s. Gen s -> ST s a) -> Random a
Random ((forall s. Gen s -> ST s b) -> Random b)
-> (forall s. Gen s -> ST s b) -> Random b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> ST s a -> ST s b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (ST s a -> ST s b) -> (Gen s -> ST s a) -> Gen s -> ST s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen s -> ST s a
forall s. Gen s -> ST s a
rx

instance Applicative Random where
    pure :: a -> Random a
pure a
x = (forall s. Gen s -> ST s a) -> Random a
forall a. (forall s. Gen s -> ST s a) -> Random a
Random ((forall s. Gen s -> ST s a) -> Random a)
-> (forall s. Gen s -> ST s a) -> Random a
forall a b. (a -> b) -> a -> b
$ \Gen s
_ -> a -> ST s a
forall (m :: Type -> Type) a. Monad m => a -> m a
return a
x
    <*> :: Random (a -> b) -> Random a -> Random b
(<*>) = Random (a -> b) -> Random a -> Random b
forall (m :: Type -> Type) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad Random where
    >>= :: Random a -> (a -> Random b) -> Random b
(>>=) (Random forall s. Gen s -> ST s a
rx) a -> Random b
rf =
        (forall s. Gen s -> ST s b) -> Random b
forall a. (forall s. Gen s -> ST s a) -> Random a
Random ((forall s. Gen s -> ST s b) -> Random b)
-> (forall s. Gen s -> ST s b) -> Random b
forall a b. (a -> b) -> a -> b
$ \Gen s
gn -> do
            a
a <- Gen s -> ST s a
forall s. Gen s -> ST s a
rx Gen s
gn
            let (Random forall s. Gen s -> ST s b
rv) = a -> Random b
rf a
a
            Gen s -> ST s b
forall s. Gen s -> ST s b
rv Gen s
gn


-- Replicated --

instance (Statistical x, KnownNat k, Storable (SamplePoint x))
  => Statistical (Replicated k x) where
    type SamplePoint (Replicated k x) = S.Vector k (SamplePoint x)

instance (KnownNat k, Generative c x, Storable (SamplePoint x))
  => Generative c (Replicated k x) where
    samplePoint :: Point c (Replicated k x) -> Random (SamplePoint (Replicated k x))
samplePoint = (Point c x -> Random (SamplePoint x))
-> Vector k (Point c x) -> Random (Vector k (SamplePoint x))
forall (m :: Type -> Type) a b (n :: Nat).
(Monad m, Storable a, Storable b) =>
(a -> m b) -> Vector n a -> m (Vector n b)
S.mapM Point c x -> Random (SamplePoint x)
forall c x. Generative c x => Point c x -> Random (SamplePoint x)
samplePoint (Vector k (Point c x) -> Random (Vector k (SamplePoint x)))
-> (Point c (Replicated k x) -> Vector k (Point c x))
-> Point c (Replicated k x)
-> Random (Vector k (SamplePoint x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point c (Replicated k x) -> Vector k (Point c x)
forall (k :: Nat) x c.
(KnownNat k, Manifold x) =>
(c # Replicated k x) -> Vector k (c # x)
splitReplicated

instance (KnownNat k, Storable (SamplePoint x), AbsolutelyContinuous c x)
  => AbsolutelyContinuous c (Replicated k x) where
    densities :: Point c (Replicated k x) -> Sample (Replicated k x) -> [Double]
densities Point c (Replicated k x)
cx Sample (Replicated k x)
sxss =
        let sxss' :: [[SamplePoint x]]
sxss' = [[SamplePoint x]] -> [[SamplePoint x]]
forall a. [[a]] -> [[a]]
L.transpose ([[SamplePoint x]] -> [[SamplePoint x]])
-> [[SamplePoint x]] -> [[SamplePoint x]]
forall a b. (a -> b) -> a -> b
$ Vector k (SamplePoint x) -> [SamplePoint x]
forall a (n :: Nat). Storable a => Vector n a -> [a]
S.toList (Vector k (SamplePoint x) -> [SamplePoint x])
-> [Vector k (SamplePoint x)] -> [[SamplePoint x]]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Vector k (SamplePoint x)]
Sample (Replicated k x)
sxss
            cxs :: [c # x]
cxs = Vector k (c # x) -> [c # x]
forall a (n :: Nat). Storable a => Vector n a -> [a]
S.toList (Vector k (c # x) -> [c # x]) -> Vector k (c # x) -> [c # x]
forall a b. (a -> b) -> a -> b
$ Point c (Replicated k x) -> Vector k (c # x)
forall (k :: Nat) x c.
(KnownNat k, Manifold x) =>
(c # Replicated k x) -> Vector k (c # x)
splitReplicated Point c (Replicated k x)
cx
            dnss :: [[Double]]
dnss = ((c # x) -> [SamplePoint x] -> [Double])
-> [c # x] -> [[SamplePoint x]] -> [[Double]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (c # x) -> [SamplePoint x] -> [Double]
forall c x.
AbsolutelyContinuous c x =>
Point c x -> Sample x -> [Double]
densities [c # x]
cxs [[SamplePoint x]]
sxss'
         in [Double] -> Double
forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
product ([Double] -> Double) -> [[Double]] -> [Double]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Double]] -> [[Double]]
forall a. [[a]] -> [[a]]
L.transpose [[Double]]
dnss

instance (KnownNat k, LogLikelihood c x s, Storable s)
  => LogLikelihood c (Replicated k x) (S.Vector k s) where
    logLikelihood :: [Vector k s] -> (c # Replicated k x) -> Double
logLikelihood [Vector k s]
cxs c # Replicated k x
ps = Vector k Double -> Double
forall a (n :: Nat). (Storable a, Num a) => Vector n a -> a
S.sum (Vector k Double -> Double)
-> (Vector k (c # x) -> Vector k Double)
-> Vector k (c # x)
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Finite k -> (c # x) -> Double)
-> Vector k (c # x) -> Vector k Double
forall a b (n :: Nat).
(Storable a, Storable b) =>
(Finite n -> a -> b) -> Vector n a -> Vector n b
S.imap Finite k -> (c # x) -> Double
subLogLikelihood (Vector k (c # x) -> Double) -> Vector k (c # x) -> Double
forall a b. (a -> b) -> a -> b
$ (c # Replicated k x) -> Vector k (c # x)
forall (k :: Nat) x c.
(KnownNat k, Manifold x) =>
(c # Replicated k x) -> Vector k (c # x)
splitReplicated c # Replicated k x
ps
        where subLogLikelihood :: Finite k -> (c # x) -> Double
subLogLikelihood Finite k
fn = [s] -> (c # x) -> Double
forall c x s. LogLikelihood c x s => [s] -> (c # x) -> Double
logLikelihood ((Vector k s -> Finite k -> s) -> Finite k -> Vector k s -> s
forall a b c. (a -> b -> c) -> b -> a -> c
flip Vector k s -> Finite k -> s
forall (n :: Nat) a. Storable a => Vector n a -> Finite n -> a
S.index Finite k
fn (Vector k s -> s) -> [Vector k s] -> [s]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Vector k s]
cxs)
    logLikelihoodDifferential :: [Vector k s] -> (c # Replicated k x) -> c #* Replicated k x
logLikelihoodDifferential [Vector k s]
cxs c # Replicated k x
ps =
        Vector k (Dual c # x) -> c #* Replicated k x
forall (k :: Nat) x c.
(KnownNat k, Manifold x) =>
Vector k (c # x) -> c # Replicated k x
joinReplicated (Vector k (Dual c # x) -> c #* Replicated k x)
-> (Vector k (c # x) -> Vector k (Dual c # x))
-> Vector k (c # x)
-> c #* Replicated k x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Finite k -> (c # x) -> Dual c # x)
-> Vector k (c # x) -> Vector k (Dual c # x)
forall a b (n :: Nat).
(Storable a, Storable b) =>
(Finite n -> a -> b) -> Vector n a -> Vector n b
S.imap Finite k -> (c # x) -> Dual c # x
subLogLikelihoodDifferential (Vector k (c # x) -> c #* Replicated k x)
-> Vector k (c # x) -> c #* Replicated k x
forall a b. (a -> b) -> a -> b
$ (c # Replicated k x) -> Vector k (c # x)
forall (k :: Nat) x c.
(KnownNat k, Manifold x) =>
(c # Replicated k x) -> Vector k (c # x)
splitReplicated c # Replicated k x
ps
            where subLogLikelihoodDifferential :: Finite k -> (c # x) -> Dual c # x
subLogLikelihoodDifferential Finite k
fn =
                    [s] -> (c # x) -> Dual c # x
forall c x s. LogLikelihood c x s => [s] -> (c # x) -> c #* x
logLikelihoodDifferential ((Vector k s -> Finite k -> s) -> Finite k -> Vector k s -> s
forall a b c. (a -> b -> c) -> b -> a -> c
flip Vector k s -> Finite k -> s
forall (n :: Nat) a. Storable a => Vector n a -> Finite n -> a
S.index Finite k
fn (Vector k s -> s) -> [Vector k s] -> [s]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Vector k s]
cxs)


-- Pair --


instance (Statistical x) => Statistical [x] where
    type SamplePoint [x] = [SamplePoint x]

instance (Statistical x, Statistical y)
  => Statistical (x,y) where
    type SamplePoint (x,y) = (SamplePoint x, SamplePoint y)

instance (Generative c x, Generative c y) => Generative c (x,y) where
    samplePoint :: Point c (x, y) -> Random (SamplePoint (x, y))
samplePoint Point c (x, y)
pmn = do
        let (Point c x
pm,Point c y
pn) = Point c (x, y) -> (c # First (x, y), c # Second (x, y))
forall z c. Product z => (c # z) -> (c # First z, c # Second z)
split Point c (x, y)
pmn
        SamplePoint x
xm <- Point c x -> Random (SamplePoint x)
forall c x. Generative c x => Point c x -> Random (SamplePoint x)
samplePoint Point c x
pm
        SamplePoint y
xn <- Point c y -> Random (SamplePoint y)
forall c x. Generative c x => Point c x -> Random (SamplePoint x)
samplePoint Point c y
pn
        (SamplePoint x, SamplePoint y)
-> Random (SamplePoint x, SamplePoint y)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SamplePoint x
xm,SamplePoint y
xn)

instance (AbsolutelyContinuous c x, AbsolutelyContinuous c y)
  => AbsolutelyContinuous c (x,y) where
    densities :: Point c (x, y) -> Sample (x, y) -> [Double]
densities Point c (x, y)
cxy Sample (x, y)
sxys =
        let (Point c x
cx,Point c y
cy) = Point c (x, y) -> (c # First (x, y), c # Second (x, y))
forall z c. Product z => (c # z) -> (c # First z, c # Second z)
split Point c (x, y)
cxy
            ([SamplePoint x]
sxs,[SamplePoint y]
sys) = [(SamplePoint x, SamplePoint y)]
-> ([SamplePoint x], [SamplePoint y])
forall a b. [(a, b)] -> ([a], [b])
unzip [(SamplePoint x, SamplePoint y)]
Sample (x, y)
sxys
         in (Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(*) (Point c x -> [SamplePoint x] -> [Double]
forall c x.
AbsolutelyContinuous c x =>
Point c x -> Sample x -> [Double]
densities Point c x
cx [SamplePoint x]
sxs) ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ Point c y -> [SamplePoint y] -> [Double]
forall c x.
AbsolutelyContinuous c x =>
Point c x -> Sample x -> [Double]
densities Point c y
cy [SamplePoint y]
sys