1/*
    2A three-sided die is repeatedly thrown until the outcome is three.
    3on(T,F) means that on the Tth throw the face F came out.
    4From
    5Riguzzi and Terrance Swift. The PITA system: Tabling and answer subsumption for 
    6reasoning under uncertainty. Theory and Practice of Logic Programming, 
    727th International Conference on Logic Programming (ICLP'11) Special Issue, 
    8Lexington, Kentucky 6-10 July 2011, 11(4-5):433-449, 2011
    9*/
   10:- use_module(library(pita)).   11
   12:- if(current_predicate(use_rendering/1)).   13:- use_rendering(c3).   14:- endif.   15
   16:- pita.   17
   18:- begin_lpad.   19
   20% on(T,F) means that the dice landed on face F at time T
   21on(0,1):1/3;on(0,2):1/3;on(0,3):1/3.
   22% at time 0 the dice lands on one of its faces with equal probability
   23
   24on(X,1):1/3;on(X,2):1/3;on(X,3):1/3:-
   25  X1 is X-1,X1>=0,
   26  on(X1,_),
   27  \+ on(X1,3).
   28% at time T the dice lands on one of its faces with equal probability if
   29% at the previous time point it was thrown and it did not landed on face 3
   30
   31:- end_lpad.

?- prob(on(0,1),Prob). % what is the probability that the dice lands on face 1 at time 0? % expected result 0.3333333333333333 ?- prob(on(1,1),Prob). % what is the probability that the dice lands on face 1 at time 1? % expected result 0.2222222222222222 ?- prob(on(2,1),Prob). % what is the probability that the dice lands on face 1 at time 2? % expected result 0.14814814814814814 ?- prob(on(3,1),Prob). % what is the probability that the dice lands on face 1 at time 3? % expected result 0.09876543209876543 ?- prob(on(0,1),Prob),bar(Prob,C). % what is the probability that the dice lands on face 1 at time 0? % expected result 0.3333333333333333 ?- prob(on(1,1),Prob),bar(Prob,C). % what is the probability that the dice lands on face 1 at time 1? % expected result 0.2222222222222222 ?- prob(on(2,1),Prob),bar(Prob,C). % what is the probability that the dice lands on face 1 at time 2? % expected result 0.14814814814814814 ?- prob(on(3,1),Prob),bar(Prob,C). % what is the probability that the dice lands on face 1 at time 3? % expected result 0.09876543209876543

?- prob(on(2,1),on(0,1),Prob). % what is the probability that the dice lands on face 1 at time 2 given that it landed on face 1 at time 0? % expected result 0.222222222222222 ?- prob(on(2,1),on(1,1),Prob). % what is the probability that the dice lands on face 1 at time 2 given that it landed on face 1 at time 1? % expected result 0.333333333333333 */