mwc-probability-transition-0.4: A Markov stochastic transition operator with logging

Safe HaskellNone
LanguageHaskell2010

System.Random.MWC.Probability.Transition

Contents

Synopsis

Transition

data Transition message s m a Source #

A Markov transition kernel.

Instances

Functor m => Functor (Transition message s m) Source # 

Methods

fmap :: (a -> b) -> Transition message s m a -> Transition message s m b #

(<$) :: a -> Transition message s m b -> Transition message s m a #

Show (Transition msg s m a) Source # 

Methods

showsPrec :: Int -> Transition msg s m a -> ShowS #

show :: Transition msg s m a -> String #

showList :: [Transition msg s m a] -> ShowS #

mkTransition Source #

Arguments

:: Monad m 
=> (s -> Prob m t)

Generation of random data

-> (s -> t -> (a, s))

(Output, Next state)

-> (s -> t -> a -> message)

Log message construction using (Next state, current random data, Output)

-> Transition message s m a 

Construct a Transition from sampling, state transformation and logging functions.

NB: The three function arguments are used in the order in which they appear here:

  1. a random sample w :: t is produced, using the current state x :: s as input
  2. output z :: a and next state x' :: s are computed using w and x
  3. a logging message is constructed, using z and x' as arguments.

runTransition Source #

Arguments

:: Monad m 
=> Handler m message

Logging handler

-> Transition message s m a 
-> Int

Number of iterations

-> s

Initial state

-> Gen (PrimState m)

PRNG

-> m ([a], s)

(Outputs, Final state)

Run a Transition for a number of steps, while logging each iteration.

Returns both the list of outputs and the final state.

Specialized combinators

evalTransition Source #

Arguments

:: Monad m 
=> Handler m message 
-> Transition message s m a 
-> Int 
-> s 
-> Gen (PrimState m) 
-> m [a]

Outputs

Run a Transition for a number of steps, while logging each iteration.

Returns the list of outputs.

execTransition Source #

Arguments

:: Monad m 
=> Handler m message 
-> Transition message s m a 
-> Int 
-> s 
-> Gen (PrimState m) 
-> m s

Final state

Run a Transition for a number of steps, while logging each iteration.

Returns the final state.

Conditional execution

stepConditional Source #

Arguments

:: Monad m 
=> (a -> s -> s -> Bool)

Inputs: Model output, Current state, New state

-> (a -> s -> s -> l)

"

-> (a -> s -> s -> r)

"

-> Handler m message 
-> Transition message s m a 
-> s

Current state

-> Gen (PrimState m) 
-> m (Either l r) 

Perform one Transition and check output and updated state against the current state, producing an Either with the result of the comparison.

Can be useful for detecting early divergence or lack of convergence etc.

Helper functions

withSeverity :: (t -> String) -> WithSeverity t -> String Source #

Render a logging message along with an annotation of its severity.

Re-exported from logging-effect

Log message severity

data WithSeverity a :: * -> * #

Add "Severity" information to a log message. This is often used to convey how significant a log message is.

Constructors

WithSeverity 

Fields

Instances

Functor WithSeverity 

Methods

fmap :: (a -> b) -> WithSeverity a -> WithSeverity b #

(<$) :: a -> WithSeverity b -> WithSeverity a #

Foldable WithSeverity 

Methods

fold :: Monoid m => WithSeverity m -> m #

foldMap :: Monoid m => (a -> m) -> WithSeverity a -> m #

foldr :: (a -> b -> b) -> b -> WithSeverity a -> b #

foldr' :: (a -> b -> b) -> b -> WithSeverity a -> b #

foldl :: (b -> a -> b) -> b -> WithSeverity a -> b #

foldl' :: (b -> a -> b) -> b -> WithSeverity a -> b #

foldr1 :: (a -> a -> a) -> WithSeverity a -> a #

foldl1 :: (a -> a -> a) -> WithSeverity a -> a #

toList :: WithSeverity a -> [a] #

null :: WithSeverity a -> Bool #

length :: WithSeverity a -> Int #

elem :: Eq a => a -> WithSeverity a -> Bool #

maximum :: Ord a => WithSeverity a -> a #

minimum :: Ord a => WithSeverity a -> a #

sum :: Num a => WithSeverity a -> a #

product :: Num a => WithSeverity a -> a #

Traversable WithSeverity 

Methods

traverse :: Applicative f => (a -> f b) -> WithSeverity a -> f (WithSeverity b) #

sequenceA :: Applicative f => WithSeverity (f a) -> f (WithSeverity a) #

mapM :: Monad m => (a -> m b) -> WithSeverity a -> m (WithSeverity b) #

sequence :: Monad m => WithSeverity (m a) -> m (WithSeverity a) #

Eq a => Eq (WithSeverity a) 
Ord a => Ord (WithSeverity a) 
Read a => Read (WithSeverity a) 
Show a => Show (WithSeverity a) 

data Severity :: * #

Classes of severity for log messages. These have been chosen to match syslog severity levels

Constructors

Emergency

System is unusable. By syslog convention, this level should not be used by applications.

Alert

Should be corrected immediately.

Critical

Critical conditions.

Error

Error conditions.

Warning

May indicate that an error will occur if action is not taken.

Notice

Events that are unusual, but not error conditions.

Informational

Normal operational messages that require no action.

Debug

Information useful to developers for debugging the application.

Handlers

type Handler (m :: * -> *) message = message -> m () #

Handlers are mechanisms to interpret the meaning of logging as an action in the underlying monad. They are simply functions from log messages to m-actions.

withFDHandler #

Arguments

:: (MonadIO io, MonadMask io) 
=> BatchingOptions 
-> Handle

The Handle to write log messages to.

-> Double

The ribbonFrac parameter to renderPretty

-> Int

The amount of characters per line. Lines longer than this will be pretty-printed across multiple lines if possible.

-> (Handler io (Doc ann) -> io a) 
-> io a 

withFDHandler creates a new Handler that will append a given file descriptor (or Handle, as it is known in the "base" library). Note that this Handler requires log messages to be of type Doc. This abstractly specifies a pretty-printing for log lines. The two arguments two withFDHandler determine how this pretty-printing should be realised when outputting log lines.

These Handlers asynchronously log messages to the given file descriptor, rather than blocking.

Batched logging

data BatchingOptions :: * #

Options that be used to configure withBatchingHandler.

Constructors

BatchingOptions 

Fields

withBatchedHandler :: (MonadIO io, MonadMask io) => BatchingOptions -> (NonEmpty message -> IO ()) -> (Handler io message -> io a) -> io a #

Create a new batched handler. Batched handlers take batches of messages to log at once, which can be more performant than logging each individual message.

A batched handler flushes under three criteria:

  1. The flush interval has elapsed and the queue is not empty.
  2. The queue has become full and needs to be flushed.
  3. The scope of withBatchedHandler is exited.

Batched handlers queue size and flush period can be configured via BatchingOptions.

Re-exported from GHC.IO.Handle.FD

stdout :: Handle #

A handle managing output to the Haskell program's standard output channel.

stderr :: Handle #

A handle managing output to the Haskell program's standard error channel.