Influence.hs

{-# LANGUAGE ViewPatterns #-}
{- | Examples of influence diagrams

An influence diagram is an extension of a Bayesian network with can be used to solve some decision problems.
In an influence diagram, there are two new kind of nodes : decision nodes and utility nodes.

Solving an influence diagram means determining the strategies for each decision variable that will maximize the average utility.

There must be an ordering of the decision variables : a path through all the decisions.

A decision variable can depend on other past decisions and probabilistic nodes. In the later case, the variable of 
the probabilistic node is assumed to be observed before the decision is taken. So, the decision is only trying to 
maximize the average utility based on what has not been observed (the future and some past probabilistic variables).

A probabilistic node can depend on other probabilistic nodes (like in a Bayesian network) and decision nodes.

An utility is a leaf of the graph.

/Example graph/

Building an influence diagram is done like for a Bayesian network : by using the right monad.

@
import Bayes.InfluenceDiagram 
studentSimple = snd . 'runID' $ do
@

Then, you create the different nodes of the graph:

@
    e <- 'decisionNode' \"E\" ('t' :: E)
    uc <- 'utilityNode' \"UC\"
    ub <- 'utilityNode' \"UB\"
    i <- 'chance' "I" ('t' :: I)
    pr <- 'chance' "P" ('t' :: Bool)
@

The types used above are:

@
data E = Dont | Do deriving(Eq,Enum,Bounded)
data I = Low | Average | High deriving(Eq,Enum,Bounded)
@

Then, you need to define the dependencies and the numerical values. For probabilistic nodes, it is done like
for Bayesian network:

@
    cpt pr ['d' e] ~~ [1-0.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]
@

The list may contain decision variables of type 'DEV' and probabilistic variables of type 'DV' or 'TDV'. So, the 
functions 'p' an 'd' are used for the embedding in the heterogenous list.

For decision nodes, the method is similar but with two differences : The first decision may depend on nothing (just on the assumed future).
And there are no values to define for a decision variable since the goal of the influence diagram is to compute them.

@
    'decision' e 'noDependencies'
@

For the utility nodes, it is similar to probabilistic nodes. You define the dependencies and the numerical values:

@
    'utility' uc [e] ~~ [0,-50000]
    'utility' ub [i] ~~ [100000,200000,500000]
@
  
Once the influence diagram is defined, you can solve it:

@
    'solveInfluenceDiagram' studentSimple
@

The result of this function is the solution : the decision strategies. You may want to display also the original
graph to see to which node are corresponding the vertex numbers.

/Policy Network/

You can transform a solved influence diagram into a policy network : a Bayesian network where decision variables have been replaced
with probabilistic variables where the conditional probability table is containing 1 for a choice of variables corresponding
to the decision and 0 otherwise.

@
    let l = 'solveInfluenceDiagram' student
        g = 'policyNetwork' l student
    print g 
    'printGraphValues' g
@ 

-}
module Bayes.Examples.Influence(
    -- * Influence diagrams
      exampleID
    , student
    , studentSimple
    , market 
    -- * Variables for some networks
    , studentDecisionVars
    , studentSimpleDecisionVar
    -- * Tests for the networks
    , theTest
    , policyTest
    , marketTest
    ) where 

import Bayes.InfluenceDiagram 
import Bayes(printGraphValues)
import Bayes.Factor(forAllInstantiations,dv,instantiationValue,DVSet(..))

-- | Very simple example with one decision node
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 

-- | Student network as found in the book by Barber
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] ~~ [1-0.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

-- | Solve the influences diagrams for the both student network.
-- Also displays each network
theTest = do
    print studentSimple
    printGraphValues studentSimple
    putStrLn "RESULT"
    print $ solveInfluenceDiagram studentSimple
    putStrLn "----"
    print student
    printGraphValues student
    putStrLn "RESULT"
    print $ solveInfluenceDiagram student


-- | Solve the influence diagram 'student' and convert it into
-- a policy network
policyTest = do 
    print student 
    printGraphValues student
    let l = solveInfluenceDiagram student
        g = policyNetwork l student
    print g 
    printGraphValues g

studentDecisionVars :: (DEV,TDV Bool,DEV)   

-- | Student network as found in the book by Barber
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] ~~ [1-0.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)


{- 

Test with a market network
    
-}
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 diagram
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 ()

-- | Solve the 'market' influence diagram
marketTest = do 
    print market 
    printGraphValues market
    let l = solveInfluenceDiagram market
    print l