An introduction to Artificial Intelligence. Finlay and Dix. 1st Edition.

meansend.p

download

Header

%  =================================================================
%  ==                                                             ==
%  ==          An Introduction to ARTIFICIAL INTELLIGENCE         ==
%  ==                  Janet Finlay and Alan Dix                  ==
%  ==                       UCL Press, 1996                       ==
%  ==                                                             ==
%  =================================================================
%  ==                                                             ==
%  ==        chapter 9, pages 205-207:  means-end analysis        ==
%  ==                                                             ==
%  ==          Prolog example, Alan Dix, September 1997           ==
%  ==                                                             ==
%  =================================================================

Code

%  ** uses set predicates:  concat, member, remove_member
%  ** see list.p for definitions if not available on your Prolog

%  operators are coded using a predicate:
%      operation( Op_Name, Precondition, Postcondition )
%  The following example are equivalent to Table 9.1 on page 206
%  We use Prolog functors such as in_hand(A) and the Prolog not operator.

operation( pick_up(A),
           [is(on_table(A)),not(on_top(C,A)), not(in_hand(X))],  % precondition
           [is(in_hand(A)),not(on_table(A))] ).                 % postcondition

operation( put_down(A),
           [is(in_hand(A))],                                   % precondition
           [is(on_table(A)),not(in_hand(A))] ).                 % postcondition

operation( pick_off(A,B),
           [is(on_top(A,B)),not(on_top(C,A)), not(in_hand(X))],  % precondition
           [is(in_hand(A)),not(on_top(A,B))] ).                 % postcondition

operation( put_on(A,B),
           [is(in_hand(A)),not(on_top(C,B))],                   % precondition
           [is(on_top(A,B)),not(in_hand(A))] ).                 % postcondition

%  We will code goals in the same way as the list of preconditions and
%  postconditions above.  States are similar except that only positive
%  facts such as on_table(green_box) are included.

%  Two predicates are used to to test whether a goal has been attained.
%  The first checks a full goal:
%      me_satisfied(Goal,State)
%  The other checks a single part of a goal such as 'on_table(red_box')
%      me_sat_one(One_Goal,State)

me_satisfied([],State).
me_satisfied([X|Goal],State) :-
        me_sat_one(X,State),
        me_satisfied(Goal,State).

me_sat_one(is(X),State) :- member(X,State).
me_sat_one(not(X),State) :- \+ me_sat_one(X,State).

%  The predicate 'me_goal_diff/3' takes a goal and a state and works out
%  the difference, those parts of the goal which are not yet satisfied
%  in the current state
%      me_goal_diff(Goal,State,Difference)

me_goal_diff([],State,[]).
me_goal_diff([X|Goal],State,Gdiff) :-
        me_sat_one(X,State), !,
        me_goal_diff(Goal,State,Gdiff).
me_goal_diff([X|Goal],State,[X|Gdiff]) :-
        me_goal_diff(Goal,State,Gdiff).

%  The main planning predicate is 'me_plan/4'.
%  This has four arguments:
%      me_plan(Init,Goal,Plan,Final)
%  It takes and initial state and a goal and works out a plan to accomplish
%  the goal and the final state after the plan.
%  It in turn uses a predicate me_plan_one/4' which attempts to achieve
%  just one part of the goal.  It has similar argumnenst to 'me_plan':
%      me_plan_one(Init,Goal,Plan,Final)
%  This predicate chooses a potential appropriate operator and then uses
%  a third predicate 'me_try_op/4' to see whether the operator can be
%  successfully applied.
%  The arguments are agan similar to 'me_plan' except a particular
%  operator is selected rather than a goal.
%      me_try_op(Init,Op,Plan,Final)
%  The application of a single operator may give rise to a plan as the
%  preconditions of the operator may not be satisfied in the initial state
%  leading to further planning in order to achieve the preconditions.
%  Finally, when the precondirons have been satisfied, the predicate
%  'me_update_state/3' takes the postcondition of a selected operator and
%  updaes the state appropriately:
%      me_update_state(Init,New_State,Final)

me_plan(State,Goal,[],State):-
            me_satisfied(Goal,State), !.
me_plan(Init,Goal,Plan,Final):-
            me_plan_one(Init,Goal,Plan_One,After_One),
            me_plan(After_One,Goal,Plan_Rest,Final),      %  **
            concat(Plan_One,Plan_Rest,Plan).

me_plan_one(Init,Goal,Plan,Final):-
            me_goal_diff(Goal,Init,Gdiff),
            member(X,Gdiff),
            operation(Op,Pre,Post),
            member(X,Post),
            me_try_op(Init,Op,Plan,Final).

say_try(Op) :- write(['trying ',Op,' ...']), nl.
say_try(Op) :- write(['...', Op, ' - Failed!!!']), nl, fail.

me_try_op(Init,Op,Plan,Final) :-
            %  say_try(Op),    % uncomment if you want to see what is going on in more detail
            operation(Op,Pre,Post),
            me_plan(Init,Pre,Plan_Pre_Op,S_Pre_Op),
            me_update_state(S_Pre_Op,Post,Final),
            concat(Plan_Pre_Op,[Op],Plan).

me_update_state(State,[],State).
me_update_state(State,[X|Rest],State2) :-
            me_sat_one(X,State),
            me_update_state(State,Rest,State2).
me_update_state(State,[not(X)|Rest],State2) :-
            !,
            remove_member(X,State,State1),
            me_update_state(State1,Rest,State2).
me_update_state(State,[is(X)|Rest],State2) :-
            me_update_state([X|State],Rest,State2).

Running this Code

%  RUNNING THIS CODE
%
%
%  Try the following planning task as found in the example on pages 206/7
%
%>         me_plan( [ on_table(blue_pyramid),             % initial state
%+                    on_top(red_pyramid,green_box),
%+                    on_top(blue_box,red_box),
%+                    on_table(green_box),
%+                    on_table(red_box)
%+                  ],
%+                  [ is(on_top(blue_pyramid,red_box)),      % goal
%+                    is(on_table(red_box))
%+                  ],
%+                  Plan, Final_state ).
%
%  When you have run it, notice how the resulting plan starts with:
%         pick_up(blue_pyramid), put_down(blue_pyramid)
%  This is because it picks up the pyramid before noticing that the red_box
%  has a blue_box on top of it.  It then has to put down the blue_pyramid in
%  order to remove the blue_box.  In this case there was interference
%  between the two goals 'is(in_hand(blue_pyramid))' and
%  'not(on_top(blue_box,red_box))'
%
%  In the definition of me_plan, one of the goal differences is resolved by
%  me_plan_one, so one might think that at the recursive call of me_plan
%  marked '**' that only the remaining goals need to be dealt with.
%  However, if this were the case, then the planner would have 'thought'
%  that the 'is(in_hand(blue_pyramid))' goal was still satisfied even after
%  it was invalidated by 'not(on_top(blue_box,red_box))'.
%  By re-examining the whole goal this is avoided. 
%  Of course, a more intelligent planner would notice the interference
%  and reorder the goals.



Examples

%  EXAMPLES
%
%>    me_plan( [ on_table(blue_pyramid),             % initial state
%+               on_top(red_pyramid,green_box),
%+               on_top(blue_box,red_box),
%+               on_table(green_box),
%+               on_table(red_box)
%+             ],
%+             [ is(on_top(blue_pyramid,red_box)),      % goal
%+               is(on_table(red_box))
%+             ],
%+             Plan, Final_state ).
%
%>    me_plan([on_table(red_box)],[is(in_hand(red_box))], Plan, Final_state ).

Query

Response