1% This is just like example1, except that search is used to minimize
    2%   the mount of up and down motion that the elevator will need
    3% Serve each floor whose call button is on initially, then park the elevator.
    4% run: ?- indigolog(smart_control)  use search
    5% run: ?- indigolog(dumb_control)   the same but without search (fails)
    6%
    7% No user input is required.
    8
    9% Interface to the outside world via read and write 
   10execute(A,Sr) :- ask_execute(A,Sr).
   11exog_occurs(_) :- fail.
   12
   13fl(N) :- N=1; N=2; N=3; N=4; N=5; N=6.    % the 6 elevator floors
   14
   15% Actions 
   16prim_action(down).              % elevator down one floor
   17prim_action(up).                % elevator up one floor
   18prim_action(off(N)) :- fl(N).   % turn off call button on floor n
   19prim_action(open).              % open elevator door
   20prim_action(close).             % close elevator door
   21
   22% Fluents 
   23prim_fluent(floor).             % the floor the elevator is on (1 to 6)
   24prim_fluent(light(N)) :- fl(N). % call button of floor n (on or off)
   25
   26% Causal laws 
   27causes_val(up,   floor, N, N is floor+1).
   28causes_val(down, floor, N, N is floor-1).
   29causes_val(off(N), light(N), off, true).  % Note: nothing turns a light on
   30
   31% Preconditions of prim actions
   32poss(down,    neg(floor=1)).
   33poss(up,      neg(floor=6)).
   34poss(off(N),  and(floor=N,light(N)=on)).
   35poss(open, true).
   36poss(close, true).
   37
   38% Initial state: elevator is at floor 3, and lights 2 and 5 are on
   39initially(floor,3).
   40initially(light(1), off).
   41initially(light(2), on).
   42initially(light(3), off).
   43initially(light(4), off).
   44initially(light(5), on).
   45initially(light(6), off).
   46
   47% Definitions of complex conditions
   48proc(below_floor(N), floor<N).
   49proc(above_floor(N), floor>N).
   50
   51% Definitions of complex actions
   52proc(go_floor(N), while(neg(floor=N), if(below_floor(N),up,down))).
   53proc(serve_floor(N), [ go_floor(N), open, close, off(N) ]).
   54
   55proc(handle_reqs(Max),      % handle all elevator reqs in Max steps
   56    ndet(  [?(and(neg(some(n,light(n)=on)),Max>=floor-1)), go_floor(1), open],
   57            pi(n, pi(m, [ ?(and(light(n)=on, m is Max-abs(floor-n))),
   58                          ?(m > 0),
   59                          serve_floor(n),
   60                          handle_reqs(m) ] )))).
   61
   62proc(minimize_motion(Max),  % iterative deepening search 
   63    ndet( handle_reqs(Max), pi(m, [?(m is Max+1), minimize_motion(m)]))).
   64
   65proc(dumb_control, minimize_motion(0) ).           % always fails 
   66proc(smart_control, search(minimize_motion(0)) ).  % eventually succeeds