{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Test.StateMachine.Markov
-- Copyright   :  (C) 2019, Stevan Andjelkovic
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Stevan Andjelkovic <stevan.andjelkovic@strath.ac.uk>
-- Stability   :  provisional
-- Portability :  non-portable (GHC extensions)
--
-- This module contains helper functions for testing using Markov chains.
--
-----------------------------------------------------------------------------

module Test.StateMachine.Markov
  ( Markov
  , makeMarkov
  , toAdjacencyMap
  , (-<)
  , (>-)
  , (/-)
  , markovGenerator
  , coverMarkov
  , tabulateMarkov
  , transitionMatrix
  , stimulusMatrix
  , historyObservations
  , markovToDot
  , markovToPs
  , StatsDb(..)
  , PropertyName
  , nullStatsDb
  , fileStatsDb
  , persistStats
  , computeReliability
  , printReliability
  , quickCheckReliability
  , testChainToDot
  )
  where

import           Control.Arrow
                   ((&&&))
import           Data.Bifunctor
                   (bimap)
import           Data.Either
                   (partitionEithers)
import           Data.List
                   (genericLength)
import qualified Data.Set                           as Set
import           Data.Map
                   (Map)
import qualified Data.Map                           as Map
import           Data.Matrix
                   (Matrix, elementwise, fromLists, matrix, ncols,
                   nrows, submatrix, toLists, zero, getElem)
import           Data.Maybe
                   (fromMaybe)
import           Generic.Data
                   (FiniteEnum, GBounded, GEnum, gfiniteEnumFromTo,
                   gmaxBound, gminBound, gtoFiniteEnum, gfromFiniteEnum)
import           GHC.Generics
                   (Generic, Rep)
import           Prelude                            hiding
                   (readFile)
import           System.Directory
                   (removeFile)
import           System.FilePath.Posix
                   (replaceExtension)
import           System.IO
                   (IOMode(ReadWriteMode), hGetContents, openFile)
import           System.Process
                   (callProcess)
import           Test.QuickCheck
                   (Gen, Property, Testable, coverTable, frequency,
                   property, quickCheck, tabulate)
import           Test.QuickCheck.Monadic
                   (PropertyM, run)
import           Test.QuickCheck.Property
                   (Callback(PostTest),
                   CallbackKind(NotCounterexample), callback)
import           Text.Read
                   (readMaybe)

import           MarkovChain

import           Test.StateMachine.Logic
                   (boolean)
import           Test.StateMachine.Types
                   (Command, Commands, Counter, History, Operation(..),
                   StateMachine(..), getCommand, makeOperations,
                   newCounter, unCommands, unHistory)
import           Test.StateMachine.Types.GenSym
                   (runGenSym)
import           Test.StateMachine.Types.References
                   (Concrete, Symbolic)

------------------------------------------------------------------------

-- | Markov chain.
newtype Markov state cmd_ prob = Markov
  { Markov state cmd_ prob -> Map state [Transition state cmd_ prob]
unMarkov :: Map state [Transition state cmd_ prob] }

data Transition state cmd_ prob = Transition
  { Transition state cmd_ prob -> cmd_
command     :: cmd_
  , Transition state cmd_ prob -> prob
probability :: prob
  , Transition state cmd_ prob -> state
to          :: state
  }

-- | Constructor for 'Markov' chains.
makeMarkov :: Ord state
           => [Map state [Transition state cmd_ prob]] -> Markov state cmd_ prob
makeMarkov :: [Map state [Transition state cmd_ prob]] -> Markov state cmd_ prob
makeMarkov = Map state [Transition state cmd_ prob] -> Markov state cmd_ prob
forall state cmd_ prob.
Map state [Transition state cmd_ prob] -> Markov state cmd_ prob
Markov (Map state [Transition state cmd_ prob] -> Markov state cmd_ prob)
-> ([Map state [Transition state cmd_ prob]]
    -> Map state [Transition state cmd_ prob])
-> [Map state [Transition state cmd_ prob]]
-> Markov state cmd_ prob
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Map state [Transition state cmd_ prob]]
-> Map state [Transition state cmd_ prob]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions

-- | Expose inner graph structure of markov chain
toAdjacencyMap
  :: Ord state
  => Markov state cmd_ prob
  -> Map state (Map state (cmd_, prob))
toAdjacencyMap :: Markov state cmd_ prob -> Map state (Map state (cmd_, prob))
toAdjacencyMap (Markov Map state [Transition state cmd_ prob]
m) =
  ([Transition state cmd_ prob] -> Map state (cmd_, prob))
-> Map state [Transition state cmd_ prob]
-> Map state (Map state (cmd_, prob))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Transition state cmd_ prob
 -> Map state (cmd_, prob) -> Map state (cmd_, prob))
-> Map state (cmd_, prob)
-> [Transition state cmd_ prob]
-> Map state (cmd_, prob)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Transition state cmd_ prob
-> Map state (cmd_, prob) -> Map state (cmd_, prob)
forall k a b.
Ord k =>
Transition k a b -> Map k (a, b) -> Map k (a, b)
f Map state (cmd_, prob)
forall a. Monoid a => a
mempty) Map state [Transition state cmd_ prob]
m
  where
    f :: Transition k a b -> Map k (a, b) -> Map k (a, b)
f Transition{k
a
b
to :: k
probability :: b
command :: a
to :: forall state cmd_ prob. Transition state cmd_ prob -> state
probability :: forall state cmd_ prob. Transition state cmd_ prob -> prob
command :: forall state cmd_ prob. Transition state cmd_ prob -> cmd_
..} = k -> (a, b) -> Map k (a, b) -> Map k (a, b)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
to (a
command, b
probability)

infixl 5 -<

-- | Infix operator for starting to creating a transition in the 'Markov' chain,
--   finish the transition with one of '(>-)' or '(/-)' depending on whether the
--   transition has a specific or a uniform probability.
(-<) :: Fractional prob
     => state -> [Either (cmd_, state) ((cmd_, prob), state)]
     -> Map state [Transition state cmd_ prob]
state
from -< :: state
-> [Either (cmd_, state) ((cmd_, prob), state)]
-> Map state [Transition state cmd_ prob]
-< [Either (cmd_, state) ((cmd_, prob), state)]
es = state
-> [Transition state cmd_ prob]
-> Map state [Transition state cmd_ prob]
forall k a. k -> a -> Map k a
Map.singleton state
from ((Either (cmd_, state) ((cmd_, prob), state)
 -> Transition state cmd_ prob)
-> [Either (cmd_, state) ((cmd_, prob), state)]
-> [Transition state cmd_ prob]
forall a b. (a -> b) -> [a] -> [b]
map Either (cmd_, state) ((cmd_, prob), state)
-> Transition state cmd_ prob
forall cmd_ state.
Either (cmd_, state) ((cmd_, prob), state)
-> Transition state cmd_ prob
go [Either (cmd_, state) ((cmd_, prob), state)]
es)
  where
    go :: Either (cmd_, state) ((cmd_, prob), state)
-> Transition state cmd_ prob
go (Left   (cmd_
command,               state
to)) = cmd_ -> prob -> state -> Transition state cmd_ prob
forall state cmd_ prob.
cmd_ -> prob -> state -> Transition state cmd_ prob
Transition cmd_
command prob
uniform state
to
    go (Right ((cmd_
command, prob
probability), state
to)) = Transition :: forall state cmd_ prob.
cmd_ -> prob -> state -> Transition state cmd_ prob
Transition {prob
state
cmd_
to :: state
probability :: prob
command :: cmd_
to :: state
probability :: prob
command :: cmd_
..}

    ([(cmd_, state)]
ls, [((cmd_, prob), state)]
rs) = [Either (cmd_, state) ((cmd_, prob), state)]
-> ([(cmd_, state)], [((cmd_, prob), state)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either (cmd_, state) ((cmd_, prob), state)]
es
    uniform :: prob
uniform  = (prob
100 prob -> prob -> prob
forall a. Num a => a -> a -> a
- [prob] -> prob
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((cmd_, prob) -> prob) -> [(cmd_, prob)] -> [prob]
forall a b. (a -> b) -> [a] -> [b]
map (cmd_, prob) -> prob
forall a b. (a, b) -> b
snd ((((cmd_, prob), state) -> (cmd_, prob))
-> [((cmd_, prob), state)] -> [(cmd_, prob)]
forall a b. (a -> b) -> [a] -> [b]
map ((cmd_, prob), state) -> (cmd_, prob)
forall a b. (a, b) -> a
fst [((cmd_, prob), state)]
rs))) prob -> prob -> prob
forall a. Fractional a => a -> a -> a
/ [(cmd_, state)] -> prob
forall i a. Num i => [a] -> i
genericLength [(cmd_, state)]
ls
    -- ^ Note: If `length ls == 0` then `uniform` is not used, so division by
    -- zero doesn't happen.

