packages feed

uncertain 0.3.1.0 → 0.4.0.0

raw patch · 10 files changed

+821/−757 lines, 10 filessetup-changedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Numeric.Uncertain: pattern (:+/-) :: Floating a => a -> a -> Uncert a
- Numeric.Uncertain.MonteCarlo: liftU4 :: PrimMonad m => (Double -> Double -> Double -> Double -> Double) -> Uncert Double -> Uncert Double -> Uncert Double -> Uncert Double -> Gen (PrimState m) -> m (Uncert Double)
+ Numeric.Uncertain.MonteCarlo: liftU4 :: (PrimMonad m, Applicative m) => (Double -> Double -> Double -> Double -> Double) -> Uncert Double -> Uncert Double -> Uncert Double -> Uncert Double -> Gen (PrimState m) -> m (Uncert Double)

Files

CHANGELOG.md view
@@ -1,5 +1,18 @@+Changelog+=========++Version 0.4.0.0+---------------++*August 22, 2024*++<https://github.com/mstksg/uncertain/releases/tag/v0.4.0.0>++* Dropped support for GHC < 8.10+* Fixed support for GHC 9.0+ Version 0.3.1.0-===============+---------------  <https://github.com/mstksg/uncertain/releases/tag/v0.3.1.0> @@ -13,7 +26,7 @@     module's `liftUX` functions.  Version 0.3.0.0-===============+---------------  <https://github.com/mstksg/uncertain/releases/tag/v0.3.0.0> @@ -22,7 +35,7 @@     convention of other similar libraries.  Version 0.2.0.0-===============+---------------  <https://github.com/mstksg/uncertain/releases/tag/v0.2.0.0>
README.md view
@@ -1,14 +1,15 @@ Uncertain ========= +[![uncertain on Hackage](https://img.shields.io/hackage/v/uncertain.svg?maxAge=2592000)](https://hackage.haskell.org/package/uncertain)+[![uncertain on Stackage LTS](http://stackage.org/package/uncertain/badge/lts)](http://stackage.org/lts/package/uncertain)+[![uncertain on Stackage Nightly](http://stackage.org/package/uncertain/badge/nightly)](http://stackage.org/nightly/package/uncertain) [![Build Status](https://travis-ci.org/mstksg/uncertain.svg?branch=master)](https://travis-ci.org/mstksg/uncertain)  Provides tools to manipulate numbers with inherent experimental/measurement uncertainty, and propagates them through functions based on principles from statistics. -Documentation maintained at <https://mstksg.github.io/uncertain>.- ## Usage  ```haskell@@ -94,7 +95,8 @@ ## Monte Carlo-based propagation of uncertainty  Provides a module for propagating uncertainty using [Monte Carlo-simulations][]+simulations][], which could potentially be more accurate if third-order and+higher taylor series expansion terms are non-negligible.  [Monte Carlo simulations]: https://en.wikipedia.org/wiki/Monte_Carlo_method @@ -122,11 +124,11 @@ ## Comparisons  Note that this is very different from other libraries with similar data types-(like from [intervals][] and [rounding][]); these do not attempt to maintain intervals or-simply digit precisions; they instead are intended to model actual-experimental and measurement data with their uncertainties, and apply-functions to the data with the uncertainties and properly propagating the-errors with sound statistical principles.+(like from [intervals][] and [rounding][]); these do not attempt to maintain+intervals or simply digit precisions; they instead are intended to model actual+experimental and measurement data with their uncertainties, and apply functions+to the data with the uncertainties and properly propagating the errors with+sound statistical principles.  [intervals]: https://hackage.haskell.org/package/intervals [rounding]: https://hackage.haskell.org/package/rounding
Setup.hs view
@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain
src/Data/Hople.hs view
@@ -1,9 +1,7 @@-{-# LANGUAGE DeriveFoldable    #-}-{-# LANGUAGE DeriveFunctor     #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE NoImplicitPrelude #-}-{-# OPTIONS_HADDOCK hide       #-}-{-# OPTIONS_HADDOCK prune      #-}+{-# OPTIONS_HADDOCK hide #-}+{-# OPTIONS_HADDOCK prune #-}  -- | -- Module      : Data.Hople@@ -15,22 +13,28 @@ -- Portability : non-portable -- -- Homogeneous strict tuples used for implementing 'liftU2', etc.--module Data.Hople-  ( H1(..)-  , H2(..)-  , H3(..)-  , H4(..)-  , H5(..)-  , curryH1, curryH2, curryH3, curryH4, curryH5-  , uncurryH1, uncurryH2, uncurryH3, uncurryH4, uncurryH5-  )-  where+module Data.Hople (+  H1 (..),+  H2 (..),+  H3 (..),+  H4 (..),+  H5 (..),+  curryH1,+  curryH2,+  curryH3,+  curryH4,+  curryH5,+  uncurryH1,+  uncurryH2,+  uncurryH3,+  uncurryH4,+  uncurryH5,+)+where  import Prelude.Compat --data H1 a = H1 !a+newtype H1 a = H1 a   deriving (Functor, Foldable, Traversable, Show)  data H2 a = H2 !a !a@@ -84,4 +88,3 @@ uncurryH5 :: (a -> a -> a -> a -> a -> a) -> H5 a -> a uncurryH5 f (H5 x y z a b) = f x y z a b {-# INLINE uncurryH5 #-}-
src/Numeric/Uncertain.hs view
@@ -1,12 +1,12 @@-{-# LANGUAGE CPP                 #-}-{-# LANGUAGE DeriveDataTypeable  #-}-{-# LANGUAGE DeriveGeneric       #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE LambdaCase          #-}-{-# LANGUAGE NoImplicitPrelude   #-}-{-# LANGUAGE RankNTypes          #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ViewPatterns        #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE NoImplicitPrelude #-}  #if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE PatternSynonyms     #-}@@ -20,42 +20,52 @@ -- Maintainer  : justin@jle.im -- Stability   : experimental -- Portability : non-portable---+module Numeric.Uncertain (+  -- * 'Uncert'+  Uncert ((:+/-)), -module Numeric.Uncertain-  ( -- * 'Uncert'-#if __GLASGOW_HASKELL__ >= 810-    Uncert((:+/-))-#else-    Uncert-#if __GLASGOW_HASKELL__ >= 708-  , pattern (:+/-)-#endif-#endif-    -- ** Creating 'Uncert' values-  , (+/-), exact, withPrecision, withPrecisionAtBase, withVar, fromSamples-    -- ** Inspecting properties-  , uMean, uVar, uStd, uMeanVar, uMeanStd, uRange-    -- * Applying arbitrary functions-  , liftU-  , liftU2, liftU3, liftU4, liftU5, liftUF-    -- * Utility functions-  , uNormalize, uNormalizeAtBase-  , uShow, uShowsPrec-  )-  where+  -- ** Creating 'Uncert' values+  (+/-),+  exact,+  withPrecision,+  withPrecisionAtBase,+  withVar,+  fromSamples, -import           Data.Data-import           Data.Foldable          (toList, foldl')-import           Data.Function-import           Data.Hople-import           Data.Ord-import           GHC.Generics-import           Numeric.AD.Mode.Sparse-import           Prelude.Compat-import qualified Numeric.AD.Mode.Tower  as T+  -- ** Inspecting properties+  uMean,+  uVar,+  uStd,+  uMeanVar,+  uMeanStd,+  uRange, +  -- * Applying arbitrary functions+  liftU,+  liftU2,+  liftU3,+  liftU4,+  liftU5,+  liftUF, +  -- * Utility functions+  uNormalize,+  uNormalizeAtBase,+  uShow,+  uShowsPrec,+)+where++import Data.Data+import Data.Foldable (toList)+import Data.Function+import Data.Hople+import Data.Ord+import GHC.Generics+import Numeric.AD.Mode.Sparse+import qualified Numeric.AD.Mode.Tower as T+import Prelude.Compat+ -- | Represents an independent experimental value centered around a mean -- value with "inherent" and independent uncertainty. --@@ -129,10 +139,11 @@ -- Also be aware that the 'Show' instance "normalizes" the result, and -- won't show any mean/central point to a decimal precision smaller than -- the uncertainty, rounding off the excess.----data Uncert a = Un { _uMean :: !a-                   , _uVar  :: !a    -- ^ maintained to be positive!-                   }+data Uncert a = Un+  { _uMean :: !a+  , _uVar :: !a+  -- ^ maintained to be positive!+  }   deriving (Data, Typeable, Generic, Generic1)  -- | Get the mean (central) value of an 'Uncert'.@@ -159,10 +170,11 @@ {-# INLINE uStd #-}  -- | Create an 'Uncert' with an exact value and 0 uncertainty.-exact-    :: Num a-    => a            -- ^ The exact value-    -> Uncert a+exact ::+  Num a =>+  -- | The exact value+  a ->+  Uncert a exact x = Un x 0 {-# INLINE exact #-} @@ -178,12 +190,14 @@ -- a bit nicer. -- -- See 'uStd' for more details.-(+/-)-    :: Num a-    => a            -- ^ The mean or central value-    -> a            -- ^ The standard deviation of the underlying uncertainty-    -> Uncert a-x +/- dx = Un x (dx*dx)+(+/-) ::+  Num a =>+  -- | The mean or central value+  a ->+  -- | The standard deviation of the underlying uncertainty+  a ->+  Uncert a+x +/- dx = Un x (dx * dx) {-# INLINE (+/-) #-}  -- | Create an 'Uncert' around a central value, specifying its uncertainty@@ -191,11 +205,13 @@ -- the square of the range of uncertainty.  See 'uStd' for more details. -- -- "Negative variances" are treated as positive.-withVar-    :: Num a-    => a            -- ^ The mean or central value-    -> a            -- ^ The variance of the underlying uncertainty-    -> Uncert a+withVar ::+  Num a =>+  -- | The mean or central value+  a ->+  -- | The variance of the underlying uncertainty+  a ->+  Uncert a withVar x vx = Un x (abs vx) {-# INLINE withVar #-} @@ -228,12 +244,12 @@   where     makeUn (H3 x0 x1 x2) = Un μ v       where-        μ = x1/x0-        v = x2/x0 - μ*μ     -- maybe use pop var?+        μ = x1 / x0+        v = x2 / x0 - μ * μ -- maybe use pop var?     foldStats = flip foldl' (H3 0 0 0) $-                  \(H3 s0 s1 s2) x ->-                    H3 (s0 + 1) (s1 + x) (s2 + x*x)-{-# INLINABLE fromSamples #-}+      \(H3 s0 s1 s2) x ->+        H3 (s0 + 1) (s1 + x) (s2 + x * x)+{-# INLINEABLE fromSamples #-}  -- | Retrieve both the mean (central) value and the underlying variance of -- an 'Uncert' together.@@ -258,65 +274,71 @@ -- -- @uRange (x +/- dx) ≡ (x - dx, x + dx)@ uRange :: Floating a => Uncert a -> (a, a)-uRange (uMeanStd->(x, dx)) = (x - dx, x + dx)-{-# INLINABLE uRange #-}+uRange (uMeanStd -> (x, dx)) = (x - dx, x + dx)+{-# INLINEABLE uRange #-}  -- | Like 'withPrecision', except takes a number of "digits" of precision in -- the desired numeric base.  For example, in base 2, takes the number of -- /bits/ of precision. -- -- @'withPrecision' ≡ withPrecisionAtBase 10@-withPrecisionAtBase-    :: (Floating a, RealFrac a)-    => Int          -- ^ The base to determine precision with respect to-    -> a            -- ^ The approximate value of the 'Uncert'-    -> Int          -- ^ The number of "digits" of precision to take-    -> Uncert a+withPrecisionAtBase ::+  (Floating a, RealFrac a) =>+  -- | The base to determine precision with respect to+  Int ->+  -- | The approximate value of the 'Uncert'+  a ->+  -- | The number of "digits" of precision to take+  Int ->+  Uncert a withPrecisionAtBase b x p = x' +/- dx'   where     leading :: Int     leading = negate . floor . logBase (fromIntegral b) $ x-    uncert  :: Int-    uncert  = leading - 1 + fromIntegral p+    uncert :: Int+    uncert = leading - 1 + fromIntegral p     rounder = fromIntegral b ** fromIntegral uncert-    x'      = (/ rounder) . fromIntegral . round' . (* rounder) $ x-    dx'     = 1 / rounder-    round'  :: RealFrac a => a -> Integer-    round'  = round-{-# INLINABLE withPrecisionAtBase #-}+    x' = (/ rounder) . fromIntegral . round' . (* rounder) $ x+    dx' = 1 / rounder+    round' :: RealFrac a => a -> Integer+    round' = round+{-# INLINEABLE withPrecisionAtBase #-}  -- | Create an 'Uncert' about a given approximate central value, with the -- given number of /digits of precision/ (in decimal notation). -- -- @5.21 `withPrecision` 3 ≡ 5.21 '+/-' 0.01@-withPrecision-    :: (Floating a, RealFrac a)-    => a            -- ^ The approximate value of the 'Uncert'-    -> Int          -- ^ The number of "digits" of precision to take-    -> Uncert a+withPrecision ::+  (Floating a, RealFrac a) =>+  -- | The approximate value of the 'Uncert'+  a ->+  -- | The number of "digits" of precision to take+  Int ->+  Uncert a withPrecision = withPrecisionAtBase 10-{-# INLINABLE withPrecision #-}+{-# INLINEABLE withPrecision #-}  -- | Like 'uNormalize', but takes a numerical base to round with respect -- to. -- -- @'uNormalize' ≡ uNormalizeAtBase 10@-uNormalizeAtBase-    :: (Floating a, RealFrac a)-    => Int          -- ^ The base to normalize with respect to-    -> Uncert a-    -> Uncert a-uNormalizeAtBase b (uMeanStd->(x, dx)) = x' +/- dx'+uNormalizeAtBase ::+  (Floating a, RealFrac a) =>+  -- | The base to normalize with respect to+  Int ->+  Uncert a ->+  Uncert a+uNormalizeAtBase b (uMeanStd -> (x, dx)) = x' +/- dx'   where-    uncert    :: Int-    uncert    = negate . floor . logBase (fromIntegral b) $ dx-    rounder   = fromIntegral b ** fromIntegral uncert-    roundTo   = (/ rounder) . fromIntegral . round' . (* rounder)-    x'        = roundTo x-    dx'       = roundTo dx-    round'    :: RealFrac a => a -> Integer-    round'    = round-{-# INLINABLE uNormalizeAtBase #-}+    uncert :: Int+    uncert = negate . floor . logBase (fromIntegral b) $ dx+    rounder = fromIntegral b ** fromIntegral uncert+    roundTo = (/ rounder) . fromIntegral . round' . (* rounder)+    x' = roundTo x+    dx' = roundTo dx+    round' :: RealFrac a => a -> Integer+    round' = round+{-# INLINEABLE uNormalizeAtBase #-}  -- | Attempts to "normalize" an 'Uncert'.  Rounds the uncertainty (the -- standard deviation) to one digit of precision, and rounds the central@@ -329,25 +351,26 @@ -- -- Note that the 'Show' instance for 'Uncert' normalizes values before -- showing them.-uNormalize-    :: (Floating a, RealFrac a)-    => Uncert a-    -> Uncert a+uNormalize ::+  (Floating a, RealFrac a) =>+  Uncert a ->+  Uncert a uNormalize = uNormalizeAtBase 10-{-# INLINABLE uNormalize #-}+{-# INLINEABLE uNormalize #-}  instance (Show a, Floating a, RealFrac a) => Show (Uncert a) where-    showsPrec d = uShowsPrec d . uNormalize+  showsPrec d = uShowsPrec d . uNormalize  -- | Like 'showsPrec' for 'Uncert', but does not normalize the value (see -- 'uNormalize') before showing.  See documentation for 'showsPrec' for -- more information on how this is meant to be used. uShowsPrec :: (Show a, Floating a) => Int -> Uncert a -> ShowS-uShowsPrec d (uMeanStd->(x, dx)) = showParen (d > 5) $-                                       showsPrec 6 x-                                     . showString " +/- "-                                     . showsPrec 6 dx-{-# INLINABLE uShowsPrec #-}+uShowsPrec d (uMeanStd -> (x, dx)) =+  showParen (d > 5) $+    showsPrec 6 x+      . showString " +/- "+      . showsPrec 6 dx+{-# INLINEABLE uShowsPrec #-}  -- | Like 'show' for 'Uncert', but does not normalize the value (see -- 'uNormalize') before showing.@@ -355,7 +378,7 @@ -- @'show' ≡ uShow . 'uNormalize'@ uShow :: (Show a, Floating a) => Uncert a -> String uShow u = uShowsPrec 0 u ""-{-# INLINABLE uShow #-}+{-# INLINEABLE uShow #-}  -- | Lifts a multivariate numeric function on a container (given as an @f -- a -> a@) to work on a container of 'Uncert's.  Correctly propagates the@@ -371,35 +394,38 @@ -- ghci> liftUF (\\[x,y,z] -> x*y+z) [12.2 +/- 0.5, 56 +/- 2, 0.12 +/- 0.08] -- 680 +/- 40 -- @----liftUF-    :: (Traversable f, Fractional a)-    => (forall s. f (AD s (Sparse a)) -> AD s (Sparse a))   -- ^ Function on container of values to lift-    -> f (Uncert a)         -- ^ Container of 'Uncert's to apply the function to-    -> Uncert a+liftUF ::+  (Traversable f, Fractional a) =>+  -- | Function on container of values to lift+  (forall s. f (AD s (Sparse a)) -> AD s (Sparse a)) ->+  -- | Container of 'Uncert's to apply the function to+  f (Uncert a) ->+  Uncert a liftUF f us = Un y vy   where-    xs          = uMean <$> us-    vxs         = uVar  <$> us-    vxsL        = toList vxs+    xs = uMean <$> us+    vxs = uVar <$> us+    vxsL = toList vxs     (fx, dfxsh) = hessian' f xs-    dfxs        = fst <$> dfxsh-    hess        = snd <$> dfxsh-    y           = fx + hessQuad / 2+    dfxs = fst <$> dfxsh+    hess = snd <$> dfxsh+    y = fx + hessQuad / 2       where-        hessQuad = dot vxsL-                 . diag-                 . toList-                 $ fmap toList hess-    vy          = dot vxsL ((^ (2::Int)) <$> dfxs)+        hessQuad =+          dot vxsL+            . diag+            . toList+            $ fmap toList hess+    vy = dot vxsL ((^ (2 :: Int)) <$> dfxs)     dot x = sum . zipWith (*) x . toList-    diag = \case []        -> []-                 []   :yss -> diag (drop1 <$> yss)-                 (x:_):yss -> x : diag (drop1 <$> yss)+    diag = \case+      [] -> []+      [] : yss -> diag (drop1 <$> yss)+      (x : _) : yss -> x : diag (drop1 <$> yss)       where-        drop1 []     = []-        drop1 (_:zs) = zs-{-# INLINABLE liftUF #-}+        drop1 [] = []+        drop1 (_ : zs) = zs+{-# INLINEABLE liftUF #-}  -- | Lifts a numeric function over an 'Uncert'.  Correctly propagates the -- uncertainty according to the second-order taylor expansion expansion of@@ -414,17 +440,21 @@ -- ghci> liftU (\\x -> log x ^ 2) (12.2 +/- 0.5) -- 6.3 +/- 0.2 -- @-liftU-    :: Fractional a-    => (forall s. AD s (T.Tower a) -> AD s (T.Tower a))     -- ^ Function on values to lift-    -> Uncert a     -- ^ 'Uncert' to apply the function to-    -> Uncert a+liftU ::+  Fractional a =>+  -- | Function on values to lift+  (forall s. AD s (T.Tower a) -> AD s (T.Tower a)) ->+  -- | 'Uncert' to apply the function to+  Uncert a ->+  Uncert a liftU f (Un x vx) = Un y vy   where-    fx:dfx:ddfx:_ = T.diffs0 f x-    y             = fx + ddfx * vx / 2-    vy            = dfx*dfx * vx-{-# INLINABLE liftU #-}+    (fx, dfx, ddfx) = case T.diffs0 f x of+      a : b : c : _ -> (a, b, c)+      _ -> error "diffs0 should return an infinite list"+    y = fx + ddfx * vx / 2+    vy = dfx * dfx * vx+{-# INLINEABLE liftU #-}  -- | Lifts a two-argument (curried) function over two 'Uncert's.  Correctly -- propagates the uncertainty according to the second-order (multivariate)@@ -439,168 +469,176 @@ -- ghci> liftU2 (\\x y -> x**y) (13.5 +/- 0.1) (1.64 +/- 0.08) -- 70 +/- 10 -- @-liftU2-    :: Fractional a-    => (forall s. AD s (Sparse a) -> AD s (Sparse a) -> AD s (Sparse a))-    -> Uncert a-    -> Uncert a-    -> Uncert a+liftU2 ::+  Fractional a =>+  (forall s. AD s (Sparse a) -> AD s (Sparse a) -> AD s (Sparse a)) ->+  Uncert a ->+  Uncert a ->+  Uncert a liftU2 f = curryH2 $ liftUF (uncurryH2 f)-{-# INLINABLE liftU2 #-}+{-# INLINEABLE liftU2 #-}  -- | Lifts a three-argument (curried) function over three 'Uncert's.  See -- 'liftU2' and 'liftUF' for more details.-liftU3-    :: Fractional a-    => (forall s. AD s (Sparse a) -> AD s (Sparse a) -> AD s (Sparse a) -> AD s (Sparse a))-    -> Uncert a-    -> Uncert a-    -> Uncert a-    -> Uncert a+liftU3 ::+  Fractional a =>+  (forall s. AD s (Sparse a) -> AD s (Sparse a) -> AD s (Sparse a) -> AD s (Sparse a)) ->+  Uncert a ->+  Uncert a ->+  Uncert a ->+  Uncert a liftU3 f = curryH3 $ liftUF (uncurryH3 f)-{-# INLINABLE liftU3 #-}+{-# INLINEABLE liftU3 #-}  -- | Lifts a four-argument (curried) function over four 'Uncert's.  See -- 'liftU2' and 'liftUF' for more details.-liftU4-    :: Fractional a-    => (forall s. AD s (Sparse a) -> AD s (Sparse a) -> AD s (Sparse a) -> AD s (Sparse a) -> AD s (Sparse a))-    -> Uncert a-    -> Uncert a-    -> Uncert a-    -> Uncert a-    -> Uncert a+liftU4 ::+  Fractional a =>+  ( forall s.+    AD s (Sparse a) -> AD s (Sparse a) -> AD s (Sparse a) -> AD s (Sparse a) -> AD s (Sparse a)+  ) ->+  Uncert a ->+  Uncert a ->+  Uncert a ->+  Uncert a ->+  Uncert a liftU4 f = curryH4 $ liftUF (uncurryH4 f)-{-# INLINABLE liftU4 #-}+{-# INLINEABLE liftU4 #-}  -- | Lifts a five-argument (curried) function over five 'Uncert's.  See -- 'liftU2' and 'liftUF' for more details.-liftU5-    :: Fractional a-    => (forall s. AD s (Sparse a) -> AD s (Sparse a) -> AD s (Sparse a) -> AD s (Sparse a) -> AD s (Sparse a) -> AD s (Sparse a))-    -> Uncert a-    -> Uncert a-    -> Uncert a-    -> Uncert a-    -> Uncert a-    -> Uncert a+liftU5 ::+  Fractional a =>+  ( forall s.+    AD s (Sparse a) ->+    AD s (Sparse a) ->+    AD s (Sparse a) ->+    AD s (Sparse a) ->+    AD s (Sparse a) ->+    AD s (Sparse a)+  ) ->+  Uncert a ->+  Uncert a ->+  Uncert a ->+  Uncert a ->+  Uncert a ->+  Uncert a liftU5 f = curryH5 $ liftUF (uncurryH5 f)-{-# INLINABLE liftU5 #-}+{-# INLINEABLE liftU5 #-}  instance Fractional a => Num (Uncert a) where-    (+)         = liftU2 (+)-    {-# INLINE (+) #-}-    (*)         = liftU2 (*)-    {-# INLINE (*) #-}-    (-)         = liftU2 (-)-    {-# INLINE (-) #-}-    negate      = liftU negate-    {-# INLINE negate #-}-    abs         = liftU abs-    {-# INLINE abs #-}-    signum      = liftU signum-    {-# INLINE signum #-}-    fromInteger = exact . fromInteger-    {-# INLINE fromInteger #-}+  (+) = liftU2 (+)+  {-# INLINE (+) #-}+  (*) = liftU2 (*)+  {-# INLINE (*) #-}+  (-) = liftU2 (-)+  {-# INLINE (-) #-}+  negate = liftU negate+  {-# INLINE negate #-}+  abs = liftU abs+  {-# INLINE abs #-}+  signum = liftU signum+  {-# INLINE signum #-}+  fromInteger = exact . fromInteger+  {-# INLINE fromInteger #-}  instance Fractional a => Fractional (Uncert a) where-    recip        = liftU recip-    {-# INLINE recip #-}-    (/)          = liftU2 (/)-    {-# INLINE (/) #-}-    fromRational = exact . fromRational-    {-# INLINE fromRational #-}+  recip = liftU recip+  {-# INLINE recip #-}+  (/) = liftU2 (/)+  {-# INLINE (/) #-}+  fromRational = exact . fromRational+  {-# INLINE fromRational #-}  instance Floating a => Floating (Uncert a) where-    pi      = exact pi-    {-# INLINE pi #-}-    exp     = liftU exp-    {-# INLINE exp #-}-    log     = liftU log-    {-# INLINE log #-}-    sqrt    = liftU sqrt-    {-# INLINE sqrt #-}-    (**)    = liftU2 (**)-    {-# INLINE (**) #-}-    logBase = liftU2 logBase-    {-# INLINE logBase #-}-    sin     = liftU sin-    {-# INLINE sin #-}-    cos     = liftU cos-    {-# INLINE cos #-}-    asin    = liftU asin-    {-# INLINE asin #-}-    acos    = liftU acos-    {-# INLINE acos #-}-    atan    = liftU atan-    {-# INLINE atan #-}-    sinh    = liftU sinh-    {-# INLINE sinh #-}-    cosh    = liftU cosh-    {-# INLINE cosh #-}-    asinh   = liftU asinh-    {-# INLINE asinh #-}-    acosh   = liftU acosh-    {-# INLINE acosh #-}-    atanh   = liftU atanh-    {-# INLINE atanh #-}+  pi = exact pi+  {-# INLINE pi #-}+  exp = liftU exp+  {-# INLINE exp #-}+  log = liftU log+  {-# INLINE log #-}+  sqrt = liftU sqrt+  {-# INLINE sqrt #-}+  (**) = liftU2 (**)+  {-# INLINE (**) #-}+  logBase = liftU2 logBase+  {-# INLINE logBase #-}+  sin = liftU sin+  {-# INLINE sin #-}+  cos = liftU cos+  {-# INLINE cos #-}+  asin = liftU asin+  {-# INLINE asin #-}+  acos = liftU acos+  {-# INLINE acos #-}+  atan = liftU atan+  {-# INLINE atan #-}+  sinh = liftU sinh+  {-# INLINE sinh #-}+  cosh = liftU cosh+  {-# INLINE cosh #-}+  asinh = liftU asinh+  {-# INLINE asinh #-}+  acosh = liftU acosh+  {-# INLINE acosh #-}+  atanh = liftU atanh+  {-# INLINE atanh #-}  instance Eq a => Eq (Uncert a) where-    (==) = (==) `on` uMean-    {-# INLINE (==) #-}-    (/=) = (/=) `on` uMean-    {-# INLINE (/=) #-}+  (==) = (==) `on` uMean+  {-# INLINE (==) #-}+  (/=) = (/=) `on` uMean+  {-# INLINE (/=) #-}  instance Ord a => Ord (Uncert a) where-    compare = comparing uMean-    {-# INLINE compare #-}+  compare = comparing uMean+  {-# INLINE compare #-}  instance (Fractional a, Real a) => Real (Uncert a) where-    toRational = toRational . uMean-    {-# INLINE toRational #-}+  toRational = toRational . uMean+  {-# INLINE toRational #-}  instance RealFrac a => RealFrac (Uncert a) where-    properFraction x = (n, d)-      where-        d    = liftU (snd' . properFraction) x-        n    = fst . properFraction $ uMean x-        snd' :: (Int, b) -> b-        snd' = snd-    {-# INLINABLE properFraction #-}-    truncate = truncate . uMean-    {-# INLINE truncate #-}-    round    = round    . uMean-    {-# INLINE round #-}-    ceiling  = ceiling  . uMean-    {-# INLINE ceiling #-}-    floor    = floor    . uMean-    {-# INLINE floor #-}+  properFraction x = (n, d)+    where+      d = liftU (snd' . properFraction) x+      n = fst . properFraction $ uMean x+      snd' :: (Int, b) -> b+      snd' = snd+  {-# INLINEABLE properFraction #-}+  truncate = truncate . uMean+  {-# INLINE truncate #-}+  round = round . uMean+  {-# INLINE round #-}+  ceiling = ceiling . uMean+  {-# INLINE ceiling #-}+  floor = floor . uMean+  {-# INLINE floor #-}  instance RealFloat a => RealFloat (Uncert a) where-    floatRadix      = floatRadix     . uMean-    {-# INLINE floatRadix #-}-    floatDigits     = floatDigits    . uMean-    {-# INLINE floatDigits #-}-    floatRange      = floatRange     . uMean-    {-# INLINE floatRange #-}-    decodeFloat     = decodeFloat    . uMean-    {-# INLINE decodeFloat #-}-    exponent        = exponent       . uMean-    {-# INLINE exponent #-}-    isNaN           = isNaN          . uMean-    {-# INLINE isNaN #-}-    isInfinite      = isInfinite     . uMean-    {-# INLINE isInfinite #-}-    isDenormalized  = isDenormalized . uMean-    {-# INLINE isDenormalized #-}-    isNegativeZero  = isNegativeZero . uMean-    {-# INLINE isNegativeZero #-}-    isIEEE          = isIEEE         . uMean-    {-# INLINE isIEEE #-}-    encodeFloat a b = exact (encodeFloat a b)-    {-# INLINE encodeFloat #-}-    significand     = liftU significand-    {-# INLINE significand #-}-    atan2           = liftU2 atan2-    {-# INLINE atan2 #-}-+  floatRadix = floatRadix . uMean+  {-# INLINE floatRadix #-}+  floatDigits = floatDigits . uMean+  {-# INLINE floatDigits #-}+  floatRange = floatRange . uMean+  {-# INLINE floatRange #-}+  decodeFloat = decodeFloat . uMean+  {-# INLINE decodeFloat #-}+  exponent = exponent . uMean+  {-# INLINE exponent #-}+  isNaN = isNaN . uMean+  {-# INLINE isNaN #-}+  isInfinite = isInfinite . uMean+  {-# INLINE isInfinite #-}+  isDenormalized = isDenormalized . uMean+  {-# INLINE isDenormalized #-}+  isNegativeZero = isNegativeZero . uMean+  {-# INLINE isNegativeZero #-}+  isIEEE = isIEEE . uMean+  {-# INLINE isIEEE #-}+  encodeFloat a b = exact (encodeFloat a b)+  {-# INLINE encodeFloat #-}+  significand = liftU significand+  {-# INLINE significand #-}+  atan2 = liftU2 atan2+  {-# INLINE atan2 #-}
src/Numeric/Uncertain/Correlated.hs view
@@ -15,28 +15,38 @@ -- -- 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, -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+  -- * Uncertain and Correlated Values+  CVar, -import           Control.Monad.Free-import           Control.Monad.Trans.State-import           Numeric.Uncertain-import           Numeric.Uncertain.Correlated.Internal-import qualified Data.IntMap.Strict                 as M+  -- ** 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. --@@ -46,7 +56,7 @@ -- allowed to ever use 'evalCorr' to evaluate a 'CVar'. evalCorr :: Fractional a => (forall s. Corr s a b) -> b evalCorr c = evalState (corrToState c) (0, M.empty)-{-# INLINABLE evalCorr #-}+{-# INLINEABLE evalCorr #-}  -- | Generate a sample in 'Corr' from an 'Uncert' value, independently from -- all other samples.@@ -72,7 +82,6 @@ -- -- 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 = return . constC {-# INLINE sampleExact #-}@@ -87,4 +96,3 @@ resolveUncert :: CVar s a -> Corr s a (Uncert a) resolveUncert v = liftF $ Rei v id {-# INLINE resolveUncert #-}-
src/Numeric/Uncertain/Correlated/Interactive.hs view
@@ -48,29 +48,39 @@ -- -- Be aware that this module is not robustly tested in heavily concurrent -- situations/applications.----module Numeric.Uncertain.Correlated.Interactive-  ( -- * Uncertain and Correlated Values-    CVar, CVarIO-    -- ** Sampling-  , sampleUncert, sampleExact, constC-    -- ** Resolving-  , resolveUncert-    -- * Applying arbitrary functions-  , liftC, liftC2, liftC3, liftC4, liftC5, liftCF-  )-  where+module Numeric.Uncertain.Correlated.Interactive (+  -- * Uncertain and Correlated Values+  CVar,+  CVarIO, -import           Control.Monad.ST-import           Control.Monad.Trans.State-import           Data.IORef-import           Data.Tuple-import           Numeric.Uncertain-import           Numeric.Uncertain.Correlated.Internal-import           System.IO.Unsafe                      (unsafePerformIO)-import qualified Data.IntMap.Strict                    as M-import qualified Numeric.Uncertain.Correlated          as C+  -- ** Sampling+  sampleUncert,+  sampleExact,+  constC, +  -- ** Resolving+  resolveUncert,++  -- * Applying arbitrary functions+  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)+ -- | A 'CVar' specialized to work in an "interactive" context, in /ghci/ or -- 'IO'. type CVarIO = CVar RealWorld Double@@ -81,15 +91,17 @@ globalCorrMap = unsafePerformIO $ newIORef (0, M.empty)  runCorrIO :: Corr RealWorld Double a -> IO a-runCorrIO c = atomicModifyIORef' globalCorrMap-                                 (swap . runState (corrToState c))+runCorrIO c =+  atomicModifyIORef'+    globalCorrMap+    (swap . runState (corrToState c)) {-# INLINE runCorrIO #-}  -- | Generate a sample in 'IO' from an @'Uncert' 'Double'@ value, -- independently from all other samples. sampleUncert :: Uncert Double -> IO CVarIO sampleUncert u = runCorrIO $ C.sampleUncert u-{-# INLINABLE sampleUncert #-}+{-# INLINEABLE sampleUncert #-}  -- | Generate an exact sample in 'IO' with zero uncertainty, -- independently from all other samples.@@ -105,7 +117,7 @@ -- But is provided for completeness alongside 'sampleUncert'. sampleExact :: Double -> IO CVarIO sampleExact d = runCorrIO $ C.sampleExact d-{-# INLINABLE sampleExact #-}+{-# INLINEABLE sampleExact #-}  -- | "Resolve" an 'Uncert' from a 'CVarIO' using its potential multiple -- samples and sample sources, taking into account inter-correlations@@ -116,4 +128,4 @@ -- only be used as the "final value" of your computation or exploration. resolveUncert :: CVarIO -> IO (Uncert Double) resolveUncert v = runCorrIO $ C.resolveUncert v-{-# INLINABLE resolveUncert #-}+{-# INLINEABLE resolveUncert #-}
src/Numeric/Uncertain/Correlated/Internal.hs view
@@ -1,15 +1,15 @@-{-# LANGUAGE DeriveFunctor              #-}-{-# LANGUAGE GADTs                      #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures             #-}-{-# LANGUAGE LambdaCase                 #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE NoImplicitPrelude          #-}-{-# LANGUAGE RankNTypes                 #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE StandaloneDeriving         #-}-{-# OPTIONS_HADDOCK hide                #-}-{-# OPTIONS_HADDOCK prune               #-}+{-# 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@@ -23,26 +23,31 @@ -- 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           Prelude.Compat-import           Data.Hople-import           Numeric.Uncertain-import           Numeric.AD.Mode.Sparse-import qualified Data.IntMap.Strict        as M+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',@@ -63,36 +68,40 @@ -- 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+  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 = \case CK x    -> CK x-                  CV k    -> CV k-                  CF f xs -> CF f (dephantom <$> xs)+dephantom = \case+  CK x -> CK x+  CV k -> CV k+  CF f xs -> CF f (dephantom <$> xs) -data CorrF :: * -> * -> * -> * 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+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 f = \case Gen u    next -> Gen u    (f . next)-                   Fun g us next -> Fun g us (f . next)-                   Rei v    next -> Rei v    (f . next)-+  fmap f = \case+    Gen u next -> Gen u (f . next)+    Fun g us next -> Fun g us (f . next)+    Rei v next -> Rei v (f . next)  -- | The 'Corr' monad allows us to keep track of correlated and -- non-independent samples.  It fixes a basic "failure" of the 'Uncert'@@ -150,42 +159,42 @@ -- 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 { corrFree :: Free (CorrF s a) b-                          }-                   deriving (Functor, Applicative, Monad)+newtype Corr s a b = Corr+  { corrFree :: Free (CorrF s a) b+  }+  deriving (Functor, Applicative, 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 ::+  (Monad m, Fractional a) =>+  Corr s a b ->+  StateT (M.Key, M.IntMap (Uncert a)) m b corrToState = iterM go . corrFree   where     go = \case-            Gen u next    -> do-              i <- gets fst-              modify $ succ *** M.insert i u-              next (CV i)-            Fun f us next ->-              next $ CF f us-            Rei v next    -> do-              u <- gets (getCVar v . snd)-              next u-    getCVar-        :: forall a s. Fractional a-        => CVar s a-        -> M.IntMap (Uncert a)-        -> Uncert a+      Gen u next -> do+        i <- gets fst+        modify $ succ *** M.insert i u+        next (CV i)+      Fun f us next ->+        next $ CF f us+      Rei v next -> do+        u <- gets (getCVar v . snd)+        next u+    getCVar ::+      forall a s.+      Fractional a =>+      CVar s a ->+      M.IntMap (Uncert a) ->+      Uncert a     getCVar cv = liftUF (cVarToF cv)       where-        cVarToF-            :: CVar s a-            -> (forall t. M.IntMap (AD t (Sparse a)) -> AD t (Sparse a))-        cVarToF (CK x)    _  = auto x-        cVarToF (CV k)    us = us M.! k-        cVarToF (CF f cs) us = f (flip cVarToF us <$> cs)-{-# INLINABLE corrToState #-}+        cVarToF :: CVar s a -> M.IntMap (AD t (Sparse a)) -> AD t (Sparse a)+        cVarToF (CK x) _ = auto x+        cVarToF (CV k) us = us M.! k+        cVarToF (CF f cs) us = f ((`cVarToF` us) <$> 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@@ -206,13 +215,14 @@ --         'resolveUncert' $ liftCF (\\[a,b,c] -> (a+c) * logBase c (b**a)) x y z -- 1200 +/- 200 -- @----liftCF-    :: Functor f-    => (forall t. f (AD t (Sparse a)) -> AD t (Sparse a)) -- ^ Function on container of values to lift-    -> f (CVar s a)     -- ^ Container of 'CVar' samples to apply the function to-    -> CVar s a-liftCF f cs = CF f cs+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 = CF {-# INLINE liftCF #-}  -- | Creates a 'CVar' representing a completely independent sample from all@@ -237,13 +247,14 @@ --         'resolveUncert' $ liftC (\\z -> log z ^ 2) (x + y) -- 11.2 +/- 0.2 -- @----liftC-    :: (forall t. AD t (Sparse a) -> AD t (Sparse a)) -- ^ Function on values to lift-    -> CVar s a         -- ^ 'CVar' sample to apply the function to-    -> CVar s a+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 f = curryH1 $ liftCF (uncurryH1 f)-{-# INLINABLE liftC #-}+{-# INLINEABLE liftC #-}  -- | Lifts a two-argument (curried) function over the samples represented -- by two 'CVar's.  Correctly propagates the uncertainty according to the@@ -263,105 +274,113 @@ --         '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 t. AD t (Sparse a) -> AD t (Sparse a) -> AD t (Sparse a)) ->+  CVar s a ->+  CVar s a ->+  CVar s a liftC2 f = curryH2 $ liftCF (uncurryH2 f)-{-# INLINABLE liftC2 #-}+{-# 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 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 f = curryH3 $ liftCF (uncurryH3 f)-{-# INLINABLE liftC3 #-}+{-# 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 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 f = curryH4 $ liftCF (uncurryH4 f)-{-# INLINABLE liftC4 #-}+{-# 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 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 f = curryH5 $ liftCF (uncurryH5 f)-{-# INLINABLE liftC5 #-}+{-# INLINEABLE liftC5 #-}  instance Fractional a => Num (CVar s a) where-    (+)    = liftC2 (+)-    {-# INLINE (+) #-}-    (*)    = liftC2 (*)-    {-# INLINE (*) #-}-    (-)    = liftC2 (-)-    {-# INLINE (-) #-}-    negate = liftC negate-    {-# INLINE negate #-}-    abs    = liftC abs-    {-# INLINE abs #-}-    signum = liftC signum-    {-# INLINE signum #-}-    fromInteger = constC . fromInteger-    {-# INLINE fromInteger #-}+  (+) = liftC2 (+)+  {-# INLINE (+) #-}+  (*) = liftC2 (*)+  {-# INLINE (*) #-}+  (-) = liftC2 (-)+  {-# INLINE (-) #-}+  negate = liftC negate+  {-# INLINE negate #-}+  abs = liftC abs+  {-# INLINE abs #-}+  signum = liftC signum+  {-# INLINE signum #-}+  fromInteger = constC . fromInteger+  {-# INLINE fromInteger #-}  instance Fractional a => Fractional (CVar s a) where-    recip = liftC recip-    {-# INLINE recip #-}-    (/)   = liftC2 (/)-    {-# INLINE (/) #-}-    fromRational = constC . fromRational-    {-# INLINE fromRational #-}+  recip = liftC recip+  {-# INLINE recip #-}+  (/) = liftC2 (/)+  {-# INLINE (/) #-}+  fromRational = constC . fromRational+  {-# INLINE fromRational #-}  instance Floating a => Floating (CVar s a) where-    pi      = constC pi-    {-# INLINE pi #-}-    exp     = liftC exp-    {-# INLINE exp #-}-    log     = liftC log-    {-# INLINE log #-}-    sqrt    = liftC sqrt-    {-# INLINE sqrt #-}-    (**)    = liftC2 (**)-    {-# INLINE (**) #-}-    logBase = liftC2 logBase-    {-# INLINE logBase #-}-    sin     = liftC sin-    {-# INLINE sin #-}-    cos     = liftC cos-    {-# INLINE cos #-}-    asin    = liftC asin-    {-# INLINE asin #-}-    acos    = liftC acos-    {-# INLINE acos #-}-    atan    = liftC atan-    {-# INLINE atan #-}-    sinh    = liftC sinh-    {-# INLINE sinh #-}-    cosh    = liftC cosh-    {-# INLINE cosh #-}-    asinh   = liftC asinh-    {-# INLINE asinh #-}-    acosh   = liftC acosh-    {-# INLINE acosh #-}-    atanh   = liftC atanh-    {-# INLINE atanh #-}+  pi = constC pi+  {-# INLINE pi #-}+  exp = liftC exp+  {-# INLINE exp #-}+  log = liftC log+  {-# INLINE log #-}+  sqrt = liftC sqrt+  {-# INLINE sqrt #-}+  (**) = liftC2 (**)+  {-# INLINE (**) #-}+  logBase = liftC2 logBase+  {-# INLINE logBase #-}+  sin = liftC sin+  {-# INLINE sin #-}+  cos = liftC cos+  {-# INLINE cos #-}+  asin = liftC asin+  {-# INLINE asin #-}+  acos = liftC acos+  {-# INLINE acos #-}+  atan = liftC atan+  {-# INLINE atan #-}+  sinh = liftC sinh+  {-# INLINE sinh #-}+  cosh = liftC cosh+  {-# INLINE cosh #-}+  asinh = liftC asinh+  {-# INLINE asinh #-}+  acosh = liftC acosh+  {-# INLINE acosh #-}+  atanh = liftC atanh+  {-# INLINE atanh #-}
src/Numeric/Uncertain/MonteCarlo.hs view
@@ -1,7 +1,6 @@-{-# LANGUAGE CPP               #-}-{-# LANGUAGE ImplicitParams    #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE ViewPatterns      #-}  -- | -- Module      : Numeric.Uncertain.MonteCarlo@@ -14,6 +13,8 @@ -- -- Provides an interface for computing and propagating uncertainty by using -- <https://en.wikipedia.org/wiki/Monte_Carlo_method Monte Carlo simulations>.+-- These may be more accurate than the normal propagators if the third-order+-- taylor series expansion terms are non-negligible. -- -- Basically simulates sampling from the distribution represented by the given -- 'Uncert's, applying the function of interest, and aggregating the mean@@ -54,44 +55,49 @@ -- ghci> MC.liftU2 (\\a b -> pi + 3 * logBase a b) x y g -- 51 +/- 5 -- @---+module Numeric.Uncertain.MonteCarlo (+  -- * Sampling from an 'Uncert'+  sampleUncert, -module Numeric.Uncertain.MonteCarlo-  ( -- * Sampling from an 'Uncert'-    sampleUncert-    -- * Lifting functions via Monte Carlo simulation-    -- ** Fixed iterations-  , liftU, liftU2, liftU3, liftU4, liftU5, liftUF-    -- ** Variable iterations-  , liftU', liftU2', liftU3', liftU4', liftU5', liftUF'-  )-  where+  -- * Lifting functions via Monte Carlo simulation +  -- ** Fixed iterations+  liftU,+  liftU2,+  liftU3,+  liftU4,+  liftU5,+  liftUF,++  -- ** Variable iterations+  liftU',+  liftU2',+  liftU3',+  liftU4',+  liftU5',+  liftUF',+)+where+ import Control.Monad import Control.Monad.Primitive import Data.Hople-import Numeric.Uncertain               (Uncert, fromSamples, uMeanStd)+import Numeric.Uncertain (Uncert, fromSamples, uMeanStd) import Prelude.Compat import System.Random.MWC import System.Random.MWC.Distributions - -- | Sample a random 'Double' from the distribution specified by an -- @'Uncert' 'Double'@.  @x '+/-' dx@ is treated as a random variable whose -- probability density is the normal distribution with mean @x@ and -- standard deviation @dx@.----sampleUncert-#if __GLASGOW_HASKELL__ < 710-    :: (PrimMonad m, Functor m)-#else-    :: PrimMonad m-#endif-    => Uncert Double-    -> Gen (PrimState m)-    -> m Double-sampleUncert (uMeanStd->(x, dx)) g = normal x dx g-{-# INLINABLE sampleUncert #-}+sampleUncert ::+  PrimMonad m =>+  Uncert Double ->+  Gen (PrimState m) ->+  m Double+sampleUncert (uMeanStd -> (x, dx)) = normal x dx+{-# INLINEABLE sampleUncert #-}  -- | Lifts a numeric function over an 'Uncert' using a Monte Carlo -- simulation with 1000 samples.@@ -101,17 +107,12 @@ -- ghci> MC.liftU (\\x -> log x ^ 2) (12.2 +/- 0.5) g -- 6.3 +/- 0.2 -- @----liftU-#if __GLASGOW_HASKELL__ >= 710-    :: PrimMonad m-#else-    :: (PrimMonad m, Functor m)-#endif-    => (Double -> Double)-    -> Uncert Double-    -> Gen (PrimState m)-    -> m (Uncert Double)+liftU ::+  PrimMonad m =>+  (Double -> Double) ->+  Uncert Double ->+  Gen (PrimState m) ->+  m (Uncert Double) liftU = liftU' 1000 {-# INLINE liftU #-} @@ -124,17 +125,12 @@ -- ghci> M.liftUF (\\[x,y,z] -> x*y+z) [12.2 +/- 0.5, 56 +/- 2, 0.12 +/- 0.08] g -- 680 +/- 40 -- @----liftUF-#if __GLASGOW_HASKELL__ >= 710-    :: (Traversable f, PrimMonad m)-#else-    :: (Traversable f, PrimMonad m, Applicative m)-#endif-    => (f Double -> Double)-    -> f (Uncert Double)-    -> Gen (PrimState m)-    -> m (Uncert Double)+liftUF ::+  (Traversable f, PrimMonad m) =>+  (f Double -> Double) ->+  f (Uncert Double) ->+  Gen (PrimState m) ->+  m (Uncert Double) liftUF = liftUF' 1000 {-# INLINE liftUF #-} @@ -146,181 +142,140 @@ -- ghci> MC.liftU2 (\\x y -> x**y) (13.5 +/- 0.1) (1.64 +/- 0.08) -- 70 +/- 20 -- @----liftU2-#if __GLASGOW_HASKELL__ >= 710-    :: PrimMonad m-#else-    :: (PrimMonad m, Applicative m)-#endif-    => (Double -> Double -> Double)-    -> Uncert Double-    -> Uncert Double-    -> Gen (PrimState m)-    -> m (Uncert Double)+liftU2 ::+  PrimMonad m =>+  (Double -> Double -> Double) ->+  Uncert Double ->+  Uncert Double ->+  Gen (PrimState m) ->+  m (Uncert Double) liftU2 = liftU2' 1000 {-# INLINE liftU2 #-}  -- | Lifts a three-argument (curried) function over three 'Uncert's.  See -- 'liftU2' and 'liftUF' for more details.-liftU3-#if __GLASGOW_HASKELL__ >= 710-    :: PrimMonad m-#else-    :: (PrimMonad m, Applicative m)-#endif-    => (Double -> Double -> Double -> Double)-    -> Uncert Double-    -> Uncert Double-    -> Uncert Double-    -> Gen (PrimState m)-    -> m (Uncert Double)+liftU3 ::+  PrimMonad m =>+  (Double -> Double -> Double -> Double) ->+  Uncert Double ->+  Uncert Double ->+  Uncert Double ->+  Gen (PrimState m) ->+  m (Uncert Double) liftU3 = liftU3' 1000 {-# INLINE liftU3 #-}  -- | Lifts a four-argument (curried) function over four 'Uncert's.  See -- 'liftU2' and 'liftUF' for more details.-liftU4-#if __GLASGOW_HASKELL__ >= 710-    :: PrimMonad m-#else-    :: (PrimMonad m, Applicative m)-#endif-    => (Double -> Double -> Double -> Double -> Double)-    -> Uncert Double-    -> Uncert Double-    -> Uncert Double-    -> Uncert Double-    -> Gen (PrimState m)-    -> m (Uncert Double)+liftU4 ::+  (PrimMonad m, Applicative m) =>+  (Double -> Double -> Double -> Double -> Double) ->+  Uncert Double ->+  Uncert Double ->+  Uncert Double ->+  Uncert Double ->+  Gen (PrimState m) ->+  m (Uncert Double) liftU4 = liftU4' 1000 {-# INLINE liftU4 #-}  -- | Lifts a five-argument (curried) function over five 'Uncert's.  See -- 'liftU2' and 'liftUF' for more details.-liftU5-#if __GLASGOW_HASKELL__ >= 710-    :: PrimMonad m-#else-    :: (PrimMonad m, Applicative m)-#endif-    => (Double -> Double -> Double -> Double -> Double -> Double)-    -> Uncert Double-    -> Uncert Double-    -> Uncert Double-    -> Uncert Double-    -> Uncert Double-    -> Gen (PrimState m)-    -> m (Uncert Double)+liftU5 ::+  PrimMonad m =>+  (Double -> Double -> Double -> Double -> Double -> Double) ->+  Uncert Double ->+  Uncert Double ->+  Uncert Double ->+  Uncert Double ->+  Uncert Double ->+  Gen (PrimState m) ->+  m (Uncert Double) liftU5 = liftU5' 1000 {-# INLINE liftU5 #-}  -- | Like 'liftU', but allows you to specify the number of samples to run -- the Monte Carlo simulation with.-liftU'-#if __GLASGOW_HASKELL__ >= 710-    :: PrimMonad m-#else-    :: (PrimMonad m, Functor m)-#endif-    => Int-    -> (Double -> Double)-    -> Uncert Double-    -> Gen (PrimState m)-    -> m (Uncert Double)+liftU' ::+  PrimMonad m =>+  Int ->+  (Double -> Double) ->+  Uncert Double ->+  Gen (PrimState m) ->+  m (Uncert Double) liftU' n f u g = fromSamples <$> replicateM n samp   where     samp = f <$> sampleUncert u g-{-# INLINABLE liftU' #-}+{-# INLINEABLE liftU' #-}  -- | Like 'liftUF', but allows you to specify the number of samples to run -- the Monte Carlo simulation with.-liftUF'-#if __GLASGOW_HASKELL__ >= 710-    :: (Traversable f, PrimMonad m)-#else-    :: (Traversable f, PrimMonad m, Applicative m)-#endif-    => Int-    -> (f Double -> Double)-    -> f (Uncert Double)-    -> Gen (PrimState m)-    -> m (Uncert Double)+liftUF' ::+  (Traversable f, PrimMonad m) =>+  Int ->+  (f Double -> Double) ->+  f (Uncert Double) ->+  Gen (PrimState m) ->+  m (Uncert Double) liftUF' n f us g = fromSamples <$> replicateM n samp   where-    samp = f <$> traverse (flip sampleUncert g) us-{-# INLINABLE liftUF' #-}+    samp = f <$> traverse (`sampleUncert` g) us+{-# INLINEABLE liftUF' #-}  -- | Like 'liftU2', but allows you to specify the number of samples to run -- the Monte Carlo simulation with.-liftU2'-#if __GLASGOW_HASKELL__ >= 710-    :: PrimMonad m-#else-    :: (PrimMonad m, Applicative m)-#endif-    => Int-    -> (Double -> Double -> Double)-    -> Uncert Double-    -> Uncert Double-    -> Gen (PrimState m)-    -> m (Uncert Double)+liftU2' ::+  PrimMonad m =>+  Int ->+  (Double -> Double -> Double) ->+  Uncert Double ->+  Uncert Double ->+  Gen (PrimState m) ->+  m (Uncert Double) liftU2' n f x y = liftUF' n (uncurryH2 f) (H2 x y)-{-# INLINABLE liftU2' #-}+{-# INLINEABLE liftU2' #-}  -- | Like 'liftU3', but allows you to specify the number of samples to run -- the Monte Carlo simulation with.-liftU3'-#if __GLASGOW_HASKELL__ >= 710-    :: PrimMonad m-#else-    :: (PrimMonad m, Applicative m)-#endif-    => Int-    -> (Double -> Double -> Double -> Double)-    -> Uncert Double-    -> Uncert Double-    -> Uncert Double-    -> Gen (PrimState m)-    -> m (Uncert Double)+liftU3' ::+  PrimMonad m =>+  Int ->+  (Double -> Double -> Double -> Double) ->+  Uncert Double ->+  Uncert Double ->+  Uncert Double ->+  Gen (PrimState m) ->+  m (Uncert Double) liftU3' n f x y z = liftUF' n (uncurryH3 f) (H3 x y z)-{-# INLINABLE liftU3' #-}+{-# INLINEABLE liftU3' #-}  -- | Like 'liftU4', but allows you to specify the number of samples to run -- the Monte Carlo simulation with.-liftU4'-#if __GLASGOW_HASKELL__ >= 710-    :: PrimMonad m-#else-    :: (PrimMonad m, Applicative m)-#endif-    => Int-    -> (Double -> Double -> Double -> Double -> Double)-    -> Uncert Double-    -> Uncert Double-    -> Uncert Double-    -> Uncert Double-    -> Gen (PrimState m)-    -> m (Uncert Double)+liftU4' ::+  PrimMonad m =>+  Int ->+  (Double -> Double -> Double -> Double -> Double) ->+  Uncert Double ->+  Uncert Double ->+  Uncert Double ->+  Uncert Double ->+  Gen (PrimState m) ->+  m (Uncert Double) liftU4' n f x y z a = liftUF' n (uncurryH4 f) (H4 x y z a)-{-# INLINABLE liftU4' #-}+{-# INLINEABLE liftU4' #-}  -- | Like 'liftU5', but allows you to specify the number of samples to run -- the Monte Carlo simulation with.-liftU5'-#if __GLASGOW_HASKELL__ >= 710-    :: PrimMonad m-#else-    :: (PrimMonad m, Applicative m)-#endif-    => Int-    -> (Double -> Double -> Double -> Double -> Double -> Double)-    -> Uncert Double-    -> Uncert Double-    -> Uncert Double-    -> Uncert Double-    -> Uncert Double-    -> Gen (PrimState m)-    -> m (Uncert Double)+liftU5' ::+  PrimMonad m =>+  Int ->+  (Double -> Double -> Double -> Double -> Double -> Double) ->+  Uncert Double ->+  Uncert Double ->+  Uncert Double ->+  Uncert Double ->+  Uncert Double ->+  Gen (PrimState m) ->+  m (Uncert Double) liftU5' n f x y z a b = liftUF' n (uncurryH5 f) (H5 x y z a b) {-# INLINEABLE liftU5' #-}
uncertain.cabal view
@@ -1,45 +1,58 @@--- Initial uncertain.cabal generated by cabal init.  For further --- documentation, see http://haskell.org/cabal/users-guide/+cabal-version:      1.12 -name:                uncertain-version:             0.3.1.0-synopsis:            Manipulating numbers with inherent experimental/measurement uncertainty-description:         See <https://github.com/mstksg/uncertain/blob/master/README.md README.md>.-                     .-                     Documentation maintained at <https://mstksg.github.io/uncertain>-homepage:            https://github.com/mstksg/uncertain-bug-reports:         https://github.com/mstksg/uncertain/issues-license:             BSD3-license-file:        LICENSE-author:              Justin Le-maintainer:          justin@jle.im-copyright:           (c) Justin Le 2016-category:            Math-build-type:          Simple-extra-source-files:  README.md-                     CHANGELOG.md-cabal-version:       >=1.10+-- This file has been generated from package.yaml by hpack version 0.36.0.+--+-- see: https://github.com/sol/hpack +name:               uncertain+version:            0.4.0.0+synopsis:+  Manipulating numbers with inherent experimental/measurement uncertainty++description:+  Provides tools to manipulate numbers with inherent experimental/measurement+  uncertainty, and propagates them through functions based on principles from+  statistics.++category:           Math+homepage:           https://github.com/mstksg/uncertain#readme+bug-reports:        https://github.com/mstksg/uncertain/issues+author:             Justin Le+maintainer:         justin@jle.im+copyright:          (c) Justin Le 2024+license:            BSD3+license-file:       LICENSE+build-type:         Simple+tested-with:        GHC >=8.10+extra-source-files:+  CHANGELOG.md+  README.md+ source-repository head-  type:                git-  location:            git://github.com/mstksg/uncertain.git+  type:     git+  location: https://github.com/mstksg/uncertain  library-  exposed-modules:     Numeric.Uncertain-                       Numeric.Uncertain.Correlated-                       Numeric.Uncertain.Correlated.Interactive-                       Numeric.Uncertain.MonteCarlo-  other-modules:       Data.Hople-                       Numeric.Uncertain.Correlated.Internal-  -- other-extensions:    -  build-depends:       base         >= 4.6 && < 5-                     , ad           >= 4-                     , containers   >= 0.5-                     , free         >= 4-                     , mwc-random   >= 0.10-                     , primitive    >= 0.1-                     , transformers >= 0.2-                     , base-compat-  hs-source-dirs:      src-  default-language:    Haskell2010-  ghc-options:         -Wall+  exposed-modules:+    Numeric.Uncertain+    Numeric.Uncertain.Correlated+    Numeric.Uncertain.Correlated.Interactive+    Numeric.Uncertain.MonteCarlo++  other-modules:+    Data.Hople+    Numeric.Uncertain.Correlated.Internal++  hs-source-dirs:   src+  ghc-options:      -Wall+  build-depends:+      ad            >=4+    , base          >=4.6  && <5+    , base-compat+    , containers    >=0.5+    , free          >=4+    , mwc-random    >=0.10+    , primitive     >=0.1+    , transformers  >=0.2++  default-language: Haskell2010