Merge pull request #322 from advancedtelematic/feat/stimulus-matrix

add stimulus matrix

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

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