1/*
    2Model of the development of an epidemic or a pandemic.
    3From 
    4E. Bellodi and F. Riguzzi. Expectation Maximization over binary decision 
    5diagrams for probabilistic logic programs. Intelligent Data Analysis, 
    617(2):343-363, 2013.
    7*/
    8:- use_module(library(pita)).    9
   10:- if(current_predicate(use_rendering/1)).   11:- use_rendering(c3).   12:- use_rendering(graphviz).   13:- use_rendering(table,[header(['Multivalued variable index','Rule index','Grounding substitution'])]).   14:- endif.   15
   16:- pita.   17
   18:- begin_lpad.   19
   20epidemic : 0.6; pandemic : 0.3 :- flu(_), cold.
   21% if somebody has the flu and the climate is cold, there is the possibility 
   22% that an epidemic arises with probability 0.6 and the possibility that a
   23% pandemic arises with probability 0.3
   24
   25cold : 0.7.
   26% it is cold with probability 0.7
   27
   28flu(david).
   29flu(robert).
   30% david and robert have the flu for sure
   31
   32:- end_lpad.

?- prob(epidemic,Prob). % what is the probability that an epidemic arises? % expected result 0.588 ?- prob(pandemic,Prob). % what is the probability that a pandemic arises? % expected result 0.357 ?- prob(epidemic,Prob),bar(Prob,C). % what is the probability that an epidemic arises? % expected result 0.588 ?- prob(pandemic,Prob),bar(Prob,C). % what is the probability that a pandemic arises? % expected result 0.357 ?- bdd_dot_string(epidemic,BDD,Var).

?- bdd_dot_string(pandemic,BDD,Var).

*/