1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2% 3% FILE : Eval/eval_know.pl 4% 5% Possible value BAT evaluator 6% (This is just a prototype and it may contain bugs and problems) 7% 8% AUTHOR : Sebastian Sardina & Stavros Vassos 9% Based also on Hector Levesque KPlanner from IJCAI-05 10% EMAIL : {ssardina,stavros}@cs.toronto.edu 11% WWW : www.cs.toronto.edu/cogrobo 12% TYPE : system independent code 13% TESTED : SWI Prolog 5.0.10 http://www.swi-prolog.org 14% 15% Copyright (C): 1999-2005, University of Toronto 16% 17%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 18% 19% This file allows for the projection of conditions wrt 20% basic action theories with possible values. 21% 22% The main tool provided in this file is the following predicate: 23% 24% -- eval(P,H,B): B=true/false/unknown is the truth value of P at history H 25% 26% For more information on Golog and some of its variants, see: 27% http://www.cs.toronto.edu/~cogrobo/ 28% 29%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 30% 31% March, 2002 32% 33% This software was developed by the Cognitive Robotics Group under the 34% direction of Hector Levesque and Ray Reiter. 35% 36% Do not distribute without permission. 37% Include this notice in any copy made. 38% 39% 40% Copyright (c) 2000 by The University of Toronto, 41% Toronto, Ontario, Canada. 42% 43% All Rights Reserved 44% 45% Permission to use, copy, and modify, this software and its 46% documentation for non-commercial research purpose is hereby granted 47% without fee, provided that the above copyright notice appears in all 48% copies and that both the copyright notice and this permission notice 49% appear in supporting documentation, and that the name of The University 50% of Toronto not be used in advertising or publicity pertaining to 51% distribution of the software without specific, written prior 52% permission. The University of Toronto makes no representations about 53% the suitability of this software for any purpose. It is provided "as 54% is" without express or implied warranty. 55% 56% THE UNIVERSITY OF TORONTO DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS 57% SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND 58% FITNESS, IN NO EVENT SHALL THE UNIVERSITY OF TORONTO BE LIABLE FOR ANY 59% SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER 60% RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF 61% CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN 62% CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 63% 64%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 65% 66% This file provides the following: 67% 68% -- eval(P, H, B) (MAIN PREDICATE, used by the transition system) 69% B is the truth value of P at history H 70% 71% SYSTEM TOOLS (used by the top-level cycle):: 72% 73% -- initializeDB/0 74% initialize the projector 75% -- finalizeDB/0 76% finalize the projector 77% -- can_roll(+H1) 78% check if the DB CAN roll forward 79% -- must_roll(+H1) 80% check if the DB MUST roll forward 81% -- roll_db(+H1,-H2) 82% perform roll forward with current history H1 and new history H2 83% -- actionolling(+H1, -H2) 84% mandatory roll forward of history H1 into new history H2 85% -- handle_sensing(+A, +H, +S, -H2) 86% H2 is H plus action A with sensing result S 87% -- debug(+A, +H, -S) 88% perform debug tasks with current action A, sensing outcome S, 89% and history H 90% -- system_action(+A) 91% action A is an action used as a specific tool for the projector 92% 93% 94% OTHER TOOLS (used by the transition system):: 95% 96% -- sensing(+A, -L) 97% action A is a sensing action with a list L of possible outcomes 98% -- sensed(+A, +S, +H) 99% action A, when executed at history H, got sensing result S 100% -- inconsistent(+H) 101% last action turned history H inconsistent, i.e., impossible 102% -- rdomain(-V, +D) 103% object V is an element of domain D 104% -- rdomain(-V, +D) 105% object V is an element of domain D (random way) 106% -- getdomain(+D, -L) 107% L is the list representing domain D 108% -- calc_arg(+A1, -A2, +H) 109% action A2 is action A1 with its arguments replaced wrt history H 110% -- before(+H1, +H2) 111% history H1 is a previous history of H2 112% -- assume(+F, +V, +H1, -H2) 113% H2 is the history resulting from assuming fluent F to 114% have value V at history H1 115%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 116% 117% A basic action theory (BAT) is described with: 118% 119% -- fun_fluent(fluent) : for each functional fluent (non-ground) 120% -- cache(fluent) : fluent should be cached (at least 1) 121% 122% e.g., fun_fluent(color(C)). 123% 124% -- prim_action(action) : for each primitive action (ground) 125% -- exog_action(action) : for each exogenous action (ground) 126% 127% e.g., prim_action(clean(C)) :- domain(C,country). 128% e.g., exog_action(painte(C,B)):- domain(C,country), domain(B,color). 129% 130% -- senses(action,fluent) : for each sensing action 131% 132% e.g, poss(check_painted(C), painted(C)). 133% 134% -- forget(action,fluent) : action makes fluent unknown 135% 136% e.g, poss(checkFloor, lightFloor). 137% -- poss(action,cond) : when cond, action is executable 138% 139% e.g, poss(clean(C), and(painted(C),holding(cleanear))). 140% 141% -- initially(fluent,value): fluent has value in S0 (ground) 142% 143% e.g., initially(painted(C), false):- domain(C,country), C\=3. 144% initially(painted(3), true). 145% initially(color(3), blue). 146% 147% -- causes_val_tt(action,sensing,fluent,value,cond) 148% when cond ek_holds, doing action with outcome sensing causes fluent 149% to have value 150% 151% e.g., causes_val(paint(C2,V), color(C), V, C = C2). 152% or causes_val(paint(C,V), color(C), V, true). 153% 154% -- causes_true(action,fluent,cond) 155% when cond ek_holds, doing act causes relational fluent to hold 156% -- causes_false(action,fluent,cond) 157% when cond ek_holds, doing act causes relational fluent to not hold 158% 159% e.g., causes_true(paint(C2,_), painted(C), C = C2). 160% or causes_true(paint(C,_), painted(C), true). 161% e.g., causes_false(clean(C2), painted(C), C = C2). 162% or causes_false(clean(C), painted(C), true). 163% 164% -- sort-name(domain_of_sort). : defines a sort 165% e.g., color([blue, green, yellow, red]). 166% temperature([-30..45]). 167% 168% Requirements: 169% 170% -- is_list(+L) : L is a list 171% -- subv(X1,X2,T1,T2) : T2 is T1 with X1 replaced by X2 172% -- multifile/1 173% -- get0/1 174%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 175%% :- module(evalbat, 176%% [eval/3, 177%% initializeDB/0, 178%% finalizeDB/0, 179%% handle_sensing/4, 180%% sensing/2, 181%% sensed/3, 182%% domain/2, 183%% getdomain/2, 184%% calc_arg/3, 185%% before/2, 186%% inconsistent/1, 187%% assume/4 188%% ]). 189%% 190%% :- use_module(library(quintus)). 191 192:- dynamic 193 currently/2, % Used to store the actual initial fluent values 194 simulator/2, % There may be no simulator 195 senses/2, % There may be no exogenous action simulator 196 forget/2, % There may be no action that "forgets" a fluent 197 has_valc/3. % used for caching some values 198 199% Predicates that they have definitions here but they can defined elsewhere 200:- multifile(prim_action/1). 201:- multifile(causes_val/4). 202%:- multifile(exog_action/1). 203:- multifile(poss/2). 204 205%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 206% Predicates to be exported 207%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 208 209 /* Move initially(-,-) to currently(-,-) and clear exog actions */ 210initializeDB:- 211 retractall(currently(_,_)), 212 forall(initially(F,V), assert(currently(F,V))), 213 clean_cache. 214 215 /* Clean all the currently(-.-) predicates */ 216%finalizeDB:- retractall(currently(_,_)), clean_cache. 217finalizeDB. % Leave the current beliefs and all the cache information there... 218 219% eval(P,H,B): this is the interface of the projector 220eval(P,H,true):- kholds(P,H). 221 222% Change the history H to encode the sensing result of action A at H 223% handle_sensing(A,H,Sr,[e(F,Sr)|H]):- senses(A,F). (OLD WAY) 224handle_sensing(A,[A|H],Sr,[e(A,Sr),A|H]):- senses(A). 225 226 227% clean_cache: remove all has_valc/3 228clean_cache :- retractall(has_valc(_,_,_)). 229 230% Set F to value V at H, return H1 (add e(F,V) to history H) 231assume(F,V,H,[e(F,V)|H]). 232 233% system_action/1 defines actions that are used by the projector for managment 234system_action(e(_,_)). 235 236% Action A is a sensing action 237sensing(A,_):- senses(A). 238 239% sensed(+A,?V,+H): action A got sensing result V w.r.t. history H 240sensed(A,V,[e(F,V2)|_]):- senses(A,F), !, V=V2. 241sensed(A,V,[_|H]) :- sensed(A,V,H). 242 243% domain/2: assigns a user-defined domain to a variable. 244%domain(V, D) :- getdomain(D, L), member(V, L). 245%rdomain(V, D) :- getdomain(D, L), shuffle(L,L2), !, member(V, L2). 246domain(V, D) :- is_list(D) -> member(V, D) ; apply(D,[V]). 247rdomain(V, D) :- (is_list(D) -> L=D ; bagof(P,apply(D,[P]),L)), 248 shuffle(L,L2), !, member(V, L2). 249 250% ***** to go 251% L is the list-domain associated to name D 252%getdomain(D, L) :- is_list(D) -> L=D ; (P =.. [D,L], call(P)). 253 254% Computes the arguments of an action or a fluent P 255% Action/Fluent P1 is action/fluent P with all arguments evaluated 256calc_arg(P,P1,H):- (is_an_action(P) ; prim_fluent(P)), 257 (atomic(P)-> P1=P ; 258 (P =..[Function|LArg], subfl(LArg,LArg2,H), 259 P1=..[Function|LArg2])). 260 261% History H1 is a previous history of H2 262before(H1,H2):- append(_,H1,H2). 263 264% No action can make a history inconsistent (simplification) 265inconsistent(_):- fail. 266 267 268%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 269% Other predicates neede but not exported 270%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 271 272% A primitive fluent is either a relational or a functional fluent 273prim_fluent(P):- fun_fluent(P). 274 275% Check if A has "the form" of a primitive action, though, its arguments 276% may need to be evaluated yet 277% We need to do this hack because actions are defined all ground 278is_an_action(A):- \+ \+ (prim_action(A) ; exog_action(A)), !. 279is_an_action(A):- \+ atomic(A), 280 A =..[F|Arg], length(Arg,LArg), length(ArgV,LArg), 281 NA =..[F|ArgV], (prim_action(NA) ; exog_action(A)). 282 283% Simulation of an action A has the same effects as action A itself 284causes_val(sim(A),F,V,C) :- !, causes_val(A,F,V,C). 285 286% Build causes_val/4 for relational fluents 287causes_val(A,F,true,C) :- causes_true(A,F,C). 288causes_val(A,F,false,C) :- causes_false(A,F,C). 289 290% Abort if P is not grounded (to use before negations as failure) 291checkgr(P):- ground(P)-> true ; warn(['CWA applied to formula: ',P]). 292 293% Update the cache information by stripping out the subhistory H 294update_cache(H) :- 295 retract(has_valc(F, V, H2)), 296 append(H1, H, H2), 297 assert(has_valc(F, V, H1)), 298 fail. 299update_cache(_). 300 301 302%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 303% Evaluation procedure for projection (START) 304%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 305 306%--------------------------------------------------------------------------- 307% kholds(+P,+H): P is known to be true at H (i.e., P ek_holds at H) 308% This is guarranteed to be sound P only when P is ground. Free vars are 309% allowed and in some special cases. *** 310%--------------------------------------------------------------------------- 311kholds(P,H) :- ground(P) -> 312 \+ ek_holds(neg(P),H) 313 ; 314 (warn(['kholds/2 called with open variables: ',P]), 315 ek_holds(P,H), 316 \+ ek_holds(neg(P),H)). 317 318%kholds(P,H) :- ground(P) -> 319% ( !, \+ ek_holds(neg(P),H), (ek_holds(P,H) -> true ; 320% (write('AAAAAAAAAAAA!:'),write(P),write('@'),writeln(H),halt))) 321% ; 322% ek_holds(P,H), \+ ek_holds(neg(P),H). 323 324%--------------------------------------------------------------------------- 325% ek_holds(+P,+H): P ek_holds in H (i.e., P is possibly true at H) 326%--------------------------------------------------------------------------- 327holds(P,H):-ek_holds(P,H). 328 329% negation normal form transformation 330ek_holds(neg(or(P1,P2)),H) :- !, ek_holds(and(neg(P1),neg(P2)),H). /* Loyd-Topor Transf */ 331ek_holds(neg(and(P1,P2)),H) :- !, ek_holds(or(neg(P1),neg(P2)),H). /* Loyd-Topor Transf */ 332ek_holds(neg(neg(P)),H) :- !, ek_holds(P,H). /* Loyd-Topor Transf */ 333ek_holds(neg(all(V,D,P)),H) :- !, ek_holds(some(V,D,neg(P)),H). /* Loyd-Topor Transf */ 334ek_holds(neg(some(V,D,P)),H) :- !, ek_holds(all(V,D,neg(P)),H). /* Loyd-Topor Transf */ 335ek_holds(neg(impl(P1,P2)),H) :- !, ek_holds(and(P1,neg(P2)),H). /* Loyd-Topor Transf */ 336ek_holds(neg(equiv(P1,P2)),H):- !, ek_holds(or(and(P1,neg(P2)),and(neg(P1),P2)),H). 337ek_holds(neg(P),H):- proc(P,P1), !, ek_holds(neg(P1), H). 338 339% implication as a macro 340ek_holds(impl(P1,P2),H) :- !, ek_holds(or(neg(P1),P2),H). 341ek_holds(equiv(P1,P2),H) :- !, ek_holds(and(impl(P1,P2),impl(P2,P1)),H). 342 343% non-atomic formulas 344ek_holds(and(P1,P2),H) :- !, ek_holds(P1,H), !, ek_holds(P2,H). 345ek_holds(or(P1,P2),H) :- !, ((ek_holds(P1,H),!) ; (ek_holds(P2,H),!)). 346ek_holds(some(V,D,P),H) :- !, domain(O,D), subv(V,O,P,P1), ek_holds(P1,H). 347ek_holds(all(V,D,P),H) :- !, \+((domain(O,D), subv(V,O,P,P1), \+ ek_holds(P1,H))). 348ek_holds(P,H) :- proc(P,P1), !, ek_holds(P1,H). 349 350 351%--------------------------------------------------------------------------- 352% Evaluation of ground atoms. Atoms are either equality (fluent) atoms or 353% prolog predicates possibly mentioning ground fluents. 354%--------------------------------------------------------------------------- 355% if it's a prolog predicate then use good-old subf *** 356% if it's a ground equality atom then optimize a bit *** 357% ola ayta 8a allajoyn me ta kainoyria domains poy 8a dhlwnontai jexwrista apo to onoma ***** 358ek_holds(neg(P),H):- !, subf(P,P1,H), \+ call(P1).
363ek_holds(T1=T2,H) :- ground(T1), ground(T2), 364 liftAtom(T1, NameT1, ArgT1, LiftT1), 365 liftAtom(T2, NameT2, ArgT2, LiftT2), 366 ( (prim_fluent(LiftT1), \+ prim_fluent(LiftT2), !, 367 subf(ArgT1,ArgT1Eval,H), 368 T1Eval =..[NameT1|ArgT1Eval], 369 has_value(T1Eval,T2,H) 370 ) 371 ; 372 (prim_fluent(LiftT2), \+ prim_fluent(LiftT1), !, 373 subf(ArgT2,ArgT2Eval,H), 374 T2Eval =..[NameT2|ArgT2Eval], 375 has_value(T2Eval,T1,H) 376 ) 377 ). 378ek_holds(P,H) :- !, subf(P,P1,H), call(P1). 379 380liftAtom(Atom, NameA, ArgA, LiftedAtom) :- 381 Atom =..[NameA|ArgA], 382 templist(ArgA,ArgAVars), 383 LiftedAtom =..[NameA|ArgAVars]. 384 385liftAtom2(Atom, NameA, ArgA, LiftedAtom) :- 386 Atom =..[NameA|ArgA], 387 length(ArgA, L), 388 length(ArgAVars, L), 389 LiftedAtom =..[NameA|ArgAVars]. 390 391 392% templist(X,Y) : X and Y are lists of the same length; Y used to return a list of variables of size |X| 393templist([],[]) :- !. 394templist([_],[_]) :- !. 395templist([_,_],[_,_]) :- !. 396templist([_,_,_],[_,_,_]) :- !. 397templist([_,_,_,_],[_,_,_,_]) :- !. 398templist([_,_,_,_,_],[_,_,_,_,_]) :- !. 399templist([_,_,_,_,_,_],[_,_,_,_,_,_]) :- !. 400templist([_,_,_,_,_,_,_],[_,_,_,_,_,_,_]) :- !. 401templist([_|R1],[_|R2]) :- templist(R1,R2). 402 403 404%--------------------------------------------------------------------------- 405% subf(+P1,?P2): P2 is P1 with all fluents replaced by a possible value at H 406%--------------------------------------------------------------------------- 407subf(P1,P2,_) :- (var(P1) ; number(P1)), !, P2 = P1. 408subf(now,H,H) :- !. 409subf(m(F),L,H) :- !, setof(V1,has_value(F,V1,H),L). 410subf(i(F),V,_) :- !, currently(F,V). 411 412subf(P1,P2,H) :- atom(P1), !, subf2(P1,P2,H). 413subf(P1,P2,H) :- P1=..[F|L1], subfl(L1,L2,H), P3=..[F|L2], subf2(P3,P2,H). 414subf2(P3,P2,H) :- prim_fluent(P3), has_value(P3,P2,H). 415subf2(P2,P2,_) :- \+ prim_fluent(P2). 416 417subfl([],[],_). 418subfl([T1|L1],[T2|L2],H) :- subf(T1,T2,H), subfl(L1,L2,H). 419 420 421%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 422% Implementation of top-level has_value/3 423% has_value(+F,?V,+H): V is a possible value for F at history H (top-level predicate) 424%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 425has_value(F,V,H) :- 426 ground(F) -> 427 has_valgc(F,V,H) 428 ; 429 (warn(['has_value/3 called with an open variable fluent: ',F]), has_valo(F,V,H)). 430 431% has_valgc/3: implements caching for ground fluents 432% if it is a cached fluent and there is no cache store, then compute all the cached values 433% if it is a cached fluent and there is cache info, then bind those values 434% it it is not a cached fluent, then just use normal regression via has_valg/3 435has_valgc(F,V,H) :- cache(F), \+ has_valc(F,_,H), 436 has_valg(F,V,H), assert(has_valc(F,V,H)), fail. 437has_valgc(F,V,H) :- cache(F), !, has_valc(F,V,H). 438has_valgc(F,V,H) :- has_valg(F,V,H). % F is a fluent with NO cache 439 440 441% This is the case when F is contains some free variable (e.g., open(X)) 442% *SV*: We do not handle free variables any more (for this version at least) 443has_valo(F,V,H):- has_valg(F,V,H). 444 445 446% has_val(F,V,H) ek_holds if V is a possible value for fluent F at history H 447% (proven by regression) 448% 449% This is the case when F is a ground fluent (e.g., open(3)) 450% has_valg/3 is guarranteed to work reasonably only if the following are true 451% - when a causes(A,F,_,_) exists then the next values for F will be 452% determined by the set of causes(A,F,_,_) which cover all the logical 453% space, i.e. \land_i \lnot C_i is unsatisfiable 454% - sensing actions and physical actions are disjoint 455% - causes/4: C is a conjunction of possibly negated ground atoms. 456% - settles/5: C is a conjunction of possibly negated ground atoms. 457% - rejects/5: C is a general formula with V as the only free variable 458% - settles and rejects do not overlap 459has_valg(F,V,[]) :- currently(F,V). 460has_valg(F, V, [A|H]):- sets_val(A, F, _, H), !, sets_val(A, F, V, H). 461has_valg(F, V, [e(A,S), A|H]):- !, has_value(F,V,H), \+ (rejects(A,S,F,V,C), kholds(C,H)). 462has_valg(F, V, [_|H]):- has_value(F,V,H). 463 464% First try if F is defined by causes/4, then by settles/5 465sets_val(A,F,V,H) :- causes(A,F,_,_), !, causes(A,F,V,C), ek_holds(C,H). 466sets_val(e(A,S),F,V,[A|H]) :- settles(A,S,F,V1,C), kholds(C,H), !, V=V1. 467 468%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 469% End of has_value/3 implementation 470%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 471 472 473 474% So far, one forgets the value of F when it is sensed (may be improved) 475forget(Act, _, F) :- forget(Act, F). 476 477% Special high-level actions to set and unset fluent F: set(F) and unset(F) 478prim_action(set(_)). 479prim_action(unset(_)). 480poss(set(F), ground(F)). 481poss(unset(F), ground(F)). 482has_val(F,V,[set(F)|_]) :- !, V=true. 483has_val(F,V,[unset(F)|_]):- !, V=false. 484 485%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 486% ROLL DATABASE FORWARD 487% 488% Rolling forward means advancing the predicate currently(-,-) and 489% discarding the corresponding tail of the history. 490% There are 3 parameters specified by roll_parameters(L,M,N). 491% L: the history has to be longer than this, or dont bother 492% M: if the history is longer than this, forced roll (M >= L) 493% N: the length of the tail of the history to be preserved 494% (set N=0 to never roll forward) 495%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 496:- dynamic temp/2. % Temporal predicate used for rolling forward 497 498% roll_parameters(1,1,0). % Never roll forward 499roll_parameters(30,40,15). 500 501can_roll(H) :- roll_parameters(L,_,N), length(H,L1), L1 > L, N>0. 502must_roll(H) :- roll_parameters(_,M,N), length(H,L1), L1 > M, N>0. 503 504% H1 is the current history (H1 = H2 + H3) 505% H2 will be the new history 506% H3 is the tail of H1 that is going to be dropped 507roll_db(H1,H2) :- 508 roll_parameters(_,_,N), 509 split(N,H1,H2,H3), 510 report_message(system(3), ['(DB) ', 'Progressing the following sub-history: ', H3]), 511 preserve(H3), 512 report_message(system(3), ['(DB) ', 'Updating cache...']), 513 update_cache(H3), % Update the cache information 514 report_message(system(3), ['(DB) ', 'Subhistory completely rolled forward']). 515 516 /* split(N,H,H1,H2) succeeds if append(H1,H2,H) and length(H1)=N. */ 517split(0,H,[],H). 518split(N,[A|H],[A|H1],H2) :- N > 0, N1 is N-1, split(N1,H,H1,H2). 519 520% preserve(H) : rolls forward the initial database currently/2 from [] to H 521preserve([]). 522preserve([A|H]) :- preserve(H), roll_action(A), update_cache([A]). 523 524 525%%%%%%%%%%% THIS NEEDS SUBSTANTIAL MORE WORK, IT IS FULLY UNTESTED!! 526%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 527 528% roll_action(A): Roll Currently/2 database with respect to action A 529roll_action(e(A,S)) :- 530 settles(A, S, F, V, C), % A may settle F 531 prim_fluent(F), 532 kholds(C, []), % Value of F is settled to V 533 retractall(currently(F, _)), 534 assert(currently(F, V)), % Update value of F to unique value V 535 fail. 536roll_action(e(A,S)) :- % A may reject F 537 rejects(A, S, F, V, C), 538 prim_fluent(F), 539 currently(F,V), % choose a potential value V for rejection 540 kholds(C, []), % V should be rejected! 541 retractall(currently(F, V)), % then, retract V from F 542 fail. 543roll_action(A) :- \+ A=e(_,_), % A may affect F 544 causes(A, F, _, _), 545 prim_fluent(F), 546 roll_action_fluent(A, F), 547 fail. 548roll_action(_). 549 550 551% Fluent F requires update wrt executed action A 552% OBS: At this point F may still contain free var 553roll_action_fluent(A, F) :- 554 has_value(F, V, [A]), % compute one possible value for F (now F is ground) 555 (\+ temp(F, V) -> assert(temp(F, V)) ; true), % if new value, put it in temp/2 556 fail. 557roll_action_fluent(_, F) :- % now update currently/2 with the just computed temp/2 558 temp(F, _), 559 retractall(currently(F,_)), % F needs a full update, remove all currently/2 560 % Next obtain all values stored in temp/2 for that specific ground F 561 temp(F,V), % Get a new possible value (maybe many, backtrack) 562 assert(currently(F,V)), % Set the new possible value in currently/2 563 retract(temp(F,V)), % Remove the new possible value from temp/2 564 fail. 565roll_action_fluent(_, _). 566 567 568 569 570 571%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 572% DEBUG ROUTINES 573%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 574% debug(+Action, +History, -SensingResult): 575% If Action=debug then a snapshot of the system is printed out 576% Otherwise, the sendRcxActionNumber/2 577% predicate failed (RCX panicked or there was a problem with the 578% communication). This predicate attempts to provide some basic debug 579% and error recovery. 580%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 581debug(debug, History, _) :- !, 582 write('-------------------------------------------------------------'), nl, 583 write('********* A SNAPSHOT OF THE SYSTEM WAS REQUESTED ************'), nl, 584 errorRecoveryData(History), 585 write('-------------------------------------------------------------'), nl. 586 587debug(Action, History, SensingResult) :- 588 write('** There is a problem with the RCX. It may need to be reset.'), nl, 589 errorRecoveryData(History), 590 errorRecoveryProc, 591 execute(Action, History, SensingResult). % Try action again 592 593% errorRecoveryData(+History): Extract values of primitive fluents at 594% the point where Hist actions are performed. 595errorRecoveryData(History) :- 596 write(' Actions performed so far: '), 597 write(History), nl, 598 bagof(U, prim_fluent(U), FluentList), 599 printFluentValues(FluentList, History). 600 601% printFluentValues(+FluentList, +History): Print value of primitive fluents 602% at the point where History actions have been performed 603printFluentValues([], _). 604 605printFluentValues([Hf | FluentList], History) :- 606 (has_value(Hf, Hv, History), % Print all instances of Hf 607 write(' PRIMITIVE FLUENT '), 608 write(Hf), 609 write(' HAS VALUE '), 610 write(Hv), nl, fail) ; 611 printFluentValues(FluentList, History). % Continue with other fluents 612 613% errorRecoveryProc: What to do in case of error. In this case, ask the user 614% to reposition the RCX so that last action can be re-attempted 615errorRecoveryProc:- 616 write('If you wish to abort, enter "a".'), nl, 617 write('If you wish to continue execution, place RCX in a position'), nl, 618 write('consistent with these values and hit any other key.'), nl, 619 get0(Val), 620 get0(_), % Clear carriage return 621 (Val == 65; Val == 97) -> % 65 is ASCII 'A', 97 is ASCII 'a' 622 abort; 623 true. 624 625%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 626% EOF: Eval/eval_know.pl 627%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%