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	findall(X,get_integer(1,X,S),L),
   73	member(V,L).
   74direction(V) :- member(V,[up,down,left,right]).
   75location(loc(I,J)) :- gridindex(I), gridindex(J).
   76
   77%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   78%  1 - ACTIONS AND PRECONDITIONS
   79%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   80prim_action(smell).
   81poss(smell, true).
   82senses(smell). 		% Perceived at a square iff the Wumpus is at this square or in its neighbourhood.
   83
   84prim_action(senseBreeze).
   85poss(senseBreeze, true).
   86senses(senseBreeze). 	% Perceived at a square iff a isPit is in the neighborhood of this square.
   87
   88prim_action(senseGold).
   89poss(senseGold, true).
   90senses(senseGold).	% Perceived at a square iff gold is in this square.
   91
   92prim_action(shootFwd).
   93poss(shootFwd, hasArrow=true).
   94
   95prim_action(pickGold).
   96poss(pickGold, isGold(locRobot)=true).
   97
   98prim_action(setTemp(_)). % sets the value of a thinking fluent temp
   99poss(setTemp(_), true).
  100
  101prim_action(moveFwd).
  102poss(moveFwd, neg(inTheEdge(locRobot,dirRobot))).
  103
  104inTheEdge(loc(1,_),left).
  105inTheEdge(loc(X,_),right)	:- gridsize(X).
  106inTheEdge(loc(_,1),down).
  107inTheEdge(loc(_,X),up)		:- gridsize(X).
  108
  109prim_action(turn).
  110poss(turn, true).
  111
  112prim_action(climb).
  113poss(climb, true).
  114
  115prim_action(enter).
  116poss(enter, true).
  117
  118prim_action(reset).
  119poss(reset, true).
  120
  121/* Exogenous Actions Available */
  122exog_action(scream).
  123
  124
  125%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  126%  2 - FUNCTIONAL FLUENTS AND CAUSAL LAWS
  127%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  128
  129% inDungeon: robot is inside the dungeon
  130fun_fluent(inDungeon).
  131causes(climb, inDungeon, false, locRobot=loc(1,1)).
  132causes(enter, inDungeon, true, true).
  133
  134% locWumpus: locations of the Wumpus
  135fun_fluent(locWumpus).
  136rejects(smell, 1, locWumpus, Y, neg(adj(locRobot,Y))).
  137rejects(smell, 0, locWumpus, Y, adj(locRobot,Y)).
  138
  139% locRobot: current location of the robot 
  140fun_fluent(locRobot).
  141causes(moveFwd, locRobot, Y, apply(dirRobot,[locRobot,Y])).
  142
  143% dirRobot: direction of the robot (up, right, left, down)
  144fun_fluent(dirRobot).
  145causes(turn, dirRobot, Y, rotateRight(dirRobot,Y)).
  146
  147% isGold(L): whether there is gold at location L
  148fun_fluent(isGold(L)):- location(L).
  149settles(senseGold, 1, isGold(L), true,  L=locRobot). 
  150settles(senseGold, 0, isGold(L), false, L=locRobot).
  151causes(pickGold, isGold(L), false, locRobot=L). 
  152causes(pickGold, isGold(L), V, and(neg(locRobot=L),V=isGold(L))). 
  153
  154% noGold: number of gold pices the robot is holding
  155fun_fluent(noGold).
  156causes(pickGold, noGold, V, V is noGold+1).
  157
  158
  159% isPit(L): whether there is a pit at location L
  160fun_fluent(isPit(L)):- location(L).
  161settles(senseBreeze, 0, isPit(L), false, adj(locRobot,L)).
  162rejects(senseBreeze, 1, isPit(L), false,  
  163	and(adj(locRobot,L),
  164	    all(y,location, impl(and(adj(locRobot,y),neg(L=y)),isPit(y)=false))
  165	)
  166).
  167
  168% hasArrow: whether the robot has an arrow to use
  169fun_fluent(hasArrow).
  170causes(shoot(_), hasArrow, false, true).
  171
  172% aliveWumpus: wumpus is alive
  173fun_fluent(aliveWumpus).
  174causes(scream, aliveWumpus, false, true).
  175%causes(shootFwd, aliveWumpus, false, in_line(locRobot,dirRobot,locWumpus)).
  176%causes(shootFwd, aliveWumpus, true, 
  177%		   and(neg(in_line(locRobot,dirRobot,locWumpus)),aliveWumpus=true)
  178%		   ).
  179
  180% visited(L): location L is visited already
  181fun_fluent(visited(L)) :- location(L).
  182causes(moveFwd, visited(L), true, apply(dirRobot,[locRobot,L])).
  183%"small" frame
  184causes(moveFwd, visited(L), V, and(neg(apply(dirRobot,[locRobot,L])),V=visited(L))).
  185causes(reset, visited(L), false,neg(locRobot=L)).
  186causes(reset, visited(L), true, locRobot=L).
  187
  188%causes(moveFwd, locWumpus, V, or(V=locWumpus,and(adj(locRobot,L),V=L)))
  189
  190fun_fluent(tries).
  191causes(reset, tries, V, V is tries+1).
  192
  193%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  194%  3 - ABBREVIATIONS
  195%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  196
  197%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  198%  4 - INITIAL STATE
  199%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  200	% Robot state
  201initially(locRobot,loc(1,1)).
  202initially(dirRobot, right).
  203initially(hasArrow,true).
  204initially(noGold,0).
  205initially(inDungeon,true).
  206	% Wumpus state
  207initially(locWumpus,R):- location(R), \+ R=loc(1,1).
  208initially(aliveWumpus,true).
  209	% Pits	
  210initially(isPit(R),true)     :- location(R), \+ R=loc(1,1).
  211initially(isPit(R),false)    :- location(R).
  212initially(isGold(R),true)     :- location(R), \+ R=loc(1,1).
  213initially(isGold(R),false)    :- location(R).
  214	% Others
  215initially(tries,1).
  216initially(visited(R),true) :- R=loc(1,1).
  217initially(visited(R),false):- location(R), \+ R=loc(1,1).
  218
  219	
  220%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  221%  5 - MAIN ROUTINE CONTROLLERS
  222%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  223
  224% THIS IS THE MAIN PROCEDURE FOR INDIGOLOG
  225proc(main,  mainControl(N)) :- controller(N), !.
  226proc(main,  mainControl(4)). % default one
  227
  228
  229% Controller for the Wumpus:
  230%	1. If agent knows where the wumpus is, she is in line with it and
  231%	   the wumpus may be alive, then aim to wumpus and shoot arrow
  232%	2. If agent knows that there is gold in the current square, pick it up
  233%	3. Otherwise: sense everything and take a randomWalk
  234proc(mainControl(3),
  235   prioritized_interrupts(
  236         [interrupt([dir], and(aliveWumpus=true,
  237	 	    	    in_line(locRobot,dir,locWumpus)), [shoot(dir)] ),
  238	  interrupt(isGold(locRobot)=true, [pickGold]),
  239	  interrupt(inDungeon=true, [smell,senseBreeze,senseGold,
  240				wndet(newRandomWalk, [goto(loc(1,1)),climb])])
  241         ])  % END OF INTERRUPTS
  242).
  243
  244
  245% Controller for the Wumpus:
  246%	1. If agent knows where the wumpus is, she is in line with it and
  247%	   the wumpus may be alive, then aim to wumpus and shoot arrow
  248%	2. If agent knows that there is gold in the current square, pick it up
  249%	3. Otherwise: sense everything and take a randomWalk
  250%		If no randomWalk exists, go to loc(1,1) and climb
  251proc(mainControl(4),
  252   prioritized_interrupts(
  253         [interrupt([dir], and(aliveWumpus=true,
  254	 	    	    in_line(locRobot,dir,locWumpus)), [shoot(dir)] ),
  255	  interrupt(isGold(locRobot)=true, [pickGold]),
  256	  interrupt(inDungeon=true, 
  257	  	if(noGold>0,[goto(loc(1,1)),climb],
  258	  	    [smell,senseBreeze,senseGold,
  259		     wndet(explore_grid, [goto(loc(1,1)),climb])
  260		     ]))
  261         ])  % END OF INTERRUPTS
  262).
  263
  264% This controller uses mainControl(4) and tries twice if no gold was obtained
  265proc(mainControl(5),
  266	[mainControl(4),
  267	 if(noGold>0, ?(true), [reset,enter,mainControl(4)])]
  268).
  269
  270
  271proc(mainControl(6),
  272   prioritized_interrupts(
  273         [interrupt([dir,r],and(locWumpus=r,
  274	 	    	and(aliveWumpus=true,
  275	 	    	    in_line(locRobot,dir,locWumpus))), [shoot(dir)] ),
  276	  interrupt(isGold(locRobot)=true, [pickGold]),
  277	  interrupt(inDungeon=true, 
  278	  	if(noGold>0,[goto(loc(1,1)),climb],
  279	  	    [smell,senseBreeze,senseGold,
  280		     wndet(explore_grid2, [goto(loc(1,1)),climb])
  281		     ]))
  282         ])  % END OF INTERRUPTS
  283).
  284
  285% This controller uses mainControl(4) and tries twice if no gold was obtained
  286
  287%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  288%  6 - EXTRA AUXILIARLY PROGRAMS
  289%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  290
  291proc(move(D),  [search([star(turn,4),?(dirRobot=D),moveFwd])]).
  292proc(shoot(D), [search([star(turn,4),?(dirRobot=D),shootFwd])]).
  293
  294
  295
  296% Think of a plan (random walk) to safely move to some unvisited location 
  297proc(newRandomWalk, 
  298	  search([
  299	  	  	rpi(y,location,[
  300	  	  		?(visited(y)=true),
  301	  	  		rpi(z,location,[
  302	  	  			?(adj(y,z)),
  303	  	  			?(visited(z)=false),
  304	  	  			?(or(aliveWumpus=false,neg(locWumpus=z))),
  305	  	  			?(isPit(z)=false),
  306	  	  			?(pathfind(locRobot,y,L)),
  307	  	  			L,
  308	  	  			rpi(w,direction,[move(w),?(locRobot=z)])
  309	  	  		])
  310	  	  	])
  311	      ],
  312		  "SEARCH FOR A (NEW) RANDOM WALK......")
  313).
  314
  315
  316proc(goto(Loc), 
  317	  search([?(pathfind(locRobot,Loc,L)), L
  318			  ], ["PLANNING TO GO TO LOCATION: ",Loc])
  319).
  320
  321
  322proc(goto1step(Loc), 
  323	  pi(x,direction,[move(x),?(locRobot=Loc)])
  324).
  325
  326
  327proc(goodBorderPair(VLoc, NLoc), 
  328	[?(visited(VLoc)=true),
  329	?(adj(VLoc,NLoc)),
  330	?(visited(NLoc)=false),
  331	?(or(aliveWumpus=false,neg(locWumpus=NLoc))),
  332	?(isPit(NLoc)=false)]
  333).
  334
  335
  336proc(explore_grid, 
  337	search(pi([s,q],[?(gridsize(s)), ?(q is 2*s-2), explore_limit(0,q)]))
  338).
  339
  340proc(explore_limit(N,MAX), 
  341	  wndet(search([
  342	  	  	pi(y,[
  343	  	  		?(neighbor(locRobot,y,N)),
  344				?(visited(y)=true),
  345				%?(and(write('----->Y:'),writeln(y))),
  346	  	  		pi(z,[
  347	  	  			?(radj(y,z)),
  348	  	  			?(visited(z)=false),
  349	  	  			?(or(aliveWumpus=false,neg(locWumpus=z))),
  350	  	  			?(isPit(z)=false),
  351					%?(and(write('----->Z:'),writeln(z))),
  352	  	  			?(pathfind(locRobot,y,L)),
  353	  	  			L,
  354					%?(and(write('----->L:'),writeln(L))),
  355	  	  			rpi(w,direction,[move(w),
  356					%?(and(write('----->W:'),writeln(w))),
  357						?(locRobot=z)])
  358	  	  		])
  359	  	  	])
  360	      		],['SEARCH FOR A LOCATION ', N, ' STEPS AWAY......']),
  361		   search([?(and(M is N+1,M=<MAX)),explore_limit(M,MAX)])
  362		   )
  363	).
  364
  365
  366proc(explore_grid2, 
  367	search(pi([s,q],[?(gridsize(s)), ?(q is 2*s-2), explore_limit2(0,q)]))
  368).
  369proc(explore_limit2(N,MAX), 
  370	  wndet(search([
  371	  	  	pi(y,[
  372	  	  		?(neighbor(locRobot,y,N)),
  373				?(visited(y)=true),
  374	  	  		pi(z,[
  375	  	  			?(adj(y,z)),
  376	  	  			?(visited(z)=false),
  377	  	  			?(or(aliveWumpus=false,neg(locWumpus=z))),
  378	  	  			?(isPit(z)=false),
  379	  	  			?(pathfind(locRobot,y,L)),
  380	  	  			L,
  381	  	  			pi(w,direction,[move(w),?(locRobot=z)])
  382	  	  		])
  383	  	  	])
  384	      		],['SEARCH FOR A LOCATION ', N, ' STEPS AWAY......']),
  385		   search([?(and(M is N+1,M=<MAX)),explore_limit2(M,MAX)])
  386		   )
  387	).
  388
  389
  390
  391
  392%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  393%  PROLOG SPECIFIC TOOLS USED
  394%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  395
  396/* Map Definitions */
  397up(loc(X,Y),loc(X,YN))    :- YN is Y+1, location(loc(X,YN)). 
  398down(loc(X,Y),loc(X,YN))  :- YN is Y-1, location(loc(X,YN)).  
  399right(loc(X,Y),loc(XN,Y)) :- XN is X+1, location(loc(XN,Y)).  
  400left(loc(X,Y),loc(XN,Y))  :- XN is X-1, location(loc(XN,Y)).  
  401
  402% rotateRight(R1, R2): R2 is the new direction from R1 after rotating clockwise once
  403rotateRight(up,right).
  404rotateRight(right,down).
  405rotateRight(down,left).
  406rotateRight(left,up).
  407
  408valid_loc(loc(I,J)) :- domain(I,gridindex), domain(J,gridindex).
  409
  410adj(R1,R2) :- (up(R1,R2) ; down(R1,R2) ; left(R1,R2) ; right(R1,R2)).
  411
  412% adj/3: R2 is the adjacent square of R1 at direction D
  413adj(R1,R2,up)    :- up(R1,R2).
  414adj(R1,R2,down)  :- down(R1,R2).	
  415adj(R1,R2,left)  :- left(R1,R2).	
  416adj(R1,R2,right) :- right(R1,R2).	
  417
  418%random adj
  419radj(L1,L2):-bagof(P,adj(L1,P),L),shuffle(L,RL),member(L2,RL). 
  420
  421neighbor(L,L,0):-!. 
  422%neighbor(L1,L2,1):-!,bagof(P,adj(L1,P),L),shuffle(L,RL),member(L2,RL). 
  423neighbor(loc(I1,J1),loc(I2,J2),N):- 
  424	location(loc(I2,J2)),
  425	DiffI is I1-I2, DiffJ is J1-J2,
  426	abs(DiffI,AbsDiffI), abs(DiffJ,AbsDiffJ),
  427	N is AbsDiffI+AbsDiffJ.
  428	
  429% R2 is the next square of R1 in direction D
  430in_line(R1,_,R1).
  431in_line(R1,D,R2) :- adj(R1,R3,D), in_line(R3,D,R2).
  432
  433% Set up path finding. Here it will be used to find paths between locs
  434% Start and End, such that the path goes through locs visited before.
  435pathfind_move(Start, End, move(D)):- 
  436	direction(D), 
  437	apply(D,[Start,End]),
  438	now(H),
  439	holds(visited(End)=true,H).
  440
  441% Set heuristic (manhattan distance)
  442pathfind_heuristic(loc(I,J), loc(I2,J2), H):- 
  443	DiffI is I-I2, 
  444	DiffJ is J-J2,
  445	abs(DiffI,AbsDiffI), 
  446	abs(DiffJ,AbsDiffJ),
  447	H is AbsDiffI+AbsDiffJ.
  448
  449
  450%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  451%  OLD STUFF
  452%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  453
  454proc(mainControl(1), L) :-
  455reverse([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).
  456
  457proc(mainControl(2), L) :-
  458reverse([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).
  459
  460% "Thinking fluent" temp to be used in lessRandomWalk
  461fun_fluent(temp).
  462causes(setTemp(V), temp, V, true).
  463
  464% Think of a plan (random walk) to safely move to some unvisited location 
  465proc(lessRandomWalk, 
  466	  search([
  467	      setTemp([]), 
  468	      star(
  469	      	[?(directions(D)),
  470	   		 rpi(y,D,[
  471	   			%?(write('-0-')),?(write(y)),?(write('\n')),
  472	   			pi(z,[
  473					?(apply(y,[locRobot,z])),
  474			  		?(valid_loc(z)),
  475					?(visited(z)=true),
  476					%?(write('-1-')),?(write(z)),?(write('\n')),
  477					%?(write('-2-')),?(write(temp)),?(write('\n')),
  478					?(\+(member(z,temp))), 
  479					%?(write('-3-')),?(write([z|temp])),?(write('\n')),
  480					setTemp([z|temp])
  481					%?(write('-4-')),?(write(temp)),?(write('\n')),
  482					%?(write('.'))
  483				]),
  484				move(y)])
  485			]
  486	      ),
  487		  moveSafely],
  488		  "SEARCH FOR A (LESS) RANDOM WALK......")
  489	).
  490
  491
  492%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  493%  INFORMATION FOR THE EXECUTOR
  494%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  495% Translations of domain actions to real actions (one-to-one)
  496actionNum(X,X).	
  497	
  498		
  499%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  500% EOF: Examples/Wumpus/wumpus.pl
  501%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  502
  503
  504
  505
  506now(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).
  507
  508
  509
  510
  511
  512
  513
  514now(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]).
  515
  516
  517
  518now(2,
  519[e(smell,0),smell,
  520e(senseBreeze,0),senseBreeze,
  521e(senseGold,0),senseGold,
  522turn,
  523turn,
  524turn,
  525moveFwd,
  526e(smell,0),smell,
  527e(senseBreeze,0),senseBreeze,
  528e(senseGold,0),senseGold,
  529turn,
  530moveFwd,
  531e(smell,0),smell,
  532e(senseBreeze,0),senseBreeze,
  533e(senseGold,0),senseGold,
  534turn,
  535turn,
  536turn,
  537moveFwd,
  538e(smell,0),smell,
  539e(senseBreeze,0),senseBreeze,
  540e(senseGold,0),senseGold,
  541turn,
  542turn,
  543turn,
  544moveFwd,
  545e(smell,0),smell,
  546e(senseBreeze,0),senseBreeze,
  547e(senseGold,0),senseGold,
  548turn,
  549moveFwd,
  550e(smell,0),smell,
  551e(senseBreeze,0),senseBreeze,
  552e(senseGold,0),senseGold,
  553turn,
  554moveFwd,
  555e(smell,0),smell,
  556e(senseBreeze,0),senseBreeze,
  557e(senseGold,0),senseGold,
  558turn,
  559turn,
  560turn,
  561moveFwd,
  562e(smell,0),smell,
  563e(senseBreeze,0),senseBreeze,
  564e(senseGold,0),senseGold,
  565moveFwd,
  566e(smell,1),smell,
  567e(senseBreeze,0),senseBreeze,
  568e(senseGold,0),senseGold,
  569turn,
  570turn,
  571moveFwd,
  572turn,
  573turn,
  574turn,
  575moveFwd,
  576e(smell,0),smell,
  577e(senseBreeze,0),senseBreeze,
  578e(senseGold,0),senseGold,
  579turn,
  580turn,
  581turn,
  582moveFwd,
  583e(smell,0),smell,
  584e(senseBreeze,0),senseBreeze,
  585e(senseGold,0),senseGold,
  586turn,
  587moveFwd,
  588e(smell,0),smell,
  589e(senseBreeze,0),senseBreeze,
  590e(senseGold,0),senseGold,
  591turn,
  592turn,
  593turn,
  594moveFwd,
  595e(smell,0),smell,
  596e(senseBreeze,0),senseBreeze,
  597e(senseGold,0),senseGold,
  598turn,
  599turn,
  600turn,
  601moveFwd,
  602e(smell,0),smell,
  603e(senseBreeze,0),senseBreeze,
  604e(senseGold,0),senseGold,
  605moveFwd,
  606e(smell,0),smell,
  607e(senseBreeze,0),senseBreeze,
  608e(senseGold,1),senseGold,
  609pickGold,
  610turn,
  611moveFwd,
  612turn,
  613turn,
  614moveFwd,
  615moveFwd,
  616turn,
  617shootFwd,
  618scream,
  619turn,
  620turn,
  621turn,
  622moveFwd,
  623moveFwd,
  624moveFwd,
  625moveFwd,
  626turn,
  627moveFwd,
  628turn,
  629turn,
  630turn,
  631moveFwd,
  632climb]).
  633
  634%H = [moveFwd, turn, turn, e(senseGold, 0), senseGold, e(senseBreeze, 0), senseBreeze, e(smell, 0), smell]
  635
  636
  637now(6,H) :-
  638reverse([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,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,turn,turn,turn,moveFwd,e(smell,0),smell,e(senseBreeze,0),senseBreeze,e(senseGold,0),senseGold],H)