module Bayes.Test.CompareEliminations(
compareVariableFactor
, compareFactorChange
) where
import Test.HUnit.Lang(assertFailure)
import Bayes.Examples(example,exampleWithFactorChange)
import Bayes.Factor
import Bayes
import Bayes.VariableElimination
import Bayes.FactorElimination
import Bayes.Factor.CPT
import Data.Maybe(fromJust)
compareFactors :: String -> Maybe CPT -> CPT -> IO ()
compareFactors s Nothing _ = assertFailure s
compareFactors s (Just a) b =
if a `isomorphicFactor` b
then
return ()
else
assertFailure s
compareFactorChange :: IO ()
compareFactorChange = do
let ([winter,sprinkler,rain,wet,road,roadandrain],exampleG) = (map dv . fst $ example,snd example)
(_,exampleGF) = exampleWithFactorChange
theNewFactor = fromJust $ factorWithVariables [wet,sprinkler,rain] [1,0.2,0.1,0.05,0,0.8,0.9,0.95]
exampleGF' = changeFactor theNewFactor exampleGF
compareG s a b = compareFactors s (Just $ priorMarginal exampleGF' a b) (priorMarginal exampleG a b)
compareG "PRIOR FOR RAIN" [winter,sprinkler,wet,road,roadandrain] [rain]
compareG "PRIOR FOR WINTER" [sprinkler,wet,road,rain,roadandrain] [winter]
compareG "PRIOR FOR SPRINKLER" [winter,wet,road,rain,roadandrain] [sprinkler]
compareG "PRIOR FOR WET" [winter,sprinkler,road,rain,roadandrain] [wet]
compareG "PRIOR FOR ROAD" [winter,sprinkler,wet,rain,roadandrain] [road]
let jt' = createJunctionTree nodeComparisonForTriangulation exampleGF
jt = changeFactor theNewFactor jt'
compareFactors "PRIOR FOR RAIN" (posterior jt rain) (priorMarginal exampleG [winter,sprinkler,wet,road,roadandrain] [rain])
let jt1 = changeEvidence [wet =: True] jt
jt2 = changeEvidence [wet =: True, sprinkler =: True] jt1
compareFactors "POSTERIOR RAIN FOR WET" (posterior jt1 rain)
(posteriorMarginal exampleG [winter,sprinkler,wet,road,roadandrain] [rain] [wet =: True])
compareFactors "POSTERIOR RAIN FOR WET" (posterior jt2 rain)
(posteriorMarginal exampleG [winter,sprinkler,wet,road,roadandrain] [rain] [wet =: True, sprinkler =: True])
compareFactors "PRIOR FOR WINTER" (posterior jt winter) (priorMarginal exampleG [sprinkler,wet,road,rain,roadandrain] [winter])
compareFactors "PRIOR FOR SPRINKLER" (posterior jt sprinkler) (priorMarginal exampleG [winter,wet,road,rain,roadandrain] [sprinkler])
compareFactors "PRIOR FOR WET" (posterior jt wet) (priorMarginal exampleG [winter,sprinkler,road,rain,roadandrain] [wet])
compareFactors "PRIOR FOR ROAD" (posterior jt road) (priorMarginal exampleG [winter,sprinkler,wet,rain,roadandrain] [road])
compareVariableFactor :: IO ()
compareVariableFactor = do
let ([winter,sprinkler,rain,wet,road,roadandrain],exampleG) = example
jt = createJunctionTree nodeComparisonForTriangulation exampleG
compareFactors "PRIOR FOR RAIN" (posterior jt rain) (priorMarginal exampleG [winter,sprinkler,wet,road,roadandrain] [rain])
let jt1 = changeEvidence [wet =: True] jt
jt2 = changeEvidence [wet =: True, sprinkler =: True] jt1
compareFactors "POSTERIOR RAIN FOR WET" (posterior jt1 rain)
(posteriorMarginal exampleG [winter,sprinkler,wet,road,roadandrain] [rain] [wet =: True])
compareFactors "POSTERIOR RAIN FOR WET" (posterior jt2 rain)
(posteriorMarginal exampleG [winter,sprinkler,wet,road,roadandrain] [rain] [wet =: True, sprinkler =: True])
compareFactors "PRIOR FOR WINTER" (posterior jt winter) (priorMarginal exampleG [sprinkler,wet,road,rain,roadandrain] [winter])
compareFactors "PRIOR FOR SPRINKLER" (posterior jt sprinkler) (priorMarginal exampleG [winter,wet,road,rain,roadandrain] [sprinkler])
compareFactors "PRIOR FOR WET" (posterior jt wet) (priorMarginal exampleG [winter,sprinkler,road,rain,roadandrain] [wet])
compareFactors "PRIOR FOR ROAD" (posterior jt road) (priorMarginal exampleG [winter,sprinkler,wet,rain,roadandrain] [road])