{-# LANGUAGE RankNTypes #-}

-- |
-- Module      : Numeric.Uncertain.Correlated
-- Copyright   : (c) Justin Le 2016
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Provides the 'Corr' monad, which allows one to describe complex
-- relationships between random variables and evaluate their propagated
-- uncertainties /respecting/ their inter-correlations.
--
-- See the "Numeric.Uncertain.Correlated.Interactive" module for an
-- "interactive" and exploratory interface for this module's functionality.
module Numeric.Uncertain.Correlated (
  -- * 'Corr'
  Corr,
  evalCorr,

  -- * Uncertain and Correlated Values
  CVar,

  -- ** Sampling
  sampleUncert,
  sampleExact,
  constC,

  -- ** Resolving
  resolveUncert,

  -- * Applying arbitrary functions
  liftC,
  liftC2,
  liftC3,
  liftC4,
  liftC5,
  liftCF,
)
where

import Control.Monad.Free
import Control.Monad.Trans.State
import qualified Data.IntMap.Strict as M
import Numeric.Uncertain
import Numeric.Uncertain.Correlated.Internal

-- | Evaluates the value described by a 'Corr' monad, taking into account
-- inter-correlations between samples.
--
-- Takes a universally qualified 'Corr', which should not affect usage.
-- See the examples in the documentation for 'Corr'.  The univeral
-- qualification is mostly a type system trick to ensure that you aren't
-- allowed to ever use 'evalCorr' to evaluate a 'CVar'.
evalCorr :: Fractional a => (forall s. Corr s a b) -> b
evalCorr :: forall a b. Fractional a => (forall s. Corr s a b) -> b
evalCorr forall s. Corr s a b
c = State (Key, IntMap (Uncert a)) b -> (Key, IntMap (Uncert a)) -> b
forall s a. State s a -> s -> a
evalState (Corr Any a b -> State (Key, IntMap (Uncert a)) b
forall (m :: * -> *) a s b.
(Monad m, Fractional a) =>
Corr s a b -> StateT (Key, IntMap (Uncert a)) m b
corrToState Corr Any a b
forall s. Corr s a b
c) (Key
0, IntMap (Uncert a)
forall a. IntMap a
M.empty)
{-# INLINEABLE evalCorr #-}

-- | Generate a sample in 'Corr' from an 'Uncert' value, independently from
-- all other samples.
--
-- Note that you can only sample @'Uncert' a@s within a @'Corr' s a@, meaning
-- that all other "sampled" values are also @a@s.
sampleUncert :: Uncert a -> Corr s a (CVar s a)
sampleUncert :: forall a s. Uncert a -> Corr s a (CVar s a)
sampleUncert Uncert a
u = CorrF s a (CVar s a) -> Corr s a (CVar s a)
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CorrF s a (CVar s a) -> Corr s a (CVar s a))
-> CorrF s a (CVar s a) -> Corr s a (CVar s a)
forall a b. (a -> b) -> a -> b
$ Uncert a -> (CVar s a -> CVar s a) -> CorrF s a (CVar s a)
forall b a c. Uncert b -> (CVar a b -> c) -> CorrF a b c
Gen Uncert a
u CVar s a -> CVar s a
forall a. a -> a
id
{-# INLINE sampleUncert #-}

-- | Generate an exact sample in 'Corr' with zero uncertainty,
-- independently from all other samples.
--
-- Not super useful, since you can do something equivalent with 'constC'
-- or the numeric instances:
--
-- @
-- sampleExact x  ≡ return ('constC' x)
-- sampleExact 10 ≡ return 10
-- @
--
-- But is provided for completeness alongside 'sampleUncert'.
--
-- Note that you can exactly sample an @a@ within a @'Corr' s a@, meaning
-- that all other "sampled" values are also @a@s.
sampleExact :: a -> Corr s a (CVar s a)
sampleExact :: forall a s. a -> Corr s a (CVar s a)
sampleExact = CVar s a -> Corr s a (CVar s a)
forall a. a -> Corr s a a
forall (m :: * -> *) a. Monad m => a -> m a
return (CVar s a -> Corr s a (CVar s a))
-> (a -> CVar s a) -> a -> Corr s a (CVar s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CVar s a
forall a s. a -> CVar s a
constC
{-# INLINE sampleExact #-}

-- | "Resolve" an 'Uncert' from a 'CVar' using its potential multiple
-- samples and sample sources, taking into account inter-correlations
-- between 'CVar's and samples.
--
-- Note that if you use 'sampleUncert' on the result, the new sample will
-- be treated as something completely independent.  Usually this should
-- only be used as the "exit point" of a 'Corr' description.
resolveUncert :: CVar s a -> Corr s a (Uncert a)
resolveUncert :: forall s a. CVar s a -> Corr s a (Uncert a)
resolveUncert CVar s a
v = CorrF s a (Uncert a) -> Corr s a (Uncert a)
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CorrF s a (Uncert a) -> Corr s a (Uncert a))
-> CorrF s a (Uncert a) -> Corr s a (Uncert a)
forall a b. (a -> b) -> a -> b
$ CVar s a -> (Uncert a -> Uncert a) -> CorrF s a (Uncert a)
forall a b c. CVar a b -> (Uncert b -> c) -> CorrF a b c
Rei CVar s a
v Uncert a -> Uncert a
forall a. a -> a
id
{-# INLINE resolveUncert #-}