1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2% FILE    : Examples/Wumpus/wumpus.pl
    3%
    4%       Axiomatization of the Wumpus World 
    5%       under the BAT with possible values evaluator
    6%
    7%  AUTHOR : Stavros Vassos & Sebastian Sardina (2005)
    8%  email  : {ssardina,stavros}@cs.toronto.edu
    9%  WWW    : www.cs.toronto.edu/cogrobo
   10%  TYPE   : system independent code
   11%  TESTED : SWI Prolog 5.0.10 http://www.swi-prolog.org
   12%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   13%
   14%                             May 18, 2001
   15%
   16% This software was developed by the Cognitive Robotics Group under the
   17% direction of Hector Levesque and Ray Reiter.
   18% 
   19%        Do not distribute without permission.
   20%        Include this notice in any copy made.
   21% 
   22% 
   23%         Copyright (c) 2000 by The University of Toronto,
   24%                        Toronto, Ontario, Canada.
   25% 
   26%                          All Rights Reserved
   27% 
   28% Permission to use, copy, and modify, this software and its
   29% documentation for non-commercial research purpose is hereby granted
   30% without fee, provided that the above copyright notice appears in all
   31% copies and that both the copyright notice and this permission notice
   32% appear in supporting documentation, and that the name of The University
   33% of Toronto not be used in advertising or publicity pertaining to
   34% distribution of the software without specific, written prior
   35% permission.  The University of Toronto makes no representations about
   36% the suitability of this software for any purpose.  It is provided "as
   37% is" without express or implied warranty.
   38% 
   39% THE UNIVERSITY OF TORONTO DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS
   40% SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
   41% FITNESS, IN NO EVENT SHALL THE UNIVERSITY OF TORONTO BE LIABLE FOR ANY
   42% SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
   43% RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
   44% CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
   45% CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
   46%
   47%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   48% 
   49%  A possible-value basic action theory (KBAT) is described with:
   50%
   51%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   52
   53:- style_check(-discontiguous).   54% :- style_check(-singleton).
   55% :- style_check(-atom).
   56
   57/* IndiGolog caching: fluents that are heavily used should be cached */
   58cache(locWumpus).
   59cache(locRobot).
   60%cache(isPit(_)).
   61%cache(isGold(_)).
   62cache(_):-fail.
   63
   64%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   65%  0 - DEFINITIONS OF DOMAINS/SORTS
   66%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   67:- dynamic gridsize/1.   68
   69gridsize(8).
   70gridindex(V) :- 
   71	gridsize(S),
   72        between(1,S,V).
   73      /*
   74	findall(X,get_integer(1,X,S),L),
   75	member(V,L).*/
   76direction(V) :- member(V,[up,down,left,right]).
   77location(loc(I,J)) :- gridindex(I), gridindex(J).
   78
   79%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   80%  1 - ACTIONS AND PRECONDITIONS
   81%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   82prim_action(smell).
   83poss(smell, true).
   84senses(smell). 		% Perceived at a square iff the Wumpus is at this square or in its neighbourhood.
   85
   86prim_action(senseBreeze).
   87poss(senseBreeze, true).
   88senses(senseBreeze). 	% Perceived at a square iff a isPit is in the neighborhood of this square.
   89
   90prim_action(senseGold).
   91poss(senseGold, true).
   92senses(senseGold).	% Perceived at a square iff gold is in this square.
   93
   94prim_action(shootFwd).
   95poss(shootFwd, hasArrow=true).
   96
   97prim_action(pickGold).
   98poss(pickGold, isGold(locRobot)=true).
   99
  100prim_action(setTemp(_)). % sets the value of a thinking fluent temp
  101poss(setTemp(_), true).
  102
  103prim_action(moveFwd).
  104poss(moveFwd, neg(inTheEdge(locRobot,dirRobot))).
  105
  106inTheEdge(loc(1,_),left).
  107inTheEdge(loc(X,_),right)	:- gridsize(X).
  108inTheEdge(loc(_,1),down).
  109inTheEdge(loc(_,X),up)		:- gridsize(X).
  110
  111prim_action(turn).
  112poss(turn, true).
  113
  114prim_action(climb).
  115poss(climb, true).
  116
  117prim_action(enter).
  118poss(enter, true).
  119
  120prim_action(reset).
  121poss(reset, true).
  122
  123/* Exogenous Actions Available */
  124exog_action(scream).
  125
  126
  127%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  128%  2 - FUNCTIONAL FLUENTS AND CAUSAL LAWS
  129%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  130
  131% inDungeon: robot is inside the dungeon
  132fun_fluent(inDungeon).
  133causes(climb, inDungeon, false, locRobot=loc(1,1)).
  134causes(enter, inDungeon, true, true).
  135
  136% locWumpus: locations of the Wumpus
  137fun_fluent(locWumpus).
  138rejects(smell, 1, locWumpus, Y, neg(adj(locRobot,Y))).
  139rejects(smell, 0, locWumpus, Y, adj(locRobot,Y)).
  140
  141% locRobot: current location of the robot 
  142fun_fluent(locRobot).
  143causes(moveFwd, locRobot, Y, apply(dirRobot,[locRobot,Y])).
  144
  145% dirRobot: direction of the robot (up, right, left, down)
  146fun_fluent(dirRobot).
  147causes(turn, dirRobot, Y, rotateRight(dirRobot,Y)).
  148
  149% isGold(L): whether there is gold at location L
  150fun_fluent(isGold(L)):- location(L).
  151settles(senseGold, 1, isGold(L), true,  L=locRobot). 
  152settles(senseGold, 0, isGold(L), false, L=locRobot).
  153causes(pickGold, isGold(L), false, locRobot=L). 
  154causes(pickGold, isGold(L), V, and(neg(locRobot=L),V=isGold(L))). 
  155
  156% noGold: number of gold pices the robot is holding
  157fun_fluent(noGold).
  158causes(pickGold, noGold, V, V is noGold+1).
  159
  160
  161% isPit(L): whether there is a pit at location L
  162fun_fluent(isPit(L)):- location(L).
  163settles(senseBreeze, 0, isPit(L), false, adj(locRobot,L)).
  164rejects(senseBreeze, 1, isPit(L), false,  
  165	and(adj(locRobot,L),
  166	    all(y,location, impl(and(adj(locRobot,y),neg(L=y)),isPit(y)=false))
  167	)
  168).
  169
  170% hasArrow: whether the robot has an arrow to use
  171fun_fluent(hasArrow).
  172causes(shoot(_), hasArrow, false, true).
  173
  174% aliveWumpus: wumpus is alive
  175fun_fluent(aliveWumpus).
  176causes(scream, aliveWumpus, false, true).
  177%causes(shootFwd, aliveWumpus, false, in_line(locRobot,dirRobot,locWumpus)).
  178%causes(shootFwd, aliveWumpus, true, 
  179%		   and(neg(in_line(locRobot,dirRobot,locWumpus)),aliveWumpus=true)
  180%		   ).
  181
  182% visited(L): location L is visited already
  183fun_fluent(visited(L)) :- location(L).
  184causes(moveFwd, visited(L), true, apply(dirRobot,[locRobot,L])).
  185%"small" frame
  186causes(moveFwd, visited(L), V, and(neg(apply(dirRobot,[locRobot,L])),V=visited(L))).
  187causes(reset, visited(L), false,neg(locRobot=L)).
  188causes(reset, visited(L), true, locRobot=L).
  189
  190%causes(moveFwd, locWumpus, V, or(V=locWumpus,and(adj(locRobot,L),V=L)))
  191
  192fun_fluent(tries).
  193causes(reset, tries, V, V is tries+1).
  194
  195%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  196%  3 - ABBREVIATIONS
  197%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  198
  199%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  200%  4 - INITIAL STATE
  201%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  202	% Robot state
  203initially(locRobot,loc(1,1)).
  204initially(dirRobot, right).
  205initially(hasArrow,true).
  206initially(noGold,0).
  207initially(inDungeon,true).
  208	% Wumpus state
  209initially(locWumpus,R):- location(R), \+ R=loc(1,1).
  210initially(aliveWumpus,true).
  211	% Pits	
  212initially(isPit(R),true)     :- location(R), \+ R=loc(1,1).
  213initially(isPit(R),false)    :- location(R).
  214initially(isGold(R),true)     :- location(R), \+ R=loc(1,1).
  215initially(isGold(R),false)    :- location(R).
  216	% Others
  217initially(tries,1).
  218initially(visited(R),true) :- R=loc(1,1).
  219initially(visited(R),false):- location(R), \+ R=loc(1,1).
  220
  221	
  222%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  223%  5 - MAIN ROUTINE CONTROLLERS
  224%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  225
  226% THIS IS THE MAIN PROCEDURE FOR INDIGOLOG
  227proc(main,  mainControl(N)) :- controller(N), !.
  228proc(main,  mainControl(4)). % default one
  229
  230
  231% Controller for the Wumpus:
  232%	1. If agent knows where the wumpus is, she is in line with it and
  233%	   the wumpus may be alive, then aim to wumpus and shoot arrow
  234%	2. If agent knows that there is gold in the current square, pick it up
  235%	3. Otherwise: sense everything and take a randomWalk
  236proc(mainControl(3),
  237   prioritized_interrupts(
  238         [interrupt([dir], and(aliveWumpus=true,
  239	 	    	    in_line(locRobot,dir,locWumpus)), [shoot(dir)] ),
  240	  interrupt(isGold(locRobot)=true, [pickGold]),
  241	  interrupt(inDungeon=true, [smell,senseBreeze,senseGold,
  242				wndet(newRandomWalk, [goto(loc(1,1)),climb])])
  243         ])  % END OF INTERRUPTS
  244).
  245
  246
  247% Controller for the Wumpus:
  248%	1. If agent knows where the wumpus is, she is in line with it and
  249%	   the wumpus may be alive, then aim to wumpus and shoot arrow
  250%	2. If agent knows that there is gold in the current square, pick it up
  251%	3. Otherwise: sense everything and take a randomWalk
  252%		If no randomWalk exists, go to loc(1,1) and climb
  253proc(mainControl(4),
  254   prioritized_interrupts(
  255         [interrupt([dir], and(aliveWumpus=true,
  256	 	    	    in_line(locRobot,dir,locWumpus)), [shoot(dir)] ),
  257	  interrupt(isGold(locRobot)=true, [pickGold]),
  258	  interrupt(inDungeon=true, 
  259	  	if(noGold>0,[goto(loc(1,1)),climb],
  260	  	    [smell,senseBreeze,senseGold,
  261		     wndet(explore_grid, [goto(loc(1,1)),climb])
  262		     ]))
  263         ])  % END OF INTERRUPTS
  264).
  265
  266% This controller uses mainControl(4) and tries twice if no gold was obtained
  267proc(mainControl(5),
  268	[mainControl(4),
  269	 if(noGold>0, ?(true), [reset,enter,mainControl(4)])]
  270).
  271
  272
  273proc(mainControl(6),
  274   prioritized_interrupts(
  275         [interrupt([dir,r],and(locWumpus=r,
  276	 	    	and(aliveWumpus=true,
  277	 	    	    in_line(locRobot,dir,locWumpus))), [shoot(dir)] ),
  278	  interrupt(isGold(locRobot)=true, [pickGold]),
  279	  interrupt(inDungeon=true, 
  280	  	if(noGold>0,[goto(loc(1,1)),climb],
  281	  	    [smell,senseBreeze,senseGold,
  282		     wndet(explore_grid2, [goto(loc(1,1)),climb])
  283		     ]))
  284         ])  % END OF INTERRUPTS
  285).
  286
  287% This controller uses mainControl(4) and tries twice if no gold was obtained
  288
  289%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  290%  6 - EXTRA AUXILIARLY PROGRAMS
  291%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  292
  293proc(move(D),  [search([star(turn,4),?(dirRobot=D),moveFwd])]).
  294proc(shoot(D), [search([star(turn,4),?(dirRobot=D),shootFwd])]).
  295
  296
  297
  298% Think of a plan (random walk) to safely move to some unvisited location 
  299proc(newRandomWalk, 
  300	  search([
  301	  	  	rpi(y,location,[
  302	  	  		?(visited(y)=true),
  303	  	  		rpi(z,location,[
  304	  	  			?(adj(y,z)),
  305	  	  			?(visited(z)=false),
  306	  	  			?(or(aliveWumpus=false,neg(locWumpus=z))),
  307	  	  			?(isPit(z)=false),
  308	  	  			?(pathfind(locRobot,y,L)),
  309	  	  			L,
  310	  	  			rpi(w,direction,[move(w),?(locRobot=z)])
  311	  	  		])
  312	  	  	])
  313	      ],
  314		  "SEARCH FOR A (NEW) RANDOM WALK......")
  315).
  316
  317
  318proc(goto(Loc), 
  319	  search([?(pathfind(locRobot,Loc,L)), L
  320			  ], ["PLANNING TO GO TO LOCATION: ",Loc])
  321).
  322
  323
  324proc(goto1step(Loc), 
  325	  pi(x,direction,[move(x),?(locRobot=Loc)])
  326).
  327
  328
  329proc(goodBorderPair(VLoc, NLoc), 
  330	[?(visited(VLoc)=true),
  331	?(adj(VLoc,NLoc)),
  332	?(visited(NLoc)=false),
  333	?(or(aliveWumpus=false,neg(locWumpus=NLoc))),
  334	?(isPit(NLoc)=false)]
  335).
  336
  337
  338proc(explore_grid, 
  339	search(pi([s,q],[?(gridsize(s)), ?(q is 2*s-2), explore_limit(0,q)]))
  340).
  341
  342proc(explore_limit(N,MAX), 
  343	  wndet(search([
  344	  	  	pi(y,[
  345	  	  		?(neighbor(locRobot,y,N)),
  346				?(visited(y)=true),
  347				%?(and(write('----->Y:'),writeln(y))),
  348	  	  		pi(z,[
  349	  	  			?(radj(y,z)),
  350	  	  			?(visited(z)=false),
  351	  	  			?(or(aliveWumpus=false,neg(locWumpus=z))),
  352	  	  			?(isPit(z)=false),
  353					%?(and(write('----->Z:'),writeln(z))),
  354	  	  			?(pathfind(locRobot,y,L)),
  355	  	  			L,
  356					%?(and(write('----->L:'),writeln(L))),
  357	  	  			rpi(w,direction,[move(w),
  358					%?(and(write('----->W:'),writeln(w))),
  359						?(locRobot=z)])
  360	  	  		])
  361	  	  	])
  362	      		],['SEARCH FOR A LOCATION ', N, ' STEPS AWAY......']),
  363		   search([?(and(M is N+1,M=<MAX)),explore_limit(M,MAX)])
  364		   )
  365	).
  366
  367
  368proc(explore_grid2, 
  369	search(pi([s,q],[?(gridsize(s)), ?(q is 2*s-2), explore_limit2(0,q)]))
  370).
  371proc(explore_limit2(N,MAX), 
  372	  wndet(search([
  373	  	  	pi(y,[
  374	  	  		?(neighbor(locRobot,y,N)),
  375				?(visited(y)=true),
  376	  	  		pi(z,[
  377	  	  			?(adj(y,z)),
  378	  	  			?(visited(z)=false),
  379	  	  			?(or(aliveWumpus=false,neg(locWumpus=z))),
  380	  	  			?(isPit(z)=false),
  381	  	  			?(pathfind(locRobot,y,L)),
  382	  	  			L,
  383	  	  			pi(w,direction,[move(w),?(locRobot=z)])
  384	  	  		])
  385	  	  	])
  386	      		],['SEARCH FOR A LOCATION ', N, ' STEPS AWAY......']),
  387		   search([?(and(M is N+1,M=<MAX)),explore_limit2(M,MAX)])
  388		   )
  389	).
  390
  391
  392
  393
  394%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  395%  PROLOG SPECIFIC TOOLS USED
  396%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  397
  398/* Map Definitions */
  399up(loc(X,Y),loc(X,YN))    :- YN is Y+1, location(loc(X,YN)). 
  400down(loc(X,Y),loc(X,YN))  :- YN is Y-1, location(loc(X,YN)).  
  401right(loc(X,Y),loc(XN,Y)) :- XN is X+1, location(loc(XN,Y)).  
  402left(loc(X,Y),loc(XN,Y))  :- XN is X-1, location(loc(XN,Y)).  
  403
  404% rotateRight(R1, R2): R2 is the new direction from R1 after rotating clockwise once
  405rotateRight(up,right).
  406rotateRight(right,down).
  407rotateRight(down,left).
  408rotateRight(left,up).
  409
  410valid_loc(loc(I,J)) :- domain(I,gridindex), domain(J,gridindex).
  411
  412adj(R1,R2) :- (up(R1,R2) ; down(R1,R2) ; left(R1,R2) ; right(R1,R2)).
  413
  414% adj/3: R2 is the adjacent square of R1 at direction D
  415adj(R1,R2,up)    :- up(R1,R2).
  416adj(R1,R2,down)  :- down(R1,R2).	
  417adj(R1,R2,left)  :- left(R1,R2).	
  418adj(R1,R2,right) :- right(R1,R2).	
  419
  420%random adj
  421radj(L1,L2):-bagof(P,adj(L1,P),L),shuffle(L,RL),member(L2,RL). 
  422
  423neighbor(L,L,0):-!. 
  424%neighbor(L1,L2,1):-!,bagof(P,adj(L1,P),L),shuffle(L,RL),member(L2,RL). 
  425neighbor(loc(I1,J1),loc(I2,J2),N):- 
  426	location(loc(I2,J2)),
  427	DiffI is I1-I2, DiffJ is J1-J2,
  428	abs(DiffI,AbsDiffI), abs(DiffJ,AbsDiffJ),
  429	N is AbsDiffI+AbsDiffJ.
  430	
  431% R2 is the next square of R1 in direction D
  432in_line(R1,_,R1).
  433in_line(R1,D,R2) :- adj(R1,R3,D), in_line(R3,D,R2).
  434
  435% Set up path finding. Here it will be used to find paths between locs
  436% Start and End, such that the path goes through locs visited before.
  437pathfind_move(Start, End, move(D)):- 
  438	direction(D), 
  439	apply(D,[Start,End]),
  440	now(H),
  441	holds(visited(End)=true,H).
  442
  443% Set heuristic (manhattan distance)
  444pathfind_heuristic(loc(I,J), loc(I2,J2), H):- 
  445	DiffI is I-I2, 
  446	DiffJ is J-J2,
  447	abs(DiffI,AbsDiffI), 
  448	abs(DiffJ,AbsDiffJ),
  449	H is AbsDiffI+AbsDiffJ.
  450
  451
  452%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  453%  OLD STUFF
  454%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  455
  456proc(mainControl(1), L) :-
  457reverse([climb, shootFwd, turn, moveFwd, moveFwd, moveFwd, turn, turn, senseGold, senseBreeze, smell, moveFwd, senseGold, senseBreeze, smell, moveFwd, turn, turn, turn, senseGold, senseBreeze, smell, moveFwd, turn, turn, turn, moveFwd, turn, turn, senseGold, senseBreeze, smell, moveFwd, turn, turn, turn, moveFwd, turn, turn, senseGold, senseBreeze, smell, moveFwd, turn, turn, turn, senseGold, senseBreeze, smell, moveFwd, turn, turn, turn, moveFwd, turn, turn, senseGold, senseBreeze, smell, moveFwd, senseGold, senseBreeze, smell, moveFwd, turn, turn, turn, senseGold, senseBreeze, smell],L).
  458
  459proc(mainControl(2), L) :-
  460reverse([climb, moveFwd, turn, moveFwd, moveFwd, moveFwd, moveFwd, moveFwd, turn, turn, moveFwd, turn, moveFwd, turn, turn, turn, moveFwd, turn, pickGold, senseGold, senseBreeze, smell, moveFwd, turn, senseGold, senseBreeze, smell, moveFwd, senseGold, senseBreeze, smell, moveFwd, turn, senseGold, senseBreeze, smell, moveFwd, turn, turn, turn, moveFwd, turn, turn, senseGold, senseBreeze, smell, moveFwd, senseGold, senseBreeze, smell, moveFwd, turn, turn, turn, senseGold, senseBreeze, smell, moveFwd, turn, senseGold, senseBreeze, smell, moveFwd, turn, turn, turn, senseGold, senseBreeze, smell, moveFwd, turn, turn, turn, moveFwd, turn, turn, senseGold, senseBreeze, smell, moveFwd, senseGold, senseBreeze, smell, moveFwd, senseGold, senseBreeze, shootFwd, smell, moveFwd, turn, senseGold, senseBreeze, smell, moveFwd, turn, moveFwd, turn, turn, senseGold, senseBreeze, smell, moveFwd, turn, senseGold, senseBreeze, smell, moveFwd, turn, turn, turn, senseGold, senseBreeze, smell, moveFwd, turn, turn, turn, senseGold, senseBreeze, smell, moveFwd, senseGold, senseBreeze, smell, moveFwd, senseGold, senseBreeze, smell], L).
  461
  462% "Thinking fluent" temp to be used in lessRandomWalk
  463fun_fluent(temp).
  464causes(setTemp(V), temp, V, true).
  465
  466% Think of a plan (random walk) to safely move to some unvisited location 
  467proc(lessRandomWalk, 
  468	  search([
  469	      setTemp([]), 
  470	      star(
  471	      	[?(directions(D)),
  472	   		 rpi(y,D,[
  473	   			%?(write('-0-')),?(write(y)),?(write('\n')),
  474	   			pi(z,[
  475					?(apply(y,[locRobot,z])),
  476			  		?(valid_loc(z)),
  477					?(visited(z)=true),
  478					%?(write('-1-')),?(write(z)),?(write('\n')),
  479					%?(write('-2-')),?(write(temp)),?(write('\n')),
  480					?(\+(member(z,temp))), 
  481					%?(write('-3-')),?(write([z|temp])),?(write('\n')),
  482					setTemp([z|temp])
  483					%?(write('-4-')),?(write(temp)),?(write('\n')),
  484					%?(write('.'))
  485				]),
  486				move(y)])
  487			]
  488	      ),
  489		  moveSafely],
  490		  "SEARCH FOR A (LESS) RANDOM WALK......")
  491	).
  492
  493
  494%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  495%  INFORMATION FOR THE EXECUTOR
  496%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  497% Translations of domain actions to real actions (one-to-one)
  498actionNum(X,X).	
  499	
  500		
  501%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  502% EOF: Examples/Wumpus/wumpus.pl
  503%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  504
  505
  506
  507
  508now(5,H):- reverse([e(smell,0),smell,e(senseBreeze,0),senseBreeze,e(senseGold,0),senseGold,turn,turn,turn,moveFwd,e(smell,0),smell,e(senseBreeze,0),senseBreeze,e(senseGold,0),senseGold,moveFwd,e(smell,0),smell,e(senseBreeze,0),senseBreeze,e(senseGold,0),senseGold,moveFwd,e(smell,0),smell,e(senseBreeze,0),senseBreeze,e(senseGold,0),senseGold,turn,moveFwd,e(smell,1),smell,e(senseBreeze,0),senseBreeze,e(senseGold,0),senseGold,turn,moveFwd,e(smell,0),smell],H).
  509
  510
  511
  512
  513
  514
  515
  516now(1,[climb, moveFwd, turn, turn, turn, moveFwd, turn, moveFwd, moveFwd, moveFwd, moveFwd, turn, turn, turn, scream, shootFwd, turn, moveFwd, moveFwd, turn, turn, moveFwd, turn, pickGold, e(senseGold, 1), senseGold, e(senseBreeze, 0), senseBreeze, e(smell, 0), smell, moveFwd, e(senseGold, 0), senseGold, e(senseBreeze, 0), senseBreeze,turn, turn, turn, moveFwd, turn, turn, e(senseGold, 0), senseGold, e(senseBreeze, 0), senseBreeze, e(smell, 1), smell, moveFwd, e(senseGold, 0), senseGold, e(senseBreeze, 0), senseBreeze, e(smell, 0), smell, moveFwd, turn, turn, turn, e(senseGold, 0), senseGold, e(senseBreeze, 0), senseBreeze, e(smell, 0), smell, moveFwd, turn, e(senseGold, 0), senseGold, e(senseBreeze, 0), senseBreeze, e(smell, 0), smell, moveFwd, turn, e(senseGold, 0), senseGold, e(smell, 0), smell, moveFwd, turn, turn, turn, e(senseGold, 0), senseGold, e(senseBreeze, 0), senseBreeze, e(smell, 0), smell, moveFwd, turn, turn, turn, e(senseGold, 0), senseGold, e(senseBreeze, 0), senseBreeze, e(smell, 0), smell, moveFwd, turn, e(senseGold, 0), senseGold, e(senseBreeze, 0), senseBreeze, e(smell, 0), smell, moveFwd, turn, turn, turn, e(senseGold, 0), senseGold, e(senseBreeze, 0), senseBreeze, e(smell, 0), smell, moveFwd, e(senseBreeze, 0), senseBreeze, e(smell, 0), smell, moveFwd, turn, turn, turn, e(senseGold, 0), senseGold, e(senseBreeze, 0), senseBreeze, e(smell, 0), smell, moveFwd, turn, turn, turn, e(senseGold, 0), senseGold, e(senseBreeze, 0), senseBreeze, e(smell, 0), smell, moveFwd, turn, e(senseGold, 0), senseGold, e(senseBreeze, 0), senseBreeze, e(smell, 0), smell, moveFwd, turn, turn, turn, e(senseGold, 0), senseGold, e(senseBreeze, 0), senseBreeze, e(smell, 0), smell]).
  517
  518
  519
  520now(2,
  521[e(smell,0),smell,
  522e(senseBreeze,0),senseBreeze,
  523e(senseGold,0),senseGold,
  524turn,
  525turn,
  526turn,
  527moveFwd,
  528e(smell,0),smell,
  529e(senseBreeze,0),senseBreeze,
  530e(senseGold,0),senseGold,
  531turn,
  532moveFwd,
  533e(smell,0),smell,
  534e(senseBreeze,0),senseBreeze,
  535e(senseGold,0),senseGold,
  536turn,
  537turn,
  538turn,
  539moveFwd,
  540e(smell,0),smell,
  541e(senseBreeze,0),senseBreeze,
  542e(senseGold,0),senseGold,
  543turn,
  544turn,
  545turn,
  546moveFwd,
  547e(smell,0),smell,
  548e(senseBreeze,0),senseBreeze,
  549e(senseGold,0),senseGold,
  550turn,
  551moveFwd,
  552e(smell,0),smell,
  553e(senseBreeze,0),senseBreeze,
  554e(senseGold,0),senseGold,
  555turn,
  556moveFwd,
  557e(smell,0),smell,
  558e(senseBreeze,0),senseBreeze,
  559e(senseGold,0),senseGold,
  560turn,
  561turn,
  562turn,
  563moveFwd,
  564e(smell,0),smell,
  565e(senseBreeze,0),senseBreeze,
  566e(senseGold,0),senseGold,
  567moveFwd,
  568e(smell,1),smell,
  569e(senseBreeze,0),senseBreeze,
  570e(senseGold,0),senseGold,
  571turn,
  572turn,
  573moveFwd,
  574turn,
  575turn,
  576turn,
  577moveFwd,
  578e(smell,0),smell,
  579e(senseBreeze,0),senseBreeze,
  580e(senseGold,0),senseGold,
  581turn,
  582turn,
  583turn,
  584moveFwd,
  585e(smell,0),smell,
  586e(senseBreeze,0),senseBreeze,
  587e(senseGold,0),senseGold,
  588turn,
  589moveFwd,
  590e(smell,0),smell,
  591e(senseBreeze,0),senseBreeze,
  592e(senseGold,0),senseGold,
  593turn,
  594turn,
  595turn,
  596moveFwd,
  597e(smell,0),smell,
  598e(senseBreeze,0),senseBreeze,
  599e(senseGold,0),senseGold,
  600turn,
  601turn,
  602turn,
  603moveFwd,
  604e(smell,0),smell,
  605e(senseBreeze,0),senseBreeze,
  606e(senseGold,0),senseGold,
  607moveFwd,
  608e(smell,0),smell,
  609e(senseBreeze,0),senseBreeze,
  610e(senseGold,1),senseGold,
  611pickGold,
  612turn,
  613moveFwd,
  614turn,
  615turn,
  616moveFwd,
  617moveFwd,
  618turn,
  619shootFwd,
  620scream,
  621turn,
  622turn,
  623turn,
  624moveFwd,
  625moveFwd,
  626moveFwd,
  627moveFwd,
  628turn,
  629moveFwd,
  630turn,
  631turn,
  632turn,
  633moveFwd,
  634climb]).
  635
  636%H = [moveFwd, turn, turn, e(senseGold, 0), senseGold, e(senseBreeze, 0), senseBreeze, e(smell, 0), smell]
  637
  638
  639now(6,H) :-
  640reverse([e(smell,0),smell,e(senseBreeze,0),senseBreeze,e(senseGold,0),senseGold,moveFwd,
  641e(smell,0),smell,e(senseBreeze,0),senseBreeze,e(senseGold,0),senseGold,moveFwd,e(smell,0),smell,
  642e(senseBreeze,0),senseBreeze,e(senseGold,0),senseGold,turn,turn,turn,moveFwd,e(smell,0),
  643smell,
  644e(senseBreeze,0),senseBreeze,e(senseGold,0),senseGold,moveFwd,e(smell,0),smell,e(senseBreeze,0),senseBreeze,e(senseGold,0),senseGold,turn,turn,turn,moveFwd,e(smell,0),smell,e(senseBreeze,0),senseBreeze,e(senseGold,0),senseGold],H)