-- |
-- Module      :  Mcmc.Trace
-- Description :  Trace of a Markov chain
-- Copyright   :  (c) Dominik Schrempf 2020
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Creation date: Wed May 20 09:11:25 2020.
module Mcmc.Trace
  ( Trace,
    singletonT,
    pushT,
    headT,
    takeItems,
    takeT,
  )
where

import Data.Aeson
import Mcmc.Item

-- | A 'Trace' passes through a list of states with associated likelihoods which
-- are called 'Item's. New 'Item's are prepended, and the path of the Markov
-- chain is stored in reversed order.
newtype Trace a = Trace {Trace a -> [Item a]
fromTrace :: [Item a]}
  deriving (Int -> Trace a -> ShowS
[Trace a] -> ShowS
Trace a -> String
(Int -> Trace a -> ShowS)
-> (Trace a -> String) -> ([Trace a] -> ShowS) -> Show (Trace a)
forall a. Show a => Int -> Trace a -> ShowS
forall a. Show a => [Trace a] -> ShowS
forall a. Show a => Trace a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Trace a] -> ShowS
$cshowList :: forall a. Show a => [Trace a] -> ShowS
show :: Trace a -> String
$cshow :: forall a. Show a => Trace a -> String
showsPrec :: Int -> Trace a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Trace a -> ShowS
Show, ReadPrec [Trace a]
ReadPrec (Trace a)
Int -> ReadS (Trace a)
ReadS [Trace a]
(Int -> ReadS (Trace a))
-> ReadS [Trace a]
-> ReadPrec (Trace a)
-> ReadPrec [Trace a]
-> Read (Trace a)
forall a. Read a => ReadPrec [Trace a]
forall a. Read a => ReadPrec (Trace a)
forall a. Read a => Int -> ReadS (Trace a)
forall a. Read a => ReadS [Trace a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Trace a]
$creadListPrec :: forall a. Read a => ReadPrec [Trace a]
readPrec :: ReadPrec (Trace a)
$creadPrec :: forall a. Read a => ReadPrec (Trace a)
readList :: ReadS [Trace a]
$creadList :: forall a. Read a => ReadS [Trace a]
readsPrec :: Int -> ReadS (Trace a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Trace a)
Read, Trace a -> Trace a -> Bool
(Trace a -> Trace a -> Bool)
-> (Trace a -> Trace a -> Bool) -> Eq (Trace a)
forall a. Eq a => Trace a -> Trace a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Trace a -> Trace a -> Bool
$c/= :: forall a. Eq a => Trace a -> Trace a -> Bool
== :: Trace a -> Trace a -> Bool
$c== :: forall a. Eq a => Trace a -> Trace a -> Bool
Eq)

instance Semigroup (Trace a) where
  (Trace [Item a]
l) <> :: Trace a -> Trace a -> Trace a
<> (Trace [Item a]
r) = [Item a] -> Trace a
forall a. [Item a] -> Trace a
Trace ([Item a]
l [Item a] -> [Item a] -> [Item a]
forall a. Semigroup a => a -> a -> a
<> [Item a]
r)

instance Monoid (Trace a) where
  mempty :: Trace a
mempty = [Item a] -> Trace a
forall a. [Item a] -> Trace a
Trace []

instance ToJSON a => ToJSON (Trace a) where
  toJSON :: Trace a -> Value
toJSON (Trace [Item a]
xs) = [Item a] -> Value
forall a. ToJSON a => a -> Value
toJSON [Item a]
xs
  toEncoding :: Trace a -> Encoding
toEncoding (Trace [Item a]
xs) = [Item a] -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding [Item a]
xs

instance FromJSON a => FromJSON (Trace a) where
  parseJSON :: Value -> Parser (Trace a)
parseJSON Value
v = [Item a] -> Trace a
forall a. [Item a] -> Trace a
Trace ([Item a] -> Trace a) -> Parser [Item a] -> Parser (Trace a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [Item a]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList Value
v

-- | The empty trace.
singletonT :: Item a -> Trace a
singletonT :: Item a -> Trace a
singletonT Item a
i = [Item a] -> Trace a
forall a. [Item a] -> Trace a
Trace [Item a
i]

-- | Prepend an 'Item' to a 'Trace'.
pushT :: Item a -> Trace a -> Trace a
pushT :: Item a -> Trace a -> Trace a
pushT Item a
x = [Item a] -> Trace a
forall a. [Item a] -> Trace a
Trace ([Item a] -> Trace a)
-> (Trace a -> [Item a]) -> Trace a -> Trace a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Item a
x ([Item a] -> [Item a])
-> (Trace a -> [Item a]) -> Trace a -> [Item a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace a -> [Item a]
forall a. Trace a -> [Item a]
fromTrace
{-# INLINEABLE pushT #-}

-- | Get the most recent item of the trace.
headT :: Trace a -> Item a
headT :: Trace a -> Item a
headT = [Item a] -> Item a
forall a. [a] -> a
head ([Item a] -> Item a) -> (Trace a -> [Item a]) -> Trace a -> Item a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace a -> [Item a]
forall a. Trace a -> [Item a]
fromTrace

-- | Get the N most recent items of the trace.
takeItems :: Int -> Trace a -> [Item a]
takeItems :: Int -> Trace a -> [Item a]
takeItems Int
n = Int -> [Item a] -> [Item a]
forall a. Int -> [a] -> [a]
take Int
n ([Item a] -> [Item a])
-> (Trace a -> [Item a]) -> Trace a -> [Item a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace a -> [Item a]
forall a. Trace a -> [Item a]
fromTrace

-- | Shorten the trace to given length.
takeT :: Int -> Trace a -> Trace a
takeT :: Int -> Trace a -> Trace a
takeT Int
n = [Item a] -> Trace a
forall a. [Item a] -> Trace a
Trace ([Item a] -> Trace a)
-> (Trace a -> [Item a]) -> Trace a -> Trace a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Item a] -> [Item a]
forall a. Int -> [a] -> [a]
take Int
n ([Item a] -> [Item a])
-> (Trace a -> [Item a]) -> Trace a -> [Item a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace a -> [Item a]
forall a. Trace a -> [Item a]
fromTrace