monad-bayes 1.1.0 → 1.1.1

raw patch · 27 files changed

+187/−165 lines, 27 filesdep +directorydep −profunctorsdep ~QuickCheckdep ~abstract-pardep ~basenew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: directory

Dependencies removed: profunctors

Dependency ranges changed: QuickCheck, abstract-par, base, containers, criterion, foldl, histogram-fill, hspec, ieee754, integration, lens, linear, log-domain, math-functions, matrix, monad-extras, mtl, mwc-random, optparse-applicative, pipes, pretty-simple, primitive, process, random, scientific, statistics, text, time, transformers, typed-process, vector, vty

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−0
• README.md +2/−2
• benchmark/Speed.hs +28/−5
• models/HMM.hs +1/−1
• models/LDA.hs +1/−1
• monad-bayes.cabal +59/−91
• src/Control/Monad/Bayes/Class.hs +5/−1
• src/Control/Monad/Bayes/Inference/MCMC.hs +6/−6
• src/Control/Monad/Bayes/Inference/TUI.hs +4/−3
• src/Control/Monad/Bayes/Population.hs +4/−4
• src/Control/Monad/Bayes/Sampler/Lazy.hs +2/−2
• src/Control/Monad/Bayes/Sampler/Strict.hs +1/−1
• src/Control/Monad/Bayes/Traced/Basic.hs +3/−3
• src/Control/Monad/Bayes/Traced/Common.hs +2/−2
• src/Control/Monad/Bayes/Traced/Dynamic.hs +3/−3
• src/Control/Monad/Bayes/Traced/Static.hs +30/−3
• src/Math/Integrators/StormerVerlet.hs +6/−6
• test/Spec.hs +3/−1
• test/TestAdvanced.hs +1/−12
• test/TestDistribution.hs +1/−4
• test/TestInference.hs +1/−2
• test/TestIntegrator.hs +1/−1
• test/TestPipes.hs +3/−3
• test/TestPopulation.hs +0/−1
• test/TestSampler.hs +2/−2
• test/TestStormerVerlet.hs +5/−4
• test/TestWeighted.hs +0/−1

@@ -1,3 +1,16 @@+# 1.1.1++- add fixture tests for benchmark models+- extensive documentation improvements+- add `poissonPdf`+- Fix TUI inference+- Fix flaky test+- Support GHC 9.4++# 1.1.0++- extensive notebook improvements+ # 1.0.0 (2022-09-10)  - host website from repo

@@ -1,4 +1,4 @@-# [Monad-Bayes](https://monad-bayes-site.netlify.app/_site/about.html)+# [Monad-Bayes](https://monad-bayes.netlify.app/)  A library for probabilistic programming in Haskell.  @@ -7,7 +7,7 @@ [![Hackage Deps](https://img.shields.io/hackage-deps/v/monad-bayes.svg)](http://packdeps.haskellers.com/reverse/monad-bayes) [![Build status](https://badge.buildkite.com/147af088063e8619fcf52ecf93fa7dd3353a2e8a252ef8e6ad.svg?branch=master)](https://buildkite.com/tweag-1/monad-bayes) --> -[See the website](https://monad-bayes-site.netlify.app/_site/about.html) for an overview of the documentation, library, tutorials, examples (and a link to this very source code). +[See the docs](https://monad-bayes.netlify.app/) for a user guide, notebook-style tutorials, an example gallery, and a detailed account of the implementation.  <!-- Monad-Bayes is a library for **probabilistic programming in Haskell**. The emphasis is on composition of inference algorithms, and is implemented in terms of monad transformers. --> 

