hnuts

commit 82008cf4ca0f20f4bb7719bc43d0ebd2f793cb0c
parent 710caac18b002d4541189d8b0975ff175608365c
Author: Jared Tobin <jared@jtobin.ca>
Date:   Sun, 22 Sep 2013 17:40:52 +1200

Add debugging newtype & fix return bug.

Diffstat:
M
src/Numeric/MCMC/NUTS.hs
 | 
16
+++++++++++++++-

1 file changed, 15 insertions(+), 1 deletion(-)
diff --git a/src/Numeric/MCMC/NUTS.hs b/src/Numeric/MCMC/NUTS.hs
@@ -67,6 +67,20 @@ nutsKernel lTarget glTarget e t g = do
 
   go (t, t, r0, r0, 0, t, 1, 1) g
 
+newtype BuildTree = BuildTree { 
+    getBuildTree :: ([Double], [Double], [Double], [Double], [Double], Int, Int)
+  }
+
+instance Show BuildTree where
+  show (BuildTree (tm, rm, tp, rp, t', n, s)) = 
+       "\n" ++ "tm: " ++ show tm 
+    ++ "\n" ++ "rm: " ++ show rm
+    ++ "\n" ++ "tp: " ++ show tp
+    ++ "\n" ++ "rp: " ++ show rp
+    ++ "\n" ++ "t': " ++ show t'
+    ++ "\n" ++ "n : " ++ show n
+    ++ "\n" ++ "s : " ++ show s
+
 buildTree 
   :: PrimMonad m 
   => Density
@@ -86,7 +100,7 @@ buildTree lTarget glTarget g = go
           auxTgt   = auxilliaryTarget lTarget t0 r0
           n        = indicate (u <= auxTgt)
           s        = indicate (auxTgt > log u - 1000)
-      in  (t0, r0, t0, r0, t, n, s)
+      in  (t0, r0, t0, r0, t0, n, s)
 
     go t r u v j e = do
       z <- uniform g