Add observable probability

app/Main.hs

@@ -4,17 +4,7 @@ import Examples.Decision
 import Examples.SimultaneousMoves
 import Examples.SequentialMoves
 
+import Examples.Staking.AndGateMarkov
 
 main = do
-  putStrLn "Single decision -->"
-  isOptimalSingleDecisionVerbose (pureIdentity 4)
-  putStrLn "\n Single decision -->"
-  isOptimalSingleDecisionVerbose (pureIdentity 5)
-  putStrLn "\n Single decision with stochastic environment -->"
-  isOptimalSingleDecisionStoch peak
-  putStrLn "\n Prisoner's dilemma both cooperate -->"
-  isEquilibriumPrisonersDilemma strategTupleCooperate
-  putStrLn "\n Prisoner's dilemma both defect -->"
-  isEquilibriumPrisonersDilemma strategTupleDefect
-  putStrLn "\n Matching Pennies - mixed with equal prob -->"
-  isEquilibriumMatchingPennies strategyTupleMixed
+  testEq 2

package.yaml

@@ -40,6 +40,7 @@ library:
     - Examples.Markov.RepeatedPD
     - Examples.Markov.RepeatedPDNonState
     - Examples.Markov.TwoStageMarkov
+    - Examples.Staking.AndGateMarkov
 
 dependencies:
     - base >=4.7 && <5
@@ -56,7 +57,8 @@ dependencies:
     - haskeline
     - hashmap
     - hashable
-    - extra 
+    - extra
+    - bytestring
 
 executables:
   open-games-exe:
@@ -81,4 +83,3 @@ benchmarks:
     dependencies:
       - open-games-hs
       - criterion
-