@@ -4,7 +4,7 @@  module Main (main) where -import Control.Monad.Bayes.Class (MonadDistribution, MonadMeasure)+import Control.Monad.Bayes.Class (MonadMeasure) import Control.Monad.Bayes.Inference.MCMC (MCMCConfig (MCMCConfig, numBurnIn, numMCMCSteps, proposal), Proposal (SingleSiteMH)) import Control.Monad.Bayes.Inference.RMSMC (rmsmcDynamic) import Control.Monad.Bayes.Inference.SMC (SMCConfig (SMCConfig, numParticles, numSteps, resampler), smc)@@ -26,8 +26,9 @@ import HMM qualified import LDA qualified import LogReg qualified+import System.Directory (removeFile)+import System.IO.Error (catchIOError, isDoesNotExistError) import System.Process.Typed (runProcess)-import System.Random.Stateful (IOGenM, StatefulGen, StdGen, mkStdGen, newIOGenM)  data ProbProgSys = MonadBayes   deriving stock (Show)@@ -123,7 +124,8 @@         ++ map (HMM . (`take` hmmData)) hmmLengths         ++ map (\n -> LDA $ map (take n) ldaData) ldaLengths     algs =-      map (\x -> MH (100 * x)) [1 .. 10] ++ map (\x -> SMC (100 * x)) [1 .. 10]+      map (\x -> MH (100 * x)) [1 .. 10]+        ++ map (\x -> SMC (100 * x)) [1 .. 10]         ++ map (\x -> RMSMC 10 (10 * x)) [1 .. 10]     benchmarks = map (uncurry3 (prepareBenchmark)) $ filter supported xs       where@@ -134,13 +136,34 @@           m <- models           return (s, m, a) +speedLengthCSV :: FilePath+speedLengthCSV = "speed-length.csv"++speedSamplesCSV :: FilePath+speedSamplesCSV = "speed-samples.csv"++rawDAT :: FilePath+rawDAT = "raw.dat"++cleanupLastRun :: IO ()+cleanupLastRun = mapM_ removeIfExists [speedLengthCSV, speedSamplesCSV, rawDAT]++removeIfExists :: FilePath -> IO ()+removeIfExists file = do+  putStrLn $ "Removing: " ++ file+  catchIOError (removeFile file) $ \e ->+    if isDoesNotExistError e+      then putStrLn "Didn't find file, not removing"+      else ioError e+ main :: IO () main = do+  cleanupLastRun   lrData <- sampleIOfixed (LogReg.syntheticData 1000)   hmmData <- sampleIOfixed (HMM.syntheticData 1000)   ldaData <- sampleIOfixed (LDA.syntheticData 5 1000)-  let configLength = defaultConfig {csvFile = Just "speed-length.csv", rawDataFile = Just "raw.dat"}+  let configLength = defaultConfig {csvFile = Just speedLengthCSV, rawDataFile = Just rawDAT}   defaultMainWith configLength (lengthBenchmarks lrData hmmData ldaData)-  let configSamples = defaultConfig {csvFile = Just "speed-samples.csv", rawDataFile = Just "raw.dat"}+  let configSamples = defaultConfig {csvFile = Just speedSamplesCSV, rawDataFile = Just rawDAT}   defaultMainWith configSamples (samplesBenchmarks lrData hmmData ldaData)   void $ runProcess "python plots.py"

@@ -15,7 +15,7 @@ import Data.Vector (fromList) import Pipes (MFunctor (hoist), MonadTrans (lift), each, yield, (>->)) import Pipes.Core (Producer)-import qualified Pipes.Prelude as Pipes+import Pipes.Prelude qualified as Pipes  -- | Observed values values :: [Double]

@@ -15,7 +15,7 @@     MonadMeasure,     factor,   )-import Control.Monad.Bayes.Sampler.Strict (sampleIO, sampleIOfixed)+import Control.Monad.Bayes.Sampler.Strict (sampleIOfixed) import Control.Monad.Bayes.Traced (mh) import Control.Monad.Bayes.Weighted (unweighted) import Data.Map qualified as Map

