{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_HADDOCK hide #-}
{-# OPTIONS_HADDOCK prune #-}

-- |
-- Module      : Numeric.Uncertain.Correlated.Internal
-- Copyright   : (c) Justin Le 2016
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Internal utility functions for functionality shared by
-- "Numeric.Uncertain.Correlated" and
-- "Numeric.Uncertain.Correlated.Interactive".
module Numeric.Uncertain.Correlated.Internal (
  CVar,
  dephantom,
  CorrF (..),
  Corr,
  liftCF,
  constC,
  liftC,
  liftC2,
  liftC3,
  liftC4,
  liftC5,
  corrToState,
)
where

import Control.Arrow ((***))
import Control.Monad.Free
import Control.Monad.Trans.State
import Data.Hople
import qualified Data.IntMap.Strict as M
import Data.Kind
import Numeric.AD.Mode.Sparse
import Numeric.Uncertain
import Prelude.Compat

-- | Represents a single sample (or a value calculated from samples) within
-- the 'Corr' monad.  These can be created with 'sampleUncert',
-- 'sampleExact', and 'constC', or made by combinining others with its
-- numeric typeclass instances (like 'Num') or its functions lifting
-- arbitrary numeric functions (like 'liftC2').  These keep track of
-- inter-correlations between sources, and if you add together two 'CVar's
-- that are correlated, their results will reflect this.
--
-- Can be "resolved" into the uncertain value they represent using
-- 'resolveUncert'.
--
-- Note that these are parameterized by a dummy phantom parameter 's' so
-- that they can't be "evaluated" out of the 'Corr' they live in with
-- 'evalCorr'.
--
-- Note that a @'CVar' s a@ can only ever meaningfully "exist" in a @'Corr'
-- s a@, meaning that the all samples within that 'Corr' are of the same
-- type.
data CVar s a where
  CK :: a -> CVar s a
  CV :: M.Key -> CVar s a
  CF ::
    Functor f =>
    (forall t. f (AD t (Sparse a)) -> AD t (Sparse a)) ->
    f (CVar s a) ->
    CVar s a

-- | Unsafe function to bypass the universal qualification guard for
-- returning 'CVar's from 'Corr's.
dephantom :: CVar s a -> CVar t a
dephantom :: forall s a t. CVar s a -> CVar t a
dephantom = \case
  CK a
x -> a -> CVar t a
forall a s. a -> CVar s a
CK a
x
  CV Key
k -> Key -> CVar t a
forall s a. Key -> CVar s a
CV Key
k
  CF forall t. f (AD t (Sparse a)) -> AD t (Sparse a)
f f (CVar s a)
xs -> (forall t. f (AD t (Sparse a)) -> AD t (Sparse a))
-> f (CVar t a) -> CVar t a
forall (f :: * -> *) a s.
Functor f =>
(forall t. f (AD t (Sparse a)) -> AD t (Sparse a))
-> f (CVar s a) -> CVar s a
CF f (AD t (Sparse a)) -> AD t (Sparse a)
forall t. f (AD t (Sparse a)) -> AD t (Sparse a)
f (CVar s a -> CVar t a
forall s a t. CVar s a -> CVar t a
dephantom (CVar s a -> CVar t a) -> f (CVar s a) -> f (CVar t a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (CVar s a)
xs)

data CorrF :: Type -> Type -> Type -> Type where
  Gen :: Uncert a -> (CVar s a -> b) -> CorrF s a b
  Fun ::
    Functor f =>
    (forall t. f (AD t (Sparse a)) -> AD t (Sparse a)) ->
    f (CVar s a) ->
    (CVar s a -> b) ->
    CorrF s a b
  Rei ::
    CVar s a ->
    (Uncert a -> b) ->
    CorrF s a b

instance Functor (CorrF s a) where
  fmap :: forall a b. (a -> b) -> CorrF s a a -> CorrF s a b
fmap a -> b
f = \case
    Gen Uncert a
u CVar s a -> a
next -> Uncert a -> (CVar s a -> b) -> CorrF s a b
forall a s b. Uncert a -> (CVar s a -> b) -> CorrF s a b
Gen Uncert a
u (a -> b
f (a -> b) -> (CVar s a -> a) -> CVar s a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CVar s a -> a
next)
    Fun forall t. f (AD t (Sparse a)) -> AD t (Sparse a)
g f (CVar s a)
us CVar s a -> a
next -> (forall t. f (AD t (Sparse a)) -> AD t (Sparse a))
-> f (CVar s a) -> (CVar s a -> b) -> CorrF s a b
forall (f :: * -> *) a s b.
Functor f =>
(forall t. f (AD t (Sparse a)) -> AD t (Sparse a))
-> f (CVar s a) -> (CVar s a -> b) -> CorrF s a b
Fun f (AD t (Sparse a)) -> AD t (Sparse a)
forall t. f (AD t (Sparse a)) -> AD t (Sparse a)
g f (CVar s a)
us (a -> b
f (a -> b) -> (CVar s a -> a) -> CVar s a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CVar s a -> a
next)
    Rei CVar s a
v Uncert a -> a
next -> CVar s a -> (Uncert a -> b) -> CorrF s a b
forall s a b. CVar s a -> (Uncert a -> b) -> CorrF s a b
Rei CVar s a
v (a -> b
f (a -> b) -> (Uncert a -> a) -> Uncert a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uncert a -> a
next)

-- | The 'Corr' monad allows us to keep track of correlated and
-- non-independent samples.  It fixes a basic "failure" of the 'Uncert'
-- type, which can't describe correlated samples.
--
-- For example, consider the difference between:
--
-- @
-- ghci> sum $ replicate 10 (12.5 '+/-' 0.8)
-- 125 +/- 3
-- ghci> 10 * (12.5 +/- 0.8)
-- 125 +/- 8
-- @
--
-- The first one represents the addition of ten independent samples, whose
-- errors will in general cancel eachother out.   The second one represents
-- sampling once and multiplying it by ten, which will amplify any error by
-- a full factor of 10.
--
-- See how the 'Corr' monad expresses the above computations:
--
-- @
-- ghci> 'evalCorr' $ do
--         x  <- 'sampleUncert' $ 12.5 '+/-' 0.8
--         y1 <- 'resolveUncert' $ sum (replicate 10 x)
--         y2 <- resolveUncert $ 10 * x
--         return (y1, y2)
-- (125 +\/- 8, 125 +\/- 8)
--
-- ghci> 'evalCorr' $ do
--         xs <- replicateM 10 ('sampleUncert' (12.5 +/- 0.8))
--         'resolveUncert' $ sum xs
-- 125 +/- 3
-- @
--
-- The first example samples once and describes operations on the single
-- sample; the second example samples 10 times with 'replicateM' and sums
-- all of the results.
--
-- Things are more interesting when you sample multiple variables:
--
-- @
-- ghci> 'evalCorr' $ do
--         x <- 'sampleUncert' $ 12.5 '+/-' 0.8
--         y <- sampleUncert $ 15.9 +/- 0.5
--         z <- sampleUncert $ 1.52 +/- 0.07
--         let k = y ** x
--         'resolveUncert' $ (x+z) * logBase z k
-- 1200 +/- 200
-- @
--
-- The first parameter is a dummy phantom parameter used to prevent 'CVar's
-- from leaking out of the computation (see 'evalCorr').  The second
-- parameter is the numeric type of all samples within the description (for
-- example, if you ever sample an @'Uncert' 'Double'@, the second parameter wil
-- be 'Double').  The third parameter is the result type of the
-- computation -- the value the 'Corr' is describing.
newtype Corr s a b = Corr
  { forall s a b. Corr s a b -> Free (CorrF s a) b
corrFree :: Free (CorrF s a) b
  }
  deriving ((forall a b. (a -> b) -> Corr s a a -> Corr s a b)
-> (forall a b. a -> Corr s a b -> Corr s a a)
-> Functor (Corr s a)
forall a b. a -> Corr s a b -> Corr s a a
forall a b. (a -> b) -> Corr s a a -> Corr s a b
forall s a a b. a -> Corr s a b -> Corr s a a
forall s a a b. (a -> b) -> Corr s a a -> Corr s a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall s a a b. (a -> b) -> Corr s a a -> Corr s a b
fmap :: forall a b. (a -> b) -> Corr s a a -> Corr s a b
$c<$ :: forall s a a b. a -> Corr s a b -> Corr s a a
<$ :: forall a b. a -> Corr s a b -> Corr s a a
Functor, Functor (Corr s a)
Functor (Corr s a) =>
(forall a. a -> Corr s a a)
-> (forall a b. Corr s a (a -> b) -> Corr s a a -> Corr s a b)
-> (forall a b c.
    (a -> b -> c) -> Corr s a a -> Corr s a b -> Corr s a c)
-> (forall a b. Corr s a a -> Corr s a b -> Corr s a b)
-> (forall a b. Corr s a a -> Corr s a b -> Corr s a a)
-> Applicative (Corr s a)
forall a. a -> Corr s a a
forall s a. Functor (Corr s a)
forall a b. Corr s a a -> Corr s a b -> Corr s a a
forall a b. Corr s a a -> Corr s a b -> Corr s a b
forall a b. Corr s a (a -> b) -> Corr s a a -> Corr s a b
forall s a a. a -> Corr s a a
forall a b c.
(a -> b -> c) -> Corr s a a -> Corr s a b -> Corr s a c
forall s a a b. Corr s a a -> Corr s a b -> Corr s a a
forall s a a b. Corr s a a -> Corr s a b -> Corr s a b
forall s a a b. Corr s a (a -> b) -> Corr s a a -> Corr s a b
forall s a a b c.
(a -> b -> c) -> Corr s a a -> Corr s a b -> Corr s a c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall s a a. a -> Corr s a a
pure :: forall a. a -> Corr s a a
$c<*> :: forall s a a b. Corr s a (a -> b) -> Corr s a a -> Corr s a b
<*> :: forall a b. Corr s a (a -> b) -> Corr s a a -> Corr s a b
$cliftA2 :: forall s a a b c.
(a -> b -> c) -> Corr s a a -> Corr s a b -> Corr s a c
liftA2 :: forall a b c.
(a -> b -> c) -> Corr s a a -> Corr s a b -> Corr s a c
$c*> :: forall s a a b. Corr s a a -> Corr s a b -> Corr s a b
*> :: forall a b. Corr s a a -> Corr s a b -> Corr s a b
$c<* :: forall s a a b. Corr s a a -> Corr s a b -> Corr s a a
<* :: forall a b. Corr s a a -> Corr s a b -> Corr s a a
Applicative, Applicative (Corr s a)
Applicative (Corr s a) =>
(forall a b. Corr s a a -> (a -> Corr s a b) -> Corr s a b)
-> (forall a b. Corr s a a -> Corr s a b -> Corr s a b)
-> (forall a. a -> Corr s a a)
-> Monad (Corr s a)
forall a. a -> Corr s a a
forall s a. Applicative (Corr s a)
forall a b. Corr s a a -> Corr s a b -> Corr s a b
forall a b. Corr s a a -> (a -> Corr s a b) -> Corr s a b
forall s a a. a -> Corr s a a
forall s a a b. Corr s a a -> Corr s a b -> Corr s a b
forall s a a b. Corr s a a -> (a -> Corr s a b) -> Corr s a b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall s a a b. Corr s a a -> (a -> Corr s a b) -> Corr s a b
>>= :: forall a b. Corr s a a -> (a -> Corr s a b) -> Corr s a b
$c>> :: forall s a a b. Corr s a a -> Corr s a b -> Corr s a b
>> :: forall a b. Corr s a a -> Corr s a b -> Corr s a b
$creturn :: forall s a a. a -> Corr s a a
return :: forall a. a -> Corr s a a
Monad)

deriving instance MonadFree (CorrF s a) (Corr s a)

corrToState ::
  (Monad m, Fractional a) =>
  Corr s a b ->
  StateT (M.Key, M.IntMap (Uncert a)) m b
corrToState :: forall (m :: * -> *) a s b.
(Monad m, Fractional a) =>
Corr s a b -> StateT (Key, IntMap (Uncert a)) m b
corrToState = (CorrF s a (StateT (Key, IntMap (Uncert a)) m b)
 -> StateT (Key, IntMap (Uncert a)) m b)
-> Free (CorrF s a) b -> StateT (Key, IntMap (Uncert a)) m b
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
(f (m a) -> m a) -> Free f a -> m a
iterM CorrF s a (StateT (Key, IntMap (Uncert a)) m b)
-> StateT (Key, IntMap (Uncert a)) m b
forall {s} {b}.
CorrF s a (StateT (Key, IntMap (Uncert a)) m b)
-> StateT (Key, IntMap (Uncert a)) m b
go (Free (CorrF s a) b -> StateT (Key, IntMap (Uncert a)) m b)
-> (Corr s a b -> Free (CorrF s a) b)
-> Corr s a b
-> StateT (Key, IntMap (Uncert a)) m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Corr s a b -> Free (CorrF s a) b
forall s a b. Corr s a b -> Free (CorrF s a) b
corrFree
  where
    go :: CorrF s a (StateT (Key, IntMap (Uncert a)) m b)
-> StateT (Key, IntMap (Uncert a)) m b
go = \case
      Gen Uncert a
u CVar s a -> StateT (Key, IntMap (Uncert a)) m b
next -> do
        Key
i <- ((Key, IntMap (Uncert a)) -> Key)
-> StateT (Key, IntMap (Uncert a)) m Key
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (Key, IntMap (Uncert a)) -> Key
forall a b. (a, b) -> a
fst
        ((Key, IntMap (Uncert a)) -> (Key, IntMap (Uncert a)))
-> StateT (Key, IntMap (Uncert a)) m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (((Key, IntMap (Uncert a)) -> (Key, IntMap (Uncert a)))
 -> StateT (Key, IntMap (Uncert a)) m ())
-> ((Key, IntMap (Uncert a)) -> (Key, IntMap (Uncert a)))
-> StateT (Key, IntMap (Uncert a)) m ()
forall a b. (a -> b) -> a -> b
$ Key -> Key
forall a. Enum a => a -> a
succ (Key -> Key)
-> (IntMap (Uncert a) -> IntMap (Uncert a))
-> (Key, IntMap (Uncert a))
-> (Key, IntMap (Uncert a))
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Key -> Uncert a -> IntMap (Uncert a) -> IntMap (Uncert a)
forall a. Key -> a -> IntMap a -> IntMap a
M.insert Key
i Uncert a
u
        CVar s a -> StateT (Key, IntMap (Uncert a)) m b
next (Key -> CVar s a
forall s a. Key -> CVar s a
CV Key
i)
      Fun forall t. f (AD t (Sparse a)) -> AD t (Sparse a)
f f (CVar s a)
us CVar s a -> StateT (Key, IntMap (Uncert a)) m b
next ->
        CVar s a -> StateT (Key, IntMap (Uncert a)) m b
next (CVar s a -> StateT (Key, IntMap (Uncert a)) m b)
-> CVar s a -> StateT (Key, IntMap (Uncert a)) m b
forall a b. (a -> b) -> a -> b
$ (forall t. f (AD t (Sparse a)) -> AD t (Sparse a))
-> f (CVar s a) -> CVar s a
forall (f :: * -> *) a s.
Functor f =>
(forall t. f (AD t (Sparse a)) -> AD t (Sparse a))
-> f (CVar s a) -> CVar s a
CF f (AD t (Sparse a)) -> AD t (Sparse a)
forall t. f (AD t (Sparse a)) -> AD t (Sparse a)
f f (CVar s a)
us
      Rei CVar s a
v Uncert a -> StateT (Key, IntMap (Uncert a)) m b
next -> do
        Uncert a
u <- ((Key, IntMap (Uncert a)) -> Uncert a)
-> StateT (Key, IntMap (Uncert a)) m (Uncert a)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (CVar s a -> IntMap (Uncert a) -> Uncert a
forall a s.
Fractional a =>
CVar s a -> IntMap (Uncert a) -> Uncert a
getCVar CVar s a
v (IntMap (Uncert a) -> Uncert a)
-> ((Key, IntMap (Uncert a)) -> IntMap (Uncert a))
-> (Key, IntMap (Uncert a))
-> Uncert a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key, IntMap (Uncert a)) -> IntMap (Uncert a)
forall a b. (a, b) -> b
snd)
        Uncert a -> StateT (Key, IntMap (Uncert a)) m b
next Uncert a
u
    getCVar ::
      forall a s.
      Fractional a =>
      CVar s a ->
      M.IntMap (Uncert a) ->
      Uncert a
    getCVar :: forall a s.
Fractional a =>
CVar s a -> IntMap (Uncert a) -> Uncert a
getCVar CVar s a
cv = (forall s. IntMap (AD s (Sparse a)) -> AD s (Sparse a))
-> IntMap (Uncert a) -> Uncert a
forall (f :: * -> *) a.
(Traversable f, Fractional a) =>
(forall s. f (AD s (Sparse a)) -> AD s (Sparse a))
-> f (Uncert a) -> Uncert a
liftUF (CVar s a -> IntMap (AD s (Sparse a)) -> AD s (Sparse a)
forall t. CVar s a -> IntMap (AD t (Sparse a)) -> AD t (Sparse a)
cVarToF CVar s a
cv)
      where
        cVarToF :: CVar s a -> M.IntMap (AD t (Sparse a)) -> AD t (Sparse a)
        cVarToF :: forall t. CVar s a -> IntMap (AD t (Sparse a)) -> AD t (Sparse a)
cVarToF (CK a
x) IntMap (AD t (Sparse a))
_ = Scalar (AD t (Sparse a)) -> AD t (Sparse a)
forall t. Mode t => Scalar t -> t
auto a
Scalar (AD t (Sparse a))
x
        cVarToF (CV Key
k) IntMap (AD t (Sparse a))
us = IntMap (AD t (Sparse a))
us IntMap (AD t (Sparse a)) -> Key -> AD t (Sparse a)
forall a. IntMap a -> Key -> a
M.! Key
k
        cVarToF (CF forall t. f (AD t (Sparse a)) -> AD t (Sparse a)
f f (CVar s a)
cs) IntMap (AD t (Sparse a))
us = f (AD t (Sparse a)) -> AD t (Sparse a)
forall t. f (AD t (Sparse a)) -> AD t (Sparse a)
f ((CVar s a -> IntMap (AD t (Sparse a)) -> AD t (Sparse a)
forall t. CVar s a -> IntMap (AD t (Sparse a)) -> AD t (Sparse a)
`cVarToF` IntMap (AD t (Sparse a))
us) (CVar s a -> AD t (Sparse a))
-> f (CVar s a) -> f (AD t (Sparse a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (CVar s a)
cs)
{-# INLINEABLE corrToState #-}

-- | Lifts a multivariate numeric function on a container (given as an @f
-- a -> a@) to work on a container of 'CVar's.  Correctly propagates the
-- uncertainty according to the second-order (multivariate) taylor
-- expansion of the function, and properly takes into account and keeps
-- track of all inter-correlations between the 'CVar' samples.  Note that
-- if the higher-degree taylor series terms are large with respect to the
-- means and variances, this approximation may be inaccurate.
--
-- Should take any function sufficiently polymorphic over numeric types, so
-- you can use things like '*', 'sqrt', 'atan2', etc.
--
-- @
-- ghci> 'evalCorr' $ do
--         x <- 'sampleUncert' $ 12.5 '+/-' 0.8
--         y <- sampleUncert $ 15.9 +/- 0.5
--         z <- sampleUncert $ 1.52 +/- 0.07
--         'resolveUncert' $ liftCF (\\[a,b,c] -> (a+c) * logBase c (b**a)) x y z
-- 1200 +/- 200
-- @
liftCF ::
  Functor f =>
  -- | Function on container of values to lift
  (forall t. f (AD t (Sparse a)) -> AD t (Sparse a)) ->
  -- | Container of 'CVar' samples to apply the function to
  f (CVar s a) ->
  CVar s a
liftCF :: forall (f :: * -> *) a s.
Functor f =>
(forall t. f (AD t (Sparse a)) -> AD t (Sparse a))
-> f (CVar s a) -> CVar s a
liftCF = (forall t. f (AD t (Sparse a)) -> AD t (Sparse a))
-> f (CVar s a) -> CVar s a
forall (f :: * -> *) a s.
Functor f =>
(forall t. f (AD t (Sparse a)) -> AD t (Sparse a))
-> f (CVar s a) -> CVar s a
CF
{-# INLINE liftCF #-}

-- | Creates a 'CVar' representing a completely independent sample from all
-- other 'CVar's containing the exact value given.
constC :: a -> CVar s a
constC :: forall a s. a -> CVar s a
constC = a -> CVar s a
forall a s. a -> CVar s a
CK
{-# INLINE constC #-}

-- | Lifts a numeric function over the sample represented by a 'CVar'.
-- Correctly propagates the uncertainty according to the second-order
-- taylor expansion expansion of the function.  Note that if the
-- higher-degree taylor series terms are large with respect to the mean and
-- variance, this approximation may be inaccurate.
--
-- Should take any function sufficiently polymorphic over numeric types, so
-- you can use things like 'sqrt', 'sin', 'negate', etc.
--
-- @
-- ghci> 'evalCorr' $ do
--         x <- 'sampleUncert' $ 12.5 '+/-' 0.8
--         y <- sampleUncert $ 15.9 +/- 0.5
--         'resolveUncert' $ liftC (\\z -> log z ^ 2) (x + y)
-- 11.2 +/- 0.2
-- @
liftC ::
  -- | Function on values to lift
  (forall t. AD t (Sparse a) -> AD t (Sparse a)) ->
  -- | 'CVar' sample to apply the function to
  CVar s a ->
  CVar s a
liftC :: forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
liftC forall t. AD t (Sparse a) -> AD t (Sparse a)
f = (H1 (CVar s a) -> CVar s a) -> CVar s a -> CVar s a
forall a. (H1 a -> a) -> a -> a
curryH1 ((H1 (CVar s a) -> CVar s a) -> CVar s a -> CVar s a)
-> (H1 (CVar s a) -> CVar s a) -> CVar s a -> CVar s a
forall a b. (a -> b) -> a -> b
$ (forall t. H1 (AD t (Sparse a)) -> AD t (Sparse a))
-> H1 (CVar s a) -> CVar s a
forall (f :: * -> *) a s.
Functor f =>
(forall t. f (AD t (Sparse a)) -> AD t (Sparse a))
-> f (CVar s a) -> CVar s a
liftCF ((AD t (Sparse a) -> AD t (Sparse a))
-> H1 (AD t (Sparse a)) -> AD t (Sparse a)
forall a. (a -> a) -> H1 a -> a
uncurryH1 AD t (Sparse a) -> AD t (Sparse a)
forall t. AD t (Sparse a) -> AD t (Sparse a)
f)
{-# INLINEABLE liftC #-}

-- | Lifts a two-argument (curried) function over the samples represented
-- by two 'CVar's.  Correctly propagates the uncertainty according to the
-- second-order (multivariate) taylor expansion expansion of the function,
-- and properly takes into account and keeps track of all
-- inter-correlations between the 'CVar' samples.  Note that if the
-- higher-degree taylor series terms are large with respect to the mean and
-- variance, this approximation may be inaccurate.
--
-- Should take any function sufficiently polymorphic over numeric types, so
-- you can use things like '*', 'atan2', '**', etc.
--
-- @
-- ghci> 'evalCorr' $ do
--         x <- 'sampleUncert' $ 12.5 '+/-' 0.8
--         y <- sampleUncert $ 15.9 +/- 0.5
--         'resolveUncert' $ liftC2 (\\a b -> log (a + b) ^ 2) x y
-- 11.2 +/- 0.2
-- @
liftC2 ::
  (forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a)) ->
  CVar s a ->
  CVar s a ->
  CVar s a
liftC2 :: forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a -> CVar s a
liftC2 forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a)
f = (H2 (CVar s a) -> CVar s a) -> CVar s a -> CVar s a -> CVar s a
forall a. (H2 a -> a) -> a -> a -> a
curryH2 ((H2 (CVar s a) -> CVar s a) -> CVar s a -> CVar s a -> CVar s a)
-> (H2 (CVar s a) -> CVar s a) -> CVar s a -> CVar s a -> CVar s a
forall a b. (a -> b) -> a -> b
$ (forall t. H2 (AD t (Sparse a)) -> AD t (Sparse a))
-> H2 (CVar s a) -> CVar s a
forall (f :: * -> *) a s.
Functor f =>
(forall t. f (AD t (Sparse a)) -> AD t (Sparse a))
-> f (CVar s a) -> CVar s a
liftCF ((AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a))
-> H2 (AD t (Sparse a)) -> AD t (Sparse a)
forall a. (a -> a -> a) -> H2 a -> a
uncurryH2 AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a)
forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a)
f)
{-# INLINEABLE liftC2 #-}

-- | Lifts a three-argument (curried) function over the samples represented
-- by three 'CVar's.  See 'liftC2' and 'liftCF' for more details.
liftC3 ::
  (forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a)) ->
  CVar s a ->
  CVar s a ->
  CVar s a ->
  CVar s a
liftC3 :: forall a s.
(forall t.
 AD t (Sparse a)
 -> AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a -> CVar s a -> CVar s a
liftC3 forall t.
AD t (Sparse a)
-> AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a)
f = (H3 (CVar s a) -> CVar s a)
-> CVar s a -> CVar s a -> CVar s a -> CVar s a
forall a. (H3 a -> a) -> a -> a -> a -> a
curryH3 ((H3 (CVar s a) -> CVar s a)
 -> CVar s a -> CVar s a -> CVar s a -> CVar s a)
-> (H3 (CVar s a) -> CVar s a)
-> CVar s a
-> CVar s a
-> CVar s a
-> CVar s a
forall a b. (a -> b) -> a -> b
$ (forall t. H3 (AD t (Sparse a)) -> AD t (Sparse a))
-> H3 (CVar s a) -> CVar s a
forall (f :: * -> *) a s.
Functor f =>
(forall t. f (AD t (Sparse a)) -> AD t (Sparse a))
-> f (CVar s a) -> CVar s a
liftCF ((AD t (Sparse a)
 -> AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a))
-> H3 (AD t (Sparse a)) -> AD t (Sparse a)
forall a. (a -> a -> a -> a) -> H3 a -> a
uncurryH3 AD t (Sparse a)
-> AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a)
forall t.
AD t (Sparse a)
-> AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a)
f)
{-# INLINEABLE liftC3 #-}

-- | Lifts a four-argument (curried) function over the samples represented
-- by four 'CVar's.  See 'liftC2' and 'liftCF' for more details.
liftC4 ::
  ( forall t.
    AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a)
  ) ->
  CVar s a ->
  CVar s a ->
  CVar s a ->
  CVar s a ->
  CVar s a
