Generalize from double

.gitignore

@@ -1,3 +1,4 @@
+src/data
 _cache
 docs/build
 *.csv

CHANGELOG.md

@@ -1,10 +1,17 @@
-# 0.2.0 (2021-07-18)
+# 0.2.0 (2021-07-26)
 
-  * Addition of `sampleIOwith` and `sampleSTwith` allowing the usage
-    of your favourite RNG with seed of your choice.
-  * 
+- rename various functions to match the names of the corresponding types (e.g. `Enumerator` goes with `enumerator`)
+- add configs as arguments to inference methods `smc` and `mcmc`
+- add rudimentary tests for all inference methods
+- put `mcmc` as inference method in new module `Control.Monad.Bayes.Inference.MCMC`
+- update history of changelog in line with semantic versioning conventions
+- bumped to GHC 9.2.3
 
-# 0.1.1.3 (2021-06-15)
+# 0.1.5 (2021-07-26)
+
+- Refactor of sampler to be parametric in the choice of a pair of IO monad and RNG
+
+# 0.1.4 (2021-06-15)
 
 Addition of new helper functions, plotting tools, tests, and Integrator monad.
 
@@ -15,7 +22,7 @@ Addition of new helper functions, plotting tools, tests, and Integrator monad.
 - `models` directory is cleaned up. New sequential models using `pipes` package to represent monadic streams
 
 
-# 0.1.1.2 (2021-06-08)
+# 0.1.3 (2021-06-08)
 
 Clean up of unused functions and broken code
 
@@ -24,18 +31,18 @@ Clean up of unused functions and broken code
 - explicit imports
 - added some global language extensions
 
-# 0.1.1.1 (2021-06-08)
+# 0.1.2 (2021-06-08)
 
 Add documentation
 
 - docs written in markdown
 - docs built by sphinx
 
 
-# 0.1.1.0 (2020-04-08)
+# 0.1.1 (2020-04-08)
 
 - New exported function: `Control.Monad.Bayes.Class` now exports `discrete`.
 
-# 0.1.0.0 (2020-02-17)
+# 0.1.0 (2020-02-17)
 
 Initial release.

benchmark/SSM.hs

@@ -1,35 +1,43 @@
 module Main where
 
+import Control.Monad.Bayes.Inference.MCMC
 import Control.Monad.Bayes.Inference.PMMH as PMMH (pmmh)
-import Control.Monad.Bayes.Inference.RMSMC (rmsmcLocal)
-import Control.Monad.Bayes.Inference.SMC (smcMultinomial)
+import Control.Monad.Bayes.Inference.RMSMC (rmsmcDynamic)
+import Control.Monad.Bayes.Inference.SMC
 import Control.Monad.Bayes.Inference.SMC2 as SMC2 (smc2)
-import Control.Monad.Bayes.Population (runPopulation)
-import Control.Monad.Bayes.Sampler (sampleWith)
-import Control.Monad.Bayes.Weighted (prior)
+import Control.Monad.Bayes.Population
+import Control.Monad.Bayes.Population (population, resampleMultinomial, runPopulation)
+import Control.Monad.Bayes.Sampler (sampleIO, sampleIOfixed, sampleWith)
+import Control.Monad.Bayes.Weighted (unweighted)
 import Control.Monad.IO.Class (MonadIO (liftIO))
 import NonlinearSSM (generateData, model, param)
 import System.Random.Stateful (mkStdGen, newIOGenM)
 
 main :: IO ()