@@ -1,13 +1,13 @@-cabal-version:      2.0+cabal-version:      2.2 name:               monad-bayes-version:            1.1.0+version:            1.1.1 license:            MIT license-file:       LICENSE.md copyright:          2015-2020 Adam Scibior maintainer:         dominic.steinitz@tweag.io author:             Adam Scibior <adscib@gmail.com> stability:          experimental-tested-with:        GHC ==9.2.2+tested-with:        GHC ==9.0.2 || ==9.2.7 || ==9.4.5 homepage:           http://github.com/tweag/monad-bayes#readme bug-reports:        https://github.com/tweag/monad-bayes/issues synopsis:           A library for probabilistic programming.@@ -34,7 +34,52 @@   default:     False   manual:      True +common deps+  build-depends:+    , base             >=4.15    && <4.18+    , brick            >=1.0     && <2.0+    , containers       >=0.5.10  && <0.7+    , foldl            ^>=1.4+    , free             >=5.0.2   && <5.2+    , histogram-fill   ^>=0.9+    , ieee754          ^>=0.8.0+    , integration      ^>=0.2+    , lens             ^>=5.2+    , linear           ^>=1.22+    , log-domain       >=0.12    && <0.14+    , math-functions   >=0.2.1   && <0.4+    , matrix           ^>=0.3+    , monad-coroutine  ^>=0.9.0+    , monad-extras     ^>=0.6+    , mtl              ^>=2.2.2+    , mwc-random       >=0.13.6  && <0.16+    , pipes            ^>=4.3+    , pretty-simple    ^>=4.1+    , primitive        >=0.7     && <0.9+    , random           ^>=1.2+    , safe             ^>=0.3.17+    , scientific       ^>=0.3+    , statistics       >=0.14.0  && <0.17+    , text             >=1.2     && <2.1+    , vector           ^>=0.12.0+    , vty              ^>=5.38++common test-deps+  build-depends:+    , abstract-par          ^>=0.3+    , criterion             >=1.5    && <1.7+    , directory             ^>=1.3+    , hspec                 ^>=2.11+    , monad-bayes+    , optparse-applicative  >=0.17   && <0.19+    , process               ^>=1.6+    , QuickCheck            ^>=2.14+    , time                  >=1.9    && <1.13+    , transformers          ^>=0.5.6+    , typed-process         ^>=0.2+ library+  import:             deps   exposed-modules:     Control.Monad.Bayes.Class     Control.Monad.Bayes.Density.Free@@ -63,35 +108,6 @@   hs-source-dirs:     src   other-modules:      Control.Monad.Bayes.Traced.Common   default-language:   Haskell2010-  build-depends:-      base             >=4.11   && <4.17-    , brick            >=1.0    && <2.0-    , containers       >=0.5.10 && <0.7-    , foldl-    , free             >=5.0.2  && <5.2-    , histogram-fill-    , ieee754          ^>=0.8.0-    , integration-    , lens-    , linear-    , log-domain       >=0.12   && <0.14-    , math-functions   >=0.2.1  && <0.4-    , matrix-    , monad-coroutine  ^>=0.9.0-    , monad-extras-    , mtl              ^>=2.2.2-    , mwc-random       >=0.13.6 && <0.16-    , pipes-    , pretty-simple-    , primitive-    , random-    , safe             ^>=0.3.17-    , scientific-    , statistics       >=0.14.0 && <0.17-    , text-    , vector           ^>=0.12.0-    , vty-   default-extensions:     BlockArguments     FlexibleContexts@@ -102,14 +118,15 @@    if flag(dev)     ghc-options:-      -Wall -Wno-missing-local-signatures -Wno-trustworthy-safe-      -Wno-missing-import-lists -Wno-implicit-prelude-      -Wno-monomorphism-restriction+      -Wall -Werror -Wno-missing-local-signatures -Wno-trustworthy-safe+      -Wno-missing-import-lists -Wno-implicit-prelude -Wno-name-shadowing+      -Wno-monomorphism-restriction -Wredundant-constraints    else     ghc-options: -Wall  executable example+  import:             deps, test-deps   main-is:            Single.hs   hs-source-dirs:     benchmark models   other-modules:@@ -119,24 +136,10 @@     LogReg    default-language:   Haskell2010-  build-depends:-      base-    , containers-    , log-domain-    , math-functions-    , monad-bayes-    , mwc-random-    , optparse-applicative-    , pipes-    , pretty-simple-    , random-    , text-    , time-    , vector    if flag(dev)     ghc-options:-      -Wall -Wcompat -Wincomplete-record-updates+      -Wall -Werror -Wcompat -Wincomplete-record-updates       -Wincomplete-uni-patterns -Wnoncanonical-monad-instances    else@@ -151,6 +154,7 @@     TupleSections  test-suite monad-bayes-test+  import:             deps, test-deps   type:               exitcode-stdio-1.0   main-is:            Spec.hs   hs-source-dirs:     test models@@ -172,33 +176,10 @@     TestWeighted    default-language:   Haskell2010-  build-depends:-      base-    , containers-    , foldl-    , hspec-    , ieee754-    , lens-    , linear-    , log-domain-    , math-functions-    , matrix-    , monad-bayes-    , mtl-    , mwc-random-    , pipes-    , pretty-simple-    , profunctors-    , QuickCheck-    , random-    , statistics-    , text-    , transformers-    , vector    if flag(dev)     ghc-options:-      -Wall -Wno-missing-local-signatures -Wno-unsafe+      -Wall -Werror -Wno-missing-local-signatures -Wno-unsafe       -Wno-missing-import-lists -Wno-implicit-prelude    else@@ -213,18 +194,20 @@     TupleSections  benchmark ssm-bench+  import:           deps, test-deps   type:             exitcode-stdio-1.0   main-is:          SSM.hs   hs-source-dirs:   models benchmark   other-modules:    NonlinearSSM   default-language: Haskell2010   build-depends:-      base+    , base     , monad-bayes     , pretty-simple     , random  benchmark speed-bench+  import:             deps, test-deps   type:               exitcode-stdio-1.0   main-is:            Speed.hs   hs-source-dirs:     models benchmark@@ -234,25 +217,10 @@     LogReg    default-language:   Haskell2010-  build-depends:-      abstract-par-    , base-    , containers-    , criterion-    , log-domain-    , monad-bayes-    , mwc-random-    , pipes-    , pretty-simple-    , process-    , random-    , text-    , typed-process-    , vector    if flag(dev)     ghc-options:-      -Wall -Wno-missing-local-signatures -Wno-unsafe+      -Wall -Werror -Wno-missing-local-signatures -Wno-unsafe       -Wno-missing-import-lists -Wno-implicit-prelude    else

