1% Decision Theory, the Situation Calculus and Conditional Plans
    2% ICL axiomatization of the example from the paper.
    3% Copyright, David Poole, 1998.  http://www.cs.ubc.ca/spider/poole/
    4% (See the end for how to run this).
    5
    6% ACTIONS
    7%    goto(Pos,Route) robot takes Route to Pos
    8%    pickup(X)       robot picks up X
    9%    unlock_door     robot unlocks the door
   10%    enter_lab       robot enters the lab
   11
   12% Fluents
   13%    at(Obj,Pos,S)   Obj is at Pos in state S (and not crashed)
   14%    carrying(X,S)   robot is carrying X in state S
   15%    locked(door,S)  door is locked at state S
   16%    crashed(S)      robot is in a tangled mess at bottom of the stairs in S
   17%    value(V,S)      robot would receive V is it stopped in S
   18%    resources(R,S)  robot has R resources left
   19
   20% Sensing conditions
   21%     sense(at_key,S) robot senses that it is at the same location as the key.
   22
   23:- expects_dialect(icl).   24
   25
   26%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   27%             INITIAL SITUATION                         %
   28%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   29
   30% initial situation has the following probabilities
   31%   P(locked(door,s0)) = 0.9
   32%   P(at_key(r101,s0)|locked(door,s0)) = 0.7
   33%   P(at_key(r101,s0)|unlocked(door,s0)) = 0.2
   34%   ( from which we conclude P(at_key(r101,s0))=0.65
   35
   36random([locked(door,s0):0.9,unlocked(door,s0):0.1]).
   37random([at_key_lo(r101,s0):0.7,at_key_lo(r123,s0):0.3]).
   38random([at_key_unlo(r101,s0):0.2,at_key_unlo(r123,s0):0.8]).
   39
   40at(key,R,s0) <- at_key_lo(R,s0) & locked(door,s0).
   41at(key,R,s0) <- at_key_unlo(R,s0) & unlocked(door,s0).
   42
   43% initially the robot is at room 111.
   44at(robot,r111,s0) <- true.
   45
   46%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   47%             LOCATION                                  %
   48%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   49
   50% The robot reaches its desitination as long as it does not fall down
   51% the stairs and as long as it has enough resources.
   52
   53at(robot,To,do(goto(To,Route),S)) <-
   54    at(robot,From,S) &
   55    path(From,To,Route,no,Cost) &        % not risky
   56    resources(R,S) &
   57    R >= Cost.
   58
   59at(robot,To,do(goto(To,Route),S)) <-
   60    at(robot,From,S) &
   61    path(From,To,Route,yes,Cost) &       % is risky & don't fall down
   62    would_not_fall_down_stairs(S) &
   63    resources(R,S) &
   64    R >= Cost.
   65
   66at(robot,Pos,do(A,S)) <-
   67   ~ gotoaction(A) &
   68   at(robot,Pos,S).
   69
   70% non-robots remain where they were unless they are being carried
   71at(X,P,S) <-
   72   X \= robot &
   73   carrying(X,S)&
   74   at(robot,P,S).
   75
   76at(X,Pos,do(A,S)) <-
   77   X \= robot &
   78   ~ carrying(X,S)&
   79   at(X,Pos,S).
   80
   81gotoaction(goto(_,_)) <- true.
   82
   83% Whenever the robot goes past the stairs there is a 10% chance 
   84% that it will fall down the stairs, in which case it has crashed
   85% permanently.
   86% N.B. we assume when the robot has crashed, it is not "at" anywhere.
   87
   88random([would_fall_down_stairs(S):0.1,would_not_fall_down_stairs(S):0.9]).
   89
   90crashed(do(A,S)) <- crashed(S).
   91crashed(do(A,S)) <- risky(A,S) & would_fall_down_stairs(S).
   92
   93
   94
   95% path(From,To,Route,Risky,Cost)
   96%     Risky means whether it has to go past the stairs
   97path(r101,r111,direct,yes,10) <- true.
   98path(r101,r111,long,no,100) <- true.
   99path(r101,r123,direct,yes,50) <- true.
  100path(r101,r123,long,no,90) <- true.
  101path(r101,door,direct,yes,50) <- true.
  102path(r101,door,long,no,70) <- true.
  103
  104path(r111,r101,direct,yes,10) <- true.
  105path(r111,r101,long,no,100) <- true.
  106path(r111,r123,direct,no,30) <- true.
  107path(r111,r123,long,yes,90) <- true.
  108path(r111,door,direct,no,30) <- true.
  109path(r111,door,long,yes,70) <- true.
  110
  111path(r123,r101,direct,yes,50) <- true.
  112path(r123,r101,long,no,90) <- true.
  113path(r123,r111,direct,no,30) <- true.
  114path(r123,r111,long,yes,90) <- true.
  115path(r123,door,direct,no,20) <- true.
  116path(r123,door,long,yes,100) <- true.
  117
  118path(door,r101,direct,yes,50) <- true.
  119path(door,r101,long,no,70) <- true.
  120path(door,r111,direct,no,30) <- true.
  121path(door,r111,long,yes,70) <- true.
  122path(door,r123,direct,no,20) <- true.
  123path(door,r123,long,yes,100) <- true.
  124
  125
  126risky(goto(To,Route),S) <-
  127    path(From,To,Route,yes,_) &
  128    at(robot,From,S).
  129
  130
  131%    carrying(X,S) means robot is carrying X in state S
  132
  133carrying(key,do(pickup(key),S)) <-
  134    at(robot,P,S) &
  135    at(key,P,S) &
  136    pickup_succeeds(S).
  137
  138carrying(key,do(A,S)) <-
  139    carrying(key,S) &
  140    A \= putdown(key) &
  141    A \= pickup(key) &
  142    keeps_carrying(key,S).
  143
  144% 88% chance that a legal pickup will succeed and 
  145% 5% chance that the robot will drop the key
  146
  147random([pickup_succeeds(S):0.88, pickup_fails(S):0.12]).
  148random([keeps_carrying(key,S):0.95, drops(key,S):0.05]).
  149
  150
  151unlocked(door,do(unlock_door,S)) <-
  152   at(robot,door,S) &
  153   at(key,door,S).
  154unlocked(door,do(A,S)) <-
  155   ~ ( at(robot,door,S) & at(key,door,S)) &   % ensures rules are dijoint
  156   unlocked(door,S).
  157
  158%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  159%             UTILITY                                   %
  160%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  161
  162% utility is the prize plus the resources remaining
  163utility(V,S) <- 
  164    prize(P,S) &
  165    resources(R,S) &
  166    V is R+P.
  167
  168prize(1000,S) <- in_lab(S).
  169prize(-1000,S) <- crashed(S).
  170prize(0,S) <- ~ in_lab(S) & ~ crashed(S).
  171
  172in_lab(do(enter_lab,S)) <-
  173   at(robot,door,S) &
  174   unlocked(door,S).
  175
  176resources(200,s0) <- true.
  177resources(RR,do(goto(To,Route),S)) <-
  178    at(robot,From,S) &
  179    path(From,To,Route,Risky,Cost) &
  180    resources(R,S) &
  181    RR is R-Cost.
  182
  183resources(R,do(A,S)) <-
  184    crashed(S) &
  185    resources(R,S).
  186
  187resources(RR,do(A,S)) <-
  188    ~ crashed(S) &
  189    ~ gotoaction(A) &
  190    resources(R,S) &
  191    RR is R-10.           % every other action costs 10
  192
  193
  194%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  195%             SENSING                                   %
  196%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  197
  198sense(at_key,S) <-
  199   at(robot,P,S) &
  200   at(key,P,S) &
  201   sensor_true_pos(S).
  202sense(at_key,S) <-
  203   at(robot,P1,S) &
  204   at(key,P2,S) &
  205   P1 \= P2 &
  206   sensor_false_neg(S).
  207
  208% sensor to detect if at the same location as the key is noisy.
  209% It has a 3% false positive rate and an 8% false negative rate
  210
  211random([sensor_true_pos(S):0.92, sensor_false_neg(S):0.08]).
  212random([sensor_true_neg(S):0.97, sensor_false_pos(S):0.03]).
  213
  214%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  215%             TO RUN THIS                               %
  216%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  217
  218% This has only been tested with Sicstus Prolog, although it is
  219% reasonably standard Edinburgh prolog
  220
  221% compile('icl_int.tex').
  222% thconsult('dtp.pl').
  223
  224% Here is a simple plan:
  225example_query(explain(utility(V,do(enter_lab,do(goto(door,direct),s0))),[],[])).
  226
  227%Here is the explanations of the sensing
  228example_query(explain(sense(at_key,do(goto(r101,direct), s0)),[],[])).
  229
  230% The following two generate the explanations needed to determine the
  231% expected utility of the plan in the paper:
  232example_query(explain((sense(at_key,do(goto(r101,direct), s0)) & utility(V,do(enter_lab, do(unlock_door, do(goto(door,long), do(pickup(key), do(goto(r101,direct), s0))))))) ,[],[])).
  233
  234example_query(explain((~