infixl 5 >-

-- | Finish making a transition with a specified probability distribution.
(>-) :: (cmd_, prob) -> state -> Either (cmd_, state) ((cmd_, prob), state)
(cmd_
cmd, prob
prob) >- :: (cmd_, prob) -> state -> Either (cmd_, state) ((cmd_, prob), state)
>- state
state = ((cmd_, prob), state) -> Either (cmd_, state) ((cmd_, prob), state)
forall a b. b -> Either a b
Right ((cmd_
cmd, prob
prob), state
state)

infixl 5 /-

-- | Finish making a transition with an uniform probability distribution.
(/-) :: cmd_ -> state -> Either (cmd_, state) ((cmd_, prob), state)
cmd_
cmd /- :: cmd_ -> state -> Either (cmd_, state) ((cmd_, prob), state)
/- state
state = (cmd_, state) -> Either (cmd_, state) ((cmd_, prob), state)
forall a b. a -> Either a b
Left (cmd_
cmd, state
state)

------------------------------------------------------------------------

-- | Create a generator from a 'Markov' chain.
markovGenerator :: forall state cmd_ cmd model. (Show state, Show cmd_)
                => (Ord state, Ord cmd_)
                => Markov state cmd_ Double
                -> Map cmd_ (model Symbolic -> Gen (cmd Symbolic))
                -> (model Symbolic -> state)
                -> (state -> Bool)
                -> (model Symbolic -> Maybe (Gen (cmd Symbolic)))
markovGenerator :: Markov state cmd_ Double
-> Map cmd_ (model Symbolic -> Gen (cmd Symbolic))
-> (model Symbolic -> state)
-> (state -> Bool)
-> model Symbolic
-> Maybe (Gen (cmd Symbolic))
markovGenerator Markov state cmd_ Double
markov Map cmd_ (model Symbolic -> Gen (cmd Symbolic))
gens model Symbolic -> state
partition state -> Bool
isSink model Symbolic
model
  | state -> Bool
isSink (model Symbolic -> state
partition model Symbolic
model) = Maybe (Gen (cmd Symbolic))
forall a. Maybe a
Nothing
  | Bool
otherwise                = Gen (cmd Symbolic) -> Maybe (Gen (cmd Symbolic))
forall a. a -> Maybe a
Just ([(Int, Gen (cmd Symbolic))] -> Gen (cmd Symbolic)
forall a. [(Int, Gen a)] -> Gen a
frequency (state -> [(Int, Gen (cmd Symbolic))]
go (model Symbolic -> state
partition model Symbolic
model)))
  where
    go :: state -> [(Int, Gen (cmd Symbolic))]
    go :: state -> [(Int, Gen (cmd Symbolic))]
go state
state
      = (Transition state cmd_ Double -> (Int, Gen (cmd Symbolic)))
-> [Transition state cmd_ Double] -> [(Int, Gen (cmd Symbolic))]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int)
-> (Transition state cmd_ Double -> Double)
-> Transition state cmd_ Double
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transition state cmd_ Double -> Double
forall state cmd_ prob. Transition state cmd_ prob -> prob
probability
             (Transition state cmd_ Double -> Int)
-> (Transition state cmd_ Double -> Gen (cmd Symbolic))
-> Transition state cmd_ Double
-> (Int, Gen (cmd Symbolic))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (\cmd_
cmd_ -> (model Symbolic -> Gen (cmd Symbolic))
-> Maybe (model Symbolic -> Gen (cmd Symbolic))
-> model Symbolic
-> Gen (cmd Symbolic)
forall a. a -> Maybe a -> a
fromMaybe (cmd_ -> model Symbolic -> Gen (cmd Symbolic)
forall a a. Show a => a -> a
errMissing cmd_
cmd_) (cmd_
-> Map cmd_ (model Symbolic -> Gen (cmd Symbolic))
-> Maybe (model Symbolic -> Gen (cmd Symbolic))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup cmd_
cmd_ Map cmd_ (model Symbolic -> Gen (cmd Symbolic))
gens) model Symbolic
model) (cmd_ -> Gen (cmd Symbolic))
-> (Transition state cmd_ Double -> cmd_)
-> Transition state cmd_ Double
-> Gen (cmd Symbolic)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transition state cmd_ Double -> cmd_
forall state cmd_ prob. Transition state cmd_ prob -> cmd_
command)
      ([Transition state cmd_ Double] -> [(Int, Gen (cmd Symbolic))])
-> (Markov state cmd_ Double -> [Transition state cmd_ Double])
-> Markov state cmd_ Double
-> [(Int, Gen (cmd Symbolic))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Transition state cmd_ Double]
-> Maybe [Transition state cmd_ Double]
-> [Transition state cmd_ Double]
forall a. a -> Maybe a -> a
fromMaybe [Transition state cmd_ Double]
forall a. a
errDeadlock
      (Maybe [Transition state cmd_ Double]
 -> [Transition state cmd_ Double])
-> (Markov state cmd_ Double
    -> Maybe [Transition state cmd_ Double])