@@ -58,6 +58,7 @@     discrete,     normalPdf,     Bayesian (..),+    poissonPdf,     posterior,     priorPredictive,     posteriorPredictive,@@ -96,7 +97,7 @@ import Numeric.Log (Log (..)) import Statistics.Distribution   ( ContDistr (logDensity, quantile),-    DiscreteDistr (probability),+    DiscreteDistr (logProbability, probability),   ) import Statistics.Distribution.Beta (betaDistr) import Statistics.Distribution.Gamma (gammaDistr)@@ -284,6 +285,9 @@   -- | relative likelihood of observing sample x in \(\mathcal{N}(\mu, \sigma^2)\)   Log Double normalPdf mu sigma x = Exp $ logDensity (normalDistr mu sigma) x++poissonPdf :: Double -> Integer -> Log Double+poissonPdf rate n = Exp $ logProbability (Poisson.poisson rate) (fromIntegral n)  -- | multivariate normal mvNormal :: MonadDistribution m => V.Vector Double -> Matrix Double -> m (V.Vector Double)

@@ -12,19 +12,19 @@ module Control.Monad.Bayes.Inference.MCMC where  import Control.Monad.Bayes.Class (MonadDistribution)-import qualified Control.Monad.Bayes.Traced.Basic as Basic+import Control.Monad.Bayes.Traced.Basic qualified as Basic import Control.Monad.Bayes.Traced.Common   ( MHResult (MHResult, trace),     Trace (probDensity),     burnIn,     mhTransWithBool,   )-import qualified Control.Monad.Bayes.Traced.Dynamic as Dynamic-import qualified Control.Monad.Bayes.Traced.Static as Static+import Control.Monad.Bayes.Traced.Dynamic qualified as Dynamic+import Control.Monad.Bayes.Traced.Static qualified as Static import Control.Monad.Bayes.Weighted (Weighted, unweighted) import Pipes ((>->))-import qualified Pipes as P-import qualified Pipes.Prelude as P+import Pipes qualified as P+import Pipes.Prelude qualified as P  data Proposal = SingleSiteMH @@ -44,7 +44,7 @@  -- -- | draw iid samples until you get one that has non-zero likelihood independentSamples :: Monad m => Static.Traced m a -> P.Producer (MHResult a) m (Trace a)-independentSamples (Static.Traced w d) =+independentSamples (Static.Traced _w d) =   P.repeatM d     >-> P.takeWhile' ((== 0) . probDensity)     >-> P.map (MHResult False)