liftC4 :: forall a s.
(forall t.
 AD t (Sparse a)
 -> AD t (Sparse a)
 -> AD t (Sparse a)
 -> AD t (Sparse a)
 -> AD t (Sparse a))
-> CVar s a -> CVar s a -> CVar s a -> CVar s a -> CVar s a
liftC4 forall t.
AD t (Sparse a)
-> AD t (Sparse a)
-> AD t (Sparse a)
-> AD t (Sparse a)
-> AD t (Sparse a)
f = (H4 (CVar s a) -> CVar s a)
-> CVar s a -> CVar s a -> CVar s a -> CVar s a -> CVar s a
forall a. (H4 a -> a) -> a -> a -> a -> a -> a
curryH4 ((H4 (CVar s a) -> CVar s a)
 -> CVar s a -> CVar s a -> CVar s a -> CVar s a -> CVar s a)
-> (H4 (CVar s a) -> CVar s a)
-> CVar s a
-> CVar s a
-> CVar s a
-> CVar s a
-> CVar s a
forall a b. (a -> b) -> a -> b
$ (forall t. H4 (AD t (Sparse a)) -> AD t (Sparse a))
-> H4 (CVar s a) -> CVar s a
forall (f :: * -> *) a s.
Functor f =>
(forall t. f (AD t (Sparse a)) -> AD t (Sparse a))
-> f (CVar s a) -> CVar s a
liftCF ((AD t (Sparse a)
 -> AD t (Sparse a)
 -> AD t (Sparse a)
 -> AD t (Sparse a)
 -> AD t (Sparse a))
-> H4 (AD t (Sparse a)) -> AD t (Sparse a)
forall a. (a -> a -> a -> a -> a) -> H4 a -> a
uncurryH4 AD t (Sparse a)
-> AD t (Sparse a)
-> AD t (Sparse a)
-> AD t (Sparse a)
-> AD t (Sparse a)
forall t.
AD t (Sparse a)
-> AD t (Sparse a)
-> AD t (Sparse a)
-> AD t (Sparse a)
-> AD t (Sparse a)
f)
{-# INLINEABLE liftC4 #-}

-- | Lifts a five-argument (curried) function over the samples represented
-- by five 'CVar's.  See 'liftC2' and 'liftCF' for more details.
liftC5 ::
  ( forall t.
    AD t (Sparse a) ->
    AD t (Sparse a) ->
    AD t (Sparse a) ->
    AD t (Sparse a) ->
    AD t (Sparse a) ->
    AD t (Sparse a)
  ) ->
  CVar s a ->
  CVar s a ->
  CVar s a ->
  CVar s a ->
  CVar s a ->
  CVar s a
liftC5 :: forall a s.
(forall t.
 AD t (Sparse a)
 -> AD t (Sparse a)
 -> AD t (Sparse a)
 -> AD t (Sparse a)
 -> AD t (Sparse a)
 -> AD t (Sparse a))
-> CVar s a
-> CVar s a
-> CVar s a
-> CVar s a
-> CVar s a
-> CVar s a
liftC5 forall t.
AD t (Sparse a)
-> AD t (Sparse a)
-> AD t (Sparse a)
-> AD t (Sparse a)
-> AD t (Sparse a)
-> AD t (Sparse a)
f = (H5 (CVar s a) -> CVar s a)
-> CVar s a
-> CVar s a
-> CVar s a
-> CVar s a
-> CVar s a
-> CVar s a
forall a. (H5 a -> a) -> a -> a -> a -> a -> a -> a
curryH5 ((H5 (CVar s a) -> CVar s a)
 -> CVar s a
 -> CVar s a
 -> CVar s a
 -> CVar s a
 -> CVar s a
 -> CVar s a)
-> (H5 (CVar s a) -> CVar s a)
-> CVar s a
-> CVar s a
-> CVar s a
-> CVar s a
-> CVar s a
-> CVar s a
forall a b. (a -> b) -> a -> b
$ (forall t. H5 (AD t (Sparse a)) -> AD t (Sparse a))
-> H5 (CVar s a) -> CVar s a
forall (f :: * -> *) a s.
Functor f =>
(forall t. f (AD t (Sparse a)) -> AD t (Sparse a))
-> f (CVar s a) -> CVar s a
liftCF ((AD t (Sparse a)
 -> AD t (Sparse a)
 -> AD t (Sparse a)
 -> AD t (Sparse a)
 -> AD t (Sparse a)
 -> AD t (Sparse a))
-> H5 (AD t (Sparse a)) -> AD t (Sparse a)
forall a. (a -> a -> a -> a -> a -> a) -> H5 a -> a
uncurryH5 AD t (Sparse a)
-> AD t (Sparse a)
-> AD t (Sparse a)
-> AD t (Sparse a)
-> AD t (Sparse a)
-> AD t (Sparse a)
forall t.
AD t (Sparse a)
-> AD t (Sparse a)
-> AD t (Sparse a)
-> AD t (Sparse a)
-> AD t (Sparse a)
-> AD t (Sparse a)
f)
{-# INLINEABLE liftC5 #-}

instance Fractional a => Num (CVar s a) where
  + :: CVar s a -> CVar s a -> CVar s a
(+) = (forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a -> CVar s a
liftC2 AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a)
forall a. Num a => a -> a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a)
(+)
  {-# INLINE (+) #-}
  * :: CVar s a -> CVar s a -> CVar s a
(*) = (forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a -> CVar s a
liftC2 AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a)
forall a. Num a => a -> a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a)
(*)
  {-# INLINE (*) #-}
  (-) = (forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a -> CVar s a
liftC2 (-)
  {-# INLINE (-) #-}
  negate :: CVar s a -> CVar s a
negate = (forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
liftC AD t (Sparse a) -> AD t (Sparse a)
forall a. Num a => a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a)
negate
  {-# INLINE negate #-}
  abs :: CVar s a -> CVar s a
abs = (forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
liftC AD t (Sparse a) -> AD t (Sparse a)
forall a. Num a => a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a)
abs
  {-# INLINE abs #-}
  signum :: CVar s a -> CVar s a
signum = (forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
liftC AD t (Sparse a) -> AD t (Sparse a)
forall a. Num a => a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a)
signum
  {-# INLINE signum #-}
  fromInteger :: Integer -> CVar s a
fromInteger = a -> CVar s a
forall a s. a -> CVar s a
constC (a -> CVar s a) -> (Integer -> a) -> Integer -> CVar s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger
  {-# INLINE fromInteger #-}

instance Fractional a => Fractional (CVar s a) where
  recip :: CVar s a -> CVar s a
recip = (forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
liftC AD t (Sparse a) -> AD t (Sparse a)
forall a. Fractional a => a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a)
recip
  {-# INLINE recip #-}
  / :: CVar s a -> CVar s a -> CVar s a
(/) = (forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a -> CVar s a
liftC2 AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a)
forall a. Fractional a => a -> a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a)
(/)
  {-# INLINE (/) #-}
  fromRational :: Rational -> CVar s a
fromRational = a -> CVar s a
forall a s. a -> CVar s a
constC (a -> CVar s a) -> (Rational -> a) -> Rational -> CVar s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational
  {-# INLINE fromRational #-}

instance Floating a => Floating (CVar s a) where
  pi :: CVar s a
pi = a -> CVar s a
forall a s. a -> CVar s a
constC a
forall a. Floating a => a
pi
  {-# INLINE pi #-}
  exp :: CVar s a -> CVar s a
exp = (forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
liftC AD t (Sparse a) -> AD t (Sparse a)
forall a. Floating a => a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a)
exp
  {-# INLINE exp #-}
  log :: CVar s a -> CVar s a
log = (forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
liftC AD t (Sparse a) -> AD t (Sparse a)
forall a. Floating a => a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a)
log
  {-# INLINE log #-}
  sqrt :: CVar s a -> CVar s a
sqrt = (forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
liftC AD t (Sparse a) -> AD t (Sparse a)
forall a. Floating a => a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a)
sqrt
  {-# INLINE sqrt #-}
  ** :: CVar s a -> CVar s a -> CVar s a
(**) = (forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a -> CVar s a
liftC2 AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a)
forall a. Floating a => a -> a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a)
(**)
  {-# INLINE (**) #-}
  logBase :: CVar s a -> CVar s a -> CVar s a
logBase = (forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a -> CVar s a
liftC2 AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a)
forall a. Floating a => a -> a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a)
logBase
  {-# INLINE logBase #-}
  sin :: CVar s a -> CVar s a
sin = (forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
liftC AD t (Sparse a) -> AD t (Sparse a)
forall a. Floating a => a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a)
sin
  {-# INLINE sin #-}
  cos :: CVar s a -> CVar s a
cos = (forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
liftC AD t (Sparse a) -> AD t (Sparse a)
forall a. Floating a => a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a)
cos
  {-# INLINE cos #-}
  asin :: CVar s a -> CVar s a
asin = (forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
liftC AD t (Sparse a) -> AD t (Sparse a)
forall a. Floating a => a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a)
asin
  {-# INLINE asin #-}
  acos :: CVar s a -> CVar s a
acos = (forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
liftC AD t (Sparse a) -> AD t (Sparse a)
forall a. Floating a => a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a)
acos
  {-# INLINE acos #-}
  atan :: CVar s a -> CVar s a
atan = (forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
liftC AD t (Sparse a) -> AD t (Sparse a)
forall a. Floating a => a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a)
atan
  {-# INLINE atan #-}
  sinh :: CVar s a -> CVar s a
sinh = (forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
liftC AD t (Sparse a) -> AD t (Sparse a)
forall a. Floating a => a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a)
sinh
  {-# INLINE sinh #-}
  cosh :: CVar s a -> CVar s a
cosh = (forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
liftC AD t (Sparse a) -> AD t (Sparse a)
forall a. Floating a => a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a)
cosh
  {-# INLINE cosh #-}
  asinh :: CVar s a -> CVar s a
asinh = (forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
liftC AD t (Sparse a) -> AD t (Sparse a)
forall a. Floating a => a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a)
asinh
  {-# INLINE asinh #-}
  acosh :: CVar s a -> CVar s a
acosh = (forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
liftC AD t (Sparse a) -> AD t (Sparse a)
forall a. Floating a => a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a)
acosh
  {-# INLINE acosh #-}
  atanh :: CVar s a -> CVar s a
atanh = (forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
forall a s.
(forall t. AD t (Sparse a) -> AD t (Sparse a))
-> CVar s a -> CVar s a
liftC AD t (Sparse a) -> AD t (Sparse a)
forall a. Floating a => a -> a
forall t. AD t (Sparse a) -> AD t (Sparse a)
atanh
  {-# INLINE atanh #-}