packages feed

mcmc 0.2.0 → 0.2.1

raw patch · 14 files changed

+274/−249 lines, 14 filesdep +double-conversiondep −text

Dependencies added: double-conversion

Dependencies removed: text

Files

ChangeLog.md view
@@ -2,10 +2,19 @@ # Markov chain Monte Carlo sampling - ChangeLog  -## 0.1.3+## Unreleased changes -Many changes; notably it is now possible to continue a Markov chain run. +## 0.2.1 -## Unreleased changes+-   Consistently use ByteString instead of Text.+-   Verbosity levels.+-   Improved handling of proposals, moves, and monitors.+-   Bactrian moves.+-   Many small changes.+++## 0.1.3++Many changes; notably it is now possible to continue a Markov chain run.
bench/Normal.hs view
@@ -40,7 +40,7 @@     [slideSymmetric "medium" 1 1.0 True]  mons :: [MonitorParameter Double]-mons = [monitorRealFloat "mu"]+mons = [monitorDouble "mu"]  monStd :: MonitorStdOut Double monStd = monitorStdOut mons 200
bench/Poisson.hs view
@@ -60,10 +60,10 @@ initial = (0, 0)  monAlpha :: MonitorParameter I-monAlpha = _1 @. monitorRealFloat "alpha"+monAlpha = _1 @. monitorDouble "alpha"  monBeta :: MonitorParameter I-monBeta = _2 @. monitorRealFloat "beta"+monBeta = _2 @. monitorDouble "beta"  monStd :: MonitorStdOut I monStd = monitorStdOut [monAlpha, monBeta] 150
mcmc.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           mcmc-version:        0.2.0+version:        0.2.1 synopsis:       Sample from a posterior using Markov chain Monte Carlo description:    Please see the README on GitHub at <https://github.com/dschrempf/mcmc#readme> category:       Math, Statistics@@ -27,6 +27,7 @@ library   exposed-modules:       Mcmc+      Mcmc.Internal.ByteString       Mcmc.Item       Mcmc.Mcmc       Mcmc.Metropolis@@ -59,11 +60,11 @@     , containers     , data-default     , directory+    , double-conversion     , log-domain     , microlens     , mwc-random     , statistics-    , text     , time     , transformers     , vector@@ -111,6 +112,5 @@     , microlens     , mwc-random     , statistics-    , text     , vector   default-language: Haskell2010
+ src/Mcmc/Internal/ByteString.hs view
@@ -0,0 +1,46 @@+-- |+-- Module      :  Mcmc.Internal.ByteString+-- Description :  ByteString tools+-- Copyright   :  (c) Dominik Schrempf, 2020+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Mon Aug  3 10:46:27 2020.+module Mcmc.Internal.ByteString+  ( alignRightWith,+    alignRight,+    alignLeftWith,+    alignLeft,+  )+where++import qualified Data.ByteString.Lazy.Char8 as BL++-- | For a given width, align string to the right; use given fill character;+-- trim on the left if string is longer.+alignRightWith :: Char -> Int -> BL.ByteString -> BL.ByteString+alignRightWith c n s =+  BL.replicate (fromIntegral n - l) c <> BL.take (fromIntegral n) s+  where+    l = BL.length s++-- | For a given width, align string to the right; trim on the left if string is+-- longer.+alignRight :: Int -> BL.ByteString -> BL.ByteString+alignRight = alignRightWith ' '++-- | For a given width, align string to the left; use given fill character; trim+-- on the right if string is longer.+alignLeftWith :: Char -> Int -> BL.ByteString -> BL.ByteString+alignLeftWith c n s =+  BL.take (fromIntegral n) s <> BL.replicate (fromIntegral n - l) c+  where+    l = BL.length s++-- | For a given width, align string to the left; trim on the right if string is+-- longer.+alignLeft :: Int -> BL.ByteString -> BL.ByteString+alignLeft = alignLeftWith ' '
src/Mcmc/Mcmc.hs view
@@ -35,10 +35,8 @@ import Control.Monad.IO.Class import Control.Monad.Trans.State import Data.Aeson+import qualified Data.ByteString.Lazy.Char8 as BL import Data.Maybe-import qualified Data.Text.Lazy as T-import Data.Text.Lazy (Text)-import qualified Data.Text.Lazy.IO as T import Data.Time.Clock import Data.Time.Format import Mcmc.Monitor@@ -55,54 +53,54 @@ -- required, but it is used by the different inference algorithms. type Mcmc a = StateT (Status a) IO -msgPrepare :: Char -> Text -> Text-msgPrepare c t = T.cons c $ ": " <> t+msgPrepare :: Char -> BL.ByteString -> BL.ByteString+msgPrepare c t = BL.cons c $ ": " <> t  -- | Write to standard output and log file.-mcmcOutT :: Text -> Mcmc a ()+mcmcOutT :: BL.ByteString -> Mcmc a () mcmcOutT msg = do   h <- fromMaybe (error "mcmcOut: Log handle is missing.") <$> gets logHandle-  liftIO $ T.putStrLn msg >> T.hPutStrLn h msg+  liftIO $ BL.putStrLn msg >> BL.hPutStrLn h msg  -- | Write to standard output and log file. mcmcOutS :: String -> Mcmc a ()-mcmcOutS = mcmcOutT . T.pack+mcmcOutS = mcmcOutT . BL.pack  -- Perform warning action. mcmcWarnA :: Mcmc a () -> Mcmc a () mcmcWarnA a = gets verbosity >>= \v -> info v a  -- | Print warning message.-mcmcWarnT :: Text -> Mcmc a ()+mcmcWarnT :: BL.ByteString -> Mcmc a () mcmcWarnT = mcmcWarnA . mcmcOutT . msgPrepare 'W'  -- | Print warning message. mcmcWarnS :: String -> Mcmc a ()-mcmcWarnS = mcmcWarnT . T.pack+mcmcWarnS = mcmcWarnT . BL.pack  -- Perform info action. mcmcInfoA :: Mcmc a () -> Mcmc a () mcmcInfoA a = gets verbosity >>= \v -> info v a  -- | Print info message.-mcmcInfoT :: Text -> Mcmc a ()+mcmcInfoT :: BL.ByteString -> Mcmc a () mcmcInfoT = mcmcInfoA . mcmcOutT . msgPrepare 'I'  -- | Print info message. mcmcInfoS :: String -> Mcmc a ()-mcmcInfoS = mcmcInfoT . T.pack+mcmcInfoS = mcmcInfoT . BL.pack  -- Perform debug action. mcmcDebugA :: Mcmc a () -> Mcmc a () mcmcDebugA a = gets verbosity >>= \v -> debug v a  -- | Print debug message.-mcmcDebugT :: Text -> Mcmc a ()+mcmcDebugT :: BL.ByteString -> Mcmc a () mcmcDebugT = mcmcDebugA . mcmcOutT . msgPrepare 'D'  -- | Print debug message. mcmcDebugS :: String -> Mcmc a ()-mcmcDebugS = mcmcDebugT . T.pack+mcmcDebugS = mcmcDebugT . BL.pack  -- | Auto tune the 'Proposal's in the 'Cycle' of the chain. Reset acceptance counts. -- See 'autotuneCycle'.@@ -124,7 +122,7 @@   put $ s {acceptance = resetA a}  -- | Print short summary of 'Proposal's in 'Cycle'. See 'summarizeCycle'.-mcmcSummarizeCycle :: Mcmc a Text+mcmcSummarizeCycle :: Mcmc a BL.ByteString mcmcSummarizeCycle = do   a <- gets acceptance   c <- gets cycle@@ -143,11 +141,12 @@   fe <- liftIO $ doesFileExist lfn   mh <- liftIO $ case verbosity s of     Quiet -> return Nothing-    _ -> Just <$> case (fe, n, frc) of-      (False, _, _) -> openFile lfn WriteMode-      (True, 0, True) -> openFile lfn WriteMode-      (True, 0, False) -> error "mcmcInit: Log file exists; use 'force' to overwrite output files."-      (True, _, _) -> openFile lfn AppendMode+    _ ->+      Just <$> case (fe, n, frc) of+        (False, _, _) -> openFile lfn WriteMode+        (True, 0, True) -> openFile lfn WriteMode+        (True, 0, False) -> error "mcmcInit: Log file exists; use 'force' to overwrite output files."+        (True, _, _) -> openFile lfn AppendMode   put s {logHandle = mh}   mcmcDebugS $ "Log file name: " ++ lfn ++ "."   mcmcDebugT "Log file opened."
src/Mcmc/Monitor.hs view
@@ -31,12 +31,11 @@ where  import Control.Monad+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Lazy.Char8 as BL import Data.Int-import qualified Data.Text.Lazy as T-import Data.Text.Lazy (Text)-import qualified Data.Text.Lazy.Builder as T-import qualified Data.Text.Lazy.IO as T import Data.Time.Clock+import Mcmc.Internal.ByteString import Mcmc.Item import Mcmc.Monitor.Log import Mcmc.Monitor.Parameter@@ -52,23 +51,21 @@ -- | A 'Monitor' describes which part of the Markov chain should be logged and -- where. Further, they allow output of summary statistics per iteration in a -- flexible way.-data Monitor a-  = Monitor-      { -- | Monitor writing to standard output.-        mStdOut :: MonitorStdOut a,-        -- | Monitors writing to files.-        mFiles :: [MonitorFile a],-        -- | Monitors calculating batch means and-        -- writing to files.-        mBatches :: [MonitorBatch a]-      }+data Monitor a = Monitor+  { -- | Monitor writing to standard output.+    mStdOut :: MonitorStdOut a,+    -- | Monitors writing to files.+    mFiles :: [MonitorFile a],+    -- | Monitors calculating batch means and+    -- writing to files.+    mBatches :: [MonitorBatch a]+  }  -- | Monitor to standard output; constructed with 'monitorStdOut'.-data MonitorStdOut a-  = MonitorStdOut-      { msParams :: [MonitorParameter a],-        msPeriod :: Int-      }+data MonitorStdOut a = MonitorStdOut+  { msParams :: [MonitorParameter a],+    msPeriod :: Int+  }  -- | Monitor to standard output. monitorStdOut ::@@ -81,27 +78,27 @@   | p < 1 = error "monitorStdOut: Monitor period has to be 1 or larger."   | otherwise = MonitorStdOut ps p -msIWidth :: Int64+msIWidth :: Int msIWidth = 12 -msWidth :: Int64+msWidth :: Int msWidth = 22 -msRenderRow :: [Text] -> Text-msRenderRow xs = T.justifyRight msIWidth ' ' (head xs) <> T.concat vals+msRenderRow :: [BL.ByteString] -> BL.ByteString+msRenderRow xs = alignRight msIWidth (head xs) <> BL.concat vals   where-    vals = map (T.justifyRight msWidth ' ') (tail xs)+    vals = map (alignRight msWidth) (tail xs) -msHeader :: MonitorStdOut a -> Text-msHeader m = T.intercalate "\n" [row, sep]+msHeader :: MonitorStdOut a -> BL.ByteString+msHeader m = BL.intercalate "\n" [row, sep]   where     row =       msRenderRow $         ["Iteration", "Log-Prior", "Log-Likelihood", "Log-Posterior"]           ++ nms           ++ ["Runtime", "ETA"]-    sep = "   " <> T.replicate (T.length row - 3) "─"-    nms = [T.pack $ mpName p | p <- msParams m]+    sep = "   " <> BL.replicate (BL.length row - 3) '-'+    nms = [BL.pack $ mpName p | p <- msParams m]  msExec ::   Int ->@@ -110,35 +107,36 @@   UTCTime ->   Int ->   MonitorStdOut a ->-  IO (Maybe Text)+  IO (Maybe BL.ByteString) msExec i (Item x p l) ss st j m   | i `mod` msPeriod m /= 0 = return Nothing   | otherwise = do-      ct <- getCurrentTime-      let dt = ct `diffUTCTime` st-          -- Careful, don't evaluate this when i == ss.-          timePerIter = dt / fromIntegral (i - ss)-          -- -- Always 0; doesn't make much sense.-          -- tpi = if (i - ss) < 10-          --       then ""-          --       else renderDurationS timePerIter-          eta =-            if (i - ss) < 10+    ct <- getCurrentTime+    let dt = ct `diffUTCTime` st+        -- Careful, don't evaluate this when i == ss.+        timePerIter = dt / fromIntegral (i - ss)+        -- -- Always 0; doesn't make much sense.+        -- tpi = if (i - ss) < 10+        --       then ""+        --       else renderDurationS timePerIter+        eta =+          if (i - ss) < 10             then ""             else renderDuration $ timePerIter * fromIntegral (j - i)-      return $ Just $ msRenderRow $-        [T.pack (show i), renderLog p, renderLog l, renderLog (p * l)]-        ++ [T.toLazyText $ mpFunc mp x | mp <- msParams m]-        ++ [renderDuration dt, eta]+    return $+      Just $+        msRenderRow $+          [BL.pack (show i), renderLog p, renderLog l, renderLog (p * l)]+            ++ [BB.toLazyByteString $ mpFunc mp x | mp <- msParams m]+            ++ [renderDuration dt, eta]  -- | Monitor to a file; constructed with 'monitorFile'.-data MonitorFile a-  = MonitorFile-      { mfName :: String,-        mfHandle :: Maybe Handle,-        mfParams :: [MonitorParameter a],-        mfPeriod :: Int-      }+data MonitorFile a = MonitorFile+  { mfName :: String,+    mfHandle :: Maybe Handle,+    mfParams :: [MonitorParameter a],+    mfPeriod :: Int+  }  -- XXX: The file monitor also includes iteration, prior, likelihood, and -- posterior. What if I want to log trees; or other complex objects? In this@@ -157,8 +155,8 @@   | p < 1 = error "monitorFile: Monitor period has to be 1 or larger."   | otherwise = MonitorFile n Nothing ps p -mfRenderRow :: [Text] -> Text-mfRenderRow = T.intercalate "\t"+mfRenderRow :: [BL.ByteString] -> BL.ByteString+mfRenderRow = BL.intercalate "\t"  open' :: String -> Bool -> IO Handle open' n frc = do@@ -194,10 +192,10 @@         <> mfName m         <> "."   Just h ->-    T.hPutStrLn h-      $ mfRenderRow-      $ ["Iteration", "Log-Prior", "Log-Likelihood", "Log-Posterior"]-        ++ [T.pack $ mpName p | p <- mfParams m]+    BL.hPutStrLn h $+      mfRenderRow $+        ["Iteration", "Log-Prior", "Log-Likelihood", "Log-Posterior"]+          ++ [BL.pack $ mpName p | p <- mfParams m]  mfExec ::   Int ->@@ -213,13 +211,13 @@           <> mfName m           <> "."     Just h ->-      T.hPutStrLn h-        $ mfRenderRow-        $ T.pack (show i)-          : renderLog p-          : renderLog l-          : renderLog (p * l)-          : [T.toLazyText $ mpFunc mp x | mp <- mfParams m]+      BL.hPutStrLn h $+        mfRenderRow $+          BL.pack (show i) :+          renderLog p :+          renderLog l :+          renderLog (p * l) :+            [BB.toLazyByteString $ mpFunc mp x | mp <- mfParams m]  mfClose :: MonitorFile a -> IO () mfClose m = case mfHandle m of@@ -231,13 +229,12 @@ -- -- Batch monitors are slow at the moment because the monitored parameter has to -- be extracted from the state for each iteration.-data MonitorBatch a-  = MonitorBatch-      { mbName :: String,-        mbHandle :: Maybe Handle,-        mbParams :: [MonitorParameterBatch a],-        mbSize :: Int-      }+data MonitorBatch a = MonitorBatch+  { mbName :: String,+    mbHandle :: Maybe Handle,+    mbParams :: [MonitorParameterBatch a],+    mbSize :: Int+  }  -- XXX: The batch monitor also includes iteration, prior, likelihood, and -- posterior. What if I want to log trees; or other complex objects? In this@@ -283,10 +280,10 @@         <> mbName m         <> "."   Just h ->-    T.hPutStrLn h-      $ mfRenderRow-      $ ["Iteration", "Mean log-Prior", "Mean log-Likelihood", "Mean log-Posterior"]-        ++ [T.pack $ mbpName mbp | mbp <- mbParams m]+    BL.hPutStrLn h $+      mfRenderRow $+        ["Iteration", "Mean log-Prior", "Mean log-Likelihood", "Mean log-Posterior"]+          ++ [BL.pack $ mbpName mbp | mbp <- mbParams m]  mean :: [Log Double] -> Log Double mean xs = sum xs / fromIntegral (length xs)@@ -305,13 +302,13 @@           <> mbName m           <> "."     Just h ->-      T.hPutStrLn h-        $ mfRenderRow-        $ T.pack (show i)-          : renderLog mlps-          : renderLog mlls-          : renderLog mlos-          : [T.toLazyText $ mbpFunc mbp (map state t) | mbp <- mbParams m]+      BL.hPutStrLn h $+        mfRenderRow $+          BL.pack (show i) :+          renderLog mlps :+          renderLog mlls :+          renderLog mlos :+            [BB.toLazyByteString $ mbpFunc mbp (map state t) | mbp <- mbParams m]   where     t = takeT (mbSize m) t'     lps = map prior t@@ -343,7 +340,7 @@   return $ Monitor s fs' bs'  -- | Get header line of 'MonitorStdOut'.-mHeader :: Monitor a -> Text+mHeader :: Monitor a -> BL.ByteString mHeader (Monitor s _ _) = msHeader s  -- | Execute monitors; print status information to files and return text to be@@ -363,7 +360,7 @@   Int ->   -- | The monitor.   Monitor a ->-  IO (Maybe Text)+  IO (Maybe BL.ByteString) mExec v i ss st xs j (Monitor s fs bs) = do   mapM_ (mfExec i $ headT xs) fs   mapM_ (mbExec i xs) bs
src/Mcmc/Monitor/Log.hs view
@@ -14,12 +14,11 @@   ) where -import Data.Text.Lazy (Text)-import qualified Data.Text.Lazy.Builder as T-import qualified Data.Text.Lazy.Builder.RealFloat as T+import qualified Data.ByteString.Lazy.Char8 as BL+import qualified Data.Double.Conversion.ByteString as BC import Numeric.Log  -- | Print a log value.-renderLog :: Log Double -> Text-renderLog = T.toLazyText . T.formatRealFloat T.Fixed (Just 8) . ln+renderLog :: Log Double -> BL.ByteString+renderLog = BL.fromStrict . BC.toFixed 8 . ln {-# INLINEABLE renderLog #-}
src/Mcmc/Monitor/Parameter.hs view
@@ -16,70 +16,59 @@     MonitorParameter (..),     (@.),     monitorInt,-    monitorRealFloat,-    monitorRealFloatF,-    monitorRealFloatS,+    monitorDouble,+    monitorDoubleF,+    monitorDoubleE,   ) where -import Data.Text.Lazy.Builder (Builder)-import qualified Data.Text.Lazy.Builder.Int as T-import qualified Data.Text.Lazy.Builder.RealFloat as T+import qualified Data.ByteString.Builder as BB+import qualified Data.Double.Conversion.ByteString as BC import Lens.Micro  -- | Instruction about a parameter to monitor.-data MonitorParameter a-  = MonitorParameter-      { -- | Name of parameter.-        mpName :: String,-        -- | Instruction about how to extract the parameter from the state.-        mpFunc :: a -> Builder-      }+data MonitorParameter a = MonitorParameter+  { -- | Name of parameter.+    mpName :: String,+    -- | Instruction about how to extract the parameter from the state.+    mpFunc :: a -> BB.Builder+  }  -- | Convert a parameter monitor from one data type to another using a lens. ----- For example, to monitor a real float value being the first entry of a tuple:+-- For example, to monitor a 'Double' value being the first entry of a tuple: -- -- @--- mon = _1 @@ monitorRealFloat+-- mon = _1 @@ monitorDouble -- @ (@.) :: Lens' b a -> MonitorParameter a -> MonitorParameter b-(@.) l (MonitorParameter n f) = MonitorParameter n (\x -> f $ x^.l)+(@.) l (MonitorParameter n f) = MonitorParameter n (\x -> f $ x ^. l) --- | Monitor integral parameters such as 'Int'.+-- | Monitor 'Int'. monitorInt ::-  Integral a =>-  -- | Name of monitor.+  -- | Name.   String ->-  MonitorParameter a-monitorInt n = MonitorParameter n T.decimal-{-# SPECIALIZE monitorInt :: String -> MonitorParameter Int #-}+  MonitorParameter Int+monitorInt n = MonitorParameter n BB.intDec --- | Monitor real float parameters such as 'Double' with eight decimal places--- (half precision).-monitorRealFloat ::-  RealFloat a =>-  -- | Name of monitor.+-- | Monitor 'Double' with eight decimal places (half precision).+monitorDouble ::+  -- | Name.   String ->-  MonitorParameter a-monitorRealFloat n = MonitorParameter n (T.formatRealFloat T.Fixed (Just 8))-{-# SPECIALIZE monitorRealFloat :: String -> MonitorParameter Double #-}+  MonitorParameter Double+monitorDouble n = MonitorParameter n (BB.byteString . BC.toFixed 8) --- | Monitor real float parameters such as 'Double' with full precision.-monitorRealFloatF ::-  RealFloat a =>-  -- | Name of monitor.+-- | Monitor 'Double' with full precision computing the shortest string of+-- digits that correctly represent the number.+monitorDoubleF ::+  -- | Name.   String ->-  MonitorParameter a-monitorRealFloatF n = MonitorParameter n T.realFloat-{-# SPECIALIZE monitorRealFloatF :: String -> MonitorParameter Double #-}+  MonitorParameter Double+monitorDoubleF n = MonitorParameter n (BB.byteString . BC.toShortest) --- | Monitor real float parameters such as 'Double' with scientific notation and--- eight decimal places.-monitorRealFloatS ::-  RealFloat a =>-  -- | Name of monitor.+-- | Monitor 'Double' in exponential format and half precision.+monitorDoubleE ::+  -- | Name.   String ->-  MonitorParameter a-monitorRealFloatS n = MonitorParameter n (T.formatRealFloat T.Exponent (Just 8))-{-# SPECIALIZE monitorRealFloatS :: String -> MonitorParameter Double #-}+  MonitorParameter Double+monitorDoubleE n = MonitorParameter n (BB.byteString . BC.toExponential 8)
src/Mcmc/Monitor/ParameterBatch.hs view
@@ -17,17 +17,15 @@   ( -- * Batch parameter monitors     MonitorParameterBatch (..),     (@#),-    monitorBatchMeanInt,-    monitorBatchMeanIntF,-    monitorBatchMeanRealFloat,-    monitorBatchMeanRealFloatF,-    monitorBatchMeanRealFloatS,+    monitorBatchMean,+    monitorBatchMeanF,+    monitorBatchMeanE,     monitorBatchCustom,   ) where -import Data.Text.Lazy.Builder (Builder)-import qualified Data.Text.Lazy.Builder.RealFloat as T+import qualified Data.ByteString.Builder as BB+import qualified Data.Double.Conversion.ByteString as BC import Lens.Micro  -- | Instruction about a parameter to monitor via batch means. Usually, the@@ -42,7 +40,7 @@       { -- | Name of batch monitored parameter.         mbpName :: String,         -- | Instruction about how to extract the batch mean from the trace.-        mbpFunc :: [a] -> Builder+        mbpFunc :: [a] -> BB.Builder       }  -- | Convert a batch parameter monitor from one data type to another using a@@ -61,62 +59,45 @@ {-# SPECIALIZE mean :: [Double] -> Double #-} {-# SPECIALIZE mean :: [Int] -> Double #-} --- | Batch monitor integral parameters such as 'Int'. Print the mean with eight--- decimal places (half precision).-monitorBatchMeanInt ::-  Integral a =>-  -- | Name of monitor.-  String ->-  MonitorParameterBatch a-monitorBatchMeanInt n = MonitorParameterBatch n (T.formatRealFloat T.Fixed (Just 8) . mean)-{-# SPECIALIZE monitorBatchMeanInt :: String -> MonitorParameterBatch Int #-}---- | Batch monitor integral parameters such as 'Int'. Print the mean with full--- precision.-monitorBatchMeanIntF ::-  Integral a =>-  -- | Name of monitor.-  String ->-  MonitorParameterBatch a-monitorBatchMeanIntF n = MonitorParameterBatch n (T.realFloat . mean)-{-# SPECIALIZE monitorBatchMeanIntF :: String -> MonitorParameterBatch Int #-}---- | Batch monitor real float parameters such as 'Double' with eight decimal--- places (half precision).-monitorBatchMeanRealFloat ::-  RealFloat a =>-  -- | Name of monitor.+-- | Batch monitor. Print the mean with eight decimal places (half precision).+monitorBatchMean ::+  Real a =>+  -- | Name.   String ->   MonitorParameterBatch a-monitorBatchMeanRealFloat n = MonitorParameterBatch n (T.formatRealFloat T.Fixed (Just 8) . mean)-{-# SPECIALIZE monitorBatchMeanRealFloat :: String -> MonitorParameterBatch Double #-}+monitorBatchMean n = MonitorParameterBatch n (BB.byteString . BC.toFixed 8 . mean)+{-# SPECIALIZE monitorBatchMean :: String -> MonitorParameterBatch Int #-}+{-# SPECIALIZE monitorBatchMean :: String -> MonitorParameterBatch Double #-} --- | Batch monitor real float parameters such as 'Double' with full precision.-monitorBatchMeanRealFloatF ::-  RealFloat a =>-  -- | Name of monitor.+-- | Batch monitor. Print the mean with full precision computing the shortest+-- string of digits that correctly represent the number.+monitorBatchMeanF ::+  Real a =>+  -- | Name.   String ->   MonitorParameterBatch a-monitorBatchMeanRealFloatF n = MonitorParameterBatch n (T.realFloat . mean)-{-# SPECIALIZE monitorBatchMeanRealFloatF :: String -> MonitorParameterBatch Double #-}+monitorBatchMeanF n = MonitorParameterBatch n (BB.byteString . BC.toShortest . mean)+{-# SPECIALIZE monitorBatchMeanF :: String -> MonitorParameterBatch Int #-}+{-# SPECIALIZE monitorBatchMeanF :: String -> MonitorParameterBatch Double #-}  -- | Batch monitor real float parameters such as 'Double' with scientific -- notation and eight decimal places.-monitorBatchMeanRealFloatS ::-  RealFloat a =>-  -- | Name of monitor.+monitorBatchMeanE ::+  Real a =>+  -- | Name.   String ->   MonitorParameterBatch a-monitorBatchMeanRealFloatS n = MonitorParameterBatch n (T.formatRealFloat T.Exponent (Just 8) . mean)-{-# SPECIALIZE monitorBatchMeanRealFloatS :: String -> MonitorParameterBatch Double #-}+monitorBatchMeanE n = MonitorParameterBatch n (BB.byteString . BC.toExponential 8 . mean)+{-# SPECIALIZE monitorBatchMeanE :: String -> MonitorParameterBatch Int #-}+{-# SPECIALIZE monitorBatchMeanE :: String -> MonitorParameterBatch Double #-}  -- | Batch monitor parameters with custom lens and builder. monitorBatchCustom ::-  -- | Name of monitor.+  -- | Name.   String ->   -- | Function to calculate the batch mean.   ([a] -> a) ->   -- | Custom builder.-  (a -> Builder) ->+  (a -> BB.Builder) ->   MonitorParameterBatch a monitorBatchCustom n f b = MonitorParameterBatch n (b . f)
src/Mcmc/Monitor/Time.hs view
@@ -17,15 +17,14 @@   ) where -import qualified Data.Text.Lazy as T-import Data.Text.Lazy (Text)-import qualified Data.Text.Lazy.Builder as T-import qualified Data.Text.Lazy.Builder.Int as T+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Lazy.Char8 as BL+import Mcmc.Internal.ByteString import Data.Time.Clock  -- | Adapted from System.ProgressBar.renderDuration of package -- [terminal-progressbar-0.4.1](https://hackage.haskell.org/package/terminal-progress-bar-0.4.1).-renderDuration :: NominalDiffTime -> Text+renderDuration :: NominalDiffTime -> BL.ByteString renderDuration dt = hTxt <> mTxt <> sTxt   where     hTxt = renderDecimal h <> ":"@@ -36,11 +35,11 @@     -- Total amount of seconds     ts :: Int     ts = round dt-    renderDecimal n = T.justifyRight 2 '0' $ T.toLazyText $ T.decimal n+    renderDecimal n = alignRightWith '0' 2 $ BB.toLazyByteString $ BB.intDec n  -- | Render duration in seconds.-renderDurationS :: NominalDiffTime -> Text-renderDurationS dt = T.toLazyText $ T.decimal ts+renderDurationS :: NominalDiffTime -> BL.ByteString+renderDurationS dt = BB.toLazyByteString $ BB.intDec ts   where     ts :: Int     ts = round dt
src/Mcmc/Proposal.hs view
@@ -50,18 +50,17 @@ where  import Data.Aeson+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Lazy.Char8 as BL import Data.Default+import qualified Data.Double.Conversion.ByteString as BC import Data.Function import Data.List-import qualified Data.Map.Strict as M import Data.Map.Strict (Map)+import qualified Data.Map.Strict as M import Data.Maybe-import qualified Data.Text.Lazy as T-import Data.Text.Lazy (Text)-import qualified Data.Text.Lazy.Builder as B-import qualified Data.Text.Lazy.Builder.Int as B-import qualified Data.Text.Lazy.Builder.RealFloat as B import Lens.Micro+import Mcmc.Internal.ByteString import Mcmc.Tools.Shuffle import Numeric.Log hiding (sum) import System.Random.MWC@@ -115,7 +114,7 @@ -- ratio of the backward to forward kernels (i.e., the probability masses or -- probability densities). For unbiased proposals, this ratio is 1.0. newtype ProposalSimple a = ProposalSimple-  {     pSample :: a -> GenIO -> IO (a, Log Double)+  { pSample :: a -> GenIO -> IO (a, Log Double)   }  convertS :: Lens' b a -> ProposalSimple a -> ProposalSimple b@@ -257,43 +256,50 @@ autotuneCycle :: Acceptance (Proposal a) -> Cycle a -> Cycle a autotuneCycle a = tuneCycle (M.map (\x -> exp $ x - ratioOpt) $ acceptanceRatios a) -renderRow :: Text -> Text -> Text -> Text -> Text -> Text -> Text+renderRow ::+  BL.ByteString ->+  BL.ByteString ->+  BL.ByteString ->+  BL.ByteString ->+  BL.ByteString ->+  BL.ByteString ->+  BL.ByteString renderRow name weight nAccept nReject acceptRatio tuneParam = "   " <> nm <> wt <> na <> nr <> ra <> tp   where-    nm = T.justifyLeft 30 ' ' name-    wt = T.justifyRight 8 ' ' weight-    na = T.justifyRight 15 ' ' nAccept-    nr = T.justifyRight 15 ' ' nReject-    ra = T.justifyRight 15 ' ' acceptRatio-    tp = T.justifyRight 20 ' ' tuneParam+    nm = alignLeft 30 name+    wt = alignRight 8 weight+    na = alignRight 15 nAccept+    nr = alignRight 15 nReject+    ra = alignRight 15 acceptRatio+    tp = alignRight 20 tuneParam -proposalHeader :: Text+proposalHeader :: BL.ByteString proposalHeader =   renderRow "Proposal" "Weight" "Accepted" "Rejected" "Ratio" "Tuning parameter" -summarizeProposal :: Proposal a -> Maybe (Int, Int, Double) -> Text-summarizeProposal m r = renderRow (T.pack name) weight nAccept nReject acceptRatio tuneParamStr+summarizeProposal :: Proposal a -> Maybe (Int, Int, Double) -> BL.ByteString+summarizeProposal m r = renderRow (BL.pack name) weight nAccept nReject acceptRatio tuneParamStr   where     name = pName m-    weight = B.toLazyText $ B.decimal $ pWeight m-    nAccept = B.toLazyText $ maybe "" (B.decimal . (^. _1)) r-    nReject = B.toLazyText $ maybe "" (B.decimal . (^. _2)) r-    acceptRatio = B.toLazyText $ maybe "" (B.formatRealFloat B.Fixed (Just 3) . (^. _3)) r-    tuneParamStr = B.toLazyText $ maybe "" (B.formatRealFloat B.Fixed (Just 3)) (tParam <$> pTuner m)+    weight = BB.toLazyByteString $ BB.intDec $ pWeight m+    nAccept = BB.toLazyByteString $ maybe "" (BB.intDec . (^. _1)) r+    nReject = BB.toLazyByteString $ maybe "" (BB.intDec . (^. _2)) r+    acceptRatio = BL.fromStrict $ maybe "" (BC.toFixed 3 . (^. _3)) r+    tuneParamStr = BL.fromStrict $ maybe "" (BC.toFixed 3) (tParam <$> pTuner m)  -- | Summarize the 'Proposal's in the 'Cycle'. Also report acceptance ratios.-summarizeCycle :: Acceptance (Proposal a) -> Cycle a -> Text+summarizeCycle :: Acceptance (Proposal a) -> Cycle a -> BL.ByteString summarizeCycle a c =-  T.intercalate "\n" $+  BL.intercalate "\n" $     [ "Summary of proposal(s) in cycle. " <> mpi <> " proposal(s) per iteration.",       proposalHeader,-      "   " <> T.replicate (T.length proposalHeader - 3) "─"+      "   " <> BL.replicate (BL.length proposalHeader - 3) '-'     ]       ++ [summarizeProposal m (ar m) | m <- ps]-      ++ ["   " <> T.replicate (T.length proposalHeader - 3) "─"]+      ++ ["   " <> BL.replicate (BL.length proposalHeader - 3) '-']   where     ps = ccProposals c-    mpi = B.toLazyText $ B.decimal $ sum $ map pWeight ps+    mpi = BB.toLazyByteString $ BB.intDec $ sum $ map pWeight ps     ar m = acceptanceRatio m a  -- | For each key @k@, store the number of accepted and rejected proposals.
src/Mcmc/Save.hs view
@@ -26,7 +26,7 @@ import Control.Monad import Data.Aeson import Data.Aeson.TH-import qualified Data.ByteString.Lazy as B+import qualified Data.ByteString.Lazy.Char8 as BL import Data.List hiding (cycle) import qualified Data.Map as M import Data.Vector.Unboxed (Vector)@@ -104,7 +104,7 @@ -- - cycle -- - monitor saveStatus :: ToJSON a => FilePath -> Status a -> IO ()-saveStatus fn s = B.writeFile fn $ compress $ encode (toSave s)+saveStatus fn s = BL.writeFile fn $ compress $ encode (toSave s)  -- fromSav prior lh cycle monitor save fromSave ::@@ -157,7 +157,7 @@   FilePath ->   IO (Status a) loadStatus p l c m fn = do-  res <- eitherDecode . decompress <$> B.readFile fn+  res <- eitherDecode . decompress <$> BL.readFile fn   let s = case res of         Left err -> error err         Right sv -> fromSave p l c m sv
test/Mcmc/SaveSpec.hs view
@@ -46,7 +46,7 @@     ]  monStd :: MonitorStdOut Double-monStd = monitorStdOut [monitorRealFloat "mu"] 10+monStd = monitorStdOut [monitorDouble "mu"] 10  mon :: Monitor Double mon = Monitor monStd [] []