@@ -19,9 +19,8 @@ import Control.Monad.Bayes.Inference.MCMC import Control.Monad.Bayes.Sampler.Strict (SamplerIO, sampleIO) import Control.Monad.Bayes.Traced (Traced)-import Control.Monad.Bayes.Traced.Common+import Control.Monad.Bayes.Traced.Common hiding (burnIn) import Control.Monad.Bayes.Weighted-import Control.Monad.State.Class (put) import Data.Scientific (FPFormat (Exponent), formatScientific, fromFloatDigits) import Data.Text qualified as T import Data.Text.Lazy qualified as TL@@ -58,7 +57,9 @@               (toDoAttr, B.progressIncompleteAttr)             ]         )-        $ toBar $ fromIntegral $ numSteps state+        $ toBar+        $ fromIntegral+        $ numSteps state      likelihoodBar =       updateAttrMap

@@ -181,11 +181,11 @@       cumulativeSum = V.scanl (+) 0.0 weights       coalg (i, j)         | i < bigN =-          if (positions ! i) < (cumulativeSum ! j)-            then Just (Just j, (i + 1, j))-            else Just (Nothing, (i, j + 1))+            if (positions ! i) < (cumulativeSum ! j)+              then Just (Just j, (i + 1, j))+              else Just (Nothing, (i, j + 1))         | otherwise =-          Nothing+            Nothing   return $ map (\i -> i - 1) $ catMaybes $ unfoldr coalg (0, 0)  -- | Resample the population using the underlying monad and a stratified resampling scheme.

@@ -6,7 +6,7 @@ -- | This is a port of the implementation of LazyPPL: https://lazyppl.bitbucket.io/ module Control.Monad.Bayes.Sampler.Lazy where -import Control.Monad (ap, liftM)+import Control.Monad (ap) import Control.Monad.Bayes.Class (MonadDistribution (random)) import Control.Monad.Bayes.Weighted (Weighted, weighted) import Numeric.Log (Log (..))@@ -15,7 +15,7 @@     getStdGen,     newStdGen,   )-import qualified System.Random as R+import System.Random qualified as R  -- | A 'Tree' is a lazy, infinitely wide and infinitely deep tree, labelled by Doubles -- | Our source of randomness will be a Tree, populated by uniform [0,1] choices for each label.

@@ -77,7 +77,7 @@ -- >>> import System.Random.Stateful hiding (random) -- >>> newIOGenM (mkStdGen 1729) >>= sampleWith random -- 4.690861245089605e-2-sampleWith :: StatefulGen g m => Sampler g m a -> g -> m a+sampleWith :: Sampler g m a -> g -> m a sampleWith (Sampler m) = runReaderT m  -- | initialize random seed using system entropy, and sample

@@ -85,6 +85,6 @@     f k       | k <= 0 = fmap (:| []) d       | otherwise = do-        (x :| xs) <- f (k - 1)-        y <- mhTrans' m x-        return (y :| x : xs)+          (x :| xs) <- f (k - 1)+          y <- mhTrans' m x+          return (y :| x : xs)

