1/*
    2A six-sided die is repeatedly thrown until the outcome is six.
    3on(T,F) means that on the Tth throw the face F came out.
    4From
    5J. Vennekens, S. Verbaeten, and M. Bruynooghe. Logic programs with annotated 
    6disjunctions. In International Conference on Logic Programming, 
    7volume 3131 of LNCS, pages 195-209. Springer, 2004.
    8*/
    9:- use_module(library(pita)).   10
   11:- if(current_predicate(use_rendering/1)).   12:- use_rendering(c3).   13:- endif.   14
   15:- pita.   16
   17:- begin_lpad.   18
   19% on(T,F) means that the die landed on face F at time T
   20
   21on(0,1):1/6;on(0,2):1/6;on(0,3):1/6;
   22on(0,4):1/6;on(0,5):1/6;on(0,6):1/6.
   23% at time 0 the dice lands on one of its faces with equal probability
   24
   25on(X,1):1/6;on(X,2):1/6;on(X,3):1/6;
   26on(X,4):1/6;on(X,5):1/6;on(X,6):1/6:-
   27  X1 is X-1,X1>=0,on(X1,_),
   28  \+ on(X1,6).
   29% at time T the die lands on one of its faces with equal probability if
   30% at the previous time point it was thrown and it did not land on face 6
   31
   32evidence:-
   33  on(0,1),
   34  on(1,1).
   35
   36:- end_lpad.

?- prob(on(0,1),Prob). % what is the probability that the die lands on face 1 at time 0? % expected result 0.16666666666666666 ?- prob(on(1,1),Prob). % what is the probability that the die lands on face 1 at time 1? % expected result 0.13888888888888887 ?- prob(on(2,1),Prob). % what is the probability that the die lands on face 1 at time 2? % expected result 0.11574074074074071 ?- prob(on(2,1),on(0,1),Prob). % what is the probability that the die lands on face 1 at time 2 given that it landed on face 1 at time 0? % expected result 0.13888888888888887 ?- prob(on(2,1),evidence,Prob). % what is the probability that the die lands on face 1 at time 2 given that it landed on face 1 at times 0 and 1? % expected result 0.16666666666666666 ?- prob(on(0,1),Prob),bar(Prob,C). % what is the probability that the die lands on face 1 at time 0? % expected result 0.16666666666666666 ?- prob(on(1,1),Prob),bar(Prob,C). % what is the probability that the die lands on face 1 at time 1? % expected result 0.13888888888888887 ?- prob(on(2,1),Prob),bar(Prob,C). % what is the probability that the die lands on face 1 at time 2? % expected result 0.11574074074074071

?- prob(on(2,1),on(0,1),Prob),bar(Prob,C). % what is the probability that the die lands on face 1 at time 2 given that it landed on face 1 at time 0? % expected result 0.13888888888888887 ?- prob(on(2,1),on(1,1),Prob),bar(Prob,C). % what is the probability that the die lands on face 1 at time 2 given that it landed on face 1 at time 1? % expected result 0.16666666666666666

*/