/* Part of SWI-Prolog Author: Anne Ogborn E-mail: anne@swi-prolog.org WWW: http://www.swi-prolog.org Copyright (c) 2018, Anne Ogborn All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ :- module(planner, [ plan/4, apply_action_dict/3 ]). /** A STRIPS type planner. * * This planner depends on action modules, called 'genres', as sets * of actions. See * the 'fairy.pl' example for format. * * */ :- license(bsd). % ! plan(+InitConditions:list, +Genre:atom, -Plan:list, +Options:list) % ! is nondet % % Given a set of initial conditions and a Genre, generate different % plans on backtracking % % @arg InitConditions is a list of conditions at the start. Goals % should be listed as goal(X), and when all X appear in the conditions, % planning terminates % @arg Genre is an atomic genre, allowing actions to be defined for % different genres. % @arg Plan - a list of action names % @arg Options - the only available options are order(random) % (default), which randomizes at each step, and order(first), which % takes actions in lexical order % plan(InitConditions, Genre, Plan, Options) :- ( member(order(Order), Options) ; Order = random ), list_to_ord_set(InitConditions, OrdCond), plan_(Genre, Order, /*Open*/ [OrdCond-[]], /* Closed*/[OrdCond], RPlan), reverse(RPlan, Plan). % Genre is the *|module name|* of the actions % Order is the argument of the order/1 option % Open is a list of nodes to explore, as State-Story pairs % Closed is a list of states to never again put on Open % RPlan is the plan, with the last action first, % % if the Open list is exhausted, plan_(_, _, [], _, _) :- !, fail. % % if we've reached a goal state we have a solution. plan_(_Genre, _Order, [State-Story |_], _Closed, Story) :- debug(planner(current), '~q ~q', [State, Story]), at_goal(State). % if we have a shaggy dog story, discard from Open plan_(Genre, Order, [_State-Story | Open], Closed, FullStory) :- length(Story, Len), ( max_plan_len(Genre, MaxLen) *-> true ; MaxLen = 18 ), Len > MaxLen, plan_(Genre, Order, Open, Closed, FullStory). % process head of Open plan_(Genre, Order, [State-Story | Open], Closed, FullStory) :- ordered_possible_action_states(State, Genre, Order, PossibleActions), actions_children(State, Genre, PossibleActions, Children), add_unclosed_children_to_open(Story, Closed, PossibleActions, Children, % list of states Open, Open1), add_unique( Closed, Children, Closed1), plan_(Genre, Order, Open1, [State | Closed1], FullStory). %! ordered_possible_action_states(+State:state, +Genre:atom, %! +Order:atom, -Possible:list) is det % % Give a state list and Genre, return the possible actions % as a list of action names, sorted in order found if Order=first % and in random order if Order=random % ordered_possible_action_states(State, Genre, Order, Possible) :- possible_actions(State, Genre, RawPossible), ( Order = random -> random_permutation(RawPossible, Possible) ; RawPossible = Possible ). %! add_unclosed_children_to_open(+Story:listpair, +Closed:list, %! +Actions:list, +Children:list, +OpenIn:list, %! -OpenOut:list) is det % % True when OpenOut is the new Open list resulting from adding % the State-Story pairs in Children to the open list, % discarding those already in the closed list. % % @arg Story the current story so far % @arg Closed list of States we should ignore % @arg Actions list of actions that got the children in Children % @arg Children list of States resulting from the current state via % the action in the corresponding position of Actions % @arg OpenIn list of State-Story pairs not yet processed, to be added % to % @arg OpenOut the new Open, after adding the Children with the stories % % we have no more children to add add_unclosed_children_to_open( _Story, _Closed, _, % action [], % children Open, Open) :- !. % green % in the closed set add_unclosed_children_to_open( Story, Closed, [_Action | Actions], [Child | Children], Open, OpenOut) :- memberchk(Child, Closed), % its in the closed set !, % green add_unclosed_children_to_open(Story, Closed, Actions, Children, Open, OpenOut). % already in the open set add_unclosed_children_to_open( Story, Closed, [Action | Actions], [Child | Children], Open, OpenOut) :- memberchk(Child-_, Open), % it's already in the open set debug(planner(dup_open), '~q', [Child-[Action | Story]]), !, % green add_unclosed_children_to_open(Story, Closed, Actions, Children, Open, OpenOut). % main case add_unclosed_children_to_open( Story, Closed, [Action | Actions], [Child | Children], Open, OpenOut) :- append(Open, [Child-[Action | Story]], OpenX), !, % green add_unclosed_children_to_open(Story, Closed, Actions, Children, OpenX, OpenOut). % ! add_unique(+In:list, +New:list, %! -Out:list) is det % % prepend those elements of New which are not in % the In set. Elements of New are added in reverse order, % and second occurances of elements of New are ignored. % add_unique(In, [], In) :- !. % green add_unique(In, [NewH| New], Out) :- memberchk(NewH, In), !, % green add_unique(In, New, Out). add_unique(In, [NewH| New], [NewH | Out]) :- add_unique(In, New, Out). %! at_goal(+State:list) is det % % succeeds if we're at the final goal % at_goal(Cond) :- check_goals(Cond, Cond), !. % green check_goals([], _). check_goals([goal(Goal)|T], Cond) :- memberchk(Goal, Cond), check_goals(T, Cond). check_goals([H|T], Cond) :- H \= goal(_), check_goals(T, Cond). %! possible_actions(+Cond:list, +Genre:atom, -Possible) is det % % succeeds when Possible is the list of actions that can be performed % from Cond using Genre as the action list. % possible_actions(Cond, Genre, Possible) :- findall(Name, possible_action(Cond, Genre, Name), Possible). possible_action(Cond, Genre, Name) :- Genre:action(Name, Act), action{ pre:Pre, negpre: NegPre } :< Act, maplist(is_in(Cond), Pre), maplist(not_in(Cond), NegPre). % famulus to swap memberchk's args is_in(List, Member) :- memberchk(Member, List). not_in(List, Member) :- \+ memberchk(Member, List). %! actions_children(+State:list, %! +Genre:list, %! +PossibleActions:list, %! -Children:list) is det % % succeeds when Children is a list of new states resulting % from applying the members of PossibleActions to State % % @arg State the current state % @arg Genre the module name of the actions % @arg PossibleActions a list of atom action names. Assumed possible % @arg Children The subsequent states % actions_children(State, Genre, PossibleActions, Children) :- maplist(apply_action(State, Genre), PossibleActions, Children). apply_action(State, Genre, Name, NewState) :- Genre:action(Name, Action), apply_action_dict(State, Action, NewState). apply_action_dict(State, Action, NewState) :- action{ add: Add, remove: Remove } :< Action, my_subtract(State, Remove, S1), list_to_ord_set(Add, OrdAdd), ord_union(S1, OrdAdd, NewState). %! my_subtract(+A:list, +B:list, -C:list) is det % % ord_subtract uses the standard term order, which isn't happy % when we have a not fully ground term. To avoid it, we build our % own subtract % % Succeeds when C = A - B as set operation, where A must be ground % and B possibly contains partially ground elements which remove % all elements of A they unify with % my_subtract([], _, []). my_subtract([H|T], Remove, TOut) :- memberchk(H, Remove), !, my_subtract(T, Remove, TOut). my_subtract([H|T], Remove, [H|TOut]) :- my_subtract(T, Remove, TOut). :- multifile planner:max_plan_len/2. max_plan_len(nothing, 18).