{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      :  Mcmc.Acceptance
-- Description :  Handle acceptance rates
-- Copyright   :  2021 Dominik Schrempf
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Creation date: Thu Jul  8 18:12:07 2021.
module Mcmc.Acceptance
  ( -- * Acceptance rates
    AcceptanceRate,
    AcceptanceCounts (..),
    AcceptanceRates (..),
    Acceptance,
    Acceptances (fromAcceptances),
    emptyA,
    pushAccept,
    pushReject,
    ResetAcceptance (..),
    resetA,
    transformKeysA,
    acceptanceRate,
    acceptanceRates,
  )
where

import Data.Aeson
import Data.Aeson.TH
import Data.Foldable
import qualified Data.Map.Strict as M

-- | Acceptance rate.
type AcceptanceRate = Double

-- | Number of accepted and rejected proposals.
data AcceptanceCounts = AcceptanceCounts
  { AcceptanceCounts -> Int
nAccepted :: !Int,
    AcceptanceCounts -> Int
nRejected :: !Int
  }
  deriving (Int -> AcceptanceCounts -> ShowS
[AcceptanceCounts] -> ShowS
AcceptanceCounts -> String
(Int -> AcceptanceCounts -> ShowS)
-> (AcceptanceCounts -> String)
-> ([AcceptanceCounts] -> ShowS)
-> Show AcceptanceCounts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AcceptanceCounts -> ShowS
showsPrec :: Int -> AcceptanceCounts -> ShowS
$cshow :: AcceptanceCounts -> String
show :: AcceptanceCounts -> String
$cshowList :: [AcceptanceCounts] -> ShowS
showList :: [AcceptanceCounts] -> ShowS
Show, AcceptanceCounts -> AcceptanceCounts -> Bool
(AcceptanceCounts -> AcceptanceCounts -> Bool)
-> (AcceptanceCounts -> AcceptanceCounts -> Bool)
-> Eq AcceptanceCounts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AcceptanceCounts -> AcceptanceCounts -> Bool
== :: AcceptanceCounts -> AcceptanceCounts -> Bool
$c/= :: AcceptanceCounts -> AcceptanceCounts -> Bool
/= :: AcceptanceCounts -> AcceptanceCounts -> Bool
Eq, Eq AcceptanceCounts
Eq AcceptanceCounts =>
(AcceptanceCounts -> AcceptanceCounts -> Ordering)
-> (AcceptanceCounts -> AcceptanceCounts -> Bool)
-> (AcceptanceCounts -> AcceptanceCounts -> Bool)
-> (AcceptanceCounts -> AcceptanceCounts -> Bool)
-> (AcceptanceCounts -> AcceptanceCounts -> Bool)
-> (AcceptanceCounts -> AcceptanceCounts -> AcceptanceCounts)
-> (AcceptanceCounts -> AcceptanceCounts -> AcceptanceCounts)
-> Ord AcceptanceCounts
AcceptanceCounts -> AcceptanceCounts -> Bool
AcceptanceCounts -> AcceptanceCounts -> Ordering
AcceptanceCounts -> AcceptanceCounts -> AcceptanceCounts
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AcceptanceCounts -> AcceptanceCounts -> Ordering
compare :: AcceptanceCounts -> AcceptanceCounts -> Ordering
$c< :: AcceptanceCounts -> AcceptanceCounts -> Bool
< :: AcceptanceCounts -> AcceptanceCounts -> Bool
$c<= :: AcceptanceCounts -> AcceptanceCounts -> Bool
<= :: AcceptanceCounts -> AcceptanceCounts -> Bool
$c> :: AcceptanceCounts -> AcceptanceCounts -> Bool
> :: AcceptanceCounts -> AcceptanceCounts -> Bool
$c>= :: AcceptanceCounts -> AcceptanceCounts -> Bool
>= :: AcceptanceCounts -> AcceptanceCounts -> Bool
$cmax :: AcceptanceCounts -> AcceptanceCounts -> AcceptanceCounts
max :: AcceptanceCounts -> AcceptanceCounts -> AcceptanceCounts
$cmin :: AcceptanceCounts -> AcceptanceCounts -> AcceptanceCounts
min :: AcceptanceCounts -> AcceptanceCounts -> AcceptanceCounts
Ord)

$(deriveJSON defaultOptions ''AcceptanceCounts)

-- | Proposals based on Hamiltonian dynamics use expected acceptance rates, not counts.
data AcceptanceRates = AcceptanceRates
  { AcceptanceRates -> Double
totalAcceptanceRate :: !Double,
    AcceptanceRates -> Int
nAcceptanceRates :: !Int
  }
  deriving (Int -> AcceptanceRates -> ShowS
[AcceptanceRates] -> ShowS
AcceptanceRates -> String
(Int -> AcceptanceRates -> ShowS)
-> (AcceptanceRates -> String)
-> ([AcceptanceRates] -> ShowS)
-> Show AcceptanceRates
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AcceptanceRates -> ShowS
showsPrec :: Int -> AcceptanceRates -> ShowS
$cshow :: AcceptanceRates -> String
show :: AcceptanceRates -> String
$cshowList :: [AcceptanceRates] -> ShowS
showList :: [AcceptanceRates] -> ShowS
Show, AcceptanceRates -> AcceptanceRates -> Bool
(AcceptanceRates -> AcceptanceRates -> Bool)
-> (AcceptanceRates -> AcceptanceRates -> Bool)
-> Eq AcceptanceRates
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AcceptanceRates -> AcceptanceRates -> Bool
== :: AcceptanceRates -> AcceptanceRates -> Bool
$c/= :: AcceptanceRates -> AcceptanceRates -> Bool
/= :: AcceptanceRates -> AcceptanceRates -> Bool
Eq)

$(deriveJSON defaultOptions ''AcceptanceRates)

-- | Stored actual acceptance counts and maybe expected acceptance rates.
data Acceptance = A AcceptanceCounts (Maybe AcceptanceRates)
  deriving (Int -> Acceptance -> ShowS
[Acceptance] -> ShowS
Acceptance -> String
(Int -> Acceptance -> ShowS)
-> (Acceptance -> String)
-> ([Acceptance] -> ShowS)
-> Show Acceptance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Acceptance -> ShowS
showsPrec :: Int -> Acceptance -> ShowS
$cshow :: Acceptance -> String
show :: Acceptance -> String
$cshowList :: [Acceptance] -> ShowS
showList :: [Acceptance] -> ShowS
Show, Acceptance -> Acceptance -> Bool
(Acceptance -> Acceptance -> Bool)
-> (Acceptance -> Acceptance -> Bool) -> Eq Acceptance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Acceptance -> Acceptance -> Bool
== :: Acceptance -> Acceptance -> Bool
$c/= :: Acceptance -> Acceptance -> Bool
/= :: Acceptance -> Acceptance -> Bool
Eq)

$(deriveJSON defaultOptions ''Acceptance)

addAccept :: Maybe AcceptanceRates -> Acceptance -> Acceptance
addAccept :: Maybe AcceptanceRates -> Acceptance -> Acceptance
addAccept Maybe AcceptanceRates
mr' (A (AcceptanceCounts Int
a Int
r) Maybe AcceptanceRates
mr) = AcceptanceCounts -> Maybe AcceptanceRates -> Acceptance
A (Int -> Int -> AcceptanceCounts
AcceptanceCounts (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
r) (Maybe AcceptanceRates
-> Maybe AcceptanceRates -> Maybe AcceptanceRates
addAcceptanceRates Maybe AcceptanceRates
mr' Maybe AcceptanceRates
mr)

addReject :: Maybe AcceptanceRates -> Acceptance -> Acceptance
addReject :: Maybe AcceptanceRates -> Acceptance -> Acceptance
addReject Maybe AcceptanceRates
mr' (A (AcceptanceCounts Int
a Int
r) Maybe AcceptanceRates
mr) = AcceptanceCounts -> Maybe AcceptanceRates -> Acceptance
A (Int -> Int -> AcceptanceCounts
AcceptanceCounts Int
a (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) (Maybe AcceptanceRates
-> Maybe AcceptanceRates -> Maybe AcceptanceRates
addAcceptanceRates Maybe AcceptanceRates
mr' Maybe AcceptanceRates
mr)

addAcceptanceRates :: Maybe AcceptanceRates -> Maybe AcceptanceRates -> Maybe AcceptanceRates
addAcceptanceRates :: Maybe AcceptanceRates
-> Maybe AcceptanceRates -> Maybe AcceptanceRates
addAcceptanceRates Maybe AcceptanceRates
Nothing Maybe AcceptanceRates
Nothing = Maybe AcceptanceRates
forall a. Maybe a
Nothing
addAcceptanceRates (Just AcceptanceRates
r) Maybe AcceptanceRates
Nothing = AcceptanceRates -> Maybe AcceptanceRates
forall a. a -> Maybe a
Just AcceptanceRates
r
addAcceptanceRates Maybe AcceptanceRates
Nothing (Just AcceptanceRates
r) = AcceptanceRates -> Maybe AcceptanceRates
forall a. a -> Maybe a
Just AcceptanceRates
r
addAcceptanceRates (Just (AcceptanceRates Double
al Int
rl)) (Just (AcceptanceRates Double
ar Int
rr)) =
  AcceptanceRates -> Maybe AcceptanceRates
forall a. a -> Maybe a
Just (AcceptanceRates -> Maybe AcceptanceRates)
-> AcceptanceRates -> Maybe AcceptanceRates
forall a b. (a -> b) -> a -> b
$ Double -> Int -> AcceptanceRates
AcceptanceRates (Double
al Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ar) (Int
rl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rr)

-- | For each key @k@, store the number of accepted and rejected proposals.
newtype Acceptances k = Acceptances {forall k. Acceptances k -> Map k Acceptance
fromAcceptances :: M.Map k Acceptance}
  deriving (Acceptances k -> Acceptances k -> Bool
(Acceptances k -> Acceptances k -> Bool)
-> (Acceptances k -> Acceptances k -> Bool) -> Eq (Acceptances k)
forall k. Eq k => Acceptances k -> Acceptances k -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall k. Eq k => Acceptances k -> Acceptances k -> Bool
== :: Acceptances k -> Acceptances k -> Bool
$c/= :: forall k. Eq k => Acceptances k -> Acceptances k -> Bool
/= :: Acceptances k -> Acceptances k -> Bool
Eq, Int -> Acceptances k -> ShowS
[Acceptances k] -> ShowS
Acceptances k -> String
(Int -> Acceptances k -> ShowS)
-> (Acceptances k -> String)
-> ([Acceptances k] -> ShowS)
-> Show (Acceptances k)
forall k. Show k => Int -> Acceptances k -> ShowS
forall k. Show k => [Acceptances k] -> ShowS
forall k. Show k => Acceptances k -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall k. Show k => Int -> Acceptances k -> ShowS
showsPrec :: Int -> Acceptances k -> ShowS
$cshow :: forall k. Show k => Acceptances k -> String
show :: Acceptances k -> String
$cshowList :: forall k. Show k => [Acceptances k] -> ShowS
showList :: [Acceptances k] -> ShowS
Show)

instance (ToJSONKey k) => ToJSON (Acceptances k) where
  toJSON :: Acceptances k -> Value
toJSON (Acceptances Map k Acceptance
m) = Map k Acceptance -> Value
forall a. ToJSON a => a -> Value
toJSON Map k Acceptance
m
  toEncoding :: Acceptances k -> Encoding
toEncoding (Acceptances Map k Acceptance
m) = Map k Acceptance -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Map k Acceptance
m

instance (Ord k, FromJSONKey k) => FromJSON (Acceptances k) where
  parseJSON :: Value -> Parser (Acceptances k)
parseJSON Value
v = Map k Acceptance -> Acceptances k
forall k. Map k Acceptance -> Acceptances k
Acceptances (Map k Acceptance -> Acceptances k)
-> Parser (Map k Acceptance) -> Parser (Acceptances k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Map k Acceptance)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

-- | In the beginning there was the Word.
--
-- Initialize an empty storage of accepted/rejected values.
emptyA :: (Ord k) => [k] -> Acceptances k
emptyA :: forall k. Ord k => [k] -> Acceptances k
emptyA [k]
ks = Map k Acceptance -> Acceptances k
forall k. Map k Acceptance -> Acceptances k
Acceptances (Map k Acceptance -> Acceptances k)
-> Map k Acceptance -> Acceptances k
forall a b. (a -> b) -> a -> b
$ [(k, Acceptance)] -> Map k Acceptance
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(k
k, AcceptanceCounts -> Maybe AcceptanceRates -> Acceptance
A AcceptanceCounts
noCounts Maybe AcceptanceRates
forall a. Maybe a
Nothing) | k
k <- [k]
ks]
  where
    noCounts :: AcceptanceCounts
