Refactor SSM benchmark & fixture test

benchmark/SSM.hs

@@ -11,33 +11,22 @@ import Control.Monad.Bayes.Sampler.Strict (sampleIO, sampleIOfixed, sampleWith)
 import Control.Monad.Bayes.Weighted (unweighted)
 import Control.Monad.IO.Class (MonadIO (liftIO))
 import NonlinearSSM (generateData, model, param)
+import NonlinearSSM.Algorithms
 import System.Random.Stateful (mkStdGen, newIOGenM)
 
 main :: IO ()
 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
+  smcRes <- runAlgFixed ys SMC
+  liftIO $ print 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
+  smcrmRes <- runAlgFixed ys RMSMCDynamic
+  liftIO $ print 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
+  pmmhRes <- runAlgFixed ys PMMH
+  liftIO $ print pmmhRes
   liftIO $ print "SMC2"
-  smc2Res <- population $ smc2 t 3 2 1 param (model ys)
+  smc2Res <- runAlgFixed ys SMC2
   liftIO $ print $ show smc2Res

models/NonlinearSSM/Algorithms.hs

@@ -0,0 +1,56 @@
+module NonlinearSSM.Algorithms where
+
+import Control.Monad.Bayes.Class (MonadDistribution)
+import Control.Monad.Bayes.Inference.MCMC
+import Control.Monad.Bayes.Inference.PMMH as PMMH (pmmh)
+import Control.Monad.Bayes.Inference.RMSMC (rmsmc, rmsmcBasic, rmsmcDynamic)
+import Control.Monad.Bayes.Inference.SMC
+import Control.Monad.Bayes.Inference.SMC2 as SMC2 (smc2)
+import Control.Monad.Bayes.Population
+import Control.Monad.Bayes.Weighted (unweighted)
+import NonlinearSSM
+
+data Alg = SMC | RMSMC | RMSMCDynamic | RMSMCBasic | PMMH | SMC2
+  deriving (Show, Read, Eq, Ord, Enum, Bounded)
+
+algs :: [Alg]
+algs = [minBound .. maxBound]
+
+type SSMData = [Double]
+
+t :: Int
+t = 5
+
+-- FIXME refactor such that it can be reused in ssm benchmark
+runAlgFixed :: MonadDistribution m => SSMData -> Alg -> m String
+runAlgFixed ys SMC = fmap show $ population $ smc SMCConfig {numSteps = t, numParticles = 10, resampler = resampleMultinomial} (param >>= model ys)
+runAlgFixed ys RMSMC =
+  fmap show $
+    population $
+      rmsmc
+        MCMCConfig {numMCMCSteps = 10, numBurnIn = 0, proposal = SingleSiteMH}
+        SMCConfig {numSteps = t, numParticles = 10, resampler = resampleSystematic}
+        (param >>= model ys)
+runAlgFixed ys RMSMCBasic =
+  fmap show $
+    population $
+      rmsmcBasic
+        MCMCConfig {numMCMCSteps = 10, numBurnIn = 0, proposal = SingleSiteMH}
+        SMCConfig {numSteps = t, numParticles = 10, resampler = resampleSystematic}
+        (param >>= model ys)
+runAlgFixed ys RMSMCDynamic =
+  fmap show $
+    population $
+      rmsmcDynamic
+        MCMCConfig {numMCMCSteps = 10, numBurnIn = 0, proposal = SingleSiteMH}
+        SMCConfig {numSteps = t, numParticles = 10, resampler = resampleSystematic}
+        (param >>= model ys)
+runAlgFixed ys PMMH =
+  fmap show $
+    unweighted $
+      pmmh
+        MCMCConfig {numMCMCSteps = 2, numBurnIn = 0, proposal = SingleSiteMH}
+        SMCConfig {numSteps = t, numParticles = 3, resampler = resampleSystematic}
+        param
+        (model ys)
+runAlgFixed ys SMC2 = fmap show $ population $ smc2 t 3 2 1 param (model ys)

monad-bayes.cabal

