1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2% 3% World Smallest Iterative Deeping Forward Filtering 4% Conditional Planner 5% (Version with constraints for ECLIPSE Prolog) 6% Tested with ECLIPSE 5.3 and SWI Prolog over Linux RH 7.0-7.2 7% 8% c) Hector J. Levesque Many rights reserved (Nov 2001) 9% Modified by Sebastian Sardina Many rights reserved (Jan 2002) 10% 11%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 12% This file provides the following: 13% 14% --- wscp(Name,Goal,Max,IA,SimNo,S,Plan): Plan for Goal up to depth Max 15% wscp(Name,Goal,Max,S,Plan) 16% Name : symbolic name of the planning problem 17% Goal : goal 18% Max : max depth to search for 19% IA : initial set of actions to use 20% SimNo: Use SimNo simulator controller for exogenous actions 21% S : initial history/situation 22% Plan : plan 23% 24% --- pplan(Name,Goal,Max,End): 25% pplan(Goal,Max) [Name=Goal and End=true] 26% pplan(Name,Goal,Max) [End=true] 27% plan for Goal up to Max depth. At the end print 28% the plan using End as the final condition to print out 29% 30% --- run(CP,H,H2): H2 is a possible extension of H by executing CP 31% 32% The following predicates are required: 33% --- prim_action(action) - for each primitive action 34% --- poss(action,cond) - when cond holds, action is executable 35% --- sensing(A,VL) - VL is a list of possible sensing values of action A 36% 37% --- simulator(N,P) - P is the N exogenous action simulator (optional) 38% --- inconsistent(H) - last action make history H inconsistent 39% --- restrict_actions(Name,Goal,N,AA,C,NA) - 40% In the planning Name, when C holds, restrict to 41% actions in NA when planning for Goal at the Nth level 42% with initial set of actions AA 43% To achieve no Filtering: restrict_actions(name,_,_,_,false,_). 44% 45% --- eval(P,H,B): B is the truth value of P at history H (MAIN PREDICATE) 46% --- handle_sensing(A,H,Sr,H2): alter the history H to encode the sensing 47% result of action A at H 48% --- fix_term(A): fix all of some of the variables in A (optional) 49%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50:- dynamic simulator/3, % These predicates may be not defined 51 fix_term/1, 52 restrict_actions/6. 53 54%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 55% The planner (extended) 56% Differences with the original version: 57% 1) change good_state/3 for the more general restrict_actions/5 58% 2) simulate exogenous action after each step using user provided 59% exogenous action simulator via simulator/2 60% 3) sensing handlede more general by using handle_sensing/3 depending 61% on what theory of action is used 62% 4) inconsistent situations is now handle via type-theory inconsistent/1 63% 5) 64%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 65 66% PLANNER TOP LEVEL. 67% wscp/5 plans for a Goal up to some Max depth. 68% Assumes no exogenous action simulator and all actions allowed 69% wscp/7 plans for a Goal up to some Max depth. 70% It uses the SimNo^th exogenous action simulator and 71% IA is the list of actions allowed for the planning problem 72% S is the initial history to plan from 73% Name is a descriptive name for the planning (link restrict_actions) 74wscp(Name,Goal,Max,S,Plan) :- wscp(Name,Goal,Max,all,_,S,Plan). 75wscp(Name,Goal,Max,IA,SimNo,S,Plan) :- idplan(Name,Goal,0,Max,S,Plan,IA,SimNo). 76 77% Iterative deeping planner 78% --- Goal is the condition to planfor 79% --- N is the current level 80% --- M is the maximum level allowed 81% --- Ini is the initial history 82% --- Plan is the computed plan 83% --- IA is the initial set (list) of legal actions to use (all=all actions) 84% --- SimNo is the number of the exogenous action simulator to use (if any) 85idplan(Name,Goal,N,_,Ini,Plan,IA,SimNo) :- 86 dfplan(Name,Goal,N,Ini,Plan,IA,SimNo). 87idplan(Name,Goal,N,M,Ini,Plan,IA,SimNo) :- N < M, N1 is N+1, 88 idplan(Name,Goal,N1,M,Ini,Plan,IA,SimNo). 89 90% Depth-first planner for Goal, up to depth level N 91% Simulated actions are "added" to both the situation S and the Plan 92% Usually, simulated actions will be stated via the sim(_) construct 93dfplan(_,Goal,_,S,[],_,_) :- holds_wscp(Goal,S). 94dfplan(Name,Goal,N,S,Plan,AA,SimNo) :- N > 0, 95 filter(Name,Goal,N,AA,S,AA3), AA3\=[], 96 simulate_exog(S,SimNo,SE), append(SE,S,S2), append(SE,Plan2,Plan), 97 prim_action(A), allowed(A,AA3), 98 poss(A,C2), holds_wscp(C2,S2), 99 (fix_term(A) -> true ; true), % Ground the action A if possible 100 N1 is N-1, try_action(Name,Goal,N1,S2,A,Plan2,AA,SimNo). 101 102% Perform the forward filtering. AA3 is the new set of possible actions 103filter(Name,Goal,N,AA,S,AA3):- restrict_actions(Name,Goal,N,AA,C1,AA2), !, 104 (holds_wscp(C1,S) -> AA3=AA2 ; AA3=AA). 105filter(_,_,_,A,_,A). % Assume no forward filtering 106 107% Try sensing action A at level N 108try_action(Name,Goal,N,S,A,[A,case(A,BL)],AA,SimNo) :- 109 sensing(A,VL), !, build_ifs(Name,Goal,N,S,A,VL,BL,AA,SimNo). 110% Try non-sensing action A at level N 111try_action(Name,Goal,N,S,A,[A|RPlan],AA,SimNo) :- 112 dfplan(Name,Goal,N,[A|S],RPlan,AA,SimNo). 113 114% Build case structure using the list [V|VL] of sensing results for A 115build_ifs(_,_,_,_,_,[],[],_,_). 116build_ifs(Name,Goal,N,S,A,[V|VL],[if(V,Plan)|BL],AA,SimNo) :- 117 handle_sensing(A,[A|S],V,S2), 118 ( inconsistent(S2) -> Plan=[inc] ; 119 once(dfplan(Name,Goal,N,S2,Plan,AA,SimNo)) ), 120 build_ifs(Name,Goal,N,S,A,VL,BL,AA,SimNo). 121 122 123% allowed(A,AA): Action A is an allowed action w.r.t. AA 124% If AA=[], then every action of the domain is allowed 125allowed(_,all):- !. 126allowed(A,AA):- \+ \+ member(A,AA), !. 127 128% Given situation S, and simulator number SimNo, S2 will be the next 129% situation that will contain all simulated exogenous actions 130simulate_exog(S,SimNo,[A|SE]):- \+ var(SimNo), 131 simulator(SimNo,C,A), holds_wscp(C,S), !, 132 simulate_exog([A|S],SimNo,SE). 133simulate_exog(_,_,[]). 134 135 136% WSCP only considers true projection. Ignore false or unknowns. 137holds_wscp(C,H):- eval(C,H,true). 138 139%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 140% Plan & Print plan (Name is the name of the planning problem) 141% pplan(Name,Goal,Max) : plan for Goal up to Max depth 142% pplan(Name,Goal,Max,End): plan for Goal up to Max depth. At the end print 143% the plan using End as the final condition to print out 144%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 145pplan(Goal,Max) :- pplan(Goal, Goal,Max,true). % Make Name=Goal 146pplan(Name,Goal,Max) :- pplan(Name,Goal,Max,true). 147pplan(Name,Goal,Max,End) :- wscp(Name,Goal,Max,[],Plan), nl, 148 write('Planning name is '), write(Name), nl, 149 write('Goal is '), write(Goal), nl, nl, pp(0,Plan,[],End), nl. 150 151%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 152% pp(I,Plan,S,E): Pretty print of a plan Pt 153% - I is the initial indentation 154% - Plan is the plan to print 155% - S is the initial situation 156% - E is the final condition to print out 157%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 158pp(_,[],_,true) :- !. 159pp(N,[],S,End) :- subf(End,P,S), tab(N), write('*** '), call(P), nl. 160pp(N,[case(A,L)],S,End) :- !, tab(N), 161 write(A), nl, N2 is N+1, pp2(N2,L,A,S,End). 162pp(N,[A|L],S,End) :- !, tab(N), write(A), nl, pp(N,L,[A|S],End). 163 164pp2(_,[],_,_,_). 165pp2(N,[if(V,P)|L],A,S,End) :- tab(N), write(V), write(' => '), nl, N2 is N+1, 166 pp(N2,P,[e(_,V)|S],End), pp2(N,L,A,S,End). 167 168 169 170 171%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 172% run/3 extracts each potential history-path in a conditional plan 173%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 174% H is a potential history after executing the CPP 175% (i.e, H is a history after executing "some" branch in CPP) 176run(CPP,H):- run(CPP,[],H). 177run([],H,H). 178run([A,case(A,BL)],H,H3):-!, member(if(V,PV),BL), 179 handle_sensing(A,[A|H],V,H2), 180 run(PV,H2,H3). 181run([A|R],H,H2):- run(R,[A|H],H2). 182 183% FL is the length (i.e, number of actions) of history H 184% FL is the real length minus the number of sensing results in H 185hist_length(H,N):- findall(A, (member(A,H), prim_action(A)),LA), 186 length(LA,N)