1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%
    3% FILE    : Examples/CLIMA/agent_clima.pl
    4%
    5%       BAT axiomatization of the CLIMA Agent 
    6%
    7%  AUTHOR : Sebastian Sardina (2007)
    8%  email  : ssardina@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 basic action theory (BAT) is described with:
   50%
   51% -- fun_fluent(fluent)     : for each functional fluent (non-ground)
   52%
   53%           e.g., fun_fluent(color(C)).
   54%
   55% -- prim_action(action)    : for each primitive action (ground)
   56% -- exog_action(action)    : for each exogenous action (ground)
   57%
   58%           e.g., prim_action(clean(C)) :- domain(C,country).
   59%           e.g., exog_action(painte(C,B)):- domain(C,country), domain(B,color).
   60%
   61% -- senses(action,fluent)  : for each sensing action
   62%
   63%           e.g, poss(check_painted(C),  painted(C)).
   64%
   65% -- poss(action,cond)      : when cond, action is executable
   66%
   67%           e.g, poss(clean(C),   and(painted(C),holding(cleanear))).
   68%
   69% -- initially(fluent,value): fluent has value in S0 (ground)
   70%
   71%          e.g., initially(painted(C), false):- domain(C,country), C\=3.
   72%                initially(painted(3), true).
   73%                initially(color(3), blue).
   74%
   75% -- causes_tt(action,fluent,value,cond)
   76%          when cond holds, doing act causes functional fluent to have value
   77%
   78%            e.g., causes_tt(paint(C2,V), color(C), V, C = C2).
   79%               or causes_tt(paint(C,V), color(C), V, true).
   80%
   81% -- sort(name,domain_of_sort).      : all sorts used in the domain
   82%
   83%        e.g., varsort(c, colors).
   84%              varsort(temp, temperature).
   85%              color([blue, green, yellow, red]).       
   86%              temperature([-10,0,10,20,30,40]).
   87%
   88%
   89% A high-level program-controller is described with:
   90%
   91% -- proc(name,P): for each procedure P 
   92% -- simulator(N,P): P is the N exogenous action simulator
   93%
   94% The interface for Lego is described with:
   95%
   96% -- actionNum(action, num)  
   97%         action has RCX code num
   98% -- simulateSensing(action)
   99%         sensing result for action should be asked to the user
  100% -- translateSensing(action, sensorValue, sensorResult) 
  101%         translate the sensorValue of action to sensorResult
  102% -- translateExogAction(codeAction, action) 
  103%         translateSensing action name into codeAction and vice-versa
  104%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  105
  106:- style_check(-discontiguous).  107% :- style_check(-singleton).
  108% :- style_check(-atom).
  109
  110
  111% Indigolog caching: fluents that are heavily used should be cached 
  112cache(_):-fail, !.	% Do no caching.
  113%cache(locRobot(me)).
  114%cache(isPit(_)).
  115%cache(isGold(_)).
  116
  117% roll always if possible; forced rolling if larger than 3.
  118roll_parameters(0,0,0).	   % roll-forward every single action
  119
  120
  121%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  122%  0 - DEFINITIONS OF DOMAINS/SORTS
  123%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  124:- dynamic gridsizeX/1, gridsizeY/1.  125
  126gridsizeX(100).
  127gridsizeY(100).
  128gridindexX(V) :- gridsizeX(S), S2 is S-1, !, get_integer(0,V,S2).
  129gridindexY(V) :- gridsizeY(S), S2 is S-1, !, get_integer(0,V,S2).
  130gridsize(X,Y) :- gridsizeX(X), gridsizeY(Y).
  131
  132% This are the domains/sorts used in the application
  133direction(V) :- member(V, [up,down,left,right]).
  134
  135all_direction(V) :- member(V, [n,s,r,l,ne,nw,se,sw,cur]).
  136location(loc(I,J)) :- gridindexX(I), gridindexY(J).
  137agent(A) :- A=me.
  138agent(A) :- teammember(A), \+ agentID(A).
  139
  140
  141%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  142%  1 - ACTIONS AND PRECONDITIONS
  143%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  144prim_action(skip).
  145poss(skip, true).
  146
  147prim_action(left).
  148poss(left, and(locRobot(me)=loc(X,_), X>0)).
  149
  150prim_action(right).
  151poss(right, and(locRobot(me)=loc(X,_), X<gridSizeX)).
  152
  153prim_action(up).
  154poss(up, and(locRobot(me)=loc(_,Y), Y>0)).
  155
  156prim_action(down).
  157poss(down, and(locRobot(me)=loc(_,Y),  Y<gridSizeY)).
  158
  159prim_action(pick).
  160poss(pick, and(isGold(locRobot(me))=true, neg(fullLoaded))).
  161
  162prim_action(drop).
  163poss(drop, true).
  164
  165prim_action(mark(_)).
  166poss(mark(_), true).
  167
  168prim_action(unmark).
  169poss(unmark, true).
  170
  171
  172prim_action(tell(_Agent,_Message)).
  173poss(tell(_,_), true).
  174prim_action(broadcast(_Message)).
  175poss(broadcast(_), true).
  176
  177prim_action(assumePit(_)).
  178poss(assumePit(_), true).
  179
  180prim_action(assumeBlocked(_)).
  181poss(assumeBlocked(_), true).
  182
  183prim_action(setState(_,_)).
  184poss(setState(_,TimeStamp), get_time(TimeStamp)).
  185
  186prim_action(enterDungeon).
  187poss(enterDungeon, canEnterDungeon).
  188
  189prim_action(initGrid).
  190poss(initGrid, true).
  191
  192prim_action(setUrgentPlan(_Plan)).
  193poss(setUrgentPlan(Plan), assert(urgentExec(Plan))).
  194
  195
  196/* Exogenous Actions Available */
  197exog_action(simStart(_, _)).
  198exog_action(simEnd(_, _)).
  199exog_action(requestAction(_, _)).
  200exog_action(told(_,_)).
  201exog_action(connected(climaServer)).
  202exog_action(connected(messServer)).
  203
  204
  205%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  206%  2 - FUNCTIONAL FLUENTS AND CAUSAL LAWS
  207%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  208
  209% For compatibility with the form of BAT 
  210causes_val(A, F, V, C) :- causes(A, F, V, C).
  211
  212
  213%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  214%% FLUENTS USED TO MODEL THE WORLD STATE
  215%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  216
  217% playingGame: are we still playing in the simulation?
  218rel_fluent(playingGame).
  219causes_true(nothing, playingGame, true).
  220causes_false(bye, playingGame, true).
  221
  222% are we already inside the grid?
  223rel_fluent(inDungeon).
  224causes_true(enterDungeon, inDungeon, true).
  225causes_false(simEnd(_, _), inDungeon, true).
  226
  227% can we get into the grid?
  228rel_fluent(canEnterDungeon).
  229causes_true(simStart(_, _), canEnterDungeon, true).
  230causes_false(simEnd(_, _), canEnterDungeon, true).
  231
  232
  233% what is the actual grid size for the game
  234fun_fluent(gridSizeX).
  235causes(simStart(_, Data), gridSizeX, V, member(gsizeX(V), Data)).
  236fun_fluent(gridSizeY).
  237causes(simStart(_, Data), gridSizeY, V, member(gsizeY(V), Data)).
  238fun_fluent(gridSize).
  239causes(simStart(_, Data), gridSize, (X,Y), 
  240				and(member(gsizeY(Y), Data), member(gsizeX(X),Data)) ).
  241
  242
  243% where is the location of the depot
  244fun_fluent(depotX).
  245causes(simStart(_, Data), depotX, V, member(depotX(V), Data)).
  246fun_fluent(depotY).
  247causes(simStart(_, Data), depotY, V, member(depotY(V), Data)).
  248fun_fluent(locDepot).
  249causes(simStart(_, Data), locDepot, loc(X,Y), 
  250				and(member(depotY(Y), Data), member(depotX(X),Data))).
  251
  252
  253% locRobot(A): current location of agent A
  254fun_fluent(locRobot(A)) :- agent(A).
  255causes(up, 	locRobot(me), Y, up(locRobot(me),Y)).
  256causes(down, 	locRobot(me), Y, down(locRobot(me),Y)).
  257causes(left, 	locRobot(me), Y, left(locRobot(me),Y)).
  258causes(right, 	locRobot(me), Y, right(locRobot(me),Y)).
  259causes(requestAction(_, Data), locRobot(me), L,  sense_location(Data, L)).
  260causes(told(A, Data), locRobot(A), L,  sense_location(Data, L)).
  261
  262% locRobotBefore: previous position of robot me before moving
  263fun_fluent(locRobotBefore).
  264causes(up,   locRobotBefore, V, V=locRobot(me)).
  265causes(down, locRobotBefore, V, V=locRobot(me)).
  266causes(left, locRobotBefore, V, V=locRobot(me)).
  267causes(right,locRobotBefore, V, V=locRobot(me)).
  268causes(setState(goingTo(_),_), locRobotBefore, V, locRobot(me)=V).
  269
  270% locExpected: location the agent is expected to be (after moving)
  271fun_fluent(locExpected).
  272causes(up, 	locExpected, Y, up(locRobot(me),Y)).
  273causes(down, 	locExpected, Y, down(locRobot(me),Y)).
  274causes(left, 	locExpected, Y, left(locRobot(me),Y)).
  275causes(right, 	locExpected, Y, right(locRobot(me),Y)).
  276
  277
  278
  279% robotState: sets the current state of the robot
  280fun_fluent(robotState).
  281causes(setState(State,Time), robotState, [State,Time], true).
  282causes(simStart(_,_), robotState, idle, true).
  283
  284
  285% isGold(L): whether there is gold at location L
  286fun_fluent(isGold(L)):- location(L).
  287causes(pick, isGold(L), false, locRobot(me)=L). 
  288causes(drop, isGold(L), true, locRobot(me)=L). 
  289causes(requestAction(_, Data), isGold(L), V, sense_gold(Data, L, V)).
  290causes(told(_, Data), isGold(L), V, sense_gold(Data, L, V)).
  291causes(told(_, gridInfo(gold, Data)), isGold(L), V, 
  292		and(member(isGold(List, V), Data), member(L,List))).
  293
  294
  295% isAgent(T): whether there is another agent of type T=enemy/ally at location L
  296rel_fluent(isAgent(L)):- location(L).
  297causes_true(requestAction(_, Data), isAgent(L),  
  298					and(sense_agent(Data, L, T), member(T,[enemy,ally]))).
  299causes_false(requestAction(_, Data), isAgent(L), sense_agent(Data, L, none)).
  300causes_true(told(_, Data), isAgent(L),  and(sense_agent(Data, L, T), member(T,[enemy,ally]))).
  301causes_false(told(_, Data), isAgent(L), sense_agent(Data, L, none)).
  302
  303
  304% hasGold: is the robot holding a gold brick?
  305fun_fluent(hasGold).
  306causes_val(requestAction(_, Data), hasGold, true, and(sense_items(Data,N),N>0)). 
  307causes_val(requestAction(_, Data), hasGold, false, and(sense_items(Data,N),N=0)). 
  308causes_val(drop, hasGold, false, true).
  309causes_val(simStart(_,_), hasGold, false, true).
  310
  311% For CLIMA06 (OLD)
  312%causes_val(pick, hasGold, true, true).
  313%causes_val(requestAction(_, Data), hasGold, true,
  314%			and(sense_items(Data,N),
  315%			and(N<0,
  316%			and(lastAction=pick, sense_data(Data, gold, cur, false))))). 
  317
  318
  319% noGold: number of gold pieces we are carrying
  320fun_fluent(noGold).
  321%causes_val(pick, noGold, M2, and(noGold=M1,M2 is M1+1)).
  322causes_val(simStart(_,_), noGold, 0, true).
  323causes_val(drop, noGold, 0, true).
  324causes_val(requestAction(_, Data), noGold, N, and(sense_items(Data,N), N>=0)).
  325%causes_val(requestAction(_, Data), noGold, M2,
  326%		and(sense_items(Data,N),
  327%		and(N<0,
  328%		and(lastAction=pick, 
  329%		and(sense_data(Data, gold, cur, true),  % there is still gold here
  330%		and(noGold=M1,M2 is M1-1)))))).
  331
  332
  333% maxNoGold: a rigid fluent storing how many pieces of gold we can carry
  334fun_fluent(maxNoGold).
  335def_fluent(maxNoGold, 3, true).
  336
  337fun_fluent(isBlocked(_Loc)).
  338%def_fluent(isBlocked(Loc), V, and(isPit(Loc)=R, blocked(R,V))).
  339def_fluent(isBlocked(Loc), V, myblocked(Loc,V)).
  340myblocked(Loc,V) :- currently(isPit(Loc),R), blocked(R,V).
  341
  342blocked(true,true).
  343blocked(blocked,true).
  344blocked(false,false).
  345blocked(unknown,unknown).
  346
  347% fullLoaded: the agent is carrying the maximum number of gold pieces
  348fun_fluent(fullLoaded).
  349def_fluent(fullLoaded, false, noGold < maxNoGold).
  350def_fluent(fullLoaded, true, noGold=maxNoGold).
  351
  352fullLoaded(true) :- currently(noGold,3).
  353fullLoaded(false) :- currently(noGold,3).
  354
  355
  356
  357% isPit(L): whether there is an object/pit at location L
  358fun_fluent(isPit(L)):- location(L).
  359causes(requestAction(_, Data), isPit(L), true, sense_obstacle(Data, L, true)).
  360causes(requestAction(_, Data), isPit(L), false, and(noObstacle(Data, L), neg(isPit(L)=blocked))).
  361/*causes(requestAction(_, Data), isPit(L), false, 
  362			and(sense_agent(Data, L, true), isPit(L)=unknown)).*/
  363causes(told(_, Data), isPit(L), V, sense_obstacle(Data, L, V)).
  364causes(told(_, Data), isPit(L), false, and(noObstacle(Data, L), neg(isPit(L)=blocked))).
  365causes(assumePit(L), isPit(L), true, and(neg(locDepot=L), isAgent(L))).
  366causes(assumeBlocked(L), isPit(L), blocked, neg(locDepot=L)).
  367causes(told(_, gridInfo(pit, Data)), isPit(L), V, 
  368		and(member(isPit(List, V), Data), member(L,List))).
  369
  370%causes(simStart(_, _), isPit(L), possibly, location(L)).
  371
  372
  373noObstacle(Data, Loc) :-
  374	get_loc_info(Data, Loc, LocInfo),
  375	\+ member(unknown,LocInfo),
  376	\+ member(obstacle,LocInfo).
  377
  378
  379drop_at_depot(Data) :-
  380	member(cells(LCells), Data), 
  381	member(cell(cur, LCellProp), LCells),
  382	member(depot,LCellProp).
  383
  384	
  385
  386
  387% deadline: next server deadline to submit action
  388fun_fluent(deadline).
  389causes(requestAction(_, Data), deadline, V, sense_deadline(Data, V)).
  390
  391
  392% A is an action that the agent can do in the CLIMA world
  393clima_action(A) :- member(A,[up,down,left,right,pick,drop,skip]).
  394
  395
  396%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  397%% FLUENTS USED TO MODEL BEHAVIOR
  398%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  399
  400% actionRequested: an action has been requested from game server and it is pending
  401rel_fluent(actionRequested).
  402causes_true(requestAction(_, _), actionRequested, true).
  403causes_false(A, actionRequested, clima_action(A)).
  404causes_false(simStart(_,_), actionRequested, true).
  405
  406% brodcasted: have we already boradcasted the info that we got from the sensors?
  407rel_fluent(broadcasted).
  408causes_true(broadcast(_), broadcasted, true).
  409causes_false(requestAction(_, _), broadcasted, true).
  410causes_true(simStart(_, _), broadcasted, true).
  411
  412% lastSensor: store the last sensing information obtained from game server
  413fun_fluent(lastSensor).
  414causes(requestAction(_, Data), lastSensor, Data, true).
  415
  416
  417% lastAction: store the last executed action
  418fun_fluent(lastAction).
  419causes(Action, lastAction, Action, clima_action(Action)).
  420
  421
  422% actionRequested: an action has been requested from game server and it is pending
  423% fun_fluent(lastActionFailed).
  424% def_fluent(lastActionFailed, unknown, neg(actionRequested)).
  425% def_fluent(lastActionFailed, V, 
  426% 	and(actionRequested,
  427% 	and(member(lastAction,[up,down,right,left]),
  428% 	or(and(locRobot(me)=locRobotBefore, V=true),
  429% 	   and(neg(locRobot(me)=locRobotBefore), V=false))))).
  430% def_fluent(lastActionFailed, V, 
  431% 	and(actionRequested,
  432% 	and(lastAction=pick,
  433% 		or(and(isGold(locRobot(me))=true, V=true),
  434% 	   	   and(neg(isGold(locRobot(me))=true), V=false))))).
  435% def_fluent(lastActionFailed, V, 
  436% 	and(actionRequested,
  437% 	and(lastAction=drop,
  438% 	or(and(and(neg(locRobot(me)=locDepot),neg(isGold(locRobot(me))=true)), V=true),
  439% 	   and(or(locRobot(me)=locDepot,isGold(locRobot(me))=true), V=false))))).
  440
  441
  442
  443% visited(L): location L is visited already
  444rel_fluent(visited(L)) :- location(L).
  445causes_true(requestAction(_, Data), visited(L), sense_location(Data, L)).
  446causes_false(reset, visited(L), and(location(L), neg(L=locRobot(me)))).
  447causes_false(reset, visited(L), false, locRobot(me)=L).
  448%causes_false(simStart(_,_), visited(L), location(L)).
  449
  450% noVisited(L): number of times location L has been 
  451fun_fluent(noVisited(L)) :- location(L).
  452causes(requestAction(_, Data), noVisited(L), V, 
  453		and(sense_location(Data, L), V is noVisited(L)+1)).
  454causes(reset, noVisited(L), 0, location(L)).
  455%causes(simStart(_,_), noVisited(L), 0, location(L)).
  456
  457
  458% are we entering the simulation in the middle?
  459rel_fluent(reconnecting).
  460causes_true(requestAction(_,Data), reconnecting, 
  461			and(neg(inDungeon),and(sense_step(Data,N), N>5))).
  462causes_false(tell(_, sendGridInfo), reconnecting, true).
  463
  464
  465% Agent has requested me information about the grid
  466rel_fluent(requestInfoGrid(_Agent)).
  467causes_true(told(Agent, sendGridInfo), requestInfoGrid(Agent), true).
  468causes_false(tell(Agent, gridInfo(_,_)), requestInfoGrid(Agent), true).
  469
  470
  471rel_fluent(restart).
  472causes_true(told(_,Data), restart, sense_step(Data,0)).
  473causes_false(told(_,Data), restart, and(sense_step(Data,N), N>5)).
  474causes_false(initGrid, restart, true).
  475
  476
  477
  478% fun_fluent(diffSteps).
  479% causes(told(_,Data), diffSteps, V, and(sense_step(Data,N), V is N-diffSteps)).
  480% causes(initGrid, diffSteps, 0, true).
  481% 
  482% fun_fluent(curSteps).
  483% causes(told(_,Data), diffSteps, V, and(sense_step(Data,N), V is N-diffSteps)).
  484% causes(initGrid, diffSteps, 0, true).
  485
  486
  487
  488% dummy fluent to force re-initializing the initial database
  489fun_fluent(restartGame).
  490causes(simStart(_,_), restartGame, true, resetInitialDB).
  491causes(initGrid, restartGame, true, resetInitialDB).
  492
  493
  494
  495
  496% No sensing actions in the domain. all sensing is done via exog actions
  497senses(_, _) :- fail.
  498senses(_, _, _, _, _) :- fail.
  499
  500
  501
  502
  503
  504
  505%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  506%  3 - ABBREVIATIONS
  507%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  508
  509
  510% Dir is the best direction to go if:
  511% 	- there is no pit & it has the lowest noVisited() score
  512% proc(bestAdjacent(Dir),
  513% 	some(n, 
  514% 	some(loc,
  515% 		and(apply(Dir, [locRobot(me), loc]), 
  516% 		and(isPit(loc)=false, 
  517% 		and(noVisited(loc)=n,
  518% 		    all(dir2,direction,
  519% 			or(dir2=Dir,
  520% 			   some(loc2,
  521% 				or(neg(apply(dir2,[locRobot(me),loc2])), % no loc2: out grid
  522% 			   	   and(apply(dir2,[locRobot(me),loc2]),
  523% 			  		or(neg(isPit(loc2)=false),noVisited(loc2)>=n)
  524% 				)))
  525% 			))
  526% 		)))
  527% 	))
  528% ).
  529
  530bestAdjacent(Dir) :-
  531	currently(locRobot(me), LocRobotMe),
  532	apply(Dir, [LocRobotMe, Loc]),
  533	currently(isPit(Loc), false), 
  534	currently(noVisited(Loc), N),
  535	\+ (	member(Dir2, [up,down,left,right]),
  536		Dir2\=Dir,
  537		apply(Dir2, [LocRobotMe, Loc2]),
  538  		currently(isPit(Loc2), false),
  539		currently(noVisited(Loc2), N2), N2<N
  540	).
  541	
  542
  543
  544% proc(destinationGold(LocWithGold, Limit),
  545% 	and(isGold(LocWithGold)=true, 
  546% 	    some(dist,and(manhattanDistance(LocWithGold,locRobot(me),dist), dist<Limit))
  547% 	)	
  548% ).
  549proc(destinationGold(LocWithGold), closestGold(locRobot(me),LocWithGold)).
  550
  551
  552
  553closestGold(LocRobot,LocWithGold,Limit) :-
  554	currently(isGold(LocWithGold), true),
  555	manhattanDistance(LocWithGold, LocRobot, Dist), 
  556	Dist =< Limit.
  557
  558closestGold(LocRobot,LocWithGold) :-
  559	percentage_limit(5, Limit),
  560	closestGold(LocRobot,LocWithGold,Limit).
  561closestGold(LocRobot,LocWithGold) :-
  562	percentage_limit(10, Limit),
  563	closestGold(LocRobot,LocWithGold,Limit).
  564closestGold(LocRobot,LocWithGold) :-
  565	percentage_limit(20, Limit),
  566	closestGold(LocRobot,LocWithGold,Limit).
  567closestGold(LocRobot,LocWithGold) :-
  568	percentage_limit(40, Limit),
  569	closestGold(LocRobot,LocWithGold,Limit).
  570closestGold(LocRobot,LocWithGold) :-
  571	percentage_limit(80, Limit),
  572	closestGold(LocRobot,LocWithGold,Limit).
  573	
  574
  575percentage_limit(Perc, Limit) :-
  576	gridsizeX(X),
  577	gridsizeY(Y),
  578	Limit is round((Perc*X*Y)/100).
  579
  580
  581
  582
  583
  584
  585%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  586% Data is a list of the following form:
  587%
  588% [step(19), posX(13), posY(0), deadline(1143592298798), id('20'), items(2),
  589% cells([cell(cur, [agent(ally)]), cell(w, [empty]), cell(sw, [empty]), cell(s, [empty]), 
  590% cell(se, [gold]), cell(e, [obstacle])])]) which includes all the information received
  591% 
  592% which encoded all the information obtained in a requestAction() exogenous
  593% action from the game server. It provides sensing information relative 
  594% to the center position posX(X) posY(Y) (13,0 above)
  595%
  596% 
  597% The following predicates extract all the information from a Data as above:
  598%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  599
  600% sensing of non-cells information: location, deadline, step number, id, items.
  601sense_location(Data, loc(X,Y)) :-  member(posX(X),Data), member(posY(Y),Data).
  602sense_deadline(Data, Deadline) :-  member(deadline(Deadline),Data).
  603sense_step(Data, Step) :-  member(step(Step),Data).
  604sense_id(Data, Id) :-  member(id(AtomId),Data), atom_number(AtomId,Id).
  605sense_items(Data, Items) :-  member(items(Items),Data).
  606
  607get_loc_info(Data, Loc, LCellProp) :-
  608	sense_location(Data, LocRobot),
  609	member(cells(LCells), Data), 
  610	member(cell(CellID, LCellProp), LCells),
  611	apply(CellID, [LocRobot, Loc]).
  612	
  613
  614% location Loc is a cell around the centre and V is true/false depending
  615% on whether the Obj (e.g., object, gold, enemy) was sensed in Loc
  616sense_data(Data, Obj, Loc, V) :-	% Loc is a relative position to the center in Data
  617	ground(Loc),
  618	member(Loc, [n,s,e,w,ne,nw,se,sw,cur]), !,
  619	sense_location(Data, LocCenter),
  620	apply(Loc, [LocCenter, Loc2]),
  621	sense_data(Data, Obj, Loc2, V).	
  622sense_data(Data, Obj, Loc, V) :-	% Loc is a veriable or a loc(_,_)
  623	sense_location(Data, LocRobot),
  624	member(cells(LCells), Data), 
  625	member(cell(CellID, LCellProp), LCells),
  626	apply(CellID, [LocRobot, Loc]),
  627	(member(Obj, LCellProp) -> V=true ; V=false).
  628
  629% location Loc is a cell around the centre and V is true/false depending
  630% on whether gold was sensed in Loc
  631sense_gold(Data, Loc, V) :- sense_data(Data, gold, Loc, V).
  632sense_obstacle(Data, Loc, V) :- sense_data(Data, obstacle, Loc, V).
  633
  634% Does Data says that there is an agent (T=enemy/ally) in Loc?
  635sense_agent(Data, Loc, T) :- 
  636	sense_location(Data, LocAgent),	
  637	sense_data(Data, agent(Type), Loc, V), 
  638	Loc\=LocAgent,
  639	(V=true -> T=Type ; T=none).
  640
  641
  642
  643
  644
  645
  646%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  647%  4 - INITIAL STATE
  648%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  649
  650
  651	% Robot state
  652initially(locRobot(me),loc(0,0)).
  653initially(hasGold,false).
  654initially(noGold,0).
  655initially(inDungeon, false).
  656initially(canEnterDungeon, false).
  657initially(playingGame, true).
  658initially(gridSizeX, 99).
  659initially(gridSizeY, 99).
  660initially(gridSize, (99,99)).
  661
  662
  663
  664	% Locations	
  665initially(isPit(R), unknown) :- location(R).
  666initially(isGold(R), unknown) :- location(R).
  667initially(visited(R), false):- location(R).
  668initially(noVisited(R), 0):- location(R).
  669initially(isAgent(L), false) :- location(L).
  670
  671	% Others
  672initially(broadcasted,true).
  673initially(actionRequested,false).
  674initially(robotState, idle).
  675initially(reconnecting, false).
  676
  677
  678
  679% Beliefs for the Boss agent
  680initially(restart, false).
  681initially(diffSteps, 0).
  682initially(requestInfoGrid(Agent), false) :- teammember(Agent).
  683
  684
  685% resets the initially/2 database	
  686resetInitialDB :- 
  687	initializeDB(isPit(_)),
  688	initializeDB(isGold(_)),
  689	initializeDB(visited(_)),
  690	initializeDB(noVisited(_)),
  691	initializeDB(isAgent(_)).
  692
  693% Setup simulation with X and Y as the limits of the grid
  694setupSimulation(X,Y) :-
  695	retractall(gridsizeX(_)),
  696	retractall(gridsizeY(_)),
  697	assert(gridsizeX(X)),
  698	assert(gridsizeY(Y)).
  699
  700
  701
  702
  703
  704
  705
  706
  707
  708
  709
  710
  711
  712
  713%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  714%  5 - MAIN ROUTINE CONTROLLERS
  715%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  716
  717%proc(main, if(some(x,clima_agentID(boss,x)), mainBoss, mainPlayer)).
  718proc(main, if(some(x,clima_agentID(boss,x)), mainBoss, mainControl(4))).
  719
  720proc(mainBoss, mainControl(boss)).
  721proc(mainPlayer,
  722  	[gexec2(playingGame,
  723		[while(true, 
  724			[if(neg(inDungeon),
  725				[say('Waiting simulation to start'), 
  726			 	 while(neg(canEnterDungeon), wait), 	% wait for sim-start
  727			 	 ?(setupSimulation(gridSizeX, gridSizeY)),
  728				 say('Waiting for next request-action'),
  729			 	 while(neg(actionRequested), wait), 	% wait for sim-start
  730				 if(reconnecting,tell(boss,sendGridInfo),?(true)),
  731				 enterDungeon],
  732			?(true)),
  733			 say('Simulation started - Starting main controller'),
  734			 exogint(gexec2(inDungeon, mainControl(3,locDepot)),
  735							 abortCondition(locRobot(me))),
  736			 say('Simulation ended...')
  737			])
  738		]),
  739	say('BYE messages recevied. Tournament finished...')
  740	]		
  741).
  742abortCondition(Loc) :- 
  743	exists_pending_exog_event(requestAction(_,Data)),
  744	sense_location(Data,Loc2),
  745	Loc\=Loc2.
  746abortCondition(_) :-
  747	exists_pending_exog_event(simEnd(_,_)).
  748
  749
  750
  751% Controller for the CLIMA agent:
  752%	1. Wait until a new action is requested from the game server
  753%	2. If not brodcasted yet, broadcast last sensing information received
  754%	2. If we have gold, then go to depot and drop gold
  755%	3. If there is gold in the current location, pick it up
  756%	4. If there is gold directly around us (e,w,n,s), move there right away
  757%	5. If there is gold indirectly around us (sw,nw,se,sw), move there in 2 steps
  758%	6. If there is a cell directly around us that we have not explored, go there
  759%	7. Otherwise, move random if possible
  760%	8. Otherwise, just do a skip action the turn
  761proc(mainControl(2, LocDepot),
  762	prioritized_interrupts(
  763	[interrupt(locRobot(me)=LocDepot, 
  764			[while(neg(actionRequested),wait),
  765			 if(locRobot(me)=LocDepot,
  766				[drop, pi(time,setState(dropped,time)), 
  767				 while(neg(actionRequested),wait),
  768				 wndet(safeRandomMove,?(true))], ?(true))
  769			]
  770		),
  771	  interrupt(plan, and(retract(urgentExec(plan)),
  772				report('Executing urgent plan')), plan),
  773	  interrupt(neg(actionRequested), if(broadcasted, wait, broadcast(lastSensor))),
  774	  interrupt(and(isGold(locRobot(me))=true,neg(fullLoaded)), pick), % gold here?
  775	  interrupt([(dir,direction), loc], 	% Gold around us?
  776			and(report(['THINK: ','Checking for gold around us: ',dir]), 
  777			and(neg(fullLoaded), 
  778			and(apply(dir, [locRobot(me), loc]), 
  779			and(isGold(loc)=true, report('Spotted gold around! Moving there...'))))), 
  780				pi(time,[setState(pickCloseGold,time), dir])
  781		),
  782	  interrupt(and(hasGold=true, report(['DECISION: ','We have gold! Planning to depot...'])), 
  783			travelTo(opt, LocDepot)),	% do we have gold? go back to depot?
  784	  interrupt(locWithGold, 	% plan to go to a particular gold
  785			and(report(['THINK: ','Looking for a close gold somewhere']),
  786			and(empty_nowhist,		% make sure now=[] (otherwise too slow)
  787			and(destinationGold(locWithGold),
  788			    report(['Going for gold at location: ',locWithGold])))),
  789			 travelTo(opt, locWithGold)
  790		),
  791	  interrupt((dir,direction), 
  792			and(report(['THINK: ','Looking for best adjacent cell...']),
  793			and(bestAdjacent(dir), 
  794				report(['DECISION: ','Moving to best adjacent cell: ',dir]))),
  795			 pi(result,try_movement(dir,result))),
  796	  interrupt(and(playingGame, report(['DECISION: ','Random movement...'])), safeRandomMove),
  797	  interrupt(and(playingGame, report(['DECISION: ','Cannot do anything, thus we skip...'])), skip)
  798	])  % END OF INTERRUPTS
  799).
  800
  801
  802proc(mainControl(3, LocDepot),
  803	prioritized_interrupts(
  804	[interrupt(locRobot(me)=LocDepot, 
  805			[while(neg(actionRequested),wait),
  806			 if(locRobot(me)=LocDepot,
  807				[drop, pi(time,setState(dropped,time)), 
  808				 while(neg(actionRequested),wait),
  809				 wndet(safeRandomMove,?(true))], ?(true))
  810			]
  811		),
  812	  interrupt(plan, retract(urgentExec(plan)), plan),
  813	  interrupt(neg(actionRequested), if(broadcasted, wait, broadcast(lastSensor))),
  814	  interrupt(and(isGold(locRobot(me))=true,neg(fullLoaded)), pick), % gold here?
  815	  interrupt([(dir,direction), loc], 	% Gold around us?
  816			and(neg(fullLoaded), 
  817			and(apply(dir, [locRobot(me), loc]),isGold(loc)=true)), 
  818				pi(time,[setState(pickCloseGold,time), dir])
  819		),
  820	  interrupt(hasGold=true, travelTo(opt, LocDepot)),	% do we have gold? go back to depot?
  821	  interrupt(locWithGold, 	% plan to go to a particular gold
  822			and(empty_nowhist, destinationGold(locWithGold)),
  823			 travelTo(opt, locWithGold)
  824		),
  825	  interrupt((dir,direction), bestAdjacent(dir), pi(result,try_movement(dir,result))),
  826	  interrupt(playingGame, safeRandomMove),
  827	  interrupt(playingGame, skip)
  828	])  % END OF INTERRUPTS
  829).
  830
  831
  832
  833proc(mainControl(4),
  834	prioritized_interrupts(
  835	[interrupt(neg(actionRequested), wait),
  836	 interrupt(true, skip)
  837	])  % END OF INTERRUPTS
  838).
  839
  840
  841
  842
  843
  844
  845
  846proc(mainControl(boss),
  847	prioritized_interrupts_simple(
  848	[interrupt((agent,teammember), requestInfoGrid(agent),
  849			pi([dataPitT,dataGold],
  850				[?(buildInfoData(dataPitT, pittrue)),
  851				  tell(agent,gridInfo(pit,dataPitT)),
  852				 %?(buildInfoData(dataPitF, pitfalse)),
  853				  %tell(agent,gridInfo(pit,dataPitF)),
  854				 ?(buildInfoData(dataGold, gold)),
  855				  tell(agent,gridInfo(gold,dataGold))
  856				]
  857			)),
  858	  interrupt(and(restart,report('Reinitializing database')), initGrid),
  859% 	  interrupt(and(diffSteps<(-10),report('Reinitializing database')), initGrid),
  860	  interrupt(true, wait)
  861	])  % END OF INTERRUPTS
  862).
  863
  864
  865
  866buildInfoData([isPit(ListLoc,true)], pittrue) :-
  867	setof(Loc,currently(isPit(Loc),true),ListLoc).
  868buildInfoData([isPit(ListLoc,false)], pitfalse) :-
  869	setof(Loc,currently(isPit(Loc),false),ListLoc).
  870buildInfoData(Data,gold) :-
  871	setof(LocG,currently(isGold(LocG),true),ListTrueGold),
  872	Data=[isGold(ListTrueGold,true)].
  873buildInfoData([],_).
  874
  875
  876
  877proc(goByPlanning(Method, Destination),
  878	pi([plan,myLocation,precPlan,planQual,time],
  879		[?(and(myLocation=locRobot(me),
  880		   and(bounded_pathfind(myLocation,Destination,Method,plan,planQual,8),
  881			report(['======PLAN FOUND: ',textual(plan)])))),
  882                setState(goingTo(Destination),time),	% set the agent state to goingTo(Destination)
  883		goal(locRobot(me)=Destination,	% success condition
  884			insist_movement(plan), 	% procedural plan to execute
  885			or(neg(robotState=[goingTo(Destination),time]),	% condition to fail
  886				neg(or(locRobot(me)=locRobotBefore,locRobot(me)=locExpected))),
  887			say(['Aborting plan to destination :',time])	% plan to recover from failure
  888			)
  889		]
  890	)
  891).
  892bounded_pathfind(Loc1,Loc2,Method,Plan,PlanQual,Sec) :-
  893catch(call_with_time_limit(Sec, pathfind(Loc1,Loc2,Method,Plan,PlanQual)),
  894	time_limit_exceeded,
  895      (report('!!!!!!!!!!!!!!!!! Bounded Planning aborted!'), fail)
  896).
  897
  898% Take a step towards destination (mark current as blocked if we have to go back)
  899proc(goTowards(Destination),
  900	wndet(search(pi([(dir,[up,left,right,up]), curDist, futDist],
  901			[?(manhattanDistance(locRobot(me), Destination, curDist)), 
  902			?(actionRequested),
  903			 dir,
  904			?(manhattanDistance(locRobot(me), Destination, futDist)), 
  905			futDist < curDist
  906			]
  907			)),
  908		[assumeBlocked(locRobot(me)), 
  909		?(actionRequested),
  910		 wndet(pi([dir,result],[?(safeRandomDir(dir)),try_movement(dir,result)]), ?(true))]
  911	)
  912).	
  913
  914% Execute sequential plan Plan by insisting on each individual action until success or failure
  915proc(insist_movement(Plan),
  916	ndet(?(Plan=[]),
  917	      	pi(result,
  918		[
  919		?(textual(Plan=[A|RestPlan])),
  920		?(actionRequested),	% block until next action is requested
  921		try_movement(A,result),
  922		if(result=ok,
  923			[say(['Action *',A,'* succeeded. Rest of plan: ',RestPlan]),
  924			 insist_movement(RestPlan)],
  925			say(['Action *',A,'* failed!. Dropping remaining plan...'])
  926		)
  927		])
  928	)
  929).
  930
  931
  932% Try to do movement A N times with Result (ok, failed, limit)
  933proc(try_movement(A,Result),
  934   	[?(apply(A,[locRobot(me), ExpectedLoc])),
  935		% Try 3 times action A, failing by executing assumePit(ExpectedLoc)
  936		% Abort if isPit(ExpectedLoc)=true
  937		% Succeed if locRobot(me)=ExpectedLoc 
  938	 try_action(4, A, isBlocked(ExpectedLoc)=true, locRobot(me)=ExpectedLoc,
  939		if(adj(locRobot(me),ExpectedLoc),assumePit(ExpectedLoc),?(true)), Result)
  940	]
  941).	
  942
  943
  944% Action A is tried N number of times to get SuccessCond (Result=ok) 
  945% Abort when AbortCond with Result=aborted 
  946% Fail with Result=failed if A has been tried N times already; execute PFailProg
  947proc(try_action(N,A,AbortCond,SuccCond,PFailProg,Result),
  948	[?(true), 	% Here there should be a condition to wait for evaluation exec of A
  949	if(AbortCond,[say('Abort condition applied.. aborting'),?(Result=aborted)],
  950		if(SuccCond, ?(Result=ok),
  951			if(N=1,[?(Result=failed),say('Gave up on action!'),PFailProg],
  952				pi(m,[A, ?(m is N-1), 	
  953				try_action(m,A,AbortCond,SuccCond,PFailProg,Result)])
  954			)
  955		)
  956	)
  957	]
  958).
  959
  960
  961% Say Text. For now it just prints the text in the console...
  962proc(say(Text), ?(report(Text))).
  963%proc(say(_Text), ?(true)).
  964
  965
  966% Just picks a direct adjacent direction where there is no obstacle and go
  967proc(safeRandomMove, search([randomMove,?(isPit(locRobot(me))=false)])).
  968safeRandomDir(Dir) :-
  969	currently(locRobot(me), LocRobot),
  970	direction(Dir),
  971	apply(Dir,[LocRobot,LocNew]),
  972	currently(isPit(LocNew),false).
  973	
  974
  975
  976	and(search([randomMove,?(isPit(locRobot(me))=false)])).
  977proc(randomMove,rpi(a,[up,down,left,right],a)).
  978
  979% Solve P, if possible with C holding at the end
  980proc(search_pref(P,C), wndet(search([P,?(C)]),search(P))).
  981
  982
  983
  984
  985
  986%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  987%  6 - EXTRA AUXILIARLY PROGRAMS
  988%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  989
  990report(M) :- report_message(M).
  991empty_nowhist :- now([]).
  992
  993
  994
  995
  996
  997
  998
  999
 1000
 1001
 1002
 1003
 1004
 1005
 1006
 1007
 1008
 1009
 1010
 1011
 1012
 1013
 1014
 1015%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 1016%  MAP TOOLS
 1017%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 1018
 1019% Map Relative Definitions 
 1020% To change the relative orientation of the grid, one has to only change this definitions 
 1021% All the rest below should work out well and transparently of the grid orientation
 1022up(loc(X,Y),loc(X,YN))    	:- YN is Y-1, location(loc(X,YN)).
 1023down(loc(X,Y),loc(X,YN)) 	:- YN is Y+1, location(loc(X,YN)).
 1024right(loc(X,Y),loc(XN,Y)) 	:- XN is X+1, location(loc(XN,Y)).
 1025left(loc(X,Y),loc(XN,Y))  	:- XN is X-1, location(loc(XN,Y)).
 1026
 1027% in case we got out of the grid
 1028up(loc(X,Y),out)    	:- YN is Y-1, \+ location(loc(X,YN)).
 1029down(loc(X,Y),out) 	:- YN is Y+1, \+ location(loc(X,YN)).
 1030right(loc(X,Y),out) 	:- XN is X+1, \+ location(loc(XN,Y)).
 1031left(loc(X,Y),out)  	:- XN is X-1, \+ location(loc(XN,Y)).
 1032 
 1033
 1034% to_up(Loc1,Loc2): Loc2 is towards direction "up" from Loc1
 1035to_up(loc(_, Y1),loc(_, Y2)) 	:- gridindexY(Y1), gridindexY(Y2), Y2<Y1.
 1036to_right(loc(X1, _),loc(X2, _))	:- gridindexX(X1), gridindexX(X2), X2>X1.
 1037to_down(Loc1, Loc2) :- to_up(Loc2, Loc1).
 1038to_left(Loc1, Loc2)	:- to_right(Loc2, Loc1).
 1039
 1040
 1041% Directions: north, south, east, west, and combinations
 1042n(L, L2) 	:- up(L, L2).
 1043s(L, L2) 	:- down(L, L2).
 1044e(L, L2)	:- right(L, L2).
 1045w(L, L2)	:- left(L, L2).
 1046ne(L, L2)	:- n(L, A), e(A, L2).
 1047nw(L, L2)	:- n(L, A), w(A, L2).
 1048sw(L, L2)	:- s(L, A), w(A, L2).
 1049se(L, L2)	:- s(L, A), e(A, L2).
 1050cur(L,L).
 1051
 1052% to_north(Loc1,Loc2): Loc2 is towards direction "north" from Loc1
 1053to_north(Loc1, Loc2) :- to_up(Loc1,Loc2).
 1054to_east(Loc1, Loc2) :- to_right(Loc1, Loc2).
 1055to_south(Loc1, Loc2) :- to_down(Loc1, Loc2).
 1056to_west(Loc1, Loc2) :- to_left(Loc1, Loc2).
 1057to_northwest(Loc1, Loc2) :- to_north(Loc1, Loc2), to_west(Loc1, Loc2).
 1058to_northeast(Loc1, Loc2) :- to_north(Loc1, Loc2), to_east(Loc1, Loc2).
 1059to_southwest(Loc1, Loc2) :- to_south(Loc1, Loc2), to_west(Loc1, Loc2).
 1060to_southeast(Loc1, Loc2) :- to_south(Loc1, Loc2), to_east(Loc1, Loc2).
 1061
 1062
 1063% rotateRight(R1, R2): R2 is the new direction from R1 after rotating clockwise
 1064% rotateLeft(R1, R2): R2 is the new direction from R1 after rotating counter-clockwise
 1065rotateRight(up,right).
 1066rotateRight(right,down).
 1067rotateRight(down,left).
 1068rotateRight(left,up).
 1069rotateLeft(R1, R2) :- rotateRight(R2,R1).
 1070
 1071% oppdir(D1,D2): D2 is the oppositive movement to D1
 1072oppdir(up,down).
 1073oppdir(down,up).
 1074oppdir(left,right).
 1075oppdir(right,left).
 1076
 1077
 1078
 1079% is loc(I,J) a valid location?
 1080%valid_loc(loc(I,J)) :- domain(I,gridindexX), domain(J,gridindexY).
 1081valid_loc(loc(I,J)) :- gridindexX(I), gridindexY(J).
 1082
 1083% location R1 and R2 are adjacents
 1084adj(R1,R2) :- (up(R1,R2) ; down(R1,R2) ; left(R1,R2) ; right(R1,R2)).
 1085
 1086% adj/3: R2 is the adjacent square of R1 at direction D
 1087adj(R1,R2,up)		:- up(R1,R2).
 1088adj(R1,R2,down)  	:- down(R1,R2).	
 1089adj(R1,R2,left)  	:- left(R1,R2).	
 1090adj(R1,R2,right) 	:- right(R1,R2).	
 1091
 1092% random adj
 1093radj(L1,L2):-bagof(P,adj(L1,P),L),shuffle(L,RL),member(L2,RL). 
 1094
 1095neighbor(L,L,0):-!. 
 1096%neighbor(L1,L2,1):-!,bagof(P,adj(L1,P),L),shuffle(L,RL),member(L2,RL). 
 1097neighbor(loc(I1,J1),loc(I2,J2),N):- 
 1098	location(loc(I2,J2)),
 1099	DiffI is I1-I2, DiffJ is J1-J2,
 1100	abs(DiffI,AbsDiffI), abs(DiffJ,AbsDiffJ),
 1101	N is AbsDiffI+AbsDiffJ.
 1102	
 1103% R2 is the next square of R1 in direction D
 1104in_line(R1,_,R1).
 1105in_line(R1,D,R2) :- adj(R1,R3,D), in_line(R3,D,R2).
 1106
 1107
 1108% manhattanDistance(Loc1,Loc2,Distance): calculates Manhattan Distance between Loc1 and Loc2
 1109manhattanDistance(loc(X1,Y1),loc(X2,Y2), Distance) :-
 1110	DiffX is X1-X2, 
 1111	DiffY is Y1-Y2,
 1112	abs(DiffX,AbsDiffX), 
 1113	abs(DiffY,AbsDiffY),
 1114	Distance is AbsDiffX+AbsDiffY.
 1115
 1116
 1117
 1118%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 1119%  PATH FINDING
 1120%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 1121
 1122% pathfind(L1, L2, Type, Limit, Plan, Stats)
 1123% Find a plan that takes you from L1 to L2 using path planning of type Type and
 1124% with limit Limit. The heuristic, the cost model, the property used for 
 1125% termination, and some statistics (Stats) are specified in the definition of the type. 
 1126
 1127% pathfind(L1, L2, Type, inf, Plan, Stats)
 1128% same as pathfind/6 but without a limit condition.
 1129%
 1130% pathfind_move/4 defines which locations to consider as part of a plan.
 1131% Any valid location that is probably not a pit is ok to check as part of a plan.
 1132% This is the same for all types of path finding. 
 1133
 1134% SLOW BUT CORRECT ROBOUST VERSION
 1135%
 1136%pathfind_move(Start, End, _, D):- 
 1137% 	%direction(D), 
 1138% 	rdomain(D,[up,down,left,right]), 
 1139% 	apply(D,[Start,End]),
 1140% 	valid_loc(End),
 1141% 	now(H),
 1142% 	\+ holds(isPit(End)=true,H),
 1143% 	\+ (holds(locDepot=End,H), holds(noGold=0,H)).	
 1144
 1145% FAST: RELIES ON FULL PROGRESSION
 1146%
 1147pathfind_move(Start, End, _, D):- 
 1148	rdomain(D,[up,down,left,right]), 
 1149	apply(D,[Start,End]),
 1150	valid_loc(End),
 1151	\+ currently(isPit(End),true),
 1152	\+ currently(isPit(End),blocked),
 1153	\+ (currently(locDepot,End), currently(noGold,0)).	
 1154
 1155
 1156
 1157% Pathfinding type safe(N): 
 1158% Only go trhough unsafe places as long as this makes the path feasible or gives a shortcut 
 1159% that will gain N moves. 
 1160%
 1161% Uses manhattan distance as the heuristic for the remaining path.
 1162% Uses the following for computing the cost of the path found so far. 
 1163% i)  The cost of each action is .99 so that there is preference in continuing a path rather
 1164%     than searching for a new one with the same cost
 1165% ii) The cost of an action that leads to an unsafe location is further increased by N
 1166% Uses the number of possibly unsafe locations as termination condition
 1167pathfind_f_function(loc(I,J), loc(I2,J2), safe(N), Cost, UpdCost, Assump, UpdAssump, Estimation):- 
 1168	DiffI is I-I2, 
 1169	DiffJ is J-J2,
 1170	abs(DiffI,AbsDiffI), 
 1171	abs(DiffJ,AbsDiffJ),
 1172	now(H),
 1173	(holds(isPit(loc(I,J))=false,H)-> 
 1174		UpdAssump=Assump, 
 1175		Demote=0 
 1176	; 
 1177		UpdAssump is Assump+1, 
 1178		Demote is N
 1179	),
 1180	UpdCost is Cost+0.99+Demote,
 1181	Estimation is AbsDiffI+AbsDiffJ.
 1182
 1183pathfind(L1, L2, safe, Plan, Stats) :- 
 1184	report(['Doing safe pathfind from location *',L1,'* to location *', L2,'*']),
 1185	pathfind(L1, L2, safe(0), 1, Plan, Stats).
 1186pathfind(L1, L2, opt, Plan, Stats)  :- 
 1187	report(['Doing opt pathfind from location *',L1,'* to location *',L2,'*']),
 1188	pathfind(L1, L2, safe(0), inf, Plan, Stats).
 1189
 1190% Use pathfind(L1, L2, safe, Plan, Stats) to force going through safe locations only.
 1191% Use pathfind(L1, L2, opt, Plan, Stats) to find the most optimistic plan.
 1192% Use pathfind(L1, L2, safe(N), Limit, Plan, Stats) with high values of N and L>1 
 1193% to avoid going through possibly unsafe locations unless it is necessary or it works 
 1194% as a short cut and limit the possibly unsafe ones to be less than Limit.
 1195
 1196
 1197% not ready yet
 1198% type expl(N): a not-necessarily-shortest exporatory path that may go
 1199% through a possibly unsafe place as long as this does not make the
 1200% path longer than N moves.
 1201
 1202% manhattan distance + plan length as the heuristic + promote
 1203pathfind_f_function(loc(I,J), loc(I2,J2), expl1(N), CostSoFar, UpdatedCost, Estimation):- 
 1204	DiffI is I-I2, 
 1205	DiffJ is J-J2,
 1206	abs(DiffI,AbsDiffI), 
 1207	abs(DiffJ,AbsDiffJ),
 1208	now(H),
 1209	(holds(isPit(loc(I2,J2))=unknown,H) -> Promote is N; Promote=0),
 1210	UpdatedCost is CostSoFar+1-Promote,
 1211	Estimation is AbsDiffI+AbsDiffJ.
 1212
 1213
 1214	
 1215
 1216%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 1217%  INFORMATION FOR THE EXECUTOR
 1218%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 1219actionNum(X,X).	% Translations of actions are one-to-one
 1220
 1221
 1222		
 1223%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 1224% EOF: Examples/CLIMA/agent_clima.pl
 1225%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 1226
 1227
 1228/*
 1229
 1230H=[
 1231=========> EXOGENOUS EVENT:: Exog. Action * requestAction(1143592282090, [step(0), posX(13), posY(14), deadline(1143592286090), id('1'), cells([cell(cur, [agent(ally)]), cell(n, [empty]), cell(nw, [empty]), cell(w, [empty]), cell(sw, [empty]), cell(s, [gold]), cell(se, [empty]), cell(e, [empty]), cell(ne, [empty])])]) * occurred
 1232random act
 1233
 1234=========> EXOGENOUS EVENT:: Exog. Action * requestAction(1143592282639, [step(1), posX(13), posY(13), deadline(1143592286639), id('2'), cells([cell(cur, [agent(ally)]), cell(n, [empty]), cell(nw, [empty]), cell(w, [empty]), cell(sw, [empty]), cell(s, [empty]), cell(se, [empty]), cell(e, [empty]), cell(ne, [empty])])]) * occurred
 1235>>>>>>>>>>>> ACTION EVENT:: Action * up * COMPLETED SUCCESSFULLY
 1236random act
 1237>>>>>>>>>>>> ACTION EVENT:: Action * up * COMPLETED SUCCESSFULLY
 1238
 1239=========> EXOGENOUS EVENT:: Exog. Action * requestAction(1143592283396, [step(2), posX(13), posY(13), deadline(1143592287396), id('3'), cells([cell(cur, [agent(ally)]), cell(n, [empty]), cell(nw, [empty]), cell(w, [empty]), cell(sw, [empty]), cell(s, [empty]), cell(se, [empty]), cell(e, [empty]), cell(ne, [empty])])]) * occurred
 1240random act
 1241
 1242=========> EXOGENOUS EVENT:: Exog. Action * requestAction(1143592283907, [step(3), posX(13), posY(12), deadline(1143592287907), id('4'), cells([cell(cur, [agent(ally)]), cell(n, [empty]), cell(nw, [empty]), cell(w, [empty]), cell(sw, [empty]), cell(s, [empty]), cell(se, [empty]), cell(e, [empty])])]) * occurred
 1243>>>>>>>>>>>> ACTION EVENT:: Action * up * COMPLETED SUCCESSFULLY
 1244random act
 1245>>>>>>>>>>>> ACTION EVENT:: Action * up * COMPLETED SUCCESSFULLY
 1246
 1247=========> EXOGENOUS EVENT:: Exog. Action * requestAction(1143592284399, [step(4), posX(13), posY(11), deadline(1143592288399), id('5'), cells([cell(cur, [agent(ally)]), cell(n, [empty]), cell(nw, [empty]), cell(w, [empty]), cell(sw, [empty]), cell(s, [empty]), cell(se, [empty]), cell(e, [empty]), cell(ne, [empty])])]) * occurred
 1248random act
 1249
 1250=========> EXOGENOUS EVENT:: Exog. Action * requestAction(1143592284827, [step(5), posX(13), posY(10), deadline(1143592288827), id('6'), cells([cell(cur, [agent(ally)]), cell(n, [empty]), cell(nw, [empty]), cell(w, [empty]), cell(sw, [empty]), cell(s, [empty]), cell(se, [empty]), cell(e, [empty]), cell(ne, [empty])])]) * occurred
 1251>>>>>>>>>>>> ACTION EVENT:: Action * up * COMPLETED SUCCESSFULLY
 1252random act
 1253>>>>>>>>>>>> ACTION EVENT:: Action * up * COMPLETED SUCCESSFULLY
 1254
 1255=========> EXOGENOUS EVENT:: Exog. Action * requestAction(1143592285346, [step(6), posX(13), posY(9), deadline(1143592289346), id('7'), cells([cell(cur, [agent(ally)]), cell(n, [empty]), cell(nw, [empty]), cell(w, [empty]), cell(sw, [empty]), cell(s, [empty]), cell(se, [empty]), cell(e, [empty]), cell(ne, [empty])])]) * occurred
 1256random act
 1257
 1258=========> EXOGENOUS EVENT:: Exog. Action * requestAction(1143592285755, [step(7), posX(13), posY(8), deadline(1143592289755), id('8'), cells([cell(cur, [agent(ally)]), cell(n, [empty]), cell(nw, [empty]), cell(w, [empty]), cell(sw, [empty]), cell(s, [empty]), cell(se, [empty]), cell(e, [empty]), cell(ne, [empty])])]) * occurred
 1259>>>>>>>>>>>> ACTION EVENT:: Action * up * COMPLETED SUCCESSFULLY
 1260random act
 1261>>>>>>>>>>>> ACTION EVENT:: Action * up * COMPLETED SUCCESSFULLY
 1262
 1263=========> EXOGENOUS EVENT:: Exog. Action * requestAction(1143592286341, [step(8), posX(13), posY(7), deadline(1143592290341), id('9'), cells([cell(cur, [agent(ally)]), cell(n, [gold]), cell(nw, [empty]), cell(w, [empty]), cell(sw, [empty]), cell(s, [empty]), cell(se, [empty]), cell(e, [empty]), cell(ne, [empty])])]) * occurred
 1264random act
 1265>>>>>>>>>>>> ACTION EVENT:: Action * up * COMPLETED SUCCESSFULLY
 1266
 1267=========> EXOGENOUS EVENT:: Exog. Action * requestAction(1143592286936, [step(9), posX(13), posY(6), deadline(1143592290936), id('10'), cells([cell(cur, [agent(ally), gold]), cell(n, [empty]), cell(nw, [empty]), cell(w, [empty]), cell(sw, [empty]), cell(s, [empty]), cell(e, [empty]), cell(ne, [empty])])]) * occurred
 1268random act
 1269
 1270=========> EXOGENOUS EVENT:: Exog. Action * requestAction(1143592287454, [step(10), posX(13), posY(5), deadline(1143592291454), id('11'), cells([cell(cur, [agent(ally)]), cell(n, [gold]), cell(nw, [empty]), cell(w, [empty]), cell(sw, [empty]), cell(s, [gold]), cell(se, [empty]), cell(e, [empty]), cell(ne, [empty])])]) * occurred
 1271>>>>>>>>>>>> ACTION EVENT:: Action * up * COMPLETED SUCCESSFULLY
 1272random act
 1273>>>>>>>>>>>> ACTION EVENT:: Action * up * COMPLETED SUCCESSFULLY
 1274DEBUG 0: Rolling down the river.......
 1275
 1276=========> EXOGENOUS EVENT:: Exog. Action * requestAction(1143592290078, [step(11), posX(13), posY(4), deadline(1143592294078), id('12'), cells([cell(cur, [agent(ally), gold]), cell(n, [empty]), cell(nw, [empty]), cell(w, [empty]), cell(s, [empty]), cell(se, [empty]), cell(e, [empty]), cell(ne, [empty])])]) * occurred
 1277DEBUG 0: done progressing the database!
 1278random act
 1279>>>>>>>>>>>> ACTION EVENT:: Action * up * COMPLETED SUCCESSFULLY
 1280
 1281=========> EXOGENOUS EVENT:: Exog. Action * requestAction(1143592291004, [step(12), posX(13), posY(3), deadline(1143592295004), id('13'), cells([cell(cur, [agent(ally)]), cell(n, [empty]), cell(nw, [empty]), cell(w, [empty]), cell(sw, [empty]), cell(s, [gold]), cell(se, [empty]), cell(e, [empty]), cell(ne, [empty])])]) * occurred
 1282random act
 1283
 1284=========> EXOGENOUS EVENT:: Exog. Action * requestAction(1143592291450, [step(13), posX(13), posY(2), deadline(1143592295450), id('14'), cells([cell(cur, [agent(ally)]), cell(n, [empty]), cell(nw, [empty]), cell(w, [empty]), cell(sw, [empty]), cell(s, [empty]), cell(se, [empty]), cell(e, [empty]), cell(ne, [gold])])]) * occurred
 1285>>>>>>>>>>>> ACTION EVENT:: Action * up * COMPLETED SUCCESSFULLY
 1286random act
 1287>>>>>>>>>>>> ACTION EVENT:: Action * up * COMPLETED SUCCESSFULLY
 1288
 1289=========> EXOGENOUS EVENT:: Exog. Action * requestAction(1143592292130, [step(14), posX(13), posY(1), deadline(1143592296130), id('15'), cells([cell(cur, [agent(ally)]), cell(n, [empty]), cell(nw, [empty]), cell(w, [empty]), cell(sw, [empty]), cell(s, [empty]), cell(se, [empty]), cell(e, [gold])])]) * occurred
 1290random act
 1291
 1292=========> EXOGENOUS EVENT:: Exog. Action * requestAction(1143592292560, [step(15), posX(13), posY(0), deadline(1143592296560), id('16'), cells([cell(cur, [agent(ally)]), cell(w, [empty]), cell(s, [empty]), cell(se, [gold]), cell(e, [obstacle])])]) * occurred
 1293>>>>>>>>>>>> ACTION EVENT:: Action * up * COMPLETED SUCCESSFULLY
 1294random act
 1295>>>>>>>>>>>> ACTION EVENT:: Action * down * COMPLETED SUCCESSFULLY
 1296
 1297=========> EXOGENOUS EVENT:: Exog. Action * requestAction(1143592293406, [step(16), posX(13), posY(1), deadline(1143592297406), id('17'), cells([cell(cur, [agent(ally)]), cell(n, [empty]), cell(nw, [empty]), cell(w, [empty]), cell(s, [empty]), cell(se, [empty]), cell(e, [gold]), cell(ne, [obstacle])])]) * occurred
 1298random act
 1299
 1300=========> EXOGENOUS EVENT:: Exog. Action * requestAction(1143592293878, [step(17), posX(13), posY(0), deadline(1143592297878), id('18'), cells([cell(cur, [agent(ally)]), cell(w, [empty]), cell(sw, [empty]), cell(s, [empty]), cell(se, [gold]), cell(e, [obstacle])])]) * occurred
 1301>>>>>>>>>>>> ACTION EVENT:: Action * up * COMPLETED SUCCESSFULLY
 1302random act
 1303>>>>>>>>>>>> ACTION EVENT:: Action * down * COMPLETED SUCCESSFULLY
 1304
 1305=========> EXOGENOUS EVENT:: Exog. Action * requestAction(1143592294479, [step(18), posX(13), posY(1), deadline(1143592298479), id('19'), cells([cell(cur, [agent(ally)]), cell(n, [empty]), cell(nw, [empty]), cell(w, [empty]), cell(sw, [empty]), cell(s, [empty]), cell(se, [empty]), cell(e, [gold]), cell(ne, [obstacle])])]) * occurred
 1306random act
 1307
 1308=========> EXOGENOUS EVENT:: Exog. Action * requestAction(1143592294798, [step(19), posX(13), posY(0), deadline(1143592298798), id('20'), cells([cell(cur, [agent(ally)]), cell(w, [empty]), cell(sw, [empty]), cell(s, [empty]), cell(se, [gold]), cell(e, [obstacle])])]) * occurred
 1309>>>>>>>>>>>> ACTION EVENT:: Action * up * COMPLETED SUCCESSFULLY
 1310random act
 1311>>>>>>>>>>>> ACTION EVENT:: Action * down * COMPLETED SUCCESSFULLY
 1312DEBUG 0: Rolling down the river.......
 1313DEBUG 0: done progressing the database!
 1314
 1315=========> EXOGENOUS EVENT:: Exog. Action * simEnd(1143592302152, [id('21'), score(0), result(draw)]) * occurred
 1316
 1317=========> EXOGENOUS EVENT:: Exog. Action * simStart(1143592311382, [id('22'), opponent(argentina), steps(20), gsizeX(25), gsizeY(25), depotX(0), depotY(1)]) * occurred
 1318
 1319
 1320requestAction(1143595358607, [step(7), posX(11), posY(10), deadline(1143595362607), id('8'),cells([cell(cur, [agent(ally)]), cell(n, [gold]), cell(nw, [empty]), cell(w, [obstacle]), cell(sw, [empty]),cell(s, [empty]), cell(se, [empty]), cell(e, [empty]), cell(ne, [empty])])])
 1321
 1322
 1323*/