@@ -163,6 +163,7 @@ test-suite monad-bayes-test
     LDA
     LogReg
     NonlinearSSM
+    NonlinearSSM.Algorithms
     Sprinkler
     TestAdvanced
     TestBenchmarks
@@ -223,7 +224,10 @@ benchmark ssm-bench
   type:             exitcode-stdio-1.0
   main-is:          SSM.hs
   hs-source-dirs:   models benchmark
-  other-modules:    NonlinearSSM
+  other-modules:
+    NonlinearSSM
+    NonlinearSSM.Algorithms
+
   default-language: Haskell2010
   build-depends:
       base

test/TestSSMFixtures.hs

@@ -1,67 +1,15 @@
 module TestSSMFixtures where
 
-import Control.Monad.Bayes.Class (MonadDistribution)
-import Control.Monad.Bayes.Inference.MCMC
-import Control.Monad.Bayes.Inference.PMMH as PMMH (pmmh)
-import Control.Monad.Bayes.Inference.RMSMC (rmsmc, rmsmcBasic, rmsmcDynamic)
-import Control.Monad.Bayes.Inference.SMC
-import Control.Monad.Bayes.Inference.SMC2 as SMC2 (smc2)
-import Control.Monad.Bayes.Population
 import Control.Monad.Bayes.Sampler.Strict (sampleIOfixed)
-import Control.Monad.Bayes.Weighted (unweighted)
 import NonlinearSSM
+import NonlinearSSM.Algorithms
 import System.IO (readFile')
 import System.IO.Error (catchIOError, isDoesNotExistError)
 import Test.Hspec
 
-data Alg = SMC | RMSMC | RMSMCDynamic | RMSMCBasic | PMMH | SMC2
-  deriving (Show, Read, Eq, Ord, Enum, Bounded)
-
-algs :: [Alg]
-algs = [minBound .. maxBound]
-
 fixtureToFilename :: Alg -> FilePath
 fixtureToFilename alg = "test/fixtures/SSM-" ++ show alg ++ ".txt"
 
-type SSMData = [Double]
-
-t :: Int
-t = 5
-
--- FIXME refactor such that it can be reused in ssm benchmark
-runAlgFixed :: MonadDistribution m => SSMData -> Alg -> m String
-runAlgFixed ys SMC = fmap show $ population $ smc SMCConfig {numSteps = t, numParticles = 10, resampler = resampleMultinomial} (param >>= model ys)
-runAlgFixed ys RMSMC =
-  fmap show $
-    population $
-      rmsmc
-        MCMCConfig {numMCMCSteps = 10, numBurnIn = 0, proposal = SingleSiteMH}
-        SMCConfig {numSteps = t, numParticles = 10, resampler = resampleSystematic}
-        (param >>= model ys)
-runAlgFixed ys RMSMCBasic =
-  fmap show $
-    population $
-      rmsmcBasic
-        MCMCConfig {numMCMCSteps = 10, numBurnIn = 0, proposal = SingleSiteMH}
-        SMCConfig {numSteps = t, numParticles = 10, resampler = resampleSystematic}
-        (param >>= model ys)
-runAlgFixed ys RMSMCDynamic =
-  fmap show $
-    population $
-      rmsmcDynamic
-        MCMCConfig {numMCMCSteps = 10, numBurnIn = 0, proposal = SingleSiteMH}
-        SMCConfig {numSteps = t, numParticles = 10, resampler = resampleSystematic}
-        (param >>= model ys)
-runAlgFixed ys PMMH =
-  fmap show $
-    unweighted $
-      pmmh
-        MCMCConfig {numMCMCSteps = 2, numBurnIn = 0, proposal = SingleSiteMH}
-        SMCConfig {numSteps = t, numParticles = 3, resampler = resampleSystematic}
-        param
-        (model ys)
-runAlgFixed ys SMC2 = fmap show $ population $ smc2 t 3 2 1 param (model ys)
-
 testFixture :: Alg -> SpecWith ()
 testFixture alg = do
   let filename = fixtureToFilename alg