flat-mcmc

commit a18cc3eee6bb54c6751f2842a3c68e06078a8a20
parent fc999b22c23d28f841ae8bee26a01d077fb52d74
Author: Jared Tobin <jared@jtobin.ca>
Date:   Wed, 30 Mar 2016 18:09:52 +0700

Rosenbrock example segfaulting.

Diffstat:
M
src/Numeric/MCMC/Flat.hs
 | 
14
++++++++++++--
A
test/Rosenbrock.hs
 | 
21
+++++++++++++++++++++

2 files changed, 33 insertions(+), 2 deletions(-)
diff --git a/src/Numeric/MCMC/Flat.hs b/src/Numeric/MCMC/Flat.hs
@@ -1,7 +1,17 @@
 {-# OPTIONS_GHC -fno-warn-type-defaults #-}
 {-# LANGUAGE RecordWildCards #-}
 
-module Numeric.MCMC.Flat (mcmc) where
+module Numeric.MCMC.Flat (
+    mcmc
+  , flat
+
+  , module Sampling.Types
+  , Chain
+  , MWC.create
+  , MWC.createSystemRandom
+  , MWC.withSystemRandom
+  , MWC.asGenIO
+  ) where
 
 import Control.Monad (replicateM)
 import Control.Monad.Par (NFData)
@@ -9,7 +19,7 @@ import Control.Monad.Par.Scheds.Direct hiding (put, get)
 import Control.Monad.Par.Combinator (parMap)
 import Control.Monad.Primitive (PrimMonad, PrimState, RealWorld)
 import Control.Monad.Trans.State.Strict (get, put, execStateT)
-import Data.Sampling.Types hiding (Chain(..))
+import Data.Sampling.Types as Sampling.Types hiding (Chain(..))
 import Data.Vector (Vector)
 import qualified Data.Vector as V
 import qualified Data.Vector.Unboxed as U
diff --git a/test/Rosenbrock.hs b/test/Rosenbrock.hs
@@ -0,0 +1,21 @@
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+
+module Main where
+
+import Numeric.MCMC.Flat
+import Data.Vector (Vector)
+import qualified Data.Vector as V (toList, fromList)
+
+rosenbrock :: Vector Double -> Double
+rosenbrock xs = negate (5  *(x1 - x0 ^ 2) ^ 2 + 0.05 * (1 - x0) ^ 2) where
+  [x0, x1] = V.toList xs
+
+main :: IO ()
+main = withSystemRandom . asGenIO $ mcmc 100 ensemble rosenbrock where
+  ensemble = V.fromList [
+      V.fromList [negate 1.0 :: Double, negate 1.0]
+    , V.fromList [negate 1.0, 1.0]
+    , V.fromList [1.0, negate 1.0]
+    , V.fromList [1.0, 1.0]
+    ]
+