-- | -- 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 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) moveCycle :: Cycle Double moveCycle = fromList [ slideSymmetric "small" 5 id 0.1 True, slideSymmetric "medium" 2 id 1.0 True, slideSymmetric "large" 2 id 5.0 True, slide "skewed" 1 id 1.0 4.0 True ] monStd :: MonitorStdOut Double monStd = monitorStdOut [monitorRealFloat "mu" id] 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 = noSave $ status "SaveSpec" (const 1) lh moveCycle mon 0 nBurn nAutoTune nIter gen saveStatus "SaveSpec.json" s s' <- loadStatus (const 1) lh moveCycle mon "SaveSpec.json" r <- mh s r' <- mh s' 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: This will only work with a splittable generator because getNCycles -- -- changes the generator. -- describe "mhContinue" -- $ it "mh 200 + mhContinue 200 == mh 400" -- $ do -- gen1 <- create -- let s1 = noSave $ status "SaveSpec" (const 1) likelihood moveCycle mon 0 nBurn nAutoTune 400 gen1 -- r1 <- mh s1 -- gen2 <- create -- let s2 = noSave $ status "SaveSpec" (const 1) likelihood moveCycle 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'