module Bayes.Examples.Influence(
exampleID
, student
, studentSimple
, market
, studentDecisionVars
, studentSimpleDecisionVar
, theTest
, policyTest
, marketTest
) where
import Bayes.InfluenceDiagram
import Bayes(printGraphValues)
import Bayes.Factor(forAllInstantiations,dv,instantiationValue,DVSet(..))
exampleID :: InfluenceDiagram
exampleID = snd . runID $ do
a <- chance "A" (t :: Bool)
d1 <- decisionNode "D" (t :: Bool)
u <- utilityNode "U"
proba a ~~ [0.8,0.1]
decision d1 [a]
utility u [d d1,p a] ~~ [1,10,8,2]
return ()
data E = Dont | Do deriving(Eq,Enum,Bounded)
data I = Low | Average | High deriving(Eq,Enum,Bounded)
data S = Found | DontFound deriving(Eq,Enum,Bounded)
studentSimpleDecisionVar :: DEV
studentSimple :: InfluenceDiagram
(studentSimpleDecisionVar,studentSimple) = runID $ do
e <- decisionNode "E" (t :: E)
uc <- utilityNode "UC"
ub <- utilityNode "UB"
i <- chance "I" (t :: I)
pr <- chance "P" (t :: Bool)
cpt pr [d e] ~~ [10.0000001,1 0.001,0.0000001, 0.001]
cpt i [p pr, d e] ~~ [0.2,0.1,0.01,0.01,0.6,0.5,0.04,0.04,0.2,0.4,0.95,0.95]
decision e noDependencies
utility uc [e] ~~ [0,50000]
utility ub [i] ~~ [100000,200000,500000]
return e
theTest = do
print studentSimple
printGraphValues studentSimple
putStrLn "RESULT"
print $ solveInfluenceDiagram studentSimple
putStrLn "----"
print student
printGraphValues student
putStrLn "RESULT"
print $ solveInfluenceDiagram student
policyTest = do
print student
printGraphValues student
let l = solveInfluenceDiagram student
g = policyNetwork l student
print g
printGraphValues g
studentDecisionVars :: (DEV,TDV Bool,DEV)
student :: InfluenceDiagram
(studentDecisionVars,student) = runID $ do
e <- decisionNode "E" (t :: E)
s <- decisionNode "S" (t :: S)
uc <- utilityNode "UC"
ub <- utilityNode "UB"
us <- utilityNode "US"
pr <- chance "P" (t :: Bool)
i <- chance "I" (t :: I)
cpt pr [d e] ~~ [10.0000001,1 0.001,0.0000001, 0.001]
cpt i [p pr, d s] ~~ [0.2,0.1,0.05,0.005, 0.6,0.5,0.15,0.005,0.2,0.4,0.8,0.99]
decision s [pr]
decision e noDependencies
utility uc [e] ~~ [0,50000]
utility ub [i] ~~ [100000,200000,500000]
utility us [s] ~~ [0,200000]
return (e,pr,s)
data F = Forecast | NoForecast deriving(Eq,Enum,Bounded)
data IN = Choice0 | Choice1 | Choice2 deriving(Eq,Enum,Bounded)
data EF = Up | Flat | Down deriving(Eq,Enum,Bounded)
genValues :: ([DVI] -> Double) -> [DV] -> [Double]
genValues f l = [f x | x <- forAllInstantiations (DVSet l)]
e :: Enum a => DVI -> a
e = toEnum . instantiationValue
vf :: [DVI] -> (EF,F,EF)
vf [a,b,c] = (e a, e b, e c)
vf _ = (toEnum 0, toEnum 0, toEnum 0)
uf :: [DVI] -> (EF,IN,F)
uf [a,b,c] = (e a, e b, e c)
uf _ = (toEnum 0, toEnum 0, toEnum 0)
getForecastUtility (uf -> (Up, Choice0, Forecast)) = 1500
getForecastUtility (uf -> (Up, Choice0, NoForecast)) = 1500
getForecastUtility (uf -> (Up, Choice1, Forecast)) = 1000
getForecastUtility (uf -> (Up, Choice1, NoForecast)) = 1000
getForecastUtility (uf -> (Up, Choice2, Forecast)) = 500
getForecastUtility (uf -> (Up, Choice2, NoForecast)) = 500
getForecastUtility (uf -> (Flat, Choice0, Forecast)) = 100
getForecastUtility (uf -> (Flat, Choice0, NoForecast)) = 100
getForecastUtility (uf -> (Flat, Choice1, Forecast)) = 200
getForecastUtility (uf -> (Flat, Choice1, NoForecast)) = 200
getForecastUtility (uf -> (Flat, Choice2, Forecast)) = 500
getForecastUtility (uf -> (Flat, Choice2, NoForecast)) = 500
getForecastUtility (uf -> (Down, Choice0, Forecast)) = 1000
getForecastUtility (uf -> (Down, Choice0, NoForecast)) = 1000
getForecastUtility (uf -> (Down, Choice1, Forecast)) = 100
getForecastUtility (uf -> (Down, Choice1, NoForecast)) = 100
getForecastUtility (uf -> (Down, Choice2, Forecast)) = 500
getForecastUtility (uf -> (Down, Choice2, NoForecast)) = 500
getForecastProba (vf -> (Up,Forecast,Up)) = 0.8
getForecastProba (vf -> (Up,Forecast,Flat)) = 0.15
getForecastProba (vf -> (Up,Forecast,Down)) = 0.2
getForecastProba (vf -> (Up,NoForecast,Up)) = 0.33
getForecastProba (vf -> (Up,NoForecast,Flat)) = 0.33
getForecastProba (vf -> (Up,NoForecast,Down)) = 0.33
getForecastProba (vf -> (Flat,Forecast,Up)) = 0.1
getForecastProba (vf -> (Flat,Forecast,Flat)) = 0.7
getForecastProba (vf -> (Flat,Forecast,Down)) = 0.2
getForecastProba (vf -> (Flat,NoForecast,Up)) = 0.33
getForecastProba (vf -> (Flat,NoForecast,Flat)) = 0.33
getForecastProba (vf -> (Flat,NoForecast,Down)) = 0.33
getForecastProba (vf -> (Down,Forecast,Up)) = 0.1
getForecastProba (vf -> (Down,Forecast,Flat)) = 0.15
getForecastProba (vf -> (Down,Forecast,Down)) = 0.6
getForecastProba (vf -> (Down,NoForecast,Up)) = 0.33
getForecastProba (vf -> (Down,NoForecast,Flat)) = 0.33
getForecastProba (vf -> (Down,NoForecast,Down)) = 0.33
market :: InfluenceDiagram
market = snd . runID $ do
o <- decisionNode "Obtain Forecast" (t :: F)
i <- decisionNode "Investment" (t :: IN)
ef <- chance "Economy Forecast" (t :: EF)
ma <- chance "Market Activity" (t :: EF)
u <- utilityNode "Payoff"
proba ma ~~ [0.5,0.3,0.2]
decision o noDependencies
decision i [d o,p ef]
cpt ef [d o, p ma] ~~ (genValues getForecastProba [dv ef, dv o, dv ma])
utility u [p ma, d i, d o] ~~ (genValues getForecastUtility [dv ma, dv i, dv o])
return ()
marketTest = do
print market
printGraphValues market
let l = solveInfluenceDiagram market
print l