-main = do
-  (smcRes, smcrmRes, pmmhRes, smc2Res) <-
-    newIOGenM (mkStdGen 1729)
-      >>= ( sampleWith $ do
-              let t = 5
-              dat <- generateData t
-              let ys = map snd dat
-              smcRes <- runPopulation $ smcMultinomial t 10 (param >>= model ys)
-              smcrmRes <- runPopulation $ rmsmcLocal t 10 10 (param >>= model ys)
-              pmmhRes <- prior $ pmmh 2 t 3 param (model ys)
-              smc2Res <- runPopulation $ smc2 t 3 2 1 param (model ys)
-              return (smcRes, smcrmRes, pmmhRes, smc2Res)
-          )
-  print "SMC"
-  print $ show smcRes
-  print "RM-SMC"
-  print $ show smcrmRes
-  print "PMMH"
-  print $ show pmmhRes
-  print "SMC2"
-  print $ show smc2Res
+main = sampleIOfixed $ do
+  let t = 5
+  dat <- generateData t
+  let ys = map snd dat
+  liftIO $ print "SMC"
+  smcRes <- population $ smc SMCConfig {numSteps = t, numParticles = 10, resampler = resampleMultinomial} (param >>= model ys)
+  liftIO $ print $ show smcRes
+  liftIO $ print "RM-SMC"
+  smcrmRes <-
+    population $
+      rmsmcDynamic
+        MCMCConfig {numMCMCSteps = 10, numBurnIn = 0, proposal = SingleSiteMH}
+        SMCConfig {numSteps = t, numParticles = 10, resampler = resampleSystematic}
+        (param >>= model ys)
+  liftIO $ print $ show smcrmRes
+  liftIO $ print "PMMH"
+  pmmhRes <-
+    unweighted $
+      pmmh
+        MCMCConfig {numMCMCSteps = 2, numBurnIn = 0, proposal = SingleSiteMH}
+        SMCConfig {numSteps = t, numParticles = 3, resampler = resampleSystematic}
+        param
+        (model ys)
+  liftIO $ print $ show pmmhRes
+  liftIO $ print "SMC2"
+  smc2Res <- population $ smc2 t 3 2 1 param (model ys)
+  liftIO $ print $ show smc2Res

benchmark/Single.hs

