{- | A comparison of factor elimination with reference values generated with another bayesian network software It is a non regression test. The test patterns are not provided with this package. So, those tests are disabled by default in the hackage version. -} module Bayes.Test.ReferencePatterns( #ifdef LOCAL compareAsiaReference , compareCancerReference , comparePokerReference , compareFarmReference , compareMpeCancer #endif ) where import Test.HUnit.Base(assertBool) import Data.Maybe(fromJust) import qualified Data.Map as Map import Bayes.Factor import Bayes import Bayes.FactorElimination import Bayes.VariableElimination(mpe) import Bayes.Examples(anyExample) import Bayes.FactorElimination.JTree(root) value varmap jt s = let v = fromJust $ Map.lookup s varmap in factorToList (fromJust $ posterior jt v) testWithRef varmap jt s l = assertBool s $ value varmap jt s ~=~ l testWithRefAndPrint varmap jt s l = do let r = value varmap jt s putStrLn $ "Computed:" ++ show r putStrLn $ "Reference:" ++ show l putStrLn "" assertBool s $ r ~=~ l -- Check that the float values are equal with an accuracy < 0.01% comparePercent :: Double -> Double -> Bool comparePercent a b = abs (a-b) < 1e-4 (~=~) a b = and (zipWith comparePercent a b) #ifdef LOCAL data Positive = Yes | No deriving(Eq,Enum,Bounded,Show) -- | Get the name of vertices in the graph for display rename :: NamedGraph g => g a b -> (TDV s,s) -> (String,s) rename g = \(a,s) -> (fromJust . vertexLabel g . vertex $ a, s) -- | Test that a MAP is not always the projection of a MPE compareMpeCancer = do (varmap,g) <- anyExample "asia.net" let [x,b,d,a,s,l,t,e] = map tdv . fromJust $ mapM (flip Map.lookup varmap) ["X","B","D","A","S","L","T","E"] :: [TDV Positive] m = mpe g [x,d] [b,a,s,l,t,e] [x =: Yes, d =: No] typedResult = map (map (rename g . tdvi)) m :: [[(String,Positive)]] assertBool "Test MPE" $ typedResult == [[("E",No),("T",No),("L",No),("S",No),("B",No),("A",No)]] let m = mpe g [x,d,b,l,t,e] [a,s] [x =: Yes, d =: No] typedResult = map (map (rename g . tdvi)) m :: [[(String,Positive)]] assertBool "Test MAP" $ typedResult == [[("S",Yes),("A",No)]] compareFarmReference = do (varmap,g) <- anyExample "studfarm.net" let jt = createJunctionTree nodeComparisonForTriangulation g assertBool "Junction Tree property" $ junctionTreeProperty jt [] (root jt) testWithRef varmap jt "L" [0.01,0.99] testWithRef varmap jt "Ann" [0.01,0.99] testWithRef varmap jt "Brian" [0.01,0.99] testWithRef varmap jt "Cecily" [0.01,0.99] testWithRef varmap jt "K" [0.01,0.99] testWithRef varmap jt "Fred" [0.01,0.99] testWithRef varmap jt "Dorothy" [0.01,0.99] testWithRef varmap jt "Eric" [0.01,0.99] testWithRef varmap jt "Gwenn" [0.01,0.99] testWithRef varmap jt "Henry" [0.0091,0.9909] testWithRef varmap jt "Irene" [0.0099,0.9901] testWithRef varmap jt "John" [0.0004,0.0087,0.9909] comparePokerReference = do (varmap,g) <- anyExample "poker.net" let jt = createJunctionTree nodeComparisonForTriangulation g assertBool "Junction Tree property" $ junctionTreeProperty jt [] (root jt) testWithRef varmap jt "OH0" [0.1672, 0.0445,0.0635,0.4659,0.1694,0.0494,0.0353,0.0024,0.0024] testWithRef varmap jt "OH1" [0.0265,0.0170,0.0357,0.4125,0.2633,0.1599,0.0676,0.0098,0.0077] testWithRef varmap jt "OH2" [0.2472,0.0628,0.2903,0.0258,0.2526,0.0881,0.0212,0.0121] testWithRef varmap jt "SC" [0.2450,0.7116,0.0435] testWithRef varmap jt "FC" [0.0895,0.6988,0.0445,0.1672] testWithRef varmap jt "Besthand" [0.6396,0.3604] testWithRef varmap jt "MH" [0.1250,0.1250,0.1250,0.1250,0.1250,0.1250,0.1250,0.1250] compareAsiaReference = do (varmap,g) <- anyExample "asia.net" let jt = createJunctionTree nodeComparisonForTriangulation g assertBool "Junction Tree property" $ junctionTreeProperty jt [] (root jt) testWithRef varmap jt "A" [0.0100, 0.9900] testWithRef varmap jt "S" [0.5000, 0.5000] testWithRef varmap jt "T" [0.0104, 0.9896] testWithRef varmap jt "L" [0.0550, 0.9450] testWithRef varmap jt "B" [0.4500, 0.5500] testWithRef varmap jt "E" [0.0648, 0.9352] testWithRef varmap jt "X" [0.1103, 0.8897] testWithRef varmap jt "D" [0.4360, 0.5640] -- | Type defined to set the evidence on the Coma variable -- from the cancer network. data Coma = Present | Absent deriving(Eq,Enum,Bounded) compareCancerReference = do (varmap,g) <- anyExample "cancer.net" let jt = createJunctionTree nodeComparisonForTriangulation g assertBool "Junction Tree property" $ junctionTreeProperty jt [] (root jt) testWithRef varmap jt "A" [0.2000, 0.8000] testWithRef varmap jt "B" [0.3200, 0.6800] testWithRef varmap jt "C" [0.0800, 0.9200] testWithRef varmap jt "D" [0.3200, 0.6800] testWithRef varmap jt "E" [0.6160, 0.3840] let varD = fromJust $ Map.lookup "D" varmap let jt' = changeEvidence [varD =: Present] jt testWithRef varmap jt' "A" [0.4250, 0.5750] testWithRef varmap jt' "B" [0.8000, 0.2000] testWithRef varmap jt' "C" [0.2000, 0.8000] testWithRef varmap jt' "D" [1.0000, 0.0000] testWithRef varmap jt' "E" [0.6400, 0.3600] let jt'' = changeEvidence [varD =: Absent] jt' testWithRef varmap jt'' "A" [0.0941, 0.9059] testWithRef varmap jt'' "B" [0.0941, 0.9059] testWithRef varmap jt'' "C" [0.0235, 0.9765] testWithRef varmap jt'' "D" [0.0000, 1.0000] testWithRef varmap jt'' "E" [0.6047, 0.3953] #endif