1/*
    2Example showing the use of negation.  From
    3J. Vennekens, Marc Denecker, and Maurice Bruynooghe. CP-logic: A language 
    4of causal probabilistic events and its relation to logic programming. 
    5Theory Pract. Log. Program., 9(3):245-308, 2009.
    6*/
    7:- use_module(library(pita)).    8
    9:- if(current_predicate(use_rendering/1)).   10:- use_rendering(c3).   11:- endif.   12
   13:- pita.   14
   15:- begin_lpad.   16
   17push.
   18% we surely push the switch
   19
   20light : 0.4 :- push.
   21% if the switch is pushed, the light goes on with probability 0.4
   22
   23replace :- \+ light.
   24% if there is no light we must replace the bulb
   25
   26:- end_lpad.

?- prob(replace,Prob). % what is the probability that we replace the bulb? % expected result 0.6 ?- prob(light,Prob). % what is the probability that the light is on? % expected result 0.4 ?- prob(replace,Prob),bar(Prob,C). % what is the probability that we replace the bulb? % expected result 0.6 ?- prob_bar(light,Prob),bar(Prob,C). % what is the probability that the light is on? % expected result 0.4

*/