1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%
    3% FILE: ElevatorSim-BAT/elevator.pl
    4%
    5%  AUTHOR : Sebastian Sardina (2001-2006)
    6%		(based on code previously written by Hector Levesque)
    7%  EMAIL  : ssardina@cs.toronto.edu
    8%  WWW    : www.cs.toronto.edu/~ssardina www.cs.toronto.edu/cogrobo
    9%  TYPE   : system independent code
   10%  TESTED : SWI Prolog 5.0.10 http://www.swi-prolog.org
   11%
   12%  This file contains 4 of the controllers from the original code
   13%  written by Hector Levesque for the 1st IndiGolog version:
   14%
   15%  mainControl(1) : (example2.pl in the original IndiGolog)
   16%  The dumb controller tries without search but commits too soon       
   17%
   18%  mainControl(2) : (example2.pl in the original IndiGolog)
   19%  The smart controller uses search to minimize the up-down motion     
   20%
   21%  mainControl(3) : (example3.pl in the original IndiGolog)
   22%  This is the elevator that appears in the IJCAI-97 paper on ConGolog 
   23%  It uses exogenous actions for temperature, smoke, and call buttons  
   24%
   25%  mainControl(4) : (example4.pl in the original IndiGolog)
   26%  This is the elevator with no exogenous events, but with sensing
   27%  actions for each call button of the elevator
   28%
   29%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   30%
   31%                             May 18, 2001
   32%
   33% This software was developed by the Cognitive Robotics Group under the
   34% direction of Hector Levesque and Ray Reiter.
   35% 
   36%        Do not distribute without permission.
   37%        Include this notice in any copy made.
   38% 
   39% 
   40%         Copyright (c) 2000 by The University of Toronto,
   41%                        Toronto, Ontario, Canada.
   42% 
   43%                          All Rights Reserved
   44% 
   45% Permission to use, copy, and modify, this software and its
   46% documentation for non-commercial research purpose is hereby granted
   47% without fee, provided that the above copyright notice appears in all
   48% copies and that both the copyright notice and this permission notice
   49% appear in supporting documentation, and that the name of The University
   50% of Toronto not be used in advertising or publicity pertaining to
   51% distribution of the software without specific, written prior
   52% permission.  The University of Toronto makes no representations about
   53% the suitability of this software for any purpose.  It is provided "as
   54% is" without express or implied warranty.
   55% 
   56% THE UNIVERSITY OF TORONTO DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS
   57% SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
   58% FITNESS, IN NO EVENT SHALL THE UNIVERSITY OF TORONTO BE LIABLE FOR ANY
   59% SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
   60% RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
   61% CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
   62% CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
   63%
   64%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   65% 
   66%  A basic action theory (BAT) is described with:
   67%
   68% -- fun_fluent(fluent)     : for each functional fluent (non-ground)
   69% -- rel_fluent(fluent)     : for each relational fluent (non-ground)
   70%
   71%           e.g., rel_fluent(painted(C)).
   72%           e.g., fun_fluent(color(C)).
   73%
   74% -- prim_action(action)    : for each primitive action (ground)
   75% -- exog_action(action)    : for each exogenous action (ground)
   76%
   77%           e.g., prim_action(clean(C)) :- domain(C,country).
   78%           e.g., exog_action(painte(C,B)):- domain(C,country), domain(B,color).
   79%
   80% -- senses(action,fluent)  : for each sensing action
   81%
   82%           e.g, poss(check_painted(C),  painted(C)).
   83%
   84% -- poss(action,cond)      : when cond, action is executable
   85%
   86%           e.g, poss(clean(C),   and(painted(C),holding(cleanear))).
   87%
   88% -- initially(fluent,value): fluent has value in S0 (ground)
   89%
   90%          e.g., initially(painted(C), false):- domain(C,country), C\=3.
   91%                initially(painted(3), true).
   92%                initially(color(3), blue).
   93%
   94% -- causes_val(action,fluent,value,cond)
   95%          when cond holds, doing act causes functional fluent to have value
   96%
   97%            e.g., causes_val(paint(C2,V), color(C), V, C = C2).
   98%               or causes_val(paint(C,V), color(C), V, true).
   99%
  100% -- causes_true(action,fluent,cond)
  101%          when cond holds, doing act causes relational fluent to hold
  102% -- causes_false(action,fluent,cond)
  103%          when cond holds, doing act causes relational fluent to not hold
  104%
  105%            e.g., causes_true(paint(C2,_), painted(C), C = C2).
  106%               or causes_true(paint(C,_), painted(C), true).
  107%            e.g., causes_false(clean(C2),  painted(C), C = C2).
  108%               or causes_false(clean(C),  painted(C), true).
  109%
  110% -- sort(name,domain_of_sort).      : all sorts used in the domain
  111%
  112%        e.g., varsort(c, colors).
  113%              varsort(temp, temperature).
  114%              color([blue, green, yellow, red]).       
  115%              temperature([-10,0,10,20,30,40]).
  116%
  117%
  118% A high-level program-controller is described with:
  119%
  120% -- proc(name,P): for each procedure P 
  121% -- simulator(N,P): P is the N exogenous action simulator
  122%
  123% The interface for Lego is described with:
  124%
  125% -- actionNum(action, num)  
  126%         action has RCX code num
  127% -- simulateSensing(action)
  128%         sensing result for action should be asked to the user
  129% -- translateSensing(action, sensorValue, sensorResult) 
  130%         translate the sensorValue of action to sensorResult
  131% -- translateExogAction(codeAction, action) 
  132%         translateSensing action name into codeAction and vice-versa
  133%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  134:- dynamic controller/1.  135
  136
  137/* DOMAINS-SORTS AVAILABLE */
  138fl([1,2,3,4,5,6,7,8,9,10]).       	% possible floors 
  139dir([up,down]).                    	% possible directions 
  140temperature([15,20,25,30,35]).     	% possible temperatures
  141
  142% There is nothing to do caching on (required becase cache/1 is static)
  143cache(_):-fail.
  144
  145floor(N) :- domain(N,fl).      /* N is a legal floor */
  146
  147
  148  /*  FLUENTS and CAUSAL LAWS */
  149fun_fluent(floor).              /* the floor the elevator is on */
  150causes_val(up,   floor, N, N is floor+1).
  151causes_val(down, floor, N, N is floor-1).
  152
  153fun_fluent(temp).               /* the temperature of the elevator */
  154causes_val(heat, temp, X, X is temp+5).
  155causes_val(cold, temp, X, X is temp-5).
  156
  157rel_fluent(fan).                   % the fan is on or off 
  158causes_true(toggle,   fan, neg(fan)).
  159causes_false(toggle,  fan, fan).
  160
  161fun_fluent(alarm).              /* the smoke alarm is on or off */
  162causes_val(smoke, alarm, on,  true).
  163causes_val(resetAlarm, alarm, off, true).
  164
  165fun_fluent(light(N)) :- floor(N).  /* call button of floor n is on or off */
  166causes_val(on(N),  light(N), on,  true).
  167causes_val(off(N), light(N), off, true).
  168senses(look(N), light(N)).      /* look(n) asks for the value of light(n) */
  169
  170
  171  /*  ACTIONS and PRECONDITIONS*/
  172prim_action(down).               /* elevator down one floor */
  173poss(down,   neg(floor=1)).
  174
  175prim_action(up).                 /* elevator up one floor */
  176poss(up,     neg(floor=10)).
  177
  178prim_action(toggle).             /* toggle the fan */
  179poss(toggle, true).
  180
  181prim_action(ring).               /* ring the smoke alarm */
  182poss(ring,   true).
  183
  184prim_action(off(N)) :- floor(N).    /* turn off call button on floor n */
  185poss(off(N), and(floor=N,light(N)=on)).
  186
  187prim_action(open).		/* open door */
  188poss(open, true).
  189
  190prim_action(close).             /* close door */
  191poss(close, true).
  192
  193prim_action(close).             /* close door */
  194poss(close, true).
  195
  196prim_action(look(N)) :- floor(N).  /* sensing action: check call button on floor n */
  197poss(look(_), true).
  198
  199
  200
  201exog_action(heat).               /* increase temperature by 1 */
  202exog_action(cold).               /* decrease temperature by 1 */
  203exog_action(smoke).              /* smoke enters elevator */
  204exog_action(resetAlarm).              /* smoke detector alarm is reset */
  205exog_action(on(N)) :- floor(N).     /* turn on call button on floor n */  
  206
  207prim_action(Act) :- exog_action(Act).
  208poss(Act, true) :- exog_action(Act).
  209
  210/* ABBREVIATIONS */
  211proc(too_hot, temp>2).
  212proc(too_cold, -2>temp).
  213proc(below_floor(N), floor<N).
  214proc(above_floor(N), floor>N).
  215proc(next_floor_to_serve(N), light(N)=on).
  216
  217
  218/* INITIAL STATE: elevator is at floor 3, lights 2 and 6 are on */
  219initially(floor,2).	
  220initially(temp,2).
  221initially(fan,false).
  222initially(light(N),off) :- floor(N), N\=1, N\=3.
  223initially(light(3),on). 		   	
  224initially(light(1),on). 		   	
  225initially(alarm,off).
  226
  227
  228%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  229%  Definitions of complex actions 
  230%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  231
  232% THIS IS THE MAIN PROCEDURE FOR INDIGOLOG
  233proc(main,  mainControl(N)) :- controller(N), !.
  234proc(main,  mainControl(3)). % default one
  235
  236proc(go_floor(N), while(neg(floor=N), if(below_floor(N),up,down))).
  237proc(serve_floor(N), [go_floor(N), off(N)]).
  238
  239proc(handle_reqs(Max),      /* handle all elevator reqs in Max steps */
  240    ndet(  [?(and(neg(some(n,light(n)=on)),Max>=floor-1)), go_floor(1), open],
  241            pi(n, pi(m, [ ?(and(light(n)=on, m is Max - abs(floor-n))),
  242                          ?(m > 0),
  243                          serve_floor(n),
  244                          handle_reqs(m) ] )))).
  245
  246
  247
  248
  249/*  This is the original elevator with no exogenous events, no sensing  */
  250/*  The smart controller uses search to minimize the up-down motion     */
  251/*  The dumb controller tries without search but commits too soon       */
  252proc(mainControl(1), dumb_control).
  253proc(mainControl(2), smart_control).
  254
  255proc(minimize_motion(Max),  /* iterative deepening search */
  256    ndet( handle_reqs(Max), pi(m, [?(m is Max+1), minimize_motion(m)]))).
  257
  258proc(dumb_control, minimize_motion(0) ).           /* always fails */
  259proc(smart_control, search(minimize_motion(0)) ).  /* eventually succeeds */
  260
  261
  262/*  This is the elevator that appears in the IJCAI-97 paper on ConGolog */
  263/*  It uses exogenous actions for temperature, smoke, and call buttons  */
  264proc(mainControl(3), prioritized_interrupts(
  265        [interrupt(and(too_hot,neg(fan)), toggle),
  266         interrupt(and(too_cold,fan), toggle),
  267         interrupt(alarm=on, ring),
  268         interrupt(n, next_floor_to_serve(n), serve_floor(n)),
  269         interrupt(above_floor(1), down)])).
  270
  271/*  This is the elevator with no exogenous events, but with sensing   	*/
  272/*  actions for each call button of the elevator                      	*/
  273proc(mainControl(4), 
  274  [ check_buttons, 
  275    while(or(some(n,light(n)=on), above_floor(1)), 
  276      if(some(n,light(n)=on), serve_a_floor, [down, check_buttons])) ]).
  277proc(serve_a_floor, pi(n, [?(next_floor_to_serve(n)), go_floor(n), off(n)])).
  278proc(check_buttons, 
  279	[look(1), look(2), look(3), look(4), look(5), look(6), look(7), look(8), look(9), look(10)]).
  280
  281
  282
  283proc(mainControl(5), searchn(minimize_motion(0),[]) ).  
  284
  285
  286
  287%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  288%  INFORMATION FOR THE EXECUTOR
  289%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  290% Translations of domain actions to real actions (one-to-one)
  291actionNum(X,X).	
  292
  293
  294%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  295% EOF: ElevatorSim-BAT/elevator.pl
  296%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  297
  298/*
  299
  300trans(searchn(minimize_motion(0),[]),[],E,H),transn(E,H,E2,H2,10),!,ttrans(E2,[on(3)|H2],EF,HF), final(EF,HF).
  301
  302
  303 trans(searchn(minimize_motion(0),[]),[],E,H),transn(E,H,E2,H2,10),!,trans(E2,[on(3)|H2],E3,H3), transn(E3,H3,E4,H4,5), ttrans(E4,[smoke|H4],EF,HF), final(EF,HF).
  304
  305
  306*/