{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
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)
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
}
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
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 -<
(-<) :: 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
infixl 5 >-
(>-) :: (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 /-
(/-) :: 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)
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_)
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
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
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
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)