noCounts = Int -> Int -> AcceptanceCounts
AcceptanceCounts Int
0 Int
0

-- | For key @k@, add an accept.
pushAccept :: (Ord k) => Maybe AcceptanceRates -> k -> Acceptances k -> Acceptances k
pushAccept :: forall k.
Ord k =>
Maybe AcceptanceRates -> k -> Acceptances k -> Acceptances k
pushAccept Maybe AcceptanceRates
mr k
k = Map k Acceptance -> Acceptances k
forall k. Map k Acceptance -> Acceptances k
Acceptances (Map k Acceptance -> Acceptances k)
-> (Acceptances k -> Map k Acceptance)
-> Acceptances k
-> Acceptances k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Acceptance -> Acceptance)
-> k -> Map k Acceptance -> Map k Acceptance
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (Maybe AcceptanceRates -> Acceptance -> Acceptance
addAccept Maybe AcceptanceRates
mr) k
k (Map k Acceptance -> Map k Acceptance)
-> (Acceptances k -> Map k Acceptance)
-> Acceptances k
-> Map k Acceptance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acceptances k -> Map k Acceptance
forall k. Acceptances k -> Map k Acceptance
fromAcceptances

-- | For key @k@, add a reject.
pushReject :: (Ord k) => Maybe AcceptanceRates -> k -> Acceptances k -> Acceptances k
pushReject :: forall k.
Ord k =>
Maybe AcceptanceRates -> k -> Acceptances k -> Acceptances k
pushReject Maybe AcceptanceRates
mr k
k = Map k Acceptance -> Acceptances k
forall k. Map k Acceptance -> Acceptances k
Acceptances (Map k Acceptance -> Acceptances k)
-> (Acceptances k -> Map k Acceptance)
-> Acceptances k
-> Acceptances k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Acceptance -> Acceptance)
-> k -> Map k Acceptance -> Map k Acceptance
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (Maybe AcceptanceRates -> Acceptance -> Acceptance
addReject Maybe AcceptanceRates
mr) k
k (Map k Acceptance -> Map k Acceptance)
-> (Acceptances k -> Map k Acceptance)
-> Acceptances k
-> Map k Acceptance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acceptances k -> Map k Acceptance
forall k. Acceptances k -> Map k Acceptance
fromAcceptances

