1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%
    3% FILE    : Examples/CLIMA/agent_clima.pl
    4%
    5%       Axiomatization of the Wumpus World 
    6%       under the BAT with possible values evaluator
    7%
    8%  AUTHOR : Stavros Vassos & Sebastian Sardina (2005)
    9%  email  : {ssardina,stavros}@cs.toronto.edu
   10%  WWW    : www.cs.toronto.edu/cogrobo
   11%  TYPE   : system independent code
   12%  TESTED : SWI Prolog 5.0.10 http://www.swi-prolog.org
   13%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   14%
   15%                             May 18, 2001
   16%
   17% This software was developed by the Cognitive Robotics Group under the
   18% direction of Hector Levesque and Ray Reiter.
   19% 
   20%        Do not distribute without permission.
   21%        Include this notice in any copy made.
   22% 
   23% 
   24%         Copyright (c) 2000 by The University of Toronto,
   25%                        Toronto, Ontario, Canada.
   26% 
   27%                          All Rights Reserved
   28% 
   29% Permission to use, copy, and modify, this software and its
   30% documentation for non-commercial research purpose is hereby granted
   31% without fee, provided that the above copyright notice appears in all
   32% copies and that both the copyright notice and this permission notice
   33% appear in supporting documentation, and that the name of The University
   34% of Toronto not be used in advertising or publicity pertaining to
   35% distribution of the software without specific, written prior
   36% permission.  The University of Toronto makes no representations about
   37% the suitability of this software for any purpose.  It is provided "as
   38% is" without express or implied warranty.
   39% 
   40% THE UNIVERSITY OF TORONTO DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS
   41% SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
   42% FITNESS, IN NO EVENT SHALL THE UNIVERSITY OF TORONTO BE LIABLE FOR ANY
   43% SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
   44% RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
   45% CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
   46% CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
   47%
   48%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   49% 
   50%  A basic action theory (BAT) is described with:
   51%
   52% -- fun_fluent(fluent)     : for each functional fluent (non-ground)
   53%
   54%           e.g., fun_fluent(color(C)).
   55%
   56% -- prim_action(action)    : for each primitive action (ground)
   57% -- exog_action(action)    : for each exogenous action (ground)
   58%
   59%           e.g., prim_action(clean(C)) :- domain(C,country).
   60%           e.g., exog_action(painte(C,B)):- domain(C,country), domain(B,color).
   61%
   62% -- senses(action,fluent)  : for each sensing action
   63%
   64%           e.g, poss(check_painted(C),  painted(C)).
   65%
   66% -- poss(action,cond)      : when cond, action is executable
   67%
   68%           e.g, poss(clean(C),   and(painted(C),holding(cleanear))).
   69%
   70% -- initially(fluent,value): fluent has value in S0 (ground)
   71%
   72%          e.g., initially(painted(C), false):- domain(C,country), C\=3.
   73%                initially(painted(3), true).
   74%                initially(color(3), blue).
   75%
   76% -- causes_tt(action,fluent,value,cond)
   77%          when cond holds, doing act causes functional fluent to have value
   78%
   79%            e.g., causes_tt(paint(C2,V), color(C), V, C = C2).
   80%               or causes_tt(paint(C,V), color(C), V, true).
   81%
   82% -- sort(name,domain_of_sort).      : all sorts used in the domain
   83%
   84%        e.g., varsort(c, colors).
   85%              varsort(temp, temperature).
   86%              color([blue, green, yellow, red]).       
   87%              temperature([-10,0,10,20,30,40]).
   88%
   89%
   90% A high-level program-controller is described with:
   91%
   92% -- proc(name,P): for each procedure P 
   93% -- simulator(N,P): P is the N exogenous action simulator
   94%
   95% The interface for Lego is described with:
   96%
   97% -- actionNum(action, num)  
   98%         action has RCX code num
   99% -- simulateSensing(action)
  100%         sensing result for action should be asked to the user
  101% -- translateSensing(action, sensorValue, sensorResult) 
  102%         translate the sensorValue of action to sensorResult
  103% -- translateExogAction(codeAction, action) 
  104%         translateSensing action name into codeAction and vice-versa
  105%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  106
  107% Indigolog caching: fluents that are heavily used should be cached 
  108cache(locRobot).
  109cache(isPit(_)).
  110cache(isGold(_)).
  111%cache(_):-fail.
  112
  113%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  114%  0 - DEFINITIONS OF DOMAINS/SORTS
  115%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  116:- dynamic gridsizeX/1, gridsizeY/1.  117
  118gridsizeX(100).
  119gridsizeY(100).
  120gridindexX(V) :- gridsizeX(S), S2 is S-1, !, get_integer(0,V,S2).
  121gridindexY(V) :- gridsizeY(S), S2 is S-1, !, get_integer(0,V,S2).
  122gridsize(X,Y) :- gridsizeX(X), gridsizeY(Y).
  123
  124% This are the domains/sorts used in the application
  125direction(V) :- member(V, [up,down,left,right]).
  126all_direction(V) :- member(V, [n,s,r,l,ne,nw,se,sw,cur]).
  127location(loc(I,J)) :- gridindexX(I), gridindexY(J).
  128
  129%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  130%  1 - ACTIONS AND PRECONDITIONS
  131%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  132prim_action(skip).
  133poss(skip, true).
  134
  135prim_action(left).
  136poss(left, and(locRobot=loc(X,_), X>0)).
  137
  138prim_action(right).
  139poss(right, and(locRobot=loc(X,_), X<gridSizeX)).
  140
  141prim_action(up).
  142poss(up, and(locRobot=loc(_,Y), Y>0)).
  143
  144prim_action(down).
  145poss(down, and(locRobot=loc(_,Y),  Y<gridSizeY)).
  146
  147prim_action(pick).
  148poss(pick, and(isGold(locRobot)=true, noGold=0)).
  149
  150prim_action(drop).
  151poss(drop, true).
  152
  153prim_action(mark(_)).
  154poss(mark(_), true).
  155
  156prim_action(unmark).
  157poss(unmark, true).
  158
  159/* Exogenous Actions Available */
  160exog_action(simStart(_, _)).
  161exog_action(simEnd(_, _)).
  162exog_action(requestAction(_, _)).
  163
  164
  165%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  166%  2 - FUNCTIONAL FLUENTS AND CAUSAL LAWS
  167%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  168
  169fun_fluent(actionRequested).
  170causes(requestAction(_, _), actionRequested, true, true).
  171causes(A, actionRequested, false, neg(A=requestAction(_, _))).
  172
  173% fun_fluent(actionRequested).
  174% causes(requestAction(_, Data), actionRequested, (Deadline, Id), true).
  175% causes(A, actionRequested, false, neg(A=requestAction(_, _))).
  176% sense_reqaction(Data, Deadline, Id) :- 
  177% 	member(deadline(Deadlne),Data), 
  178% 	member(id(Id),Data).
  179
  180
  181% inDungeon: robot is inside the dungeon playing the game!
  182fun_fluent(inDungeon).
  183causes(simStart(_, _), inDungeon, true, true).
  184causes(simEnd(_, _), inDungeon, false, true).
  185
  186
  187fun_fluent(gridSizeX).
  188causes(simStart(_, Data), gridSizeX, V, member(gsizeX(V), Data)).
  189fun_fluent(gridSizeY).
  190causes(simStart(_, Data), gridSizeY, V, member(gsizeY(V), Data)).
  191fun_fluent(gridSize).
  192causes(simStart(_, Data), gridSize, (X,Y), 
  193				and(member(gsizeY(Y), Data), member(gsizeX(X),Data)) ).
  194
  195fun_fluent(depotX).
  196causes(simStart(_, Data), depotX, V, member(depotX(V), Data)).
  197fun_fluent(depotY).
  198causes(simStart(_, Data), depotY, V, member(depotY(V), Data)).
  199fun_fluent(locDepot).
  200causes(simStart(_, Data), locDepot, loc(X,Y), 
  201				and(member(depotY(Y), Data), member(depotX(X),Data))).
  202
  203% locRobot: current location of the robot 
  204fun_fluent(locRobot).
  205causes(up, 	locRobot, Y, up(locRobot,Y)).
  206causes(down, 	locRobot, Y, down(locRobot,Y)).
  207causes(left, 	locRobot, Y, left(locRobot,Y)).
  208causes(right, 	locRobot, Y, right(locRobot,Y)).
  209causes(requestAction(_, Data), locRobot, L,  sense_location(Data, L)).
  210
  211sense_location(Data, loc(X,Y)) :- 
  212	member(posX(X),Data), 
  213	member(posY(Y),Data).
  214
  215
  216% isGold(L): whether there is gold at location L
  217fun_fluent(isGold(L)):- location(L).
  218causes(pick, isGold(L), false, locRobot=L). 
  219causes(pick, isGold(L), V, and(neg(locRobot=L),V=isGold(L))). 
  220causes(requestAction(_, Data), isGold(L), V, sense_gold(Data, L, V)).
  221causes(requestAction(_, Data), isGold(L), V, 
  222			and(location(L),
  223			and(neg(sense_gold(Data, L, V)),
  224				isGold(L)=V))
  225	).
  226
  227sense_gold(Data, Loc, V) :-
  228	sense_location(Data, LocRobot),
  229	member(cells(LCells), Data), 
  230	member(cell(CellID, LCellProp), LCells),
  231	apply(CellID, [LocRobot, Loc]),
  232	(member(gold, LCellProp) -> V=true ; V=false).
  233
  234% noGold: number of gold pices the robot is holding
  235fun_fluent(noGold).
  236causes(pick, noGold, V, V is noGold+1).
  237causes(drop, noGold, V, V is noGold-1).
  238
  239% hasGold: is the robot holding a gold brick?
  240fun_fluent(hasGold).
  241causes(pick, hasGold, possibly, true).
  242causes(requestAction(_, Data), hasGold, true,
  243		and(hasGold=possibly, sense_gold(Data, locRobot, false))). 
  244causes(requestAction(_, Data), hasGold, false,
  245		and(hasGold=possibly, sense_gold(Data, locRobot, true))). 
  246causes(A, hasGold, true, 	and(hasGold=possibly, member(A,[up,down,right,left])) ). 
  247causes(A, hasGold, false, 	and(hasGold=possibly, member(A,[up,down,right,left])) ). 
  248
  249causes(drop, hasGold, false, true).
  250
  251
  252% isPit(L): whether there is an object/pit at location L
  253fun_fluent(isPit(L)):- location(L).
  254causes(requestAction(_, Data), isPit(L), V, sense_pit(Data, L, V)).
  255causes(requestAction(_, Data), isGold(L), V, 
  256			and(location(L),
  257			and(neg(sense_pit(Data, L, V)),
  258				isPit(L)=V))
  259	).
  260
  261sense_pit(Data, Loc, V) :-
  262	sense_location(Data, LocRobot),
  263	member(cells(LCells), Data), 
  264	member(cell(CellID, LCellProp), LCells),
  265	apply(CellID, [LocRobot, Loc]),
  266	(member(object, LCellProp) -> V=true ; V=false).
  267
  268
  269
  270% visited(L): location L is visited already
  271fun_fluent(visited(L)) :- location(L).
  272causes(requestAction(_, Data), visited(L), true, sense_location(Data, L)).
  273causes(reset, visited(L), false, and(location(L), neg(L=locRobot))).
  274causes(reset, visited(L), true, locRobot=L).
  275
  276fun_fluent(tries).
  277causes(reset, tries, V, V is tries+1).
  278
  279% This clauses are not used so far as there are no sensing actions
  280settles(_, _, _, _, _) :- fail.
  281rejects(_, _, _, _, _) :- fail.
  282senses(_) :- fail.
  283
  284%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  285%  3 - ABBREVIATIONS
  286%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  287
  288
  289
  290
  291
  292%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  293%  4 - INITIAL STATE
  294%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  295	% Robot state
  296initially(locRobot,loc(0,0)).
  297initially(hasGold,false).
  298initially(noGold,0).
  299initially(inDungeon, false).
  300initially(gridSizeX, 99).
  301initially(gridSizeY, 99).
  302initially(gridSize, (99,99)).
  303
  304	% Pits	
  305initially(isPit(R),true)		:- location(R), \+ R=loc(0,0).
  306initially(isPit(R),false)		:- location(R).
  307initially(isGold(R), true)	:- location(R).
  308initially(isGold(R), false)	:- location(R).
  309
  310	% Others
  311initially(tries,1).
  312initially(visited(R), false):- location(R).
  313
  314	
  315%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  316%  5 - MAIN ROUTINE CONTROLLERS
  317%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  318
  319% THIS IS THE MAIN EXECUTOR
  320proc(main,  	[while(neg(inDungeon), [?(writeln('Waiting simulation to start')), wait]), 
  321			?(setupSimulation(gridSizeX, gridSizeY)), 
  322			mainControl(1)]).
  323
  324setupSimulation(X,Y) :-
  325	retractall(gridsizeX(_)),
  326	retractall(gridsizeY(_)),
  327	assert(gridsizeX(X)),
  328	assert(gridsizeY(Y)).
  329
  330% Controller for the Wumpus:
  331%	1. If agent knows where the wumpus is, she is in line with it and
  332%	   the wumpus may be alive, then aim to wumpus and shoot arrow
  333%	2. If agent knows that there is gold in the current square, pick it up
  334%	3. Otherwise: sense everything and take a randomWalk
  335%		If no randomWalk exists, go to loc(1,1) and climb
  336proc(mainControl(1),
  337   prioritized_interrupts(
  338         [interrupt(neg(actionRequested), wait),
  339	  interrupt(hasGold, [while(neg(locRobot=locDepot), goto(locDepot)), drop]),
  340          interrupt(isGold(locRobot)=true, pick),
  341          interrupt([(dir,direction), loc], 
  342          		and(apply(dir, [locRobot, loc]), isGold(loc)), dir),
  343          interrupt([(dir,[ne,nw,se,sw]), loc], 
  344          		and(apply(dir, [locRobot, loc]), isGold(loc)), 
  345          			search(star([pi((a,[up,down,left,right]),a), ?(locRobot=loc)], 6)) ),
  346          interrupt([(dir,direction),loc], 
  347          		and(apply(dir, [locRobot, loc]), 
  348          		and(neg(isPit(loc)), neg(visited(loc)))), dir),
  349	  interrupt(true, pi((a,[up,down,left,right]), a)),
  350	  interrupt(true, [writeln('Cannot do anything!'), skip])
  351         ])  % END OF INTERRUPTS
  352).
  353
  354% proc(closestGold(Loc, LocGold), 
  355% 	pi(x,pi(y,pi(dist,[?(gridSizeX=x), ?(gridSizeY=y), ?(dist is x+y), closestGoldIter(Loc,LocGold,0,dist))))
  356% ).
  357
  358proc(goto(Loc),
  359	[
  360% 	?(writeln('Performing step to depot!')),
  361	if(to_east(locRobot,Loc), right, 
  362	if(to_west(locRobot,Loc), left,
  363	if(to_south(locRobot,Loc), down,
  364	if(to_north(locRobot,Loc), up,
  365	if(to_northeast(locRobot,Loc), rndet(up,right),
  366	if(to_northwest(locRobot,Loc), rndet(up,left),
  367	if(to_southeast(locRobot,Loc), rndet(down,right), rndet(down,left) )))))))
  368	]
  369).	
  370
  371
  372
  373%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  374%  6 - EXTRA AUXILIARLY PROGRAMS
  375%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  376
  377proc(move(D),  [search([star(turn,4),?(dirRobot=D),moveFwd])]).
  378proc(shoot(D), [search([star(turn,4),?(dirRobot=D),shootFwd])]).
  379
  380
  381% Think of a plan (random walk) to safely move to some unvisited location 
  382proc(newRandomWalk, 
  383	  search([
  384	  	  	rpi(y,location,[
  385	  	  		?(visited(y)=true),
  386	  	  		rpi(z,location,[
  387	  	  			?(adj(y,z)),
  388	  	  			?(visited(z)=false),
  389	  	  			?(or(aliveWumpus=false,neg(locWumpus=z))),
  390	  	  			?(isPit(z)=false),
  391	  	  			?(pathfind(locRobot,y,L)),
  392	  	  			L,
  393	  	  			rpi(w,direction,[move(w),?(locRobot=z)])
  394	  	  		])
  395	  	  	])
  396	      ],
  397		  "SEARCH FOR A (NEW) RANDOM WALK......")
  398	).
  399
  400
  401proc(goto(Loc), 
  402	  search([?(pathfind(locRobot,Loc,L)), L
  403			  ], ["PLANNING TO GO TO LOCATION: ",Loc])
  404	).
  405
  406
  407proc(goto1step(Loc), 
  408	  pi(x,direction,[move(x),?(locRobot=Loc)])
  409	).
  410
  411
  412proc(goodBorderPair(VLoc, NLoc), 
  413	[?(visited(VLoc)=true),
  414	?(adj(VLoc,NLoc)),
  415	?(visited(NLoc)=false),
  416	?(or(aliveWumpus=false,neg(locWumpus=NLoc))),
  417	?(isPit(NLoc)=false)]
  418	).
  419
  420
  421proc(explore_grid, 
  422	search(pi([s,q],[?(gridsize(s)), ?(q is 2*s-2), explore_limit(0,q)]))
  423).
  424proc(explore_limit(N,MAX), 
  425	  wndet(search([
  426	  	  	pi(y,[
  427	  	  		?(neighbor(locRobot,y,N)),
  428				?(visited(y)=true),
  429				%?(and(write('----->Y:'),writeln(y))),
  430	  	  		pi(z,[
  431	  	  			?(radj(y,z)),
  432	  	  			?(visited(z)=false),
  433	  	  			?(or(aliveWumpus=false,neg(locWumpus=z))),
  434	  	  			?(isPit(z)=false),
  435					%?(and(write('----->Z:'),writeln(z))),
  436	  	  			?(pathfind(locRobot,y,L)),
  437	  	  			L,
  438					%?(and(write('----->L:'),writeln(L))),
  439	  	  			rpi(w,direction,[move(w),
  440					%?(and(write('----->W:'),writeln(w))),
  441						?(locRobot=z)])
  442	  	  		])
  443	  	  	])
  444	      		],['SEARCH FOR A LOCATION ', N, ' STEPS AWAY......']),
  445		   search([?(and(M is N+1,M=<MAX)),explore_limit(M,MAX)])
  446		   )
  447	).
  448
  449
  450proc(explore_grid2, 
  451	search(pi([s,q],[?(gridsize(s)), ?(q is 2*s-2), explore_limit2(0,q)]))
  452).
  453proc(explore_limit2(N,MAX), 
  454	  wndet(search([
  455	  	  	pi(y,[
  456	  	  		?(neighbor(locRobot,y,N)),
  457				?(visited(y)=true),
  458	  	  		pi(z,[
  459	  	  			?(adj(y,z)),
  460	  	  			?(visited(z)=false),
  461	  	  			?(or(aliveWumpus=false,neg(locWumpus=z))),
  462	  	  			?(isPit(z)=false),
  463	  	  			?(pathfind(locRobot,y,L)),
  464	  	  			L,
  465	  	  			pi(w,direction,[move(w),?(locRobot=z)])
  466	  	  		])
  467	  	  	])
  468	      		],['SEARCH FOR A LOCATION ', N, ' STEPS AWAY......']),
  469		   search([?(and(M is N+1,M=<MAX)),explore_limit2(M,MAX)])
  470		   )
  471	).
  472
  473
  474
  475
  476%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  477%  PROLOG SPECIFIC TOOLS USED
  478%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  479
  480% Map Relative Definitions 
  481% In order to change the relative orientation of the grid, one has to only change this
  482% definitions. All the rest below should work out well and transparently of the grid orientation
  483up(loc(X,Y),loc(X,YN))    	:- YN is Y-1, location(loc(X,YN)). 
  484down(loc(X,Y),loc(X,YN)) 	:- YN is Y+1, location(loc(X,YN)).  
  485right(loc(X,Y),loc(XN,Y)) 	:- XN is X+1, location(loc(XN,Y)).  
  486left(loc(X,Y),loc(XN,Y))  	:- XN is X-1, location(loc(XN,Y)).  
  487
  488% to_up(Loc1,Loc2): Loc2 is towards direction "up" from Loc1
  489to_up(loc(_, Y1),loc(_, Y2)) 	:- gridindexY(Y1), gridindexY(Y2), Y2<Y1.
  490to_right(loc(X1, _),loc(X2, _))	:- gridindexX(X1), gridindexX(X2), X2>X1.
  491to_down(Loc1, Loc2):- to_up(Loc2, Loc1).
  492to_left(Loc1, Loc2)	:- to_right(Loc2, Loc1).
  493
  494
  495% Directions: north, south, east, west, and combinations
  496n(L, L2) 	:- up(L, L2).
  497s(L, L2) 	:- down(L, L2).
  498e(L, L2)	:- right(L, L2).
  499w(L, L2)	:- left(L, L2).
  500ne(L, L2)	:- n(L, A), e(A, L2).
  501nw(L, L2)	:- n(L, A), w(A, L2).
  502sw(L, L2)	:- s(L, A), w(A, L2).
  503se(L, L2)	:- s(L, A), e(A, L2).
  504cur(L,L).
  505
  506% to_north(Loc1,Loc2): Loc2 is towards direction "north" from Loc1
  507to_north(Loc1, Loc2)	:- to_up(Loc1,Loc2).
  508to_east(Loc1, Loc2)	:- to_right(Loc1, Loc2).
  509to_south(Loc1, Loc2):- to_down(Loc1, Loc2).
  510to_west(Loc1, Loc2)	:- to_left(Loc1, Loc2).
  511to_northwest(Loc1, Loc2)	:- to_north(Loc1, Loc2), to_west(Loc1, Loc2).
  512to_northeast(Loc1, Loc2)	:- to_north(Loc1, Loc2), to_east(Loc1, Loc2).
  513to_southwest(Loc1, Loc2)	:- to_south(Loc1, Loc2), to_west(Loc1, Loc2).
  514to_southeast(Loc1, Loc2)	:- to_south(Loc1, Loc2), to_east(Loc1, Loc2).
  515
  516
  517% rotateRight(R1, R2): R2 is the new direction from R1 after rotating clockwise once
  518rotateRight(up,right).
  519rotateRight(right,down).
  520rotateRight(down,left).
  521rotateRight(left,up).
  522
  523% is loc(I,J) a valid location?
  524valid_loc(loc(I,J)) :- domain(I,gridindexX), domain(J,gridindexY).
  525
  526% location R1 and R2 are adjacents
  527adj(R1,R2) :- (up(R1,R2) ; down(R1,R2) ; left(R1,R2) ; right(R1,R2)).
  528
  529% adj/3: R2 is the adjacent square of R1 at direction D
  530adj(R1,R2,up)		:- up(R1,R2).
  531adj(R1,R2,down)  	:- down(R1,R2).	
  532adj(R1,R2,left)  	:- left(R1,R2).	
  533adj(R1,R2,right) 	:- right(R1,R2).	
  534
  535% random adj
  536radj(L1,L2):-bagof(P,adj(L1,P),L),shuffle(L,RL),member(L2,RL). 
  537
  538neighbor(L,L,0):-!. 
  539%neighbor(L1,L2,1):-!,bagof(P,adj(L1,P),L),shuffle(L,RL),member(L2,RL). 
  540neighbor(loc(I1,J1),loc(I2,J2),N):- 
  541	location(loc(I2,J2)),
  542	DiffI is I1-I2, DiffJ is J1-J2,
  543	abs(DiffI,AbsDiffI), abs(DiffJ,AbsDiffJ),
  544	N is AbsDiffI+AbsDiffJ.
  545	
  546% R2 is the next square of R1 in direction D
  547in_line(R1,_,R1).
  548in_line(R1,D,R2) :- adj(R1,R3,D), in_line(R3,D,R2).
  549
  550% Set up path finding. Here it will be used to find paths between locs
  551% Start and End, such that the path goes through locs visited before.
  552pathfind_move(Start, End, move(D)):- 
  553	direction(D), 
  554	apply(D,[Start,End]),
  555	now(H),
  556	holds(visited(End)=true,H).
  557
  558% Set heuristic (manhattan distance)
  559pathfind_heuristic(loc(I,J), loc(I2,J2), H):- 
  560	DiffI is I-I2, 
  561	DiffJ is J-J2,
  562	abs(DiffI,AbsDiffI), 
  563	abs(DiffJ,AbsDiffJ),
  564	H is AbsDiffI+AbsDiffJ.
  565
  566
  567%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  568%  INFORMATION FOR THE EXECUTOR
  569%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  570actionNum(X,X).	% Translations of actions are one-to-one
  571
  572		
  573%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  574% EOF: Examples/CLIMA/agent_clima.pl
  575%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%