{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# OPTIONS_GHC -Wno-type-defaults #-}

module Control.Monad.Bayes.Inference.TUI where

import Brick
import Brick qualified as B
import Brick.BChan qualified as B
import Brick.Widgets.Border
import Brick.Widgets.Border.Style
import Brick.Widgets.Center
import Brick.Widgets.ProgressBar qualified as B
import Control.Arrow (Arrow (..))
import Control.Concurrent (forkIO)
import Control.Foldl qualified as Fold
import Control.Monad (void)
import Control.Monad.Bayes.Enumerator (toEmpirical)
import Control.Monad.Bayes.Inference.MCMC
import Control.Monad.Bayes.Sampler.Strict (SamplerIO, sampleIO)
import Control.Monad.Bayes.Traced (Traced)
import Control.Monad.Bayes.Traced.Common hiding (burnIn)
import Control.Monad.Bayes.Weighted
import Data.Scientific (FPFormat (Exponent), formatScientific, fromFloatDigits)
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.IO qualified as TL
import GHC.Float (double2Float)
import Graphics.Vty
import Graphics.Vty qualified as V
import Numeric.Log (Log (ln))
import Pipes (runEffect, (>->))
import Pipes qualified as P
import Pipes.Prelude qualified as P
import Text.Pretty.Simple (pShow, pShowNoColor)

data MCMCData a = MCMCData
  { forall a. MCMCData a -> Int
numSteps :: Int,
    forall a. MCMCData a -> Int
numSuccesses :: Int,
    forall a. MCMCData a -> [a]
samples :: [a],
    forall a. MCMCData a -> [Double]
lk :: [Double],
    forall a. MCMCData a -> Int
totalSteps :: Int
  }
  deriving stock (Int -> MCMCData a -> ShowS
[MCMCData a] -> ShowS
MCMCData a -> String
(Int -> MCMCData a -> ShowS)
-> (MCMCData a -> String)
-> ([MCMCData a] -> ShowS)
-> Show (MCMCData a)
forall a. Show a => Int -> MCMCData a -> ShowS
forall a. Show a => [MCMCData a] -> ShowS
forall a. Show a => MCMCData a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> MCMCData a -> ShowS
showsPrec :: Int -> MCMCData a -> ShowS
$cshow :: forall a. Show a => MCMCData a -> String
show :: MCMCData a -> String
$cshowList :: forall a. Show a => [MCMCData a] -> ShowS
showList :: [MCMCData a] -> ShowS
Show)

-- | Brick is a terminal user interface (TUI)
-- which we use to display inference algorithms in progress

-- | draw the brick app
drawUI :: ([a] -> Widget n) -> MCMCData a -> [Widget n]
drawUI :: forall a n. ([a] -> Widget n) -> MCMCData a -> [Widget n]
drawUI [a] -> Widget n
handleSamples MCMCData a
state = [Widget n
ui]
  where
    completionBar :: Widget n
completionBar =
      (AttrMap -> AttrMap) -> Widget n -> Widget n
forall n. (AttrMap -> AttrMap) -> Widget n -> Widget n
updateAttrMap
        ( [(AttrName, AttrName)] -> AttrMap -> AttrMap
B.mapAttrNames
            [ (AttrName
doneAttr, AttrName
B.progressCompleteAttr),
              (AttrName
toDoAttr, AttrName
B.progressIncompleteAttr)
            ]
        )
        (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Float -> Widget n
forall {n}. Float -> Widget n
toBar
        (Float -> Widget n) -> Float -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral
        (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ MCMCData a -> Int
forall a. MCMCData a -> Int
numSteps MCMCData a
state

    likelihoodBar :: Widget n
likelihoodBar =
      (AttrMap -> AttrMap) -> Widget n -> Widget n
forall n. (AttrMap -> AttrMap) -> Widget n -> Widget n
updateAttrMap
        ( [(AttrName, AttrName)] -> AttrMap -> AttrMap
B.mapAttrNames
            [ (AttrName
doneAttr, AttrName
B.progressCompleteAttr),
              (AttrName
toDoAttr, AttrName
B.progressIncompleteAttr)
            ]
        )
        (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Maybe String -> Float -> Widget n
forall n. Maybe String -> Float -> Widget n
B.progressBar
          (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"Mean likelihood for last 1000 samples: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
10 (Double -> String
forall a. Show a => a -> String
show ([Double] -> Double
forall a. HasCallStack => [a] -> a
head ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ MCMCData a -> [Double]
forall a. MCMCData a -> [Double]
lk MCMCData a
state [Double] -> [Double] -> [Double]
forall a. Semigroup a => a -> a -> a
<> [Double
0])))
          (Double -> Float
double2Float (Fold Double Double -> [Double] -> Double
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
Fold.fold Fold Double Double
forall a. Fractional a => Fold a a
Fold.mean ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take Int
1000 ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ MCMCData a -> [Double]
forall a. MCMCData a -> [Double]
lk MCMCData a
state) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Double -> Float
double2Float ([Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ Double
0 Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: MCMCData a -> [Double]
forall a. MCMCData a -> [Double]
lk MCMCData a
state))

    displayStep :: a -> Maybe String
displayStep a
c = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"Step " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
c
    numFailures :: Int
numFailures = MCMCData a -> Int
forall a. MCMCData a -> Int
numSteps MCMCData a
state Int -> Int -> Int
forall a. Num a => a -> a -> a
- MCMCData a -> Int
forall a. MCMCData a -> Int
numSuccesses MCMCData a
state
    toBar :: Float -> Widget n
toBar Float
v = Maybe String -> Float -> Widget n
forall n. Maybe String -> Float -> Widget n
B.progressBar (Float -> Maybe String
forall {a}. Show a => a -> Maybe String
displayStep Float
v) (Float
v Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (MCMCData a -> Int
forall a. MCMCData a -> Int
totalSteps MCMCData a
state))
    displaySuccessesAndFailures :: Widget n
displaySuccessesAndFailures =
      BorderStyle -> Widget n -> Widget n
forall n. BorderStyle -> Widget n -> Widget n
withBorderStyle BorderStyle
unicode (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
        Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (String -> Widget n
forall n. String -> Widget n
str String
"Successes and failures") (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
          Widget n -> Widget n
forall n. Widget n -> Widget n
center (String -> Widget n
forall n. String -> Widget n
str (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ MCMCData a -> Int
forall a. MCMCData a -> Int
numSuccesses MCMCData a
state))
            Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
forall n. Widget n
vBorder
            Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n -> Widget n
forall n. Widget n -> Widget n
center (String -> Widget n
forall n. String -> Widget n
str (Int -> String
forall a. Show a => a -> String
show Int
numFailures))
    warning :: Widget n
warning =
      if MCMCData a -> Int
forall a. MCMCData a -> Int
numSteps MCMCData a
state Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1000 Bool -> Bool -> Bool
&& (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (MCMCData a -> Int
forall a. MCMCData a -> Int
numSuccesses MCMCData a
state) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (MCMCData a -> Int
forall a. MCMCData a -> Int
numSteps MCMCData a
state)) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.1
        then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr (String -> AttrName
attrName String
"highlight") (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
"Warning: acceptance rate is rather low.\nThis probably means that your proposal isn't good."
        else String -> Widget n
forall n. String -> Widget n
str String
""

    ui :: Widget n
ui =
      (String -> Widget n
forall n. String -> Widget n
str String
"Progress: " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
forall n. Widget n
completionBar)
        Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> (String -> Widget n
forall n. String -> Widget n
str String
"Likelihood: " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
forall n. Widget n
likelihoodBar)
        Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> String -> Widget n
forall n. String -> Widget n
str String
"\n"
        Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Widget n
forall n. Widget n
displaySuccessesAndFailures
        Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Widget n
forall n. Widget n
warning
        Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> [a] -> Widget n
handleSamples (MCMCData a -> [a]
forall a. MCMCData a -> [a]
samples MCMCData a
state)

noVisual :: b -> Widget n
noVisual :: forall b n. b -> Widget n
noVisual = Widget n -> b -> Widget n
forall a b. a -> b -> a
const Widget n
forall n. Widget n
emptyWidget

showEmpirical :: (Show a, Ord a) => [a] -> Widget n
showEmpirical :: forall a n. (Show a, Ord a) => [a] -> Widget n
showEmpirical =
  Text -> Widget n
forall n. Text -> Widget n
txt
    (Text -> Widget n) -> ([a] -> Text) -> [a] -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    (String -> Text) -> ([a] -> String) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack
    (Text -> String) -> ([a] -> Text) -> [a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, String)] -> Text
forall a. Show a => a -> Text
pShow
    ([(a, String)] -> Text) -> ([a] -> [(a, String)]) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((a, Double) -> (a, String)) -> [(a, Double)] -> [(a, String)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> String) -> (a, Double) -> (a, String)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (FPFormat -> Maybe Int -> Scientific -> String
formatScientific FPFormat
Exponent (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3) (Scientific -> String)
-> (Double -> Scientific) -> Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Scientific
forall a. RealFloat a => a -> Scientific
fromFloatDigits)))
    ([(a, Double)] -> [(a, String)])
-> ([a] -> [(a, Double)]) -> [a] -> [(a, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [(a, Double)]
forall b a. (Fractional b, Ord a, Ord b) => [a] -> [(a, b)]
toEmpirical

showVal :: Show a => [a] -> Widget n
showVal :: forall a n. Show a => [a] -> Widget n
showVal = Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> ([a] -> Text) -> [a] -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> ([a] -> String) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\case [] -> String
""; [a]
a -> a -> String
forall a. Show a => a -> String
show (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall a. HasCallStack => [a] -> a
head [a]
a)

-- | handler for events received by the TUI
appEvent :: B.BrickEvent n s -> B.EventM n s ()
appEvent :: forall n s. BrickEvent n s -> EventM n s ()
appEvent (B.VtyEvent (V.EvKey (V.KChar Char
'q') [])) = EventM n s ()
forall n s. EventM n s ()
B.halt
appEvent (B.VtyEvent Event
_) = () -> EventM n s ()
forall a. a -> EventM n s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (B.AppEvent s
d) = s -> EventM n s ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put s
d
appEvent BrickEvent n s
_ = String -> EventM n s ()
forall a. HasCallStack => String -> a
error String
"unknown event"

doneAttr, toDoAttr :: B.AttrName
doneAttr :: AttrName
doneAttr = String -> AttrName
B.attrName String
"theBase" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
B.attrName String
"done"
toDoAttr :: AttrName
toDoAttr = String -> AttrName
B.attrName String
"theBase" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
B.attrName String
"remaining"

theMap :: B.AttrMap
theMap :: AttrMap
theMap =
  Attr -> [(AttrName, Attr)] -> AttrMap
B.attrMap
    Attr
V.defAttr
    [ (String -> AttrName
B.attrName String
"theBase", Color -> Attr
bg Color
V.brightBlack),
      (AttrName
doneAttr, Color
V.black Color -> Color -> Attr
`on` Color
V.white),
      (AttrName
toDoAttr, Color
V.white Color -> Color -> Attr
`on` Color
V.black),
      (String -> AttrName
attrName String
"highlight", Color -> Attr
fg Color
yellow)
    ]

tui :: Show a => Int -> Traced (Weighted SamplerIO) a -> ([a] -> Widget ()) -> IO ()
tui :: forall a.
Show a =>
Int -> Traced (Weighted SamplerIO) a -> ([a] -> Widget ()) -> IO ()
tui Int
burnIn Traced (Weighted SamplerIO) a
distribution [a] -> Widget ()
visualizer = IO (MCMCData a) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void do
  BChan (MCMCData a)
eventChan <- Int -> IO (BChan (MCMCData a))
forall a. Int -> IO (BChan a)
B.newBChan Int
10
  Vty
initialVty <- IO Vty
buildVty
  ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Proxy X () () (MHResult a) (Weighted SamplerIO) ()
-> BChan (MCMCData a) -> Int -> IO ()
forall {a}.
Proxy X () () (MHResult a) (Weighted SamplerIO) ()
-> BChan (MCMCData a) -> Int -> IO ()
run (MCMCConfig
-> Traced (Weighted SamplerIO) a
-> Proxy X () () (MHResult a) (Weighted SamplerIO) ()
forall (m :: * -> *) a.
MonadDistribution m =>
MCMCConfig -> Traced m a -> Producer (MHResult a) m ()
mcmcP MCMCConfig {numBurnIn :: Int
numBurnIn = Int
burnIn, proposal :: Proposal
proposal = Proposal
SingleSiteMH, numMCMCSteps :: Int
numMCMCSteps = -Int
1} Traced (Weighted SamplerIO) a
distribution) BChan (MCMCData a)
eventChan Int
n
  MCMCData a
samples <-
    Vty
-> IO Vty
-> Maybe (BChan (MCMCData a))
-> App (MCMCData a) (MCMCData a) ()
-> MCMCData a
-> IO (MCMCData a)
forall n e s.
Ord n =>
Vty -> IO Vty -> Maybe (BChan e) -> App s e n -> s -> IO s
B.customMain
      Vty
initialVty
      IO Vty
buildVty
      (BChan (MCMCData a) -> Maybe (BChan (MCMCData a))
forall a. a -> Maybe a
Just BChan (MCMCData a)
eventChan)
      ( ( B.App
            { appDraw :: MCMCData a -> [Widget ()]
B.appDraw = ([a] -> Widget ()) -> MCMCData a -> [Widget ()]
forall a n. ([a] -> Widget n) -> MCMCData a -> [Widget n]
drawUI [a] -> Widget ()
visualizer,
              appChooseCursor :: MCMCData a -> [CursorLocation ()] -> Maybe (CursorLocation ())
B.appChooseCursor = MCMCData a -> [CursorLocation ()] -> Maybe (CursorLocation ())
forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
B.showFirstCursor,
              appHandleEvent :: BrickEvent () (MCMCData a) -> EventM () (MCMCData a) ()
B.appHandleEvent = BrickEvent () (MCMCData a) -> EventM () (MCMCData a) ()
forall n s. BrickEvent n s -> EventM n s ()
appEvent,
              appStartEvent :: EventM () (MCMCData a) ()
B.appStartEvent = () -> EventM () (MCMCData a) ()
forall a. a -> EventM () (MCMCData a) a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
              appAttrMap :: MCMCData a -> AttrMap
B.appAttrMap = AttrMap -> MCMCData a -> AttrMap
forall a b. a -> b -> a
const AttrMap
theMap
            }
        )
      )
      (Int -> MCMCData a
forall {a}. Int -> MCMCData a
initialState Int
n)
  String -> Text -> IO ()
TL.writeFile String
"data/tui_output.txt" (MCMCData a -> Text
forall a. Show a => a -> Text
pShowNoColor MCMCData a
samples)
  MCMCData a -> IO (MCMCData a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MCMCData a
samples
  where
    buildVty :: IO Vty
buildVty = Config -> IO Vty
V.mkVty Config
V.defaultConfig
    n :: Int
n = Int
100000
    initialState :: Int -> MCMCData a
initialState Int
n = MCMCData {numSteps :: Int
numSteps = Int
0, samples :: [a]
samples = [], lk :: [Double]
lk = [], numSuccesses :: Int
numSuccesses = Int
0, totalSteps :: Int
totalSteps = Int
n}

    run :: Proxy X () () (MHResult a) (Weighted SamplerIO) ()
-> BChan (MCMCData a) -> Int -> IO ()
run Proxy X () () (MHResult a) (Weighted SamplerIO) ()
prod BChan (MCMCData a)
chan Int
i =
      Effect IO () -> IO ()
forall (m :: * -> *) r. Monad m => Effect m r -> m r
runEffect (Effect IO () -> IO ()) -> Effect IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        (forall a. Weighted SamplerIO a -> IO a)
-> Proxy X () () (MHResult a) (Weighted SamplerIO) ()
-> Proxy X () () (MHResult a) IO ()
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> Proxy X () () (MHResult a) m b -> Proxy X () () (MHResult a) n b
P.hoist (SamplerIO a -> IO a
forall a. SamplerIO a -> IO a
sampleIO (SamplerIO a -> IO a)
-> (Weighted SamplerIO a -> SamplerIO a)
-> Weighted SamplerIO a
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Weighted SamplerIO a -> SamplerIO a
forall (m :: * -> *) a. Functor m => Weighted m a -> m a
unweighted) Proxy X () () (MHResult a) (Weighted SamplerIO) ()
prod
          Proxy X () () (MHResult a) IO ()
-> Proxy () (MHResult a) () (MCMCData a) IO ()
-> Proxy X () () (MCMCData a) IO ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> (MCMCData a -> MHResult a -> MCMCData a)
-> MCMCData a
-> (MCMCData a -> MCMCData a)
-> Proxy () (MHResult a) () (MCMCData a) IO ()
forall (m :: * -> *) x a b r.
Functor m =>
(x -> a -> x) -> x -> (x -> b) -> Pipe a b m r
P.scan
            ( \mcmcdata :: MCMCData a
mcmcdata@(MCMCData Int
ns Int
nsc [a]
smples [Double]
lk Int
_) MHResult a
a ->
                MCMCData a
mcmcdata
                  { numSteps :: Int
numSteps = Int
ns Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1,
                    numSuccesses :: Int
numSuccesses = Int
nsc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if MHResult a -> Bool
forall a. MHResult a -> Bool
success MHResult a
a then Int
1 else Int
0,
                    samples :: [a]
samples = Trace a -> a
forall a. Trace a -> a
output (MHResult a -> Trace a
forall a. MHResult a -> Trace a
trace MHResult a
a) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
smples,
                    lk :: [Double]
lk = Double -> Double
forall a. Floating a => a -> a
exp (Log Double -> Double
forall a. Log a -> a
ln (Trace a -> Log Double
forall a. Trace a -> Log Double
probDensity (MHResult a -> Trace a
forall a. MHResult a -> Trace a
trace MHResult a
a))) Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: [Double]
lk
                  }
            )
            (Int -> MCMCData a
forall {a}. Int -> MCMCData a
initialState Int
i)
            MCMCData a -> MCMCData a
forall a. a -> a
id
          Proxy X () () (MCMCData a) IO ()
-> Proxy () (MCMCData a) () (MCMCData a) IO ()
-> Proxy X () () (MCMCData a) IO ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> Int -> Proxy () (MCMCData a) () (MCMCData a) IO ()
forall (m :: * -> *) a. Functor m => Int -> Pipe a a m ()
P.take Int
i
          Proxy X () () (MCMCData a) IO ()
-> Proxy () (MCMCData a) () X IO () -> Effect IO ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> (MCMCData a -> IO ()) -> Consumer' (MCMCData a) IO ()
forall (m :: * -> *) a r. Monad m => (a -> m ()) -> Consumer' a m r
P.mapM_ (BChan (MCMCData a) -> MCMCData a -> IO ()
forall a. BChan a -> a -> IO ()
B.writeBChan BChan (MCMCData a)
chan)