-- | Reset acceptance specification.
data ResetAcceptance
  = -- | Reset actual acceptance counts and expected acceptance rates.
    ResetEverything
  | -- | Only reset expected acceptance rates.
    ResetExpectedRatesOnly

-- | Reset acceptance counts.
resetA :: (Ord k) => ResetAcceptance -> Acceptances k -> Acceptances k
resetA :: forall k.
Ord k =>
ResetAcceptance -> Acceptances k -> Acceptances k
resetA ResetAcceptance
ResetEverything = [k] -> Acceptances k
forall k. Ord k => [k] -> Acceptances k
emptyA ([k] -> Acceptances k)
-> (Acceptances k -> [k]) -> Acceptances k -> Acceptances k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k Acceptance -> [k]
forall k a. Map k a -> [k]
M.keys (Map k Acceptance -> [k])
-> (Acceptances k -> Map k Acceptance) -> Acceptances k -> [k]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acceptances k -> Map k Acceptance
forall k. Acceptances k -> Map k Acceptance
fromAcceptances
resetA ResetAcceptance
ResetExpectedRatesOnly = Map k Acceptance -> Acceptances k
forall k. Map k Acceptance -> Acceptances k
Acceptances (Map k Acceptance -> Acceptances k)
-> (Acceptances k -> Map k Acceptance)
-> Acceptances k
-> Acceptances k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Acceptance -> Acceptance) -> Map k Acceptance -> Map k Acceptance
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Acceptance -> Acceptance
f (Map k Acceptance -> Map k Acceptance)
-> (Acceptances k -> Map k Acceptance)
-> Acceptances k
-> Map k Acceptance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acceptances k -> Map k Acceptance
forall k. Acceptances k -> Map k Acceptance
fromAcceptances
  where
    f :: Acceptance -> Acceptance
