packages feed

mcmc-0.2.3: test/Mcmc/SaveSpec.hs

-- |
--   Module      :  Mcmc.SaveSpec
--   Description :  Unit tests for Mcmc.Save
--   Copyright   :  (c) Dominik Schrempf, 2020
--   License     :  GPL-3.0-or-later
--
--   Maintainer  :  dominik.schrempf@gmail.com
--   Stability   :  unstable
--   Portability :  portable
--
-- Creation date: Tue Jun 16 14:32:55 2020.
module Mcmc.SaveSpec
  ( spec,
  )
where

import Mcmc
import Mcmc.Save
import Mcmc.Status hiding (save)
import Numeric.Log
import Statistics.Distribution hiding
  ( mean,
    stdDev,
  )
import Statistics.Distribution.Normal
import System.Random.MWC
import Test.Hspec

trueMean :: Double
trueMean = 5

trueStdDev :: Double
trueStdDev = 4

lh :: Double -> Log Double
lh = Exp . logDensity (normalDistr trueMean trueStdDev)

proposals :: Cycle Double
proposals =
  fromList
    [ slideSymmetric "small" 5 0.1 True,
      slideSymmetric "medium" 2 1.0 True,
      slideSymmetric "large" 2 5.0 True,
      slide "skewed" 1 1.0 4.0 True
    ]

monStd :: MonitorStdOut Double
monStd = monitorStdOut [monitorDouble "mu"] 10

mon :: Monitor Double
mon = Monitor monStd [] []

nBurn :: Maybe Int
nBurn = Just 20

nAutoTune :: Maybe Int
nAutoTune = Just 10

nIter :: Int
nIter = 200

spec :: Spec
spec =
  describe "saveStatus and loadStatus" $
    it "doesn't change the MCMC chain" $
      do
        gen <- create
        let s =
              force $
                quiet $
                  saveWith 100 $
                    status "SaveSpec" (const 1) lh proposals mon 0 nBurn nAutoTune nIter gen
        saveStatus "SaveSpec.json" s
        s' <- loadStatus (const 1) lh proposals mon "SaveSpec.json"
        r <- mh s
        r' <- mh s'
        -- Done during 'loadStatus'.
        -- removeFile "SaveSpec.json"
        item r `shouldBe` item r'
        iteration r `shouldBe` iteration r'
        trace r `shouldBe` trace r'
        g <- save $ generator r
        g' <- save $ generator r'
        g `shouldBe` g'

-- -- TODO: Splitmix. This will only work with a splittable generator
-- -- because getNIterations changes the generator.
-- describe "mhContinue"
--   $ it "mh 200 + mhContinue 200 == mh 400"
--   $ do
--     gen1 <- create
--     let s1 = status "SaveSpec" (const 1) likelihood proposals mon 0 nBurn nAutoTune 400 gen1
--     r1 <- mh s1
--     gen2 <- create
--     let s2 = status "SaveSpec" (const 1) likelihood proposals mon 0 nBurn nAutoTune 200 gen2
--     r2' <- mh s2
--     r2 <- mhContinue 200 r2'
--     item r1 `shouldBe` item r2
--     iteration r1 `shouldBe` iteration r2
--     trace r1 `shouldBe` trace r2
--     g <- save $ generator r1
--     g' <- save $ generator r2
--     g `shouldBe` g'