1/*
    2This program models the effect of flu and hay fever on the sneezing symptom.
    3From
    4F. Riguzzi and T. Swift. The PITA system: Tabling and answer subsumption for reasoning under uncertainty. Theory and Practice of Logic Programming, 27th International Conference on Logic Programming (ICLP'11) Special Issue, 11(4-5):433-449, 2011.
    5*/
    6:- use_module(library(pita)).    7
    8:- if(current_predicate(use_rendering/1)).    9:- use_rendering(c3).   10:- endif.   11
   12:- pita.   13
   14:- begin_lpad.   15
   16strong_sneezing(X) : 0.3 ; moderate_sneezing(X) : 0.5 :- flu(X).
   17% if X has the flu, there is a probability of 0.3 that he has strong sneezing 
   18% and a probability of 0.5 that she has moderate sneezing
   19
   20strong_sneezing(X) : 0.2 ; moderate_sneezing(X) : 0.6 :- hay_fever(X).
   21% if X has hay fever, there is a probability of 0.2 that he has strong sneezing 
   22% and a probability of 0.6 that she has moderate sneezing
   23
   24flu(bob).
   25% bob has certainly the flu
   26
   27hay_fever(bob).
   28% bob has certainly hay fever
   29
   30:- end_lpad.

?- prob(strong_sneezing(bob),Prob). % what is the probability that bob has strong sneezing? % expected result 0.43999999999999995 ?- prob(moderate_sneezing(bob),Prob). % what is the probability that bob has % moderate sneezing? % expected result 0.7999999999999998 ?- prob(strong_sneezing(bob),Prob),bar(Prob,C). % what is the probability that bob has strong sneezing? % expected result 0.43999999999999995 ?- prob(moderate_sneezing(bob),Prob),bar(Prob,C). % what is the probability that bob has % moderate sneezing? % expected result 0.7999999999999998

*/