-> Markov state cmd_ Double
-> [Transition state cmd_ Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. state
-> Map state [Transition state cmd_ Double]
-> Maybe [Transition state cmd_ Double]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup state
state
      (Map state [Transition state cmd_ Double]
 -> Maybe [Transition state cmd_ Double])
-> (Markov state cmd_ Double
    -> Map state [Transition state cmd_ Double])
-> Markov state cmd_ Double
-> Maybe [Transition state cmd_ Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Markov state cmd_ Double
-> Map state [Transition state cmd_ Double]
forall state cmd_ prob.
Markov state cmd_ prob -> Map state [Transition state cmd_ prob]
unMarkov
      (Markov state cmd_ Double -> [(Int, Gen (cmd Symbolic))])
-> Markov state cmd_ Double -> [(Int, Gen (cmd Symbolic))]
forall a b. (a -> b) -> a -> b
$ Markov state cmd_ Double
markov
      where
        errDeadlock :: a
errDeadlock = [Char] -> a
forall a. HasCallStack => [Char] -> a
error
          ([Char]
"markovGenerator: deadlock, no commands can be generated in given state: "
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ state -> [Char]
forall a. Show a => a -> [Char]
show state
state)

        errMissing :: a -> a
errMissing a
cmd_ = [Char] -> a
forall a. HasCallStack => [Char] -> a
error
          ([Char]
"markovGenerator: don't know how to generate the command: "
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
cmd_)

-- | Variant of QuickCheck's 'coverTable' which works on 'Markov' chains.
coverMarkov :: (Show state, Show cmd_, Testable prop)
            => Markov state cmd_ Double -> prop -> Property
coverMarkov :: Markov state cmd_ Double -> prop -> Property
coverMarkov Markov state cmd_ Double
markov prop
prop = ((state, [Transition state cmd_ Double]) -> Property -> Property)
-> Property
-> [(state, [Transition state cmd_ Double])]
-> Property
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (state, [Transition state cmd_ Double]) -> Property -> Property
forall prop a state cmd_.
(Testable prop, Show a, Show state, Show cmd_) =>
(a, [Transition state cmd_ Double]) -> prop -> Property
go (prop -> Property
forall prop. Testable prop => prop -> Property
property prop
prop) (Map state [Transition state cmd_ Double]
-> [(state, [Transition state cmd_ Double])]
forall k a. Map k a -> [(k, a)]
Map.toList (Markov state cmd_ Double
-> Map state [Transition state cmd_ Double]
forall state cmd_ prob.
Markov state cmd_ prob -> Map state [Transition state cmd_ prob]
unMarkov Markov state cmd_ Double
markov))
  where
    go :: (a, [Transition state cmd_ Double]) -> prop -> Property
go (a
from, [Transition state cmd_ Double]
ts) prop
ih =
      [Char] -> [([Char], Double)] -> prop -> Property
forall prop.
Testable prop =>
[Char] -> [([Char], Double)] -> prop -> Property
coverTable (a -> [Char]
forall a. Show a => a -> [Char]
show a
from)
        ((Transition state cmd_ Double -> ([Char], Double))
-> [Transition state cmd_ Double] -> [([Char], Double)]
forall a b. (a -> b) -> [a] -> [b]
map (\Transition{state
cmd_
Double
to :: state
probability :: Double
command :: cmd_
to :: forall state cmd_ prob. Transition state cmd_ prob -> state
probability :: forall state cmd_ prob. Transition state cmd_ prob -> prob
command :: forall state cmd_ prob. Transition state cmd_ prob -> cmd_
..} -> (cmd_ -> state -> [Char]
forall state cmd_.
(Show state, Show cmd_) =>
cmd_ -> state -> [Char]
toTransitionString cmd_
command state
to, Double
probability)) [Transition state cmd_ Double]
ts) prop
ih

toTransitionString :: (Show state, Show cmd_) => cmd_ -> state -> String
toTransitionString :: cmd_ -> state -> [Char]
toTransitionString cmd_
cmd state
to = [Char]
"-< " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ cmd_ -> [Char]
forall a. Show a => a -> [Char]
show cmd_
cmd [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" >- " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ state -> [Char]
forall a. Show a => a -> [Char]
show state
to

-- | Variant of QuickCheck's 'tabulate' which works for 'Markov' chains.
tabulateMarkov :: forall model state cmd cmd_ m resp prop. Testable prop
               => (Show state, Show cmd_)
               => StateMachine model cmd m resp
               -> (model Symbolic -> state)
               -> (cmd Symbolic -> cmd_)
               -> Commands cmd resp
               -> prop
               -> Property
tabulateMarkov :: StateMachine model cmd m resp
-> (model Symbolic -> state)
-> (cmd Symbolic -> cmd_)
-> Commands cmd resp
-> prop
-> Property
tabulateMarkov StateMachine model cmd m resp
sm model Symbolic -> state
partition cmd Symbolic -> cmd_
constructor Commands cmd resp
cmds0 =
  [(state, Transition state cmd_ ())] -> prop -> Property
forall prob.
[(state, Transition state cmd_ prob)] -> prop -> Property
tabulateTransitions (StateMachine model cmd m resp
-> Commands cmd resp -> [(state, Transition state cmd_ ())]
commandsToTransitions StateMachine model cmd m resp
sm Commands cmd resp
cmds0)
  where
    tabulateTransitions :: [(state, Transition state cmd_ prob)]
                        -> prop
                        -> Property
    tabulateTransitions :: [(state, Transition state cmd_ prob)] -> prop -> Property
tabulateTransitions [(state, Transition state cmd_ prob)]
ts prop
prop = ((state, Transition state cmd_ prob) -> Property -> Property)
-> Property -> [(state, Transition state cmd_ prob)] -> Property
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (state, Transition state cmd_ prob) -> Property -> Property
forall prop a state cmd_ prob.
(Testable prop, Show a, Show state, Show cmd_) =>
(a, Transition state cmd_ prob) -> prop -> Property
go (prop -> Property
forall prop. Testable prop => prop -> Property
property prop
prop) [(state, Transition state cmd_ prob)]
ts
      where
        go :: (a, Transition state cmd_ prob) -> prop -> Property
go (a
from, Transition {prob
state
cmd_
to :: state
probability :: prob
command :: cmd_
to :: forall state cmd_ prob. Transition state cmd_ prob -> state
probability :: forall state cmd_ prob. Transition state cmd_ prob -> prob
command :: forall state cmd_ prob. Transition state cmd_ prob -> cmd_
..}) prop
ih =
          [Char] -> [[Char]] -> prop -> Property
forall prop.
Testable prop =>
[Char] -> [[Char]] -> prop -> Property
tabulate (a -> [Char]
forall a. Show a => a -> [Char]
show a
from) [ cmd_ -> state -> [Char]
forall state cmd_.
(Show state, Show cmd_) =>
cmd_ -> state -> [Char]
toTransitionString cmd_
command state
to ] prop
ih

    commandsToTransitions :: StateMachine model cmd m resp
                          -> Commands cmd resp
                          -> [(state, Transition state cmd_ ())]
    commandsToTransitions :: StateMachine model cmd m resp
-> Commands cmd resp -> [(state, Transition state cmd_ ())]
commandsToTransitions StateMachine { forall (r :: * -> *). model r
initModel :: forall (model :: (* -> *) -> *) (cmd :: (* -> *) -> *)
       (m :: * -> *) (resp :: (* -> *) -> *).
StateMachine model cmd m resp -> forall (r :: * -> *). model r
initModel :: forall (r :: * -> *). model r
initModel, forall (r :: * -> *).
(Show1 r, Ord1 r) =>
model r -> cmd r -> resp r -> model r
transition :: forall (model :: (* -> *) -> *) (cmd :: (* -> *) -> *)
       (m :: * -> *) (resp :: (* -> *) -> *).
StateMachine model cmd m resp
-> forall (r :: * -> *).
   (Show1 r, Ord1 r) =>
   model r -> cmd r -> resp r -> model r
transition :: forall (r :: * -> *).
(Show1 r, Ord1 r) =>
model r -> cmd r -> resp r -> model r
transition, model Symbolic -> cmd Symbolic -> GenSym (resp Symbolic)
mock :: forall (model :: (* -> *) -> *) (cmd :: (* -> *) -> *)
       (m :: * -> *) (resp :: (* -> *) -> *).
StateMachine model cmd m resp
-> model Symbolic -> cmd Symbolic -> GenSym (resp Symbolic)
mock :: model Symbolic -> cmd Symbolic -> GenSym (resp Symbolic)
mock } =
      model Symbolic
-> Counter
-> [(state, Transition state cmd_ ())]
-> [Command cmd resp]
-> [(state, Transition state cmd_ ())]
go model Symbolic
forall (r :: * -> *). model r
initModel Counter
newCounter [] ([Command cmd resp] -> [(state, Transition state cmd_ ())])
-> (Commands cmd resp -> [Command cmd resp])
-> Commands cmd resp
-> [(state, Transition state cmd_ ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Commands cmd resp -> [Command cmd resp]
forall (cmd :: (* -> *) -> *) (resp :: (* -> *) -> *).
Commands cmd resp -> [Command cmd resp]
unCommands
      where
        go :: model Symbolic -> Counter -> [(state, Transition state cmd_ ())]
           -> [Command cmd resp] -> [(state, Transition state cmd_ ())]
        go :: model Symbolic
-> Counter
-> [(state, Transition state cmd_ ())]
-> [Command cmd resp]
-> [(state, Transition state cmd_ ())]
go model Symbolic
_model Counter
_counter [(state, Transition state cmd_ ())]
acc []           = [(state, Transition state cmd_ ())]
acc
        go  model Symbolic
model  Counter
counter [(state, Transition state cmd_ ())]
acc (Command cmd resp
cmd : [Command cmd resp]
cmds) = model Symbolic
-> Counter
-> [(state, Transition state cmd_ ())]
-> [Command cmd resp]
-> [(state, Transition state cmd_ ())]
go model Symbolic
model' Counter
counter' ((state
from, Transition state cmd_ ()
t) (state, Transition state cmd_ ())
-> [(state, Transition state cmd_ ())]
-> [(state, Transition state cmd_ ())]
forall a. a -> [a] -> [a]
: [(state, Transition state cmd_ ())]
acc) [Command cmd resp]
cmds
          where
            from :: state
from   = model Symbolic -> state
partition model Symbolic
model
            cmd' :: cmd Symbolic
cmd'   = Command cmd resp -> cmd Symbolic
forall (cmd :: (* -> *) -> *) (resp :: (* -> *) -> *).
Command cmd resp -> cmd Symbolic
getCommand Command cmd resp
cmd
            model' :: model Symbolic
model' = model Symbolic -> cmd Symbolic -> resp Symbolic -> model Symbolic
forall (r :: * -> *).
(Show1 r, Ord1 r) =>
model r -> cmd r -> resp r -> model r
transition model Symbolic
model cmd Symbolic
cmd' resp Symbolic
resp

            (resp Symbolic
resp, Counter
counter') = GenSym (resp Symbolic) -> Counter -> (resp Symbolic, Counter)
forall a. GenSym a -> Counter -> (a, Counter)
runGenSym (model Symbolic -> cmd Symbolic -> GenSym (resp Symbolic)
mock model Symbolic
model cmd Symbolic
cmd') Counter
counter

            t :: Transition state cmd_ ()
t = Transition :: forall state cmd_ prob.
cmd_ -> prob -> state -> Transition state cmd_ prob
Transition
                  { command :: cmd_
command     = cmd Symbolic -> cmd_
constructor cmd Symbolic
cmd'
                  , probability :: ()
probability = ()
                  , to :: state
to          = model Symbolic -> state
partition model Symbolic
model'
                  }

------------------------------------------------------------------------

enumMatrix :: forall e a. (Generic e, GEnum FiniteEnum (Rep e), GBounded (Rep e))
           => ((e, e) -> a)
           -> Matrix a
enumMatrix :: ((e, e) -> a) -> Matrix a
enumMatrix (e, e) -> a
f = Int -> Int -> ((Int, Int) -> a) -> Matrix a
forall a. Int -> Int -> ((Int, Int) -> a) -> Matrix a
matrix Int
dimension Int
dimension ((e, e) -> a
f ((e, e) -> a) -> ((Int, Int) -> (e, e)) -> (Int, Int) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> e) -> (Int -> e) -> (Int, Int) -> (e, e)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Int -> e
g Int -> e
g)
  where
    g :: Int -> e
    g :: Int -> e
g = Int -> e
forall a. (Generic a, GEnum FiniteEnum (Rep a)) => Int -> a
gtoFiniteEnum (Int -> e) -> (Int -> Int) -> Int -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
pred -- We need the predecessor because 'matrix' starts
                             -- indexing from 1.

    dimension :: Int
    dimension :: Int
dimension = [e] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [e]
es

    es :: [e]
    es :: [e]
es = e -> e -> [e]
forall a. (Generic a, GEnum FiniteEnum (Rep a)) => a -> a -> [a]
gfiniteEnumFromTo e
forall a. (Generic a, GBounded (Rep a)) => a
gminBound e
forall a. (Generic a, GBounded (Rep a)) => a
gmaxBound

transitionMatrix :: forall state cmd_. Ord state
                 => (Generic state, GEnum FiniteEnum (Rep state), GBounded (Rep state))
                 => Markov state cmd_ Double
                 -> Matrix Double
transitionMatrix :: Markov state cmd_ Double -> Matrix Double
transitionMatrix Markov state cmd_ Double
markov = ((state, state) -> Double) -> Matrix Double
forall e a.
(Generic e, GEnum FiniteEnum (Rep e), GBounded (Rep e)) =>
((e, e) -> a) -> Matrix a
enumMatrix (state, state) -> Double
go
  where
    go :: (state, state) -> Double
    go :: (state, state) -> Double
go (state
state, state
state') = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0
      (state -> Map state Double -> Maybe Double
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup state
state' (Map state Double -> Maybe Double)
-> Maybe (Map state Double) -> Maybe Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< state -> Map state (Map state Double) -> Maybe (Map state Double)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup state
state Map state (Map state Double)
availableStates)

    availableStates :: Map state (Map state Double)
    availableStates :: Map state (Map state Double)
availableStates
      = ([Transition state cmd_ Double] -> Map state Double)
-> Map state [Transition state cmd_ Double]
-> Map state (Map state Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(state, Double)] -> Map state Double
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(state, Double)] -> Map state Double)
-> ([Transition state cmd_ Double] -> [(state, Double)])
-> [Transition state cmd_ Double]
-> Map state Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transition state cmd_ Double -> (state, Double))
-> [Transition state cmd_ Double] -> [(state, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (Transition state cmd_ Double -> state
forall state cmd_ prob. Transition state cmd_ prob -> state
to (Transition state cmd_ Double -> state)
-> (Transition state cmd_ Double -> Double)
-> Transition state cmd_ Double
-> (state, Double)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100) (Double -> Double)
-> (Transition state cmd_ Double -> Double)
-> Transition state cmd_ Double
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transition state cmd_ Double -> Double
forall state cmd_ prob. Transition state cmd_ prob -> prob
probability))
      (Map state [Transition state cmd_ Double]
 -> Map state (Map state Double))
-> (Markov state cmd_ Double
    -> Map state [Transition state cmd_ Double])
-> Markov state cmd_ Double
-> Map state (Map state Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Markov state cmd_ Double
-> Map state [Transition state cmd_ Double]
forall state cmd_ prob.
Markov state cmd_ prob -> Map state [Transition state cmd_ prob]
unMarkov
      (Markov state cmd_ Double -> Map state (Map state Double))
-> Markov state cmd_ Double -> Map state (Map state Double)
forall a b. (a -> b) -> a -> b
$ Markov state cmd_ Double
markov

enumMatrix'
  :: forall state cmd a
   . (Generic state, GEnum FiniteEnum (Rep state), GBounded (Rep state))
  => (Generic cmd,   GEnum FiniteEnum (Rep cmd),   GBounded (Rep cmd))
  => ((state, cmd) -> a)
  -> Matrix a
enumMatrix' :: ((state, cmd) -> a) -> Matrix a
enumMatrix' (state, cmd) -> a
f = Int -> Int -> ((Int, Int) -> a) -> Matrix a
forall a. Int -> Int -> ((Int, Int) -> a) -> Matrix a
matrix Int
m Int
n ((state, cmd) -> a
f ((state, cmd) -> a)
-> ((Int, Int) -> (state, cmd)) -> (Int, Int) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> state) -> (Int -> cmd) -> (Int, Int) -> (state, cmd)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Int -> state
g Int -> cmd
h)
  where
    g :: Int -> state
    g :: Int -> state
g = Int -> state
forall a. (Generic a, GEnum FiniteEnum (Rep a)) => Int -> a
gtoFiniteEnum (Int -> state) -> (Int -> Int) -> Int -> state
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
pred -- We need the predecessor because 'matrix' starts
                             -- indexing from 1.

    h :: Int -> cmd
    h :: Int -> cmd
h = Int -> cmd
forall a. (Generic a, GEnum FiniteEnum (Rep a)) => Int -> a
gtoFiniteEnum (Int -> cmd) -> (Int -> Int) -> Int -> cmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
pred

    m :: Int
    m :: Int
m = [state] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [state]
states

    n :: Int
    n :: Int
n = [cmd] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [cmd]
cmds

    states :: [state]
    states :: [state]
states = state -> state -> [state]
forall a. (Generic a, GEnum FiniteEnum (Rep a)) => a -> a -> [a]
gfiniteEnumFromTo state
forall a. (Generic a, GBounded (Rep a)) => a
gminBound state
forall a. (Generic a, GBounded (Rep a)) => a
gmaxBound

    cmds :: [cmd]
    cmds :: [cmd]
cmds = cmd -> cmd -> [cmd]
forall a. (Generic a, GEnum FiniteEnum (Rep a)) => a -> a -> [a]
gfiniteEnumFromTo cmd
forall a. (Generic a, GBounded (Rep a)) => a
gminBound cmd
forall a. (Generic a, GBounded (Rep a)) => a
gmaxBound

stimulusMatrix
  :: forall state cmd. (Ord state, Ord cmd)
  => (Generic state, GEnum FiniteEnum (Rep state), GBounded (Rep state))
  => (Generic cmd,   GEnum FiniteEnum (Rep cmd),   GBounded (Rep cmd))
  => Markov state cmd Double
  -> Matrix Double
stimulusMatrix :: Markov state cmd Double -> Matrix Double
stimulusMatrix Markov state cmd Double
markov = ((state, cmd) -> Double) -> Matrix Double
forall state cmd a.
(Generic state, GEnum FiniteEnum (Rep state), GBounded (Rep state),
 Generic cmd, GEnum FiniteEnum (Rep cmd), GBounded (Rep cmd)) =>
((state, cmd) -> a) -> Matrix a
enumMatrix' (state, cmd) -> Double
go
  where
    go :: (state, cmd) -> Double
    go :: (state, cmd) -> Double
go (state
state, cmd
cmd) = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0
      (cmd -> Map cmd Double -> Maybe Double
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup cmd
cmd (Map cmd Double -> Maybe Double)
-> Maybe (Map cmd Double) -> Maybe Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< state -> Map state (Map cmd Double) -> Maybe (Map cmd Double)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup state
state Map state (Map cmd Double)
availableCmds)

    availableCmds :: Map state (Map cmd Double)
    availableCmds :: Map state (Map cmd Double)
availableCmds
      = ([Transition state cmd Double] -> Map cmd Double)
-> Map state [Transition state cmd Double]
-> Map state (Map cmd Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(cmd, Double)] -> Map cmd Double
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(cmd, Double)] -> Map cmd Double)
-> ([Transition state cmd Double] -> [(cmd, Double)])
-> [Transition state cmd Double]
-> Map cmd Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transition state cmd Double -> (cmd, Double))
-> [Transition state cmd Double] -> [(cmd, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (Transition state cmd Double -> cmd
forall state cmd_ prob. Transition state cmd_ prob -> cmd_
command (Transition state cmd Double -> cmd)
-> (Transition state cmd Double -> Double)
-> Transition state cmd Double
-> (cmd, Double)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100) (Double -> Double)
-> (Transition state cmd Double -> Double)
-> Transition state cmd Double
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transition state cmd Double -> Double
forall state cmd_ prob. Transition state cmd_ prob -> prob
probability))
      (Map state [Transition state cmd Double]
 -> Map state (Map cmd Double))
