diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/benchmark/Speed.hs b/benchmark/Speed.hs --- a/benchmark/Speed.hs +++ b/benchmark/Speed.hs @@ -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" diff --git a/models/HMM.hs b/models/HMM.hs --- a/models/HMM.hs +++ b/models/HMM.hs @@ -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] diff --git a/models/LDA.hs b/models/LDA.hs --- a/models/LDA.hs +++ b/models/LDA.hs @@ -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 diff --git a/monad-bayes.cabal b/monad-bayes.cabal --- a/monad-bayes.cabal +++ b/monad-bayes.cabal @@ -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 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 diff --git a/src/Control/Monad/Bayes/Class.hs b/src/Control/Monad/Bayes/Class.hs --- a/src/Control/Monad/Bayes/Class.hs +++ b/src/Control/Monad/Bayes/Class.hs @@ -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) diff --git a/src/Control/Monad/Bayes/Inference/MCMC.hs b/src/Control/Monad/Bayes/Inference/MCMC.hs --- a/src/Control/Monad/Bayes/Inference/MCMC.hs +++ b/src/Control/Monad/Bayes/Inference/MCMC.hs @@ -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) diff --git a/src/Control/Monad/Bayes/Inference/TUI.hs b/src/Control/Monad/Bayes/Inference/TUI.hs --- a/src/Control/Monad/Bayes/Inference/TUI.hs +++ b/src/Control/Monad/Bayes/Inference/TUI.hs @@ -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 diff --git a/src/Control/Monad/Bayes/Population.hs b/src/Control/Monad/Bayes/Population.hs --- a/src/Control/Monad/Bayes/Population.hs +++ b/src/Control/Monad/Bayes/Population.hs @@ -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. diff --git a/src/Control/Monad/Bayes/Sampler/Lazy.hs b/src/Control/Monad/Bayes/Sampler/Lazy.hs --- a/src/Control/Monad/Bayes/Sampler/Lazy.hs +++ b/src/Control/Monad/Bayes/Sampler/Lazy.hs @@ -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. diff --git a/src/Control/Monad/Bayes/Sampler/Strict.hs b/src/Control/Monad/Bayes/Sampler/Strict.hs --- a/src/Control/Monad/Bayes/Sampler/Strict.hs +++ b/src/Control/Monad/Bayes/Sampler/Strict.hs @@ -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 diff --git a/src/Control/Monad/Bayes/Traced/Basic.hs b/src/Control/Monad/Bayes/Traced/Basic.hs --- a/src/Control/Monad/Bayes/Traced/Basic.hs +++ b/src/Control/Monad/Bayes/Traced/Basic.hs @@ -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) diff --git a/src/Control/Monad/Bayes/Traced/Common.hs b/src/Control/Monad/Bayes/Traced/Common.hs --- a/src/Control/Monad/Bayes/Traced/Common.hs +++ b/src/Control/Monad/Bayes/Traced/Common.hs @@ -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, diff --git a/src/Control/Monad/Bayes/Traced/Dynamic.hs b/src/Control/Monad/Bayes/Traced/Dynamic.hs --- a/src/Control/Monad/Bayes/Traced/Dynamic.hs +++ b/src/Control/Monad/Bayes/Traced/Dynamic.hs @@ -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) diff --git a/src/Control/Monad/Bayes/Traced/Static.hs b/src/Control/Monad/Bayes/Traced/Static.hs --- a/src/Control/Monad/Bayes/Traced/Static.hs +++ b/src/Control/Monad/Bayes/Traced/Static.hs @@ -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) diff --git a/src/Math/Integrators/StormerVerlet.hs b/src/Math/Integrators/StormerVerlet.hs --- a/src/Math/Integrators/StormerVerlet.hs +++ b/src/Math/Integrators/StormerVerlet.hs @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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 diff --git a/test/TestAdvanced.hs b/test/TestAdvanced.hs --- a/test/TestAdvanced.hs +++ b/test/TestAdvanced.hs @@ -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} diff --git a/test/TestDistribution.hs b/test/TestDistribution.hs --- a/test/TestDistribution.hs +++ b/test/TestDistribution.hs @@ -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. diff --git a/test/TestInference.hs b/test/TestInference.hs --- a/test/TestInference.hs +++ b/test/TestInference.hs @@ -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 diff --git a/test/TestIntegrator.hs b/test/TestIntegrator.hs --- a/test/TestIntegrator.hs +++ b/test/TestIntegrator.hs @@ -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) diff --git a/test/TestPipes.hs b/test/TestPipes.hs --- a/test/TestPipes.hs +++ b/test/TestPipes.hs @@ -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) diff --git a/test/TestPopulation.hs b/test/TestPopulation.hs --- a/test/TestPopulation.hs +++ b/test/TestPopulation.hs @@ -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 diff --git a/test/TestSampler.hs b/test/TestSampler.hs --- a/test/TestSampler.hs +++ b/test/TestSampler.hs @@ -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 diff --git a/test/TestStormerVerlet.hs b/test/TestStormerVerlet.hs --- a/test/TestStormerVerlet.hs +++ b/test/TestStormerVerlet.hs @@ -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) diff --git a/test/TestWeighted.hs b/test/TestWeighted.hs --- a/test/TestWeighted.hs +++ b/test/TestWeighted.hs @@ -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