f (A AcceptanceCounts
cs Maybe AcceptanceRates
_) = AcceptanceCounts -> Maybe AcceptanceRates -> Acceptance
A AcceptanceCounts
cs Maybe AcceptanceRates
forall a. Maybe a
Nothing

transformKeys :: (Ord k1, Ord k2) => [(k1, k2)] -> M.Map k1 v -> M.Map k2 v
transformKeys :: forall k1 k2 v.
(Ord k1, Ord k2) =>
[(k1, k2)] -> Map k1 v -> Map k2 v
transformKeys [(k1, k2)]
ks Map k1 v
m = (Map k2 v -> (k1, k2) -> Map k2 v)
-> Map k2 v -> [(k1, k2)] -> Map k2 v
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map k2 v -> (k1, k2) -> Map k2 v
forall {k}. Ord k => Map k v -> (k1, k) -> Map k v
insrt Map k2 v
forall k a. Map k a
M.empty [(k1, k2)]
ks
  where
    insrt :: Map k v -> (k1, k) -> Map k v
insrt Map k v
m' (k1
k1, k
k2) = k -> v -> Map k v -> Map k v
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
k2 (Map k1 v
m Map k1 v -> k1 -> v
forall k a. Ord k => Map k a -> k -> a
M.! k1
k1) Map k v
m'

