1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2% FILE    : Examples/Wumpus/statwumpus.pl
    3%
    4%       Module for computing statistics in the Wumpus World
    5%
    6%  AUTHOR : Sebastian Sardina (2005)
    7%  email  : ssardina@cs.toronto.edu
    8%  WWW    : www.cs.toronto.edu/cogrobo
    9%  TYPE   : system independent code
   10%  TESTED : SWI Prolog 5.0.10 http://www.swi-prolog.org
   11%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   12%
   13%                             April, 2005
   14%
   15% This software was developed by the Cognitive Robotics Group under the
   16% direction of Hector Levesque and Ray Reiter.
   17% 
   18%        Do not distribute without permission.
   19%        Include this notice in any copy made.
   20% 
   21% 
   22%         Copyright (c) 2000 by The University of Toronto,
   23%                        Toronto, Ontario, Canada.
   24% 
   25%                          All Rights Reserved
   26% 
   27% Permission to use, copy, and modify, this software and its
   28% documentation for non-commercial research purpose is hereby granted
   29% without fee, provided that the above copyright notice appears in all
   30% copies and that both the copyright notice and this permission notice
   31% appear in supporting documentation, and that the name of The University
   32% of Toronto not be used in advertising or publicity pertaining to
   33% distribution of the software without specific, written prior
   34% permission.  The University of Toronto makes no representations about
   35% the suitability of this software for any purpose.  It is provided "as
   36% is" without express or implied warranty.
   37% 
   38% THE UNIVERSITY OF TORONTO DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS
   39% SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
   40% FITNESS, IN NO EVENT SHALL THE UNIVERSITY OF TORONTO BE LIABLE FOR ANY
   41% SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
   42% RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
   43% CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
   44% CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
   45%
   46%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   47:- multifile wumpus_run/6.   48
   49% A - get_stat_result(?ID, ?Conf,-Result): TOP-LEVEL predicate
   50% A - get_stat_result(?Conf,-Result)     : TOP-LEVEL predicate
   51% Given a test-set ID, it computes an aggregation result in Result
   52get_stat_result(IDRun,[Size,PPits,NoGolds],Result) :-
   53	setof([Size,PPits,NoGolds],IDRun^InitGrid^FinalGrid^H^Time^
   54		wumpus_run(IDRun,[Size,PPits,NoGolds],InitGrid,FinalGrid,H,Time),L),
   55	member([Size,PPits,NoGolds],L),
   56	findall(R,(wumpus_run(IDRun,[Size,PPits,NoGolds],InitGrid,FinalGrid,H,Time),
   57		   evaluate_run(InitGrid,FinalGrid,H,Time,R)), ListResultsRuns),
   58	evaluate_many_runs(ListResultsRuns, Result).
   59get_stat_result([Size,PPits,NoGolds],Result) :-
   60	setof([Size,PPits,NoGolds],IDRun^InitGrid^FinalGrid^H^Time^
   61		wumpus_run(IDRun,[Size,PPits,NoGolds],InitGrid,FinalGrid,H,Time),L),
   62	member([Size,PPits,NoGolds],L),
   63	findall(R,(wumpus_run(_,[Size,PPits,NoGolds],InitGrid,FinalGrid,H,Time),
   64		   evaluate_run(InitGrid,FinalGrid,H,Time,R)), ListResultsRuns),
   65	evaluate_many_runs(ListResultsRuns, Result).
   66	
   67% B - evaluate_many_runs/2: Evaluate many runs
   68% +ListRRuns: list of runs
   69% -Result: evaluation result of all the runs together
   70evaluate_many_runs(ListRRuns, Result) :-
   71	length(ListRRuns, NoRuns),
   72	flatten(ListRRuns,ListRuns),
   73	findall(R1, member(wumpusDead(dead,R1),ListRuns),RR1),length(RR1,LRR1),
   74	findall(R2, member(robotDead(dead,R2),ListRuns),RR2),length(RR2,LRR2),
   75	findall(R3, (member(noGolds(N,R3),ListRuns),N>0),RR3),length(RR3,LRR3),
   76	findall(R4, (member(climbed(R4),ListRuns),R4>0),RR4),length(RR4,LRR4),
   77	findall(R5, member(noPits(R5),ListRuns),RR5),average(RR5,ARR5),
   78	findall(R6, member(totalReward(R6),ListRuns),RR6),average(RR6,ARR6),
   79	findall(R7, member(actions(_,R7),ListRuns),RR7),average(RR7,ARR7),
   80	findall(R8, member(actions(R8,_),ListRuns),RR8),average(RR8,ARR8),
   81	findall(R9, (member(impossible(R9),ListRuns),R9=1),RR9),length(RR9,LRR9),
   82	findall(R10, (member(ListRun,ListRRuns),member(impossible(0),ListRun),
   83		member(totalReward(R10),ListRun)),RR10),average(RR10,ARR10),	
   84	findall(R11, (member(ListRun,ListRRuns),member(impossible(0),ListRun),
   85		member(actions(R11,_),ListRun)),RR11),average(RR11,ARR11),	
   86	findall(R12, member(time(R12),ListRuns),RR12),average(RR12,ARR12),
   87	findall(R13, (member(ListRun,ListRRuns),member(impossible(0),ListRun),
   88		member(time(R13),ListRun)),RR13),average(RR13,ARR13),	
   89	Result=[noRuns(NoRuns),impossible(LRR9),
   90		noWumpusDead(LRR1),noRobotDead(LRR2),noGotGold(LRR3),noClimbed(LRR4),
   91		avgPits(ARR5),avgReward(ARR6),avgRewardExcludingImposs(ARR10),
   92		avgCostActions(ARR7),avgNoActions(ARR8),
   93		avgNoActionsExcludingImposs(ARR11),
   94		avgTime(ARR12), avgTimeExcludingImposs(ARR13)
   95		].
   96
   97% C - evaluate_run/5: Evaluate one run
   98% +IGrid = Initial grid configuration
   99% +FGrid = Final grid configuration
  100% +H = List of actions performed
  101% +Time = time is seconds
  102% -Result = A list representing the evaluation
  103evaluate_run(IGrid,FGrid,H,Time, Result) :-
  104		% Obtain data from the input grid IGrid
  105	%member(robot(IRX,IRY,IRD,INA,IRS), IGrid),
  106	member(wumpus(IWX,IWY,_), IGrid),
  107	member(golds(ILGolds), IGrid),
  108	member(pits(ILPits), IGrid),
  109		% Obtain data from the final grid FGrid
  110	member(robot(FRX,FRY,_,_,FRS), FGrid),
  111	member(wumpus(_,_,FWS), FGrid),
  112	member(golds(FLGolds), FGrid),
  113	findall(CA,(member(A,H),actionCost(A,CA)), ListActionCosts), % Actions costs
  114	sumlist(ListActionCosts, CostActions),
  115	length(H,LH),		% Number of actions
  116	length(ILPits,LP),	% Number of pits
  117	(FRS=alive -> CostDie is 0 ; CostDie is -1000),		% Agent dies
  118	(FWS=alive -> CostDieW is 0 ; CostDieW is 100),		% Wumpus dies
  119	length(ILGolds,L1),
  120	length(FLGolds,L2),
  121	GoldsObtained is L1-L2,
  122	(GoldsObtained>0 -> RewardGold is 1000 ; RewardGold is 0),
  123	((member(climb,H), FRX=1, FRY=1) -> Climbed is 50 ; Climbed is 0),
  124	(impossible([(IWX,IWY)|ILPits]) -> Imp=1 ; Imp=0),
  125	sumlist([CostActions,CostDie,CostDieW,RewardGold,Climbed],TReward),
  126	Result=[totalReward(TReward),time(Time),impossible(Imp),
  127		noPits(LP),actions(LH,CostActions),
  128	 	robotDead(FRS,CostDie),wumpusDead(FWS,CostDieW),
  129	 	noGolds(GoldsObtained,RewardGold),climbed(Climbed)].
  130
  131% L is a list of locations (X,Y): wumpus or pits
  132% the predicate states that under such conf. the problem is not solvable
  133impossible(L) :- member((1,2),L).
  134impossible(L) :- member((2,1),L).
  135impossible(L) :- member((2,3),L), member((3,1),L).
  136impossible(L) :- member((2,3),L), member((3,2),L).
  137
  138
  139% Definition of the cost of actions
  140actionCost(A,0) :- member(A,[smell, senseBreeze, senseGold]).
  141actionCost(A,C) :- member(A,[moveFwd,turn,pickGold,climb,enter]), C is -1.
  142actionCost(A,C) :- member(A,[shootFwd]), C is -10.
  143
  144	
  145% Sum a list of numbers
  146sumlist([],N,N).
  147sumlist([N|R],S,T) :-
  148	S2 is S+N,
  149	sumlist(R,S2,T).
  150
  151average(L, R) :-
  152	sumlist(L, Sum),
  153	length(L,LL),
  154	(LL\=0 -> R is Sum/LL ; R=none).
  155
  156%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  157% EOF: Examples/Wumpus/statwumpus.pl
  158%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%