module Numeric.Uncertain.Correlated.Interactive (
CVar,
CVarIO,
sampleUncert,
sampleExact,
constC,
resolveUncert,
liftC,
liftC2,
liftC3,
liftC4,
liftC5,
liftCF,
)
where
import Control.Monad.ST
import Control.Monad.Trans.State
import Data.IORef
import qualified Data.IntMap.Strict as M
import Data.Tuple
import Numeric.Uncertain
import qualified Numeric.Uncertain.Correlated as C
import Numeric.Uncertain.Correlated.Internal
import System.IO.Unsafe (unsafePerformIO)
type CVarIO = CVar RealWorld Double
globalCorrMap :: IORef (M.Key, M.IntMap (Uncert Double))
{-# NOINLINE globalCorrMap #-}
globalCorrMap :: IORef (Key, IntMap (Uncert Double))
globalCorrMap = IO (IORef (Key, IntMap (Uncert Double)))
-> IORef (Key, IntMap (Uncert Double))
forall a. IO a -> a
unsafePerformIO (IO (IORef (Key, IntMap (Uncert Double)))
-> IORef (Key, IntMap (Uncert Double)))
-> IO (IORef (Key, IntMap (Uncert Double)))
-> IORef (Key, IntMap (Uncert Double))
forall a b. (a -> b) -> a -> b
$ (Key, IntMap (Uncert Double))
-> IO (IORef (Key, IntMap (Uncert Double)))
forall a. a -> IO (IORef a)
newIORef (Key
0, IntMap (Uncert Double)
forall a. IntMap a
M.empty)
runCorrIO :: Corr RealWorld Double a -> IO a
runCorrIO :: forall a. Corr RealWorld Double a -> IO a
runCorrIO Corr RealWorld Double a
c =
IORef (Key, IntMap (Uncert Double))
-> ((Key, IntMap (Uncert Double))
-> ((Key, IntMap (Uncert Double)), a))
-> IO a
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef'
IORef (Key, IntMap (Uncert Double))
globalCorrMap
((a, (Key, IntMap (Uncert Double)))
-> ((Key, IntMap (Uncert Double)), a)
forall a b. (a, b) -> (b, a)
swap ((a, (Key, IntMap (Uncert Double)))
-> ((Key, IntMap (Uncert Double)), a))
-> ((Key, IntMap (Uncert Double))
-> (a, (Key, IntMap (Uncert Double))))
-> (Key, IntMap (Uncert Double))
-> ((Key, IntMap (Uncert Double)), a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State (Key, IntMap (Uncert Double)) a
-> (Key, IntMap (Uncert Double))
-> (a, (Key, IntMap (Uncert Double)))
forall s a. State s a -> s -> (a, s)
runState (Corr RealWorld Double a -> State (Key, IntMap (Uncert Double)) a
forall (m :: * -> *) a s b.
(Monad m, Fractional a) =>
Corr s a b -> StateT (Key, IntMap (Uncert a)) m b
corrToState Corr RealWorld Double a
c))
{-# INLINE runCorrIO #-}
sampleUncert :: Uncert Double -> IO CVarIO
sampleUncert :: Uncert Double -> IO CVarIO
sampleUncert Uncert Double
u = Corr RealWorld Double CVarIO -> IO CVarIO
forall a. Corr RealWorld Double a -> IO a
runCorrIO (Corr RealWorld Double CVarIO -> IO CVarIO)
-> Corr RealWorld Double CVarIO -> IO CVarIO
forall a b. (a -> b) -> a -> b
$ Uncert Double -> Corr RealWorld Double CVarIO
forall a s. Uncert a -> Corr s a (CVar s a)
C.sampleUncert Uncert Double
u
{-# INLINEABLE sampleUncert #-}
sampleExact :: Double -> IO CVarIO
sampleExact :: Double -> IO CVarIO
sampleExact Double
d = Corr RealWorld Double CVarIO -> IO CVarIO
forall a. Corr RealWorld Double a -> IO a
runCorrIO (Corr RealWorld Double CVarIO -> IO CVarIO)
-> Corr RealWorld Double CVarIO -> IO CVarIO
forall a b. (a -> b) -> a -> b
$ Double -> Corr RealWorld Double CVarIO
forall a s. a -> Corr s a (CVar s a)
C.sampleExact Double
d
{-# INLINEABLE sampleExact #-}
resolveUncert :: CVarIO -> IO (Uncert Double)
resolveUncert :: CVarIO -> IO (Uncert Double)
resolveUncert CVarIO
v = Corr RealWorld Double (Uncert Double) -> IO (Uncert Double)
forall a. Corr RealWorld Double a -> IO a
runCorrIO (Corr RealWorld Double (Uncert Double) -> IO (Uncert Double))
-> Corr RealWorld Double (Uncert Double) -> IO (Uncert Double)
forall a b. (a -> b) -> a -> b
$ CVarIO -> Corr RealWorld Double (Uncert Double)
forall s a. CVar s a -> Corr s a (Uncert a)
C.resolveUncert CVarIO
v
{-# INLINEABLE resolveUncert #-}