-- | Transform keys using the given lists. Keys not provided will not be present
-- in the new 'Acceptance' variable.
transformKeysA :: (Ord k1, Ord k2) => [(k1, k2)] -> Acceptances k1 -> Acceptances k2
transformKeysA :: forall k1 k2.
(Ord k1, Ord k2) =>
[(k1, k2)] -> Acceptances k1 -> Acceptances k2
transformKeysA [(k1, k2)]
ks = Map k2 Acceptance -> Acceptances k2
forall k. Map k Acceptance -> Acceptances k
Acceptances (Map k2 Acceptance -> Acceptances k2)
-> (Acceptances k1 -> Map k2 Acceptance)
-> Acceptances k1
-> Acceptances k2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k1, k2)] -> Map k1 Acceptance -> Map k2 Acceptance
forall k1 k2 v.
(Ord k1, Ord k2) =>
[(k1, k2)] -> Map k1 v -> Map k2 v
transformKeys [(k1, k2)]
ks (Map k1 Acceptance -> Map k2 Acceptance)
-> (Acceptances k1 -> Map k1 Acceptance)
-> Acceptances k1
-> Map k2 Acceptance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acceptances k1 -> Map k1 Acceptance
forall k. Acceptances k -> Map k Acceptance
fromAcceptances

-- | Compute acceptance counts, and actual and expected acceptances rates for a
-- specific proposal.
--
-- Return @Just (accepts, rejects, acceptance rate)@.
--
-- Return 'Nothing' if no proposals have been accepted or rejected (division by
-- zero).
acceptanceRate ::
  (Ord k) =>
  k ->
  Acceptances k ->
  -- | (nAccepts, nRejects, actualRate, expectedRate)
  (Int, Int, Maybe AcceptanceRate, Maybe AcceptanceRate)
acceptanceRate :: forall k.
Ord k =>
k -> Acceptances k -> (Int, Int, Maybe Double, Maybe Double)
acceptanceRate k
k Acceptances k
a = case Acceptances k -> Map k Acceptance
forall k. Acceptances k -> Map k Acceptance
fromAcceptances Acceptances k
a Map k Acceptance -> k -> Maybe Acceptance
forall k a. Ord k => Map k a -> k -> Maybe a
M.!? k
k of
  Just (A (AcceptanceCounts Int
as Int
rs) Maybe AcceptanceRates
mrs) -> (Int
as, Int
rs, Maybe Double
mar, Maybe Double
mtr)
    where
      s :: Int
s = Int
as Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rs
      mar :: Maybe Double
mar = if Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then Maybe Double
forall a. Maybe a
Nothing else Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
as Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s
      mtr :: Maybe Double
mtr = case Maybe AcceptanceRates
mrs of
        Maybe AcceptanceRates
Nothing -> Maybe Double
forall a. Maybe a
Nothing
        Just (AcceptanceRates Double
xs Int
n) -> Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Double
xs Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
  Maybe Acceptance
Nothing -> String -> (Int, Int, Maybe Double, Maybe Double)
forall a. HasCallStack => String -> a
error String
"acceptanceRate: Key not found in map."

-- | Compute actual acceptance rates for all proposals.
--
-- Set rate to 'Nothing' if no proposals have been accepted or rejected
-- (division by zero).
acceptanceRates :: Acceptances k -> M.Map k (Maybe AcceptanceRate)
acceptanceRates :: forall k. Acceptances k -> Map k (Maybe Double)
acceptanceRates = (Acceptance -> Maybe Double)
-> Map k Acceptance -> Map k (Maybe Double)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Acceptance -> Maybe Double
forall {a}. Fractional a => Acceptance -> Maybe a
getRate (Map k Acceptance -> Map k (Maybe Double))
-> (Acceptances k -> Map k Acceptance)
-> Acceptances k
-> Map k (Maybe Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acceptances k -> Map k Acceptance
forall k. Acceptances k -> Map k Acceptance
fromAcceptances
  where
    getRate :: Acceptance -> Maybe a
getRate (A (AcceptanceCounts Int
as Int
rs) Maybe AcceptanceRates
_) =
      let s :: Int
s = Int
as Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rs
       in if Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
            then Maybe a
forall a. Maybe a
Nothing
            else a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
as a -> a -> a
forall a. Fractional a => a -> a -> a
/ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s