@@ -2,9 +2,11 @@
 {-# LANGUAGE ImportQualifiedPost #-}
 
 import Control.Monad.Bayes.Class
+import Control.Monad.Bayes.Inference.MCMC (MCMCConfig (..), Proposal (SingleSiteMH))
 import Control.Monad.Bayes.Inference.RMSMC
 import Control.Monad.Bayes.Inference.SMC
 import Control.Monad.Bayes.Population
+import Control.Monad.Bayes.Population (population)
 import Control.Monad.Bayes.Sampler
 import Control.Monad.Bayes.Traced
 import Control.Monad.Bayes.Weighted
@@ -16,75 +18,75 @@ import LogReg qualified
 import Options.Applicative
 import System.Random.MWC (GenIO, createSystemRandom)
 
-data Model = LR Int | HMM Int | LDA (Int, Int)
-  deriving stock (Show, Read)
+-- data Model = LR Int | HMM Int | LDA (Int, Int)
+--   deriving stock (Show, Read)
 
-parseModel :: String -> Maybe Model
-parseModel s =
-  case s of
-    'L' : 'R' : n -> Just $ LR (read n)
-    'H' : 'M' : 'M' : n -> Just $ HMM (read n)
-    'L' : 'D' : 'A' : n -> Just $ LDA (5, read n)
-    _ -> Nothing
+-- parseModel :: String -> Maybe Model
+-- parseModel s =
+--   case s of
+--     'L' : 'R' : n -> Just $ LR (read n)
+--     'H' : 'M' : 'M' : n -> Just $ HMM (read n)
+--     'L' : 'D' : 'A' : n -> Just $ LDA (5, read n)
+--     _ -> Nothing
 
-getModel :: MonadInfer m => Model -> (Int, m String)
-getModel model = (size model, program model)
-  where
-    size (LR n) = n
-    size (HMM n) = n
-    size (LDA (d, w)) = d * w
-    program (LR n) = show <$> (LogReg.logisticRegression (runST $ sampleSTfixed (LogReg.syntheticData n)))
-    program (HMM n) = show <$> (HMM.hmm (runST $ sampleSTfixed (HMM.syntheticData n)))
-    program (LDA (d, w)) = show <$> (LDA.lda (runST $ sampleSTfixed (LDA.syntheticData d w)))
+-- getModel :: MonadInfer m => Model -> (Int, m String)
+-- getModel model = (size model, program model)
+--   where
+--     size (LR n) = n
+--     size (HMM n) = n
+--     size (LDA (d, w)) = d * w
+--     program (LR n) = show <$> (LogReg.logisticRegression (runST $ sampleSTfixed (LogReg.syntheticData n)))
+--     program (HMM n) = show <$> (HMM.hmm (runST $ sampleSTfixed (HMM.syntheticData n)))
+--     program (LDA (d, w)) = show <$> (LDA.lda (runST $ sampleSTfixed (LDA.syntheticData d w)))
 
-data Alg = SMC | MH | RMSMC
-  deriving stock (Read, Show)
+-- -- data Alg = SMC | MH | RMSMC
+-- --   deriving stock (Read, Show)
 
-runAlg :: Model -> Alg -> Sampler GenIO IO String
-runAlg model alg =
-  case alg of
-    SMC ->
-      let n = 100
-          (k, m) = getModel model
-       in show <$> runPopulation (smcSystematic k n m)
-    MH ->
-      let t = 100
-          (_, m) = getModel model
-       in show <$> prior (mh t m)
-    RMSMC ->
-      let n = 10
-          t = 1
-          (k, m) = getModel model
-       in show <$> runPopulation (rmsmcBasic k n t m)
+-- runAlg :: Model -> Alg -> Sampler GenIO IO String
+-- runAlg model alg =
+--   case alg of
+--     SMC ->
+--       let n = 100
+--           (k, m) = getModel model
+--        in show <$> population (smc SMCConfig {numSteps = k, numParticles = n, resampler = resampleSystematic} m)
+--     MH ->
+--       let t = 100
+--           (_, m) = getModel model
+--        in show <$> unweighted (mh t m)
+--     RMSMC ->
+--       let n = 10
+--           t = 1
+--           (k, m) = getModel model
+--        in show <$> population (rmsmcBasic MCMCConfig {numMCMCSteps = t, numBurnIn = 0, proposal = SingleSiteMH} (SMCConfig {numSteps = k, numParticles = n, resampler = resampleSystematic}) m)
 
-infer :: Model -> Alg -> IO ()
-infer model alg = do
-  g <- createSystemRandom
-  x <- sampleWith (runAlg model alg) g
-  print x
+-- infer :: Model -> Alg -> IO ()
+-- infer model alg = do
+--   g <- createSystemRandom
+--   x <- sampleWith (runAlg model alg) g
+--   print x
 
-opts :: ParserInfo (Model, Alg)
-opts = flip info fullDesc $ liftA2 (,) model alg
-  where
-    model =
-      option
-        (maybeReader parseModel)
-        ( long "model"
-            <> short 'm'
-            <> help "Model"
-        )
-    alg =
-      option
-        auto
-        ( long "alg"
-            <> short 'a'
-            <> help "Inference algorithm"
-        )
+-- -- opts :: ParserInfo (Model, Alg)
+-- -- opts = flip info fullDesc $ liftA2 (,) model alg
+-- --   where
+-- --     model =
+-- --       option
+-- --         (maybeReader parseModel)
+-- --         ( long "model"
+-- --             <> short 'm'
+-- --             <> help "Model"
+-- --         )
+-- --     alg =
+-- --       option
+-- --         auto
+-- --         ( long "alg"
+-- --             <> short 'a'
+-- --             <> help "Inference algorithm"
+-- --         )
 
-main :: IO ()
-main = do
-  (model, alg) <- execParser opts
-  startTime <- getCurrentTime
-  infer model alg
-  endTime <- getCurrentTime
-  print (diffUTCTime endTime startTime)
+-- -- main :: IO ()
+-- -- main = do
+-- --   (model, alg) <- execParser opts
+-- --   startTime <- getCurrentTime
+-- --   infer model alg
+-- --   endTime <- getCurrentTime
+-- --   print (diffUTCTime endTime startTime)