src/Engine/AtomicGames.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ExtendedDefaultRules #-}
 
 module Engine.AtomicGames
  ( decision
@@ -141,4 +142,3 @@ generateGame "pureDecision2" ["actionSpace","payoffFunction","playerName"] $
   (Block ["observation"] []
          [Line [[|observation|]] [] [|dependentDecision playerName (\y -> actionSpace)|] ["action"] [[|payoffFunction observation action returns|]]]
          [[|action|]] ["returns"])
-

src/Engine/BayesianGames.hs

@@ -36,7 +36,7 @@ import           Data.HashMap                       as HM hiding (null,map,mapMa
 import Data.List (maximumBy)
 import Data.Ord (comparing)
 import           Data.Utils
-import Numeric.Probability.Distribution hiding (map, lift, filter)
+import Numeric.Probability.Distribution.Observable hiding (map, lift, filter)
 
 import Engine.OpenGames hiding (lift)
 import Engine.OpticClass

src/Engine/BayesianGamesNonState.hs

@@ -34,7 +34,7 @@ import           Data.HashMap                       as HM hiding (null,map,mapMa
 import Data.List (maximumBy)
 import Data.Ord (comparing)
 import           Data.Utils
-import Numeric.Probability.Distribution hiding (map, lift, filter)
+import Numeric.Probability.Distribution.Observable hiding (map, lift, filter)
 
 import Engine.OpenGames hiding (lift)
 import Engine.OpticClass

src/Engine/OpticClass.hs

@@ -21,7 +21,7 @@ module Engine.OpticClass
 
 import           Control.Monad.State                hiding (state)
 import           Data.HashMap                       as HM hiding (null,map,mapMaybe)
-import           Numeric.Probability.Distribution   hiding (lift)
+import           Numeric.Probability.Distribution.Observable   hiding (lift)
 
 class Optic o where
   lens :: (s -> a) -> (s -> b -> t) -> o s t a b

src/Examples/Markov/NStageMarkov.hs

@@ -14,7 +14,7 @@ import           Examples.SimultaneousMoves (ActionPD(..), Location(..))
 import           Control.Monad.State  hiding (state,void)
 import qualified Control.Monad.State  as ST
 
-import Numeric.Probability.Distribution hiding (map, lift, filter)
+import Numeric.Probability.Distribution.Observable hiding (map, lift, filter)
 
 
 

src/Examples/Markov/RepeatedPD.hs

@@ -14,7 +14,7 @@ import           Examples.SimultaneousMoves (ActionPD(..),prisonersDilemmaMatrix
 import           Control.Monad.State  hiding (state,void)
 import qualified Control.Monad.State  as ST
 
-import Numeric.Probability.Distribution hiding (map, lift, filter)
+import Numeric.Probability.Distribution.Observable hiding (map, lift, filter)
 
 prisonersDilemma  :: OpenGame
                               StochasticStatefulOptic
@@ -27,7 +27,7 @@ prisonersDilemma  :: OpenGame
                               ()
                               (ActionPD, ActionPD)
                               ()
-discountFactor = 0.5
+discountFactor = 0.9
 
 prisonersDilemma = [opengame|
 
@@ -68,6 +68,15 @@ stageStrategy = Kleisli $
 -- Stage strategy tuple
 strategyTuple = stageStrategy ::- stageStrategy ::- Nil
 
+stageStrategy' :: Kleisli Stochastic (ActionPD, ActionPD) ActionPD
+stageStrategy' = Kleisli $
+   (\case
+       (Cooperate,Cooperate) -> uniformDist [Cooperate,Defect]
+       (_,_)         -> uniformDist [Cooperate,Defect])
+-- Stage strategy tuple
+strategyTuple' = stageStrategy ::- stageStrategy ::- Nil
+
+
 
 -- extract continuation
 extractContinuation :: StochasticStatefulOptic s () a () -> s -> StateT Vector Stochastic ()
@@ -85,22 +94,39 @@ executeStrat strat =  play prisonersDilemma strat
 
 
 -- determine continuation for iterator, with the same repeated strategy
-determineContinuationPayoffs :: Integer
+determineContinuationPayoffs__ :: Integer
                              -> List
                                       '[Kleisli Stochastic (ActionPD, ActionPD) ActionPD,
                                         Kleisli Stochastic (ActionPD, ActionPD) ActionPD]
                              -> (ActionPD,ActionPD)
                              -> StateT Vector Stochastic ()
-determineContinuationPayoffs 1        strat action = pure ()
-determineContinuationPayoffs iterator strat action = do
+determineContinuationPayoffs__ 1        strat action = pure ()
+determineContinuationPayoffs__ iterator strat action = do
    extractContinuation executeStrat action
    nextInput <- ST.lift $ extractNextState executeStrat action
-   determineContinuationPayoffs (pred iterator) strat nextInput
+   determineContinuationPayoffs__ (pred iterator) strat nextInput
  where executeStrat =  play prisonersDilemma strat
 
 
+-- Random prior indpendent of previous moves
+determineContinuationPayoffs  iterator strat action = do
+  ST.lift $ note "determineContinuationPayoffs"
+  go  iterator strat action
+  where
+    go  1 strat action = ST.lift $ note "go[1]"
+    go  iterator strat action = do
+      ST.lift $ note ("go[" ++ show iterator ++ "]")
+      extractContinuation executeStrat action
+      ST.lift $ note "nextState"
+      nextInput <- ST.lift $ extractNextState executeStrat action
+      go (pred iterator) strat nextInput
+      where
+        executeStrat = play prisonersDilemma strat
+
+
+
 -- fix context used for the evaluation
-contextCont iterator strat initialAction = StochasticStatefulContext (pure ((),initialAction)) (\_ action -> trace ",,1" (determineContinuationPayoffs iterator strat action))
+contextCont iterator strat initialAction = StochasticStatefulContext (pure ((),initialAction)) (\_ action -> determineContinuationPayoffs iterator strat action)
 
 
 
@@ -112,3 +138,8 @@ repeatedPDEq iterator strat initialAction = evaluate prisonersDilemma strat cont
 
 
 eqOutput iterator strat initialAction = generateIsEq $ repeatedPDEq iterator strat initialAction
+
+
+testEq iterator = eqOutput iterator strategyTuple (Cooperate,Cooperate)
+
+testEq' iterator = eqOutput iterator strategyTuple' (Cooperate,Cooperate)

src/Examples/Markov/RepeatedPDNonState.hs

@@ -24,7 +24,7 @@ import           Engine.BayesianGamesNonState
 import           Preprocessor.Preprocessor
 
 
-import Numeric.Probability.Distribution hiding (map, lift, filter)
+import Numeric.Probability.Distribution.Observable hiding (map, lift, filter)
 
 -- 1.0. Prisoner's dilemma
 data ActionPD = Cooperate | Defect

src/Examples/Markov/TwoStageMarkov.hs

@@ -14,7 +14,7 @@ import           Examples.SimultaneousMoves (ActionPD(..), Location(..))
 import           Control.Monad.State  hiding (state,void)
 import qualified Control.Monad.State  as ST
 
-import Numeric.Probability.Distribution hiding (map, lift, filter)
+import Numeric.Probability.Distribution.Observable hiding (map, lift, filter)