{- | Tutorial explaining how to make infereces with the library. Thus tutorial is using examples from the module "Bayes.Examples". Please, refer to this module for documentation about how the example bayesian networks are created or loaded. /Inferences/ The function 'inferencesOnStandardNetwork' is showing how to use variable elimination and factor elimination to make inferences. First, the 'example' is loaded to make its variables and its bayesian network available: @ let ([winter,sprinkler,rain,wet,road],exampleG) = 'example' @ Then, we compute a prior marginal. Prior means that no evidence is used. A bayesian network is a factorisation of a distribution P(A B C ...). If you want to know the probability of only A, you need to sum out the other variables to eliminate them and get P(A). To compute this prior marginal using variable elimnation, you need to give an elimination order. The complexity of the computation is depending on the elimination order chosen. For instance, if you want to compute the prior probability of rain, you can write: @ 'priorMarginal' exampleG [winter,sprinkler,wet,road] [rain] @ Now, if you have observed that the grass is wet and want to take into account thios observation to compute the posterior probability of rain (after observation): @ 'posteriorMarginal' exampleG [winter,sprinkler,wet,road] [rain] [wet '=:' True] @ If you want to combine several observations: @ 'posteriorMarginal' exampleG [winter,sprinkler,wet,road] [rain] [wet '=:' True, sprinkler '=:' True] @ There are several problems with variable elimination: * You have to specify an elimination order * If you want to compute another marginal (for instance probability of winter), you have to recompute everything. But, there exists another category of elimination algorithms based upon factor elimination. They require the creation of an auxiliary data structure : the junction tree. This tree is then used for computing all marginals (without having to recompute everything). The junction tree is equivalent to giving an elimination order. So, the previous examples can also be computed with factor elimination. First, the junction tree must created: @ let jt = 'createJunctionTree' 'nodeComparisonForTriangulation' exampleG @ The junction tree being equivalent to an elimination order, the order chosen will depend on a cost function. In the previous example, the cost function 'nodeComparisonForTriangulation' is used. Other cost functions may be introduced in a futute version of this library. Once the junction tree has been computd, it can be used to compute several marginals: @ 'posterior' jt rain @ The function is called posterior and will compute posterior only when solme evidence has been introduced into the tree. Otherwise it is computing a prior. To set evidence, you need to update the junction tree with new evidence: @ let jt' = 'updateEvidence' [wet '=:'' True] jt 'posterior' jt' rain @ /Inferences with an imported network/ There is a slight additional difficulty with imported networks : you need to create new data type to be able to set evidence. For instance, in the cancer network there is a Coma variable with levels Present or Absent. When imported, those levels are imported as number. But, the evidence API in this library is requiring enumerations. So, you need to create a 'Coma' type: @ data Coma = Present | Absent deriving(Eq,Enum,Bounded) @ and check that 'Present' is corresponding to the level 0 in the importd network. Once this datatype is created, you can easily use the cancer network. First we load the network and import the discrete variables of type 'DV' from the names of the nodes in the network (not the label of the nodes) @ print \"CANCER NETWORK\" (varmap,cancer) <- 'exampleImport' print cancer let [varA,varB,varC,varD,varE] = fromJust $ mapM (flip Map.lookup varmap) ["A","B","C","D","E"] @ Once the variables are available, you can create the junction tree and start making inferences: @ let jtcancer = 'createJunctionTree' 'nodeComparisonForTriangulation' cancer -- mapM_ (\x -> putStrLn (show x) >> (print . 'posterior' jtcancer $ x)) [varA,varB,varC,varD,varE] -- print \"UPDATED EVIDENCE\" let jtcancer' = 'updateEvidence' [varD '=:' Present] jtcancer mapM_ (\x -> putStrLn (show x) >> (print . 'posterior' jtcancer' $ x)) [varA,varB,varC,varD,varE] @ -} module Bayes.Examples.Tutorial( -- * Tests with the standard network inferencesOnStandardNetwork #ifndef LOCAL -- * Tests with the cancer network , inferencesOnCancerNetwork #endif #ifdef LOCAL , miscDiabete #endif , Coma(..) , miscTest ) where import Bayes.Factor import Bayes import Bayes.VariableElimination #ifndef LOCAL import Bayes.Examples(example, exampleJunction,exampleImport,exampleDiabete, exampleAsia, examplePoker, exampleFarm,examplePerso,anyExample) #else import Bayes.Examples(example, exampleJunction,exampleDiabete, exampleAsia, examplePoker, exampleFarm,examplePerso,anyExample) #endif import Bayes.FactorElimination import Data.Function(on) import qualified Data.Map as Map import Data.Maybe(fromJust,mapMaybe) import System.Exit(exitSuccess) import qualified Data.List as L((\\)) #ifdef LOCAL miscDiabete = do (varmap,perso) <- exampleDiabete let jtperso = createJunctionTree nodeComparisonForTriangulation perso cho0 = fromJust . Map.lookup "cho_0" $ varmap print $ posterior jtperso cho0 #endif miscTest s = do (varmap,perso) <- anyExample s let names = Map.keys varmap l = mapMaybe (flip Map.lookup varmap) names jtperso = createJunctionTree nodeComparisonForTriangulation perso print perso print jtperso print "FACTOR ELIMINATION" let post (v,name) = do putStrLn name print $ posterior jtperso v mapM_ post (zip l names) print "VARIABLE ELIMINATION" let prior (v,name) = do putStrLn name print $ priorMarginal perso (l L.\\ [v]) [v] mapM_ prior (zip l names) -- | Type defined to set the evidence on the Coma variable -- from the cancer network. data Coma = Present | Absent deriving(Eq,Enum,Bounded) #ifndef LOCAL -- | Inferences with the cancer network inferencesOnCancerNetwork = do print "CANCER NETWORK" (varmap,cancer) <- exampleImport print cancer let [varA,varB,varC,varD,varE] = fromJust $ mapM (flip Map.lookup varmap) ["A","B","C","D","E"] let jtcancer = createJunctionTree nodeComparisonForTriangulation cancer mapM_ (\x -> putStrLn (show x) >> (print . posterior jtcancer $ x)) [varA,varB,varC,varD,varE] print "UPDATED EVIDENCE : Coma present" let jtcancer' = changeEvidence [varD =: Present] jtcancer mapM_ (\x -> putStrLn (show x) >> (print . posterior jtcancer' $ x)) [varA,varB,varC,varD,varE] print "UPDATED EVIDENCE : Coma absent" let jtcancer' = changeEvidence [varD =: Absent] jtcancer mapM_ (\x -> putStrLn (show x) >> (print . posterior jtcancer' $ x)) [varA,varB,varC,varD,varE] #endif -- | Inferences with the standard network inferencesOnStandardNetwork = do let ([winter,sprinkler,rain,wet,road],exampleG) = example print exampleG putStrLn "" print "VARIABLE ELIMINATION" putStrLn "" print "Prior Marginal : probability of rain" let m = priorMarginal exampleG [winter,sprinkler,wet,road] [rain] print m putStrLn "" print "Posterior Marginal : probability of rain if grass wet" let m = posteriorMarginal exampleG [winter,sprinkler,wet,road] [rain] [wet =: True] print m putStrLn "" print "Posterior Marginal : probability of rain if grass wet and sprinkler used" let m = posteriorMarginal exampleG [winter,sprinkler,wet,road] [rain] [wet =: True, sprinkler =: True] print m putStrLn "" let jt = createJunctionTree nodeComparisonForTriangulation exampleG print jt displayTreeValues jt putStrLn "" print "FACTOR ELIMINATION" putStrLn "" print "Prior Marginal : probability of rain" let m = posterior jt rain print m putStrLn "" let jt' = changeEvidence [wet =: True] jt print "Posterior Marginal : probability of rain if grass wet" let m = posterior jt' rain print m putStrLn "" let jt'' = changeEvidence [] jt' print "Prior Marginal : probability of rain" let m = posterior jt rain print m putStrLn "" let jt3 = changeEvidence [wet =: True, sprinkler =: True] jt' print "Posterior Marginal : probability of rain if grass wet and sprinkler used" let m = posterior jt3 rain print m putStrLn "" return ()