-> (Markov state cmd Double
    -> Map state [Transition state cmd Double])
-> Markov state cmd Double
-> Map state (Map cmd Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Markov state cmd Double -> Map state [Transition state cmd Double]
forall state cmd_ prob.
Markov state cmd_ prob -> Map state [Transition state cmd_ prob]
unMarkov
      (Markov state cmd Double -> Map state (Map cmd Double))
-> Markov state cmd Double -> Map state (Map cmd Double)
forall a b. (a -> b) -> a -> b
$ Markov state cmd Double
markov

------------------------------------------------------------------------

historyObservations :: forall model cmd m resp state cmd_ prob. Ord state
                    => Ord cmd_
                    => (Generic state, GEnum FiniteEnum (Rep state), GBounded (Rep state))
                    => StateMachine model cmd m resp
                    -> Markov state cmd_ prob
                    -> (model Concrete -> state)
                    -> (cmd Concrete -> cmd_)
                    -> History cmd resp
                    -> ( Matrix Double
                       , Matrix Double
                       )
historyObservations :: StateMachine model cmd m resp
-> Markov state cmd_ prob
-> (model Concrete -> state)
-> (cmd Concrete -> cmd_)
-> History cmd resp
-> (Matrix Double, Matrix Double)
historyObservations StateMachine { forall (r :: * -> *). model r
initModel :: forall (r :: * -> *). model r
initModel :: forall (model :: (* -> *) -> *) (cmd :: (* -> *) -> *)
       (m :: * -> *) (resp :: (* -> *) -> *).
StateMachine model cmd m resp -> forall (r :: * -> *). model r
initModel, forall (r :: * -> *).
(Show1 r, Ord1 r) =>
model r -> cmd r -> resp r -> model r
transition :: forall (r :: * -> *).
(Show1 r, Ord1 r) =>
model r -> cmd r -> resp r -> model r
transition :: forall (model :: (* -> *) -> *) (cmd :: (* -> *) -> *)
       (m :: * -> *) (resp :: (* -> *) -> *).
StateMachine model cmd m resp
-> forall (r :: * -> *).
   (Show1 r, Ord1 r) =>
   model r -> cmd r -> resp r -> model r
transition, model Concrete -> cmd Concrete -> resp Concrete -> Logic
postcondition :: forall (model :: (* -> *) -> *) (cmd :: (* -> *) -> *)
       (m :: * -> *) (resp :: (* -> *) -> *).
StateMachine model cmd m resp
-> model Concrete -> cmd Concrete -> resp Concrete -> Logic
postcondition :: model Concrete -> cmd Concrete -> resp Concrete -> Logic
postcondition } Markov state cmd_ prob
markov model Concrete -> state
partition cmd Concrete -> cmd_
constructor
  = model Concrete
-> Map (state, state) Double
-> Map (state, state) Double
-> [Operation cmd resp]
-> (Matrix Double, Matrix Double)
forall a.
Num a =>
model Concrete
-> Map (state, state) a
-> Map (state, state) a
-> [Operation cmd resp]
-> (Matrix a, Matrix a)
go model Concrete
forall (r :: * -> *). model r
initModel Map (state, state) Double
forall k a. Map k a
Map.empty Map (state, state) Double
forall k a. Map k a
Map.empty ([Operation cmd resp] -> (Matrix Double, Matrix Double))
-> (History cmd resp -> [Operation cmd resp])
-> History cmd resp
-> (Matrix Double, Matrix Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. History' cmd resp -> [Operation cmd resp]
forall (cmd :: (* -> *) -> *) (resp :: (* -> *) -> *).
History' cmd resp -> [Operation cmd resp]
makeOperations (History' cmd resp -> [Operation cmd resp])
-> (History cmd resp -> History' cmd resp)
-> History cmd resp
-> [Operation cmd resp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. History cmd resp -> History' cmd resp
forall (cmd :: (* -> *) -> *) (resp :: (* -> *) -> *).
History cmd resp -> History' cmd resp
unHistory
  where
    go :: model Concrete
-> Map (state, state) a
-> Map (state, state) a
-> [Operation cmd resp]
-> (Matrix a, Matrix a)
go model Concrete
_model Map (state, state) a
ss Map (state, state) a
fs [] =
      ( ((state, state) -> a) -> Matrix a
forall e a.
(Generic e, GEnum FiniteEnum (Rep e), GBounded (Rep e)) =>
((e, e) -> a) -> Matrix a
enumMatrix @state (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
0 (Maybe a -> a)
-> ((state, state) -> Maybe a) -> (state, state) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((state, state) -> Map (state, state) a -> Maybe a)
-> Map (state, state) a -> (state, state) -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (state, state) -> Map (state, state) a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map (state, state) a
ss)
      , ((state, state) -> a) -> Matrix a
forall e a.
(Generic e, GEnum FiniteEnum (Rep e), GBounded (Rep e)) =>
((e, e) -> a) -> Matrix a
enumMatrix @state (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
0 (Maybe a -> a)
-> ((state, state) -> Maybe a) -> (state, state) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((state, state) -> Map (state, state) a -> Maybe a)
-> Map (state, state) a -> (state, state) -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (state, state) -> Map (state, state) a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map (state, state) a
fs)
      )
    go  model Concrete
model Map (state, state) a
ss Map (state, state) a
fs (Operation cmd resp
op : [Operation cmd resp]
ops) = case Operation cmd resp
op of
      Operation cmd Concrete
cmd resp Concrete
resp Pid
_pid ->
        let
          state :: state
state  = model Concrete -> state
partition model Concrete
model
          model' :: model Concrete
model' = model Concrete -> cmd Concrete -> resp Concrete -> model Concrete
forall (r :: * -> *).
(Show1 r, Ord1 r) =>
model r -> cmd r -> resp r -> model r
transition model Concrete
model cmd Concrete
cmd resp Concrete
resp
          state' :: state
state' = model Concrete -> state
partition model Concrete
model'
          incr :: Map (state, state) a -> Map (state, state) a
incr   = (a -> a -> a)
-> (state, state)
-> a
-> Map (state, state) a
-> Map (state, state) a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (\a
_new a
old -> a
old a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) (state
state, state
state') a
1
        in
          if Logic -> Bool
boolean (model Concrete -> cmd Concrete -> resp Concrete -> Logic
postcondition model Concrete
model cmd Concrete
cmd resp Concrete
resp)
          then model Concrete
-> Map (state, state) a
-> Map (state, state) a
-> [Operation cmd resp]
-> (Matrix a, Matrix a)
go model Concrete
model' (Map (state, state) a -> Map (state, state) a
incr Map (state, state) a
ss) Map (state, state) a
fs        [Operation cmd resp]
ops
          else model Concrete
-> Map (state, state) a
-> Map (state, state) a
-> [Operation cmd resp]
-> (Matrix a, Matrix a)
go model Concrete
model' Map (state, state) a
ss        (Map (state, state) a -> Map (state, state) a
incr Map (state, state) a
fs) [Operation cmd resp]
ops

      Crash cmd Concrete
cmd [Char]
_err Pid
_pid ->
        let
          state :: state
state  = model Concrete -> state
partition model Concrete
model
          state' :: state
state' = state -> Maybe state -> state
forall a. a -> Maybe a -> a
fromMaybe state
forall a. a
err
                     (cmd_ -> Map cmd_ state -> Maybe state
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (cmd Concrete -> cmd_
constructor cmd Concrete
cmd) (Map cmd_ state -> Maybe state)
-> Maybe (Map cmd_ state) -> Maybe state
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< state -> Map state (Map cmd_ state) -> Maybe (Map cmd_ state)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup state
state Map state (Map cmd_ state)
nextState)
          incr :: Map (state, state) a -> Map (state, state) a
incr   = (a -> a -> a)
-> (state, state)
-> a
-> Map (state, state) a
-> Map (state, state) a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (\a
_new a
old -> a
old a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) (state
state, state
state') a
1
        in
          model Concrete
-> Map (state, state) a
-> Map (state, state) a
-> [Operation cmd resp]
-> (Matrix a, Matrix a)
go model Concrete
model Map (state, state) a
ss (Map (state, state) a -> Map (state, state) a
incr Map (state, state) a
fs) [Operation cmd resp]
ops
        where
          err :: a
err = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"historyObservations: impossible."

    nextState :: Map state (Map cmd_ state)
    nextState :: Map state (Map cmd_ state)
nextState
      = ([Transition state cmd_ prob] -> Map cmd_ state)
-> Map state [Transition state cmd_ prob]
-> Map state (Map cmd_ state)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(cmd_, state)] -> Map cmd_ state
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(cmd_, state)] -> Map cmd_ state)
-> ([Transition state cmd_ prob] -> [(cmd_, state)])
-> [Transition state cmd_ prob]
-> Map cmd_ state
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transition state cmd_ prob -> (cmd_, state))
-> [Transition state cmd_ prob] -> [(cmd_, state)]
forall a b. (a -> b) -> [a] -> [b]
map (Transition state cmd_ prob -> cmd_
forall state cmd_ prob. Transition state cmd_ prob -> cmd_
command (Transition state cmd_ prob -> cmd_)
-> (Transition state cmd_ prob -> state)
-> Transition state cmd_ prob
-> (cmd_, state)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Transition state cmd_ prob -> state
forall state cmd_ prob. Transition state cmd_ prob -> state
to))
      (Map state [Transition state cmd_ prob]
 -> Map state (Map cmd_ state))
-> (Markov state cmd_ prob
    -> Map state [Transition state cmd_ prob])
-> Markov state cmd_ prob
-> Map state (Map cmd_ state)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Markov state cmd_ prob -> Map state [Transition state cmd_ prob]
forall state cmd_ prob.
Markov state cmd_ prob -> Map state [Transition state cmd_ prob]
unMarkov
      (Markov state cmd_ prob -> Map state (Map cmd_ state))
-> Markov state cmd_ prob -> Map state (Map cmd_ state)
forall a b. (a -> b) -> a -> b
$ Markov state cmd_ prob
markov

------------------------------------------------------------------------

markovToDot :: (Show state, Show cmd_, Show prob)
            => state -> state -> Markov state cmd_ prob -> String
markovToDot :: state -> state -> Markov state cmd_ prob -> [Char]
markovToDot state
source state
sink = [Char] -> [(state, [Transition state cmd_ prob])] -> [Char]
forall a a a a.
(Show a, Show a, Show a, Show a) =>
[Char] -> [(a, [Transition a a a])] -> [Char]
go ([Char]
"digraph g {\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
nodeColours) ([(state, [Transition state cmd_ prob])] -> [Char])
-> (Markov state cmd_ prob
    -> [(state, [Transition state cmd_ prob])])
-> Markov state cmd_ prob
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map state [Transition state cmd_ prob]
-> [(state, [Transition state cmd_ prob])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map state [Transition state cmd_ prob]
 -> [(state, [Transition state cmd_ prob])])
-> (Markov state cmd_ prob
    -> Map state [Transition state cmd_ prob])
-> Markov state cmd_ prob
-> [(state, [Transition state cmd_ prob])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Markov state cmd_ prob -> Map state [Transition state cmd_ prob]
forall state cmd_ prob.
Markov state cmd_ prob -> Map state [Transition state cmd_ prob]
unMarkov
  where
    nodeColours :: String
    nodeColours :: [Char]
nodeColours = [Char] -> [Char]
string (state -> [Char]
forall a. Show a => a -> [Char]
show state
source) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" [color=\"green\"]\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                  [Char] -> [Char]
string (state -> [Char]
forall a. Show a => a -> [Char]
show state
sink)   [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" [color=\"red\"]\n"

    go :: [Char] -> [(a, [Transition a a a])] -> [Char]
go [Char]
acc []                   = [Char]
acc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"}"
    go [Char]
acc ((a
from, [Transition a a a]
via) : [(a, [Transition a a a])]
more) = [Char] -> [(a, [Transition a a a])] -> [Char]
go [Char]
acc' [(a, [Transition a a a])]
more
      where
        acc' :: String
        acc' :: [Char]
acc' = [Char]
acc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
          [[Char]] -> [Char]
unlines [ [Char] -> [Char]
string (a -> [Char]
forall a. Show a => a -> [Char]
show a
from) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                    [Char]
" -> " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                    [Char] -> [Char]
string (a -> [Char]
forall a. Show a => a -> [Char]
show a
to) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                    [Char]
" [label=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
string (a -> [Char]
forall a. Show a => a -> [Char]
show a
cmd [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\\n(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
prob [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"%)") [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"]"
                  | Transition a
cmd a
prob a
to <- [Transition a a a]
via
                  ]

string :: String -> String
string :: [Char] -> [Char]
string [Char]
s = [Char]
"\"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\""

markovToPs :: (Show state, Show cmd_, Show prob)
           => state -> state -> Markov state cmd_ prob -> FilePath -> IO ()
markovToPs :: state -> state -> Markov state cmd_ prob -> [Char] -> IO ()
markovToPs state
source state
sink Markov state cmd_ prob
markov [Char]
out = do
  let dotFile :: [Char]
dotFile = [Char] -> [Char] -> [Char]
replaceExtension [Char]
out [Char]
"dot"
  [Char] -> [Char] -> IO ()
writeFile [Char]
dotFile (state -> state -> Markov state cmd_ prob -> [Char]
forall state cmd_ prob.
(Show state, Show cmd_, Show prob) =>
state -> state -> Markov state cmd_ prob -> [Char]
markovToDot state
source state
sink Markov state cmd_ prob
markov)
  [Char] -> [[Char]] -> IO ()
callProcess [Char]
"dot" [[Char]
"-Tps", [Char]
dotFile, [Char]
"-o", [Char]
out]

------------------------------------------------------------------------

data StatsDb m = StatsDb
  { StatsDb m -> (Matrix Double, Matrix Double) -> m ()
store :: (Matrix Double, Matrix Double) -> m ()
  , StatsDb m -> m (Maybe (Matrix Double, Matrix Double))
load  :: m (Maybe (Matrix Double, Matrix Double))
  }

type PropertyName = String

nullStatsDb :: Monad m => StatsDb m
nullStatsDb :: StatsDb m
nullStatsDb = StatsDb :: forall (m :: * -> *).
((Matrix Double, Matrix Double) -> m ())
-> m (Maybe (Matrix Double, Matrix Double)) -> StatsDb m
StatsDb
  { store :: (Matrix Double, Matrix Double) -> m ()
store = m () -> (Matrix Double, Matrix Double) -> m ()
forall a b. a -> b -> a
const (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  , load :: m (Maybe (Matrix Double, Matrix Double))
load  = Maybe (Matrix Double, Matrix Double)
-> m (Maybe (Matrix Double, Matrix Double))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Matrix Double, Matrix Double)
forall a. Maybe a
Nothing
  }

fileStatsDb :: FilePath -> PropertyName -> StatsDb IO
fileStatsDb :: [Char] -> [Char] -> StatsDb IO
fileStatsDb [Char]
fp [Char]
name = StatsDb :: forall (m :: * -> *).
((Matrix Double, Matrix Double) -> m ())
-> m (Maybe (Matrix Double, Matrix Double)) -> StatsDb m
StatsDb
  { store :: (Matrix Double, Matrix Double) -> IO ()
store = (Matrix Double, Matrix Double) -> IO ()
store
  , load :: IO (Maybe (Matrix Double, Matrix Double))
load  = IO (Maybe (Matrix Double, Matrix Double))
load
  }
  where
    store :: (Matrix Double, Matrix Double) -> IO ()
    store :: (Matrix Double, Matrix Double) -> IO ()
store (Matrix Double, Matrix Double)
observed = do
      [Char] -> [Char] -> IO ()
appendFile ([Char]
fp [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name) (([[Double]], [[Double]]) -> [Char]
forall a. Show a => a -> [Char]
show ((Matrix Double -> [[Double]])
-> (Matrix Double -> [[Double]])
-> (Matrix Double, Matrix Double)
-> ([[Double]], [[Double]])
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Matrix Double -> [[Double]]
forall a. Matrix a -> [[a]]
toLists Matrix Double -> [[Double]]
forall a. Matrix a -> [[a]]
toLists (Matrix Double, Matrix Double)
observed) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n")

    load :: IO (Maybe (Matrix Double, Matrix Double))
    load :: IO (Maybe (Matrix Double, Matrix Double))
load = do
      Maybe (Matrix Double, Matrix Double)
mprior <- [Char] -> Maybe (Matrix Double, Matrix Double)
parse     ([Char] -> Maybe (Matrix Double, Matrix Double))
-> IO [Char] -> IO (Maybe (Matrix Double, Matrix Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [Char]
readFile' ([Char]
fp [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-cache")
      Maybe [(Matrix Double, Matrix Double)]
mnew   <- [Char] -> Maybe [(Matrix Double, Matrix Double)]
parseMany ([Char] -> Maybe [(Matrix Double, Matrix Double)])
-> IO [Char] -> IO (Maybe [(Matrix Double, Matrix Double)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [Char]
readFile' ([Char]
fp [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name)

      let sumElem :: [Matrix Double] -> Matrix Double
          sumElem :: [Matrix Double] -> Matrix Double
sumElem = (Matrix Double -> Matrix Double -> Matrix Double)
-> [Matrix Double] -> Matrix Double
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 ((Double -> Double -> Double)
-> Matrix Double -> Matrix Double -> Matrix Double
forall a b c. (a -> b -> c) -> Matrix a -> Matrix b -> Matrix c
elementwise Double -> Double -> Double
forall a. Num a => a -> a -> a
(+))

      let mprior' :: Maybe (Matrix Double, Matrix Double)
mprior' = case (Maybe (Matrix Double, Matrix Double)
mprior, Maybe [(Matrix Double, Matrix Double)]
mnew) of
            (Just (Matrix Double
sprior, Matrix Double
fprior), Just [(Matrix Double, Matrix Double)]
new) ->
              (Matrix Double, Matrix Double)
-> Maybe (Matrix Double, Matrix Double)
forall a. a -> Maybe a
Just (([Matrix Double] -> Matrix Double)
-> ([Matrix Double] -> Matrix Double)
-> ([Matrix Double], [Matrix Double])
-> (Matrix Double, Matrix Double)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [Matrix Double] -> Matrix Double
sumElem [Matrix Double] -> Matrix Double
sumElem (([Matrix Double] -> [Matrix Double])
-> ([Matrix Double] -> [Matrix Double])
-> ([Matrix Double], [Matrix Double])
-> ([Matrix Double], [Matrix Double])
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Matrix Double
sprior Matrix Double -> [Matrix Double] -> [Matrix Double]
forall a. a -> [a] -> [a]
:) (Matrix Double
fprior Matrix Double -> [Matrix Double] -> [Matrix Double]
forall a. a -> [a] -> [a]
:) ([(Matrix Double, Matrix Double)]
-> ([Matrix Double], [Matrix Double])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Matrix Double, Matrix Double)]
new)))
            (Maybe (Matrix Double, Matrix Double)
Nothing, Just [(Matrix Double, Matrix Double)]
new)   -> (Matrix Double, Matrix Double)
-> Maybe (Matrix Double, Matrix Double)
forall a. a -> Maybe a
Just (([Matrix Double] -> Matrix Double)
-> ([Matrix Double] -> Matrix Double)
-> ([Matrix Double], [Matrix Double])
-> (Matrix Double, Matrix Double)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [Matrix Double] -> Matrix Double
sumElem [Matrix Double] -> Matrix Double
sumElem ([(Matrix Double, Matrix Double)]
-> ([Matrix Double], [Matrix Double])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Matrix Double, Matrix Double)]
new))
            (Just (Matrix Double, Matrix Double)
prior, Maybe [(Matrix Double, Matrix Double)]
Nothing) -> (Matrix Double, Matrix Double)
-> Maybe (Matrix Double, Matrix Double)
forall a. a -> Maybe a
Just (Matrix Double, Matrix Double)
prior
            (Maybe (Matrix Double, Matrix Double)
Nothing, Maybe [(Matrix Double, Matrix Double)]
Nothing)    -> Maybe (Matrix Double, Matrix Double)
forall a. Maybe a
Nothing

      case Maybe (Matrix Double, Matrix Double)
mprior' of
        Just (Matrix Double, Matrix Double)
prior' -> [Char] -> [Char] -> IO ()
writeFile  ([Char]
fp [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-cache") (([[Double]], [[Double]]) -> [Char]
forall a. Show a => a -> [Char]
show ((Matrix Double -> [[Double]])
-> (Matrix Double -> [[Double]])
-> (Matrix Double, Matrix Double)
-> ([[Double]], [[Double]])
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Matrix Double -> [[Double]]
forall a. Matrix a -> [[a]]
toLists Matrix Double -> [[Double]]
forall a. Matrix a -> [[a]]
toLists (Matrix Double, Matrix Double)
prior'))
        Maybe (Matrix Double, Matrix Double)
Nothing     -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

      [Char] -> IO ()
removeFile ([Char]
fp [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name)

      Maybe (Matrix Double, Matrix Double)
-> IO (Maybe (Matrix Double, Matrix Double))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Matrix Double, Matrix Double)
mprior'

      where
        parseMany :: String -> Maybe ([(Matrix Double, Matrix Double)])
        parseMany :: [Char] -> Maybe [(Matrix Double, Matrix Double)]
parseMany = [Maybe (Matrix Double, Matrix Double)]
-> Maybe [(Matrix Double, Matrix Double)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
                  ([Maybe (Matrix Double, Matrix Double)]
 -> Maybe [(Matrix Double, Matrix Double)])
-> ([Char] -> [Maybe (Matrix Double, Matrix Double)])
-> [Char]
-> Maybe [(Matrix Double, Matrix Double)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Maybe (Matrix Double, Matrix Double))
-> [[Char]] -> [Maybe (Matrix Double, Matrix Double)]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Maybe (Matrix Double, Matrix Double)
parse
                  ([[Char]] -> [Maybe (Matrix Double, Matrix Double)])
-> ([Char] -> [[Char]])
-> [Char]
-> [Maybe (Matrix Double, Matrix Double)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines

        parse :: String -> Maybe (Matrix Double, Matrix Double)
        parse :: [Char] -> Maybe (Matrix Double, Matrix Double)
parse = (([[Double]], [[Double]]) -> (Matrix Double, Matrix Double))
-> Maybe ([[Double]], [[Double]])
-> Maybe (Matrix Double, Matrix Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([[Double]] -> Matrix Double)
-> ([[Double]] -> Matrix Double)
-> ([[Double]], [[Double]])
-> (Matrix Double, Matrix Double)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [[Double]] -> Matrix Double
forall a. [[a]] -> Matrix a
fromLists [[Double]] -> Matrix Double
forall a. [[a]] -> Matrix a
fromLists) (Maybe ([[Double]], [[Double]])
 -> Maybe (Matrix Double, Matrix Double))
-> ([Char] -> Maybe ([[Double]], [[Double]]))
-> [Char]
-> Maybe (Matrix Double, Matrix Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe ([[Double]], [[Double]])
forall a. Read a => [Char] -> Maybe a
readMaybe

    readFile' :: FilePath -> IO String
    readFile' :: [Char] -> IO [Char]
readFile' [Char]
file = Handle -> IO [Char]
hGetContents (Handle -> IO [Char]) -> IO Handle -> IO [Char]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char] -> IOMode -> IO Handle
openFile [Char]
file IOMode
ReadWriteMode

persistStats :: Monad m
             => StatsDb m -> (Matrix Double, Matrix Double) -> PropertyM m ()
persistStats :: StatsDb m -> (Matrix Double, Matrix Double) -> PropertyM m ()
persistStats StatsDb { (Matrix Double, Matrix Double) -> m ()
store :: (Matrix Double, Matrix Double) -> m ()
store :: forall (m :: * -> *).
StatsDb m -> (Matrix Double, Matrix Double) -> m ()
store } = m () -> PropertyM m ()
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run (m () -> PropertyM m ())
-> ((Matrix Double, Matrix Double) -> m ())
-> (Matrix Double, Matrix Double)
-> PropertyM m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Matrix Double, Matrix Double) -> m ()
store

computeReliability :: Monad m
                   => StatsDb m -> Matrix Double -> (Matrix Double, Matrix Double)
                   -> m (Double, Double)
computeReliability :: StatsDb m
-> Matrix Double
-> (Matrix Double, Matrix Double)
-> m (Double, Double)
computeReliability StatsDb { m (Maybe (Matrix Double, Matrix Double))
load :: m (Maybe (Matrix Double, Matrix Double))
load :: forall (m :: * -> *).
StatsDb m -> m (Maybe (Matrix Double, Matrix Double))
load } Matrix Double
usage (Matrix Double, Matrix Double)
observed = do
  Maybe (Matrix Double, Matrix Double)
mpriors <- m (Maybe (Matrix Double, Matrix Double))
load

  (Double, Double) -> m (Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Matrix Double
-> Maybe (Matrix Double, Matrix Double)
-> (Matrix Double, Matrix Double)
-> (Double, Double)
singleUseReliability (Matrix Double -> Matrix Double
forall a. Matrix a -> Matrix a
reduce Matrix Double
usage) Maybe (Matrix Double, Matrix Double)
mpriors ((Matrix Double -> Matrix Double)
-> (Matrix Double -> Matrix Double)
-> (Matrix Double, Matrix Double)
-> (Matrix Double, Matrix Double)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Matrix Double -> Matrix Double
forall a. Matrix a -> Matrix a
reduce Matrix Double -> Matrix Double
forall a. Matrix a -> Matrix a
reduce (Matrix Double, Matrix Double)
observed))
    where
      n :: Int
n      = Matrix Double -> Int
forall a. Matrix a -> Int
ncols Matrix Double
usage
      m :: Int
m      = Int -> Int
forall a. Enum a => a -> a
pred Int
n
      reduce :: Matrix a -> Matrix a
reduce = Int -> Int -> Int -> Int -> Matrix a -> Matrix a
forall a. Int -> Int -> Int -> Int -> Matrix a -> Matrix a
submatrix Int
1 Int
m Int
1 Int
n

printReliability :: Testable prop
                 => StatsDb IO -> Matrix Double -> (Matrix Double, Matrix Double)
                 -> prop -> Property
printReliability :: StatsDb IO
-> Matrix Double
-> (Matrix Double, Matrix Double)
-> prop
-> Property
printReliability StatsDb IO
sdb Matrix Double
usage (Matrix Double, Matrix Double)
observed = Callback -> prop -> Property
forall prop. Testable prop => Callback -> prop -> Property
callback (Callback -> prop -> Property) -> Callback -> prop -> Property
forall a b. (a -> b) -> a -> b
$ CallbackKind -> (State -> Result -> IO ()) -> Callback
PostTest CallbackKind
NotCounterexample ((State -> Result -> IO ()) -> Callback)
-> (State -> Result -> IO ()) -> Callback
forall a b. (a -> b) -> a -> b
$ \State
_state Result
_result ->
  (Double, Double) -> IO ()
forall a. Show a => a -> IO ()
print ((Double, Double) -> IO ()) -> IO (Double, Double) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StatsDb IO
-> Matrix Double
-> (Matrix Double, Matrix Double)
-> IO (Double, Double)
forall (m :: * -> *).
Monad m =>
StatsDb m
-> Matrix Double
-> (Matrix Double, Matrix Double)
-> m (Double, Double)
computeReliability StatsDb IO
sdb Matrix Double
usage (Matrix Double, Matrix Double)
observed

quickCheckReliability :: Testable prop
                      => StatsDb IO -> Matrix Double -> prop -> IO ()
quickCheckReliability :: StatsDb IO -> Matrix Double -> prop -> IO ()
quickCheckReliability StatsDb IO
sdb Matrix Double
usage prop
prop = do
  prop -> IO ()
forall prop. Testable prop => prop -> IO ()
quickCheck prop
prop
  (Double, Double) -> IO ()
forall a. Show a => a -> IO ()
print ((Double, Double) -> IO ()) -> IO (Double, Double) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StatsDb IO
-> Matrix Double
-> (Matrix Double, Matrix Double)
-> IO (Double, Double)
forall (m :: * -> *).
Monad m =>
StatsDb m
-> Matrix Double
-> (Matrix Double, Matrix Double)
-> m (Double, Double)
computeReliability StatsDb IO
sdb Matrix Double
usage (Matrix Double, Matrix Double)
observed
    where
      observed :: (Matrix Double, Matrix Double)
observed = ( Int -> Int -> Matrix Double
forall a. Num a => Int -> Int -> Matrix a
zero (Matrix Double -> Int
forall a. Matrix a -> Int
nrows Matrix Double
usage) (Matrix Double -> Int
forall a. Matrix a -> Int
ncols Matrix Double
usage)
                 , Int -> Int -> Matrix Double
forall a. Num a => Int -> Int -> Matrix a
zero (Matrix Double -> Int
forall a. Matrix a -> Int
nrows Matrix Double
usage) (Matrix Double -> Int
forall a. Matrix a -> Int
ncols Matrix Double
usage)
                 )

testChainToDot :: forall state cmd_ prob m. (Show state, Ord state, Monad m)
               => (Generic state, GEnum FiniteEnum (Rep state))
               => StatsDb m -> state -> state -> Markov state cmd_ prob -> m String
testChainToDot :: StatsDb m -> state -> state -> Markov state cmd_ prob -> m [Char]
testChainToDot StatsDb { m (Maybe (Matrix Double, Matrix Double))
load :: m (Maybe (Matrix Double, Matrix Double))
load :: forall (m :: * -> *).
StatsDb m -> m (Maybe (Matrix Double, Matrix Double))
load } state
source state
sink Markov state cmd_ prob
markov = do
  Maybe (Matrix Double, Matrix Double)
mpriors <- m (Maybe (Matrix Double, Matrix Double))
load
  case Maybe (Matrix Double, Matrix Double)
mpriors of
    Maybe (Matrix Double, Matrix Double)
Nothing     -> [Char] -> m [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"testChainToDot: no test chain exists"
    Just (Matrix Double, Matrix Double)
priors -> [Char] -> m [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return
      ([Char]
-> (Matrix Double, Matrix Double) -> [(state, state)] -> [Char]
go ([Char]
"digraph g {\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
nodeColours) (Matrix Double, Matrix Double)
priors [(state, state)]
markovStatePairs)
    where
    nodeColours :: String
    nodeColours :: [Char]
nodeColours = [Char] -> [Char]
string (state -> [Char]
forall a. Show a => a -> [Char]
show state
source) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" [color=\"green\"]\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                  [Char] -> [Char]
string (state -> [Char]
forall a. Show a => a -> [Char]
show state
sink)   [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" [color=\"red\"]\n"

    go :: String -> (Matrix Double, Matrix Double) -> [(state, state)] -> String
    go :: [Char]
-> (Matrix Double, Matrix Double) -> [(state, state)] -> [Char]
go [Char]
acc (Matrix Double, Matrix Double)
_priors               []                  = [Char]
acc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"}"
    go [Char]
acc (Matrix Double
successes, Matrix Double
failures) ((state
from, state
to) : [(state, state)]
more) = [Char]
-> (Matrix Double, Matrix Double) -> [(state, state)] -> [Char]
go [Char]
acc' (Matrix Double
successes, Matrix Double
failures) [(state, state)]
more
      where
        acc' :: String
        acc' :: [Char]
acc' = [Char]
acc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
          [Char] -> [Char]
string (state -> [Char]
forall a. Show a => a -> [Char]
show state
from) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
          [Char]
" -> " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
          [Char] -> [Char]
string (state -> [Char]
forall a. Show a => a -> [Char]
show state
to) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
          [Char]
" [label=<(<font color='green'>" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (state -> state -> Matrix Double -> Int
lookupStates state
from state
to Matrix Double
successes) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"</font>"
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++    [Char]
", <font color='red'>"   [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (state -> state -> Matrix Double -> Int
lookupStates state
from state
to Matrix Double
failures)  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"</font>)>]\n"

    markovStatePairs :: [(state, state)]
    markovStatePairs :: [(state, state)]
markovStatePairs
      = Set (state, state) -> [(state, state)]
forall a. Set a -> [a]
Set.toList
      (Set (state, state) -> [(state, state)])
-> (Markov state cmd_ prob -> Set (state, state))
-> Markov state cmd_ prob
-> [(state, state)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (state, state) -> (state, [state]) -> Set (state, state))
-> Set (state, state) -> [(state, [state])] -> Set (state, state)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Set (state, state)
ih (state
from, [state]
tos) -> Set (state, state)
ih Set (state, state) -> Set (state, state) -> Set (state, state)
forall a. Ord a => Set a -> Set a -> Set a
`Set.union`
                  (Set (state, state) -> state -> Set (state, state))
-> Set (state, state) -> [state] -> Set (state, state)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Set (state, state)
ih' state
to -> (state, state) -> Set (state, state) -> Set (state, state)
forall a. Ord a => a -> Set a -> Set a
Set.insert (state
from, state
to) Set (state, state)
ih') Set (state, state)
forall a. Set a
Set.empty [state]
tos)
              Set (state, state)
forall a. Set a
Set.empty
      ([(state, [state])] -> Set (state, state))
-> (Markov state cmd_ prob -> [(state, [state])])
-> Markov state cmd_ prob
-> Set (state, state)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((state, [Transition state cmd_ prob]) -> (state, [state]))
-> [(state, [Transition state cmd_ prob])] -> [(state, [state])]
forall a b. (a -> b) -> [a] -> [b]
map (([Transition state cmd_ prob] -> [state])
-> (state, [Transition state cmd_ prob]) -> (state, [state])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Transition state cmd_ prob -> state)
-> [Transition state cmd_ prob] -> [state]
forall a b. (a -> b) -> [a] -> [b]
map Transition state cmd_ prob -> state
forall state cmd_ prob. Transition state cmd_ prob -> state
to))
      ([(state, [Transition state cmd_ prob])] -> [(state, [state])])
-> (Markov state cmd_ prob
    -> [(state, [Transition state cmd_ prob])])
-> Markov state cmd_ prob
-> [(state, [state])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map state [Transition state cmd_ prob]
-> [(state, [Transition state cmd_ prob])]
forall k a. Map k a -> [(k, a)]
Map.toList
      (Map state [Transition state cmd_ prob]
 -> [(state, [Transition state cmd_ prob])])
-> (Markov state cmd_ prob
    -> Map state [Transition state cmd_ prob])
-> Markov state cmd_ prob
-> [(state, [Transition state cmd_ prob])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Markov state cmd_ prob -> Map state [Transition state cmd_ prob]
forall state cmd_ prob.
Markov state cmd_ prob -> Map state [Transition state cmd_ prob]
unMarkov
      (Markov state cmd_ prob -> [(state, state)])
-> Markov state cmd_ prob -> [(state, state)]
forall a b. (a -> b) -> a -> b
$ Markov state cmd_ prob
markov

    lookupStates :: state -> state -> Matrix Double -> Int
    lookupStates :: state -> state -> Matrix Double -> Int
lookupStates state
from state
to = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int)
-> (Matrix Double -> Double) -> Matrix Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Matrix Double -> Double
forall a. Int -> Int -> Matrix a -> a
getElem (state -> Int
forall a. (Generic a, GEnum FiniteEnum (Rep a)) => a -> Int
gfromFiniteEnum state
from Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (state -> Int
forall a. (Generic a, GEnum FiniteEnum (Rep a)) => a -> Int
gfromFiniteEnum state
to Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)