{- | 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
#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.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
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