@@ -24,8 +24,8 @@   ( MonadDistribution (bernoulli, random),     discrete,   )-import qualified Control.Monad.Bayes.Density.Free as Free-import qualified Control.Monad.Bayes.Density.State as State+import Control.Monad.Bayes.Density.Free qualified as Free+import Control.Monad.Bayes.Density.State qualified as State import Control.Monad.Bayes.Weighted as Weighted   ( Weighted,     hoist,

@@ -105,7 +105,7 @@   let f k         | k <= 0 = return (t :| [])         | otherwise = do-          (x :| xs) <- f (k - 1)-          y <- mhTransFree m x-          return (y :| x : xs)+            (x :| xs) <- f (k - 1)+            y <- mhTransFree m x+            return (y :| x : xs)   fmap (map output . NE.toList) (f n)

@@ -82,14 +82,41 @@   where     d' = d >>= mhTransFree m +-- $setup+-- >>> import Control.Monad.Bayes.Class+-- >>> import Control.Monad.Bayes.Sampler.Strict+-- >>> import Control.Monad.Bayes.Weighted+ -- | Full run of the Trace Metropolis-Hastings algorithm with a specified -- number of steps. Newest samples are at the head of the list.+--+-- For example:+--+-- * I have forgotten what day it is.+-- * There are ten buses per hour in the week and three buses per hour at the weekend.+-- * I observe four buses in a given hour.+-- * What is the probability that it is the weekend?+--+-- >>> :{+--  let+--    bus = do x <- bernoulli (2/7)+--             let rate = if x then 3 else 10+--             factor $ poissonPdf rate 4+--             return x+--    mhRunBusSingleObs = do+--      let nSamples = 2+--      sampleIOfixed $ unweighted $ mh nSamples bus+--  in mhRunBusSingleObs+-- :}+-- [True,True,True]+--+-- Of course, it will need to be run more than twice to get a reasonable estimate. mh :: MonadDistribution m => Int -> Traced m a -> m [a] mh n (Traced m d) = fmap (map output . NE.toList) (f n)   where     f k       | k <= 0 = fmap (:| []) d       | otherwise = do-        (x :| xs) <- f (k - 1)-        y <- mhTransFree m x-        return (y :| x : xs)+          (x :| xs) <- f (k - 1)+          y <- mhTransFree m x+          return (y :| x : xs)

@@ -8,7 +8,7 @@ import Control.Lens import Control.Monad.Primitive import Data.Vector (Vector, (!))-import qualified Data.Vector as V+import Data.Vector qualified as V import Data.Vector.Mutable import Linear (V2 (..)) @@ -25,7 +25,7 @@ -- | Störmer-Verlet integration scheme for systems of the form -- \(\mathbb{H}(p,q) = T(p) + V(q)\) stormerVerlet2H ::-  (Applicative f, Num (f a), Show (f a), Fractional a) =>+  (Applicative f, Num (f a), Fractional a) =>   -- | Step size   a ->   -- | \(\frac{\partial H}{\partial q}\)@@ -71,7 +71,7 @@     compute y i out       | i == V.length times = return ()       | otherwise = do-        let h = (times ! i) - (times ! (i - 1))-            y' = integrator h y-        write out i y'-        compute y' (i + 1) out+          let h = (times ! i) - (times ! (i - 1))+              y' = integrator h y+          write out i y'+          compute y' (i + 1) out

@@ -52,7 +52,9 @@   describe "Integrator Variance" do     prop "variance numerically" $       \mean var ->-        var > 0 ==> property $ TestIntegrator.normalVariance mean (sqrt var) ~== var+        -- Because of rounding issues, require the variance to be a bit bigger than 0+        -- See https://github.com/tweag/monad-bayes/issues/275+        var > 0.1 ==> property $ TestIntegrator.normalVariance mean (sqrt var) ~== var   describe "Sampler mean and variance" do     it "gets right mean and variance" $       TestSampler.testMeanAndVariance `shouldBe` True

@@ -1,15 +1,7 @@ module TestAdvanced where -import ConjugatePriors-  ( betaBernoulli',-    betaBernoulliAnalytic,-    gammaNormal',-    gammaNormalAnalytic,-    normalNormal',-    normalNormalAnalytic,-  ) import Control.Arrow-import Control.Monad (join, replicateM)+import Control.Monad (join) import Control.Monad.Bayes.Class import Control.Monad.Bayes.Enumerator import Control.Monad.Bayes.Inference.MCMC@@ -19,9 +11,6 @@ import Control.Monad.Bayes.Inference.SMC2 import Control.Monad.Bayes.Population import Control.Monad.Bayes.Sampler.Strict-import Control.Monad.Bayes.Traced-import Control.Monad.Bayes.Weighted-import Numeric.Log (Log)  mcmcConfig :: MCMCConfig mcmcConfig = MCMCConfig {numMCMCSteps = 0, numBurnIn = 0, proposal = SingleSiteMH}

@@ -9,13 +9,10 @@ where  import Control.Monad (replicateM)-import Control.Monad.Bayes.Class (MonadDistribution, mvNormal)+import Control.Monad.Bayes.Class (mvNormal) import Control.Monad.Bayes.Sampler.Strict-import Control.Monad.Identity (runIdentity)-import Control.Monad.State (evalStateT) import Data.Matrix (fromList) import Data.Vector qualified as V-import System.Random.MWC (toSeed)  -- Test the sampled covariance is approximately the same as the -- specified covariance.

@@ -20,7 +20,6 @@ import Control.Monad.Bayes.Integrator (normalize) import Control.Monad.Bayes.Integrator qualified as Integrator import Control.Monad.Bayes.Population-import Control.Monad.Bayes.Population (collapse, runPopulation) import Control.Monad.Bayes.Sampler.Strict (Sampler, sampleIOfixed) import Control.Monad.Bayes.Sampler.Strict qualified as Sampler import Control.Monad.Bayes.Weighted (Weighted)@@ -28,7 +27,7 @@ import Data.AEq (AEq ((~==))) import Numeric.Log (Log) import Sprinkler (soft)-import System.Random.Stateful (IOGenM, StdGen, mkStdGen, newIOGenM)+import System.Random.Stateful (IOGenM, StdGen)  sprinkler :: MonadMeasure m => m Bool sprinkler = Sprinkler.soft

@@ -14,7 +14,7 @@ import Control.Monad.Bayes.Integrator import Control.Monad.Bayes.Sampler.Strict import Control.Monad.Bayes.Weighted (weighted)-import Control.Monad.ST (ST, runST)+import Control.Monad.ST (runST) import Data.AEq (AEq ((~==))) import Data.List (sortOn) import Data.Set (fromList)

@@ -6,10 +6,9 @@ import Control.Monad.Bayes.Class () import Control.Monad.Bayes.Enumerator (enumerator) import Data.AEq (AEq ((~==)))+import Data.List (sort) import HMM (hmm, hmmPosterior)-import Pipes ((>->)) import Pipes.Prelude (toListM)-import qualified Pipes.Prelude as Pipes  urns :: Int -> Bool urns n = enumerator (urn n) ~== enumerator (urnP n)@@ -18,4 +17,5 @@ hmms observations =   let hmmWithoutPipe = hmm observations       hmmWithPipe = reverse . init <$> toListM (hmmPosterior observations)-   in enumerator hmmWithPipe ~== enumerator hmmWithoutPipe+   in -- Sort enumerator again although it is already sorted, see https://github.com/tweag/monad-bayes/issues/283+      sort (enumerator hmmWithPipe) ~== sort (enumerator hmmWithoutPipe)

@@ -14,7 +14,6 @@ import Control.Monad.Bayes.Sampler.Strict (sampleIOfixed) import Data.AEq (AEq ((~==))) import Sprinkler (soft)-import System.Random.Stateful (mkStdGen, newIOGenM)  weightedSampleSize :: MonadDistribution m => Population m a -> m Int weightedSampleSize = fmap length . population

@@ -1,10 +1,10 @@ module TestSampler where -import qualified Control.Foldl as Fold+import Control.Foldl qualified as Fold import Control.Monad (replicateM) import Control.Monad.Bayes.Class (MonadDistribution (normal)) import Control.Monad.Bayes.Sampler.Strict (sampleSTfixed)-import Control.Monad.ST (ST, runST)+import Control.Monad.ST (runST)  testMeanAndVariance :: Bool testMeanAndVariance = isDiff

@@ -6,10 +6,11 @@ import Control.Lens import Control.Monad.ST import Data.Maybe (fromJust)-import qualified Data.Vector as V-import qualified Linear as L+import Data.Vector qualified as V+import Linear qualified as L import Linear.V import Math.Integrators.StormerVerlet+import Statistics.Function (square)  gConst :: Double gConst = 6.67384e-11@@ -81,8 +82,8 @@     qS = qs ^. _2     pJ = ps ^. _1     pS = ps ^. _2-    keJ = (* 0.5) $ (/ jupiterMass) $ sum $ fmap (^ 2) pJ-    keS = (* 0.5) $ (/ sunMass) $ sum $ fmap (^ 2) pS+    keJ = (* 0.5) $ (/ jupiterMass) $ sum $ fmap square pJ+    keS = (* 0.5) $ (/ sunMass) $ sum $ fmap square pS     r = qJ L.^-^ qS     ri = r `L.dot` r     peJ = 0.5 * gConst * sunMass * jupiterMass / (sqrt ri)

@@ -13,7 +13,6 @@ import Data.AEq (AEq ((~==))) import Data.Bifunctor (second) import Numeric.Log (Log (Exp, ln))-import System.Random.Stateful (mkStdGen, newIOGenM)  model :: MonadMeasure m => m (Int, Double) model = do