diff --git a/src/Test/StateMachine/Markov.hs b/src/Test/StateMachine/Markov.hs index ae5921e4..068d56cf 100644 --- a/src/Test/StateMachine/Markov.hs +++ b/src/Test/StateMachine/Markov.hs @@ -29,6 +29,7 @@ module Test.StateMachine.Markov , coverMarkov , tabulateMarkov , transitionMatrix + , stimulusMatrix , historyObservations , markovToDot , markovToPs @@ -274,6 +275,51 @@ transitionMatrix markov = enumMatrix go . unMarkov $ 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' f = matrix m n (f . bimap g h) + where + g :: Int -> state + g = gtoFiniteEnum . pred -- We need the predecessor because 'matrix' starts + -- indexing from 1. + + h :: Int -> cmd + h = gtoFiniteEnum . pred + + m :: Int + m = length states + + n :: Int + n = length cmds + + states :: [state] + states = gfiniteEnumFromTo gminBound gmaxBound + + cmds :: [cmd] + cmds = gfiniteEnumFromTo gminBound 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 = enumMatrix' go + where + go :: (state, cmd) -> Double + go (state, cmd) = fromMaybe 0 + (Map.lookup cmd =<< Map.lookup state availableCmds) + + availableCmds :: Map state (Map cmd Double) + availableCmds + = fmap (Map.fromList . map (command &&& (/ 100) . probability)) + . unMarkov + $ markov + ------------------------------------------------------------------------ historyObservations :: forall model cmd m resp state cmd_ prob. Ord state diff --git a/test/ProcessRegistry.hs b/test/ProcessRegistry.hs index c67f0acb..c7b67117 100644 --- a/test/ProcessRegistry.hs +++ b/test/ProcessRegistry.hs @@ -213,7 +213,7 @@ data Action_ | BadUnregister_ | WhereIs_ | Exit_ - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Generic) constructor :: Action r -> Action_ constructor act = case act of