TEACH PSYSRIVER                                         A.Sloman Jan 1990


An example of the use of LIB NEWPSYS to solve a planning problem.

         CONTENTS - (Use <ENTER> g to access required sections)

 -- Introduction
 -- A run of the depth-first search program
 -- Introduction to the depth-first program
 -- The depth-first program
 -- Breadth-first approach to solving the river problem
 -- The breadth-first program

-- Introduction -------------------------------------------------------

This is an example of the use of LIB * NEWPSYS to define a production
system that can solve a problem.

The problem in this case is the one described in TEACH * RIVER, namely
to make a plan to enable a man with a fox, a chicken and a bag of grain
to get them all across the river, given a boat that can hold only one
thing besides the man, and given the propensity of the fox to eat the
chicken, and the chicken to eat the grain, if the man is not nearby.

Two solutions are presented below, one involving a depth first search,
and one a breadth first search.

The first set of rules defined below do a depth first search from the
initial state, set up in the rule called "start". They try various moves
until they find a sequence that solves the problem without violating any
constraints. The successful moves are used to form a plan that is
printed out.

The second set of rules follows a breadth first strategy. All possible
ways of making one move are tried and stored if they violate no
constraints. Then for each stored partial plan the program tries all
possible legal ways of extending it by a further move, storing all the
resulting partial plans. Then for each of the stored plans it again
tries all possible ways of extending them. This continues until a
solution is found or there are no more steps to explore. This version of
the program is somewhat more complex than the depth first version, as it
has to explicitly store lists of incomplete plans and then try extending
them later, whereas the depth first version is always working on only
one plan.

Both strategies are capable of looping forever, if no solution is found,
though if there is a solution the second strategy is guaranteed to find
the shortest plan.

Unlike LIB RIVER, the rules given here do not break the actions down to
the level of getting in and out of the boat. Moving the man, or the man
and one other thing, across the river is taken as an indivisible
operation, to simplify the problem.

For details of how LIB NEWPSYS works, see HELP * NEWPSYS.

The example programs are in a later section.

-- A run of the depth-first search program ----------------------------

The following is an example of a run of the first set of rules. Notice
that one of the things to check for is the program going round in
circles. The program does this by keeping a history of previous states
associated with the current plan, and after each move checking whether
it is in the history.

Running the program in the next section should reproduce this printout,
except for comments preceded by ";;;". The lines with only a "?" are
points at which the program paused until the RETURN key was pressed.

** [Setting up "solve" ruleset]
** THE WORLD
** [man grain fox chicken .....]    ;;; initial state
** [Trying [move grain]]
** THE WORLD
** [fox chicken ..... man grain]
?
;;; Constraints are checked after each action. The above fails:
** [Constraint Eat violated]
** [[fox can eat chicken GO BACK]]
** [undoing [move grain]]
** THE WORLD
** [man grain fox chicken .....]
** [Restored previous state]
?
** [Trying [move fox]]
** THE WORLD
** [grain chicken ..... man fox]
?
** [Constraint Eat violated]
** [[chicken can eat grain GO BACK]]
** [undoing [move fox]]
** THE WORLD
** [man grain fox chicken .....]
** [Restored previous state]
?
** [Trying [move chicken]]
** THE WORLD
** [grain fox ..... man chicken]
?
;;; No constraints are violated, so a move from this state is tried.
** [Trying [move man]]
** THE WORLD
** [man grain fox ..... chicken]
?
** [Trying [move grain]]
** THE WORLD
** [fox ..... man grain chicken]
?
** [Trying [move chicken]]
** THE WORLD
** [man chicken fox ..... grain]
?
** [Trying [move fox]]
** THE WORLD
** [chicken ..... man fox grain]
?
;;; So far it has been sensible. The next move it tries [move grain] is
;;; stupid, but will not be undone till much later, when it runs out of
;;; options at a later stage.
** [Trying [move grain]]
** THE WORLD
** [man grain chicken ..... fox]
?
** [Trying [move chicken]]
** THE WORLD
** [grain ..... man chicken fox]
?
** [Trying [move fox]]
** THE WORLD
** [man fox grain ..... chicken]
?
;;; One of the constraints is that a move should not produce a state
;;; that is in the "history" list of previous states. This prevents
;;; infinite searches. This constraint is now violated.
** [Constraint Loop violated]
** [[LOOP found - Was previously in state:
     [[chicken isat right]
      [fox isat left]
      [grain isat left]
      [man isat left]]]]
** [undoing [move fox]]             ;;; so it back-tracks
** THE WORLD
** [grain ..... man fox chicken]
** [Restored previous state]
?
** [Trying [move man]]
** THE WORLD
** [man grain ..... fox chicken]
?
** [Constraint Eat violated]
** [[fox can eat chicken GO BACK]]
** [undoing [move man]]
** THE WORLD
** [grain ..... man fox chicken]
** [Restored previous state]
?
;;; All possible moves from the current state have been tried, but they
;;; all violated constraints and had to be undone. As there are no more
;;; options to try, this state is abandoned, and the previous one
;;; restored. It will also prove useless later.
** [no more options - retracing]
** [undoing [move chicken]]
** THE WORLD
** [man grain chicken ..... fox]
** [Restored previous state]
?
** [Trying [move man]]
** THE WORLD
** [grain chicken ..... man fox]
?
** [Constraint Eat violated]
** [[chicken can eat grain GO BACK]]
** [undoing [move man]]
** THE WORLD
** [man grain chicken ..... fox]
** [Restored previous state]
?
;;; No new moves from the current state remain to be tried. So it too
;;; is abandoned, by undoing the erroneous [move grain] mentioned above.
** [no more options - retracing]
** [undoing [move grain]]
** THE WORLD
** [chicken ..... man grain fox]
** [Restored previous state]
?
** [Trying [move man]]              ;;; At last.
** THE WORLD
** [man chicken ..... grain fox]    ;;; From here it's easy.
?
** [Trying [move chicken]]
** THE WORLD
** [..... man chicken grain fox]
?
** [Goal state achieved]
** THE WORLD
** [..... man chicken grain fox]
** [THE SUCCESSFUL PLAN WAS]
** [[[move chicken]
     [move man]
     [move grain]
     [move chicken]
     [move fox]
     [move man]
     [move chicken]]]
?
** [Everything successfully moved over]


-- Introduction to the depth-first program ----------------------------

The set of rules given below illustrates the way in which LIB NEWPSYS
allows meta-rules to be constructed.

In particular, the rule -check_constraints- defined below, looks for
constraints stored in the database and checks whether they are violated.
If they are, the rule causes another rule to be invoked which undoes
the last action. This makes essential use of the [history ....] list
stored in the database recording moves and states.

It would be possible (and considerably more efficient) to have a
different rule for each constraint. However, this more "declarative"
style is sometimes more convenient and modular. E.g. it allows
constraints to be added and removed, with one rule that interprets them
all, provided they have the proper form. This depends crucially on the
use of the "ALL" condition, below.

In order easily to tell whether a new state is one that was previously
achieved, states are stored in a "canonical" form, using alphabetic
ordering. The Pop-11 procedure thing_data achieves this by returning
a list of state information in the required order.

Note that in rule definitions it is possible to use ==> or --> or ; to
separate conditions and actions in rules. The definitions below use
semicolons as separators because then convenient VED commands are
available, like ved_mcp, ved_lcp. (See HELP * MARK)

The remainder of this file can be executed, if you mark and load
it, down to the first call of psys_run. The following two calls can
also be marked and loaded. (See TEACH MARK).


-- The depth-first program --------------------------------------------

uses newpsys;


vars                    ;;; declare four empty rule sets
    psys_rules = [],
    check_rules = [],
    solve_rules = [],
    backtrack_rules = [];

false -> psys_backtrack;    ;;; the built in FAIL action is too primitive
true -> psys_copy_modify;   ;;; normally safer
false -> psys_walk;         ;;; Make this true for more interaction
false -> psys_chatty;       ;;; Make this true or an integer for tracing
false -> psys_show_conditions;  ;;; Make true for detailed tracing of
                            ;;; condition testing
false -> psys_allrules;     ;;; Always run the first applicable rule
true -> psys_repeating;     ;;; The rules do their own checking
false -> psys_memlim;       ;;; Don't truncate short term memory
                            ;;; (Try the effect of a small integer?)
true -> psys_pausing;       ;;; Make [PAUSE] actions work

;;; Because psys_sortrules is not re-defined, the default strategy of
;;; selecting the first applicable rule will operate.

true -> psys_explain_trace; ;;; run [EXPLAIN ...] actions

/* DEFINE SOME UTILITIES */

define eval_message(message) -> message;
    ;;; Instantiate a message if it is a list. This is used to
    ;;; display the messages associated with constraints

    if islist(message) then instance(message) -> message endif

enddefine;

define thing_data() -> data;
    ;;; Return alphabetically ordered list of database facts
    ;;; Convenient "canonical" form, for detecting circular moves

    lvars data;

    [%psys_foreach([= isat =], procedure(); psys_found endprocedure)%]
        -> data;

    syssort(data,
        procedure(item1,item2) -> boole;
            lvars item1, item2, boole;
            alphabefore(front(item1), front(item2)) -> boole
        endprocedure) -> data

enddefine;

define display_data;
    ;;; Prints out a visual display, showing what isat left and right

    vars x;
    'THE WORLD' =>
    ;;; create a list and print it out
    [%
        psys_foreach([?x isat left], procedure(); x endprocedure),
        '.....',
        psys_foreach([?x isat right], procedure(); x endprocedure)
    %] ==>

enddefine;

/* NOW DEFINE THE RULES */

;;; This rule sets up the database and fires the rest off.
;;; It runs only once and then sets up the ruleset "solve_rules".
;;; So it does not require any further action to stop itself being
;;; re-invoked, as it is not in that ruleset.

define :rule start;

    ;;; initial state
    [chicken isat left]
    [fox isat left]
    [grain isat left]
    [man isat left]
    [plan]
    [history]

    ;;; some useful facts
    [opposite right left]
    [fox can eat chicken]
    [chicken can eat grain]

    ;;; Now the constraints - checked by rule check
    ;;; first constraint - fail if something can eat something
    [constraint Eat
        [[?thing1 isat ?side]
            [NOT man isat ?side]
            [?thing1 can eat ?thing2]
            [?thing2 isat ?side]]
        [?thing1 can eat ?thing2 GO BACK]]

    ;;; second constraint, is the current state one that's in the history?
    [constraint Loop
        [[state ?state] [history == [= ?state] == ]]
        ['LOOP found - Was previously in state: ' ?state]]

    [EXPLAIN 'Setting up "solve" ruleset']
    [RESTORE RULES solve_rules]

    ;;; describe the goal as a list of patterns

    ;;; set up initial state record in the database
    [state [apply thing_data]]

    ;;; display initial state
    [POP11 display_data()]
enddefine;


;;; The next rule is used to complete the book-keeping for different
;;; move actions, and display the result. It is invoked only after
;;; [complete_move] has been added to the database by a move operator

define :rule complete_move in solve_rules
        [complete_move ?move]
        [state ?state]
    ;
    [DEL 1 ]
    ;;; Extend the history - used for checking circularity
    [PUSH [?move ?state] history]
    ;;; Extend the plan
    [PUSH ?move plan]
    ;;; Create up to date state record (in canonical form)
    [MODIFY 2 state [apply thing_data]]
    ;;; record that this move has been tried in this state
    [tried ?move ?state]
    ;;; report move
    [SAY Trying ?move]
    ;;; print result
    [POP11 display_data()]

    ;;; Next line is simply to pause till user presses RETURN key
    [PAUSE]

    [RESTORE RULES check_rules]
enddefine;


;;; The next rule checks whether the problem has been solved, and
;;; if so aborts the program. The goal description is stored in
;;; the database, to make it easy to change, instead of always using the
;;; same goal.

define :rule done in solve_rules
         [goal ?goallist]
         [ALL ?goallist]    ;;; As if the conditions were in this rule.
         [plan ??plan]
         ;
    [SAY 'Goal state achieved']
    [POP11 display_data()]
    [SAY 'THE SUCCESSFUL PLAN WAS']
    [SAY [apply rev ?plan]]
    [PAUSE]
    [STOP 'Everything successfully moved over']
enddefine;


;;; On failure this rule is triggered to back-track by restoring a
;;; previous state, and re-displaying it.

define :rule undo in backtrack_rules
         [history [?move ?oldstate] ??history]
         [state =]
         ;
    [SAY undoing ?move]
    [MODIFY 2 state ?oldstate]
    [NOT = isat = ]
    [POP history]       ;;; Remove latest addition to history
    [POP plan ]         ;;;   ... and to plan
    [ADDALL ??oldstate] ;;; Restore the previous [... isat ...] items
    [POP11 display_data()]
    [SAY 'Restored previous state']
    [PAUSE]
    [RESTORE RULES solve_rules]
enddefine;


;;; The next rule checks that an attempted move is legal, and if
;;; not causes back-tracking, by restoring a previous state,
;;; and re-displaying it. Legality is determined by constraints
;;; in the constraints database.

define :rule check_constraints in check_rules
         [constraint ?name ?checks ?message]
         [ALL ?checks]  ;;; ( [WHERE [apply psys_allpresent ?checks]] )
         ;
    [SAY Constraint ?name violated]
    [SAY [apply eval_message ?message]]
    [RESTORE RULES backtrack_rules]
enddefine;

define :rule checks_ok in check_rules
    ;;; If no constraint violations were detected by previous rules,
    ;;; restore normal rules to continue searching for a solution.
         ;
    [RESTORE RULES solve_rules]
enddefine;


;;; Now the move operators. Because psys_allrules is set
;;; FALSE, only one will be fired on each cycle. (Note the use of
;;; the word quotes in the "WHERE" condition.)

define :rule move_thing in solve_rules
         [man isat ?place]
         [?thing isat ?place]
         [WHERE thing /== "man"]
         [OR [opposite ?place ?other][opposite ?other ?place]]
         [state ?state]
         [NOT tried [move ?thing] ?state]
         [NOT history [[move ?thing] =] ==] ;;; not last thing moved
         ;
    [MODIFY 2 isat ?other]
    [MODIFY 1 isat ?other]
    [complete_move [move ?thing]]
enddefine;

define :rule move_man in solve_rules
         [man isat ?place]
         [OR [opposite ?place ?other][opposite ?other ?place]]
         [state ?state]
         [NOT tried [move man] ?state]
         [NOT history [move man] ==]    ;;; man not last thing moved
    ;
    [MODIFY 1 isat ?other]
    [complete_move [move man]]
enddefine;

;;; This must be the last rule.
;;; When there's nothing left to try, try to undo last move

define :rule goback in solve_rules [history = ==];
    [SAY 'no more options - retracing']
    [RESTORE RULES backtrack_rules]
enddefine;

;;; Uncomment the following for selective tracing of rules
;;;psys_trace([goback complete_move undo done]);

;;; Set up goal state. This will be initial database item.
vars goal_state =
    [goal
        [[man isat right]
        [fox isat right]
        [chicken isat right]
        [grain isat right]]];

psys_run(psys_rules, [^goal_state]);


;;; Or equivalently
psys_run(psys_rules, [[goal [[NOT = isat left]] ]]);

;;; It should also be able to achieve the following goal
psys_run(psys_rules, [[goal [[man isat left] [grain isat right]] ]]);


-- Breadth-first approach to solving the river problem -----------------

This uses a slightly different representation of what has been achieved
up to a given point. Each partial plan now includes states as well as
moves. Plans are of the form

    [plan <state> <move> <state> <move> <state> ... ]

with latest move and latest state first.

This program works by building a queue of possible plans, trying
to extend them and sticking new extensions on the back. The queue
is stored in the database as follows:

    [plans plan1 plan2 plan3 ...]

where each plani is a list of alternating moves and states.

Before trying to extend each partial plan the program stores it in
working memory as a list of the form:

    [baseplan <state> <move> ....<state>].

This is copied to make the current plan, which is then extended if
possible. If it can be extended the enlarged partial plan is appended to
the [plans ...] list, and another attempt made to extend the baseplan.
If no more extensions are possible, the baseplan is discarded and the
first plan in the [plans...] list is made the new baseplan.

During attempts to extend the baseplan the current plan is in the
database entry of the form

    [plan ....]

The breadth-first program uses a set of Pop-11 utilities analogous to
those used by the depth-first program.

-- The breadth-first program --------------------------------------

uses newpsys;

vars                    ;;; declare four empty rule sets

    psys_rules = [],    ;;; each of the others takes turns being this
    check_rules = [],   ;;; rules for checking a newly extended plan
    solve_rules = [],   ;;; rules for finding an extension
    complete_rules = [],;;; rules for completing an action
    ;

false -> psys_backtrack;
true -> psys_copy_modify;   ;;; normally safer
false -> psys_walk;         ;;; Make this true for more interaction
true -> psys_chatty;        ;;; Make this true or an integer for tracing
false -> psys_show_conditions;
false -> psys_allrules;
true -> psys_repeating;
false -> psys_memlim;


;;; Because psys_sortrules is not re-defined, the default strategy of
;;; selecting the first applicable rule will operate.

true -> psys_explain_trace; ;;; run [EXPLAIN ...] actions

/* DEFINE SOME UTILITIES */

define eval_message(message) -> message;
    ;;; Instantiate a message if it is a list. This is used to
    ;;; display the messages associated with constraints

    if islist(message) then instance(message) -> message endif
enddefine;

define thing_data() -> data;
    ;;; Return alphabetically ordered list of database facts
    ;;; Convenient "canonical" form, for detecting circular moves

    lvars data;

    [%psys_foreach([= isat =], procedure(); psys_found endprocedure)%]
        -> data;

    syssort(data,
        procedure(item1,item2) -> boole;
            lvars item1, item2, boole;
            alphabefore(front(item1), front(item2)) -> boole
        endprocedure) -> data

enddefine;

define display_data;
    ;;; Prints out a visual display, showing what isat left and right

    vars x;
    'THE WORLD' =>
    ;;; create a list and print it out
    [%
        psys_foreach([?x isat left], procedure(); x endprocedure),
        '.....',
        psys_foreach([?x isat right], procedure(); x endprocedure)
    %] ==>

enddefine;

define show_plan(plan);
    ;;; Uses a recursive procedure to print out, in reverse order the
    ;;; moves in a plan of the form
    ;;; [<state> <move> <state> <move>....<state>]
    lvars plan;
    define sub_show(plan);
            lvars plan;
        if plan /== [] then
            sub_show(tl(plan));
            if hd(hd(plan)) == "move" then spr(hd(plan)) endif
        endif
    enddefine;
    sub_show(plan);
    pr(newline);
enddefine;


/* NOW DEFINE THE RULES */

;;; This rule sets up the database and fires the rest off.
;;; It runs only once and then sets up the ruleset "solve_rules".
;;; So it does not require any further action to stop itself being
;;; re-invoked, as it is not in that ruleset.

define :rule start;

    ;;; set up initial plan -just starting state
    [baseplan
        [[chicken isat left]
        [fox isat left]
        [grain isat left]
        [man isat left]]]
    [plans]

    ;;; some useful facts
    [opposite right left]
    [fox can eat chicken]
    [chicken can eat grain]

    ;;; Now the constraints - checked by rule check
    ;;; first constraint - fail if something can eat something
    [constraint Eat
        [[?thing1 isat ?side]
            [NOT man isat ?side]
            [?thing1 can eat ?thing2]
            [?thing2 isat ?side]]
        [?thing1 can eat ?thing2 NO GOOD]]

    ;;; second constraint, is the current state one that's in the history?
    [constraint Loop
        [[state ?state] [plan = == ?state == ]]
        ['LOOP found - Was previously in state: ' ?state]]

    [EXPLAIN 'Setting up "solve" ruleset']
    [RESTORE RULES solve_rules]

    ;;; describe the goal as a list of patterns


    ;;; display initial state
    [POP11 display_data()]
enddefine;


;;; The next rule copies the baseplan to be the current plan for
;;; extension

define :rule setup in solve_rules [baseplan ?state ??rest] [NOT plan ==];
    [NOT == isat ==]
    [plan ?state ??rest]
    [ADDALL ??state]
    [SAY '(Re-)starting from baseplan']
    [NULL [apply show_plan ?rest]]
    [POP11 display_data()]
enddefine;

;;; Now the move operators. Because psys_allrules is set
;;; FALSE, only one will be fired on each cycle. (Note the use of
;;; the word quotes in the "WHERE" condition.)

define :rule move_thing in solve_rules
         [man isat ?place]
         [?thing isat ?place]
         [WHERE thing /== "man"]
         [NOT tried move ?thing]
         [OR [opposite ?place ?other][opposite ?other ?place]]
         ;;; If next condition is deleted, Loop constraint will check it
         [NOT plan = [move ?thing] ==]   ;;; not last thing moved
         ;
    [MODIFY 2 isat ?other]
    [MODIFY 1 isat ?other]
    [state [apply thing_data]]
    [complete_move [move ?thing]]
    [RESTORE RULES complete_rules]
enddefine;

define :rule move_man in solve_rules
         [NOT tried move man]
         [man isat ?place]
         [OR [opposite ?place ?other][opposite ?other ?place]]
         ;;; If next condition deleted, Loop constraint will check it
         [NOT plan = [move man] ==]   ;;; not last thing moved
    ;
    [MODIFY 1 isat ?other]
    [state [apply thing_data]]
    [complete_move [move man]]
    [RESTORE RULES complete_rules]
enddefine;

;;; When there are no more ways of extending the current base plan,
;;; get a new one from the list [plans ....]
define :rule next_plan in solve_rules [plans ?plan  ==];
    [NOT baseplan ==]
    [baseplan ??plan]
    [SAY 'No more possibilities - starting new baseplan']
    [NULL [apply show_plan ?plan]]
    ;;; clean up database, ready for rule setup
    [NOT plan ==]
    [NOT tried ==]
    [POP plans]
enddefine;

define :rule failed in solve_rules [plans];
    [SAY 'FAILED: No more plans in list of plans']
    [PAUSE]
    [STOP]
enddefine;


;;; The next rule is used to complete the book-keeping for different
;;; move actions, and display the result. It is invoked only after
;;; [complete_move] has been added to the database by a move operator

define :rule complete_move in complete_rules
        [complete_move ?move]
        [state ?state]
    ;
    [DEL 1 ]
    ;;; Extend the plan
    [PUSH ?move plan]
    [PUSH ?state plan]
    [tried ??move]
    ;;; report move
    [SAY Trying ?move]
    ;;; print result
    [POP11 display_data()]

    ;;; Next line is simply to pause till user presses RETURN key
    [PAUSE]

    [RESTORE RULES check_rules]
enddefine;


;;; The next rule checks whether the problem has been solved, and
;;; if so aborts the program. The goal description is stored in
;;; the database, to make it easy to change, instead of always using the
;;; same goal.

define :rule done in check_rules
         [goal ?goallist]
         [ALL ?goallist]    ;;; As if the conditions were in this rule.
         [plan ??plan]
         ;
    [SAY 'Goal state achieved']
    [SAY 'THE SUCCESSFUL PLAN WAS']
    [NULL [apply show_plan ?plan]]
    [POP11 display_data()]
    [PAUSE]
    [STOP 'Everything successfully moved over']
enddefine;


;;; The next rule checks that an attempted move is legal, and if
;;; not causes back-tracking, by restoring a previous state,
;;; and re-displaying it. Legality is determined by constraints
;;; in the constraints database.

define :rule check_constraints in check_rules
         [constraint ?name ?checks ?message]
         [ALL ?checks]
         [plan ??plan]
         [state ==]
         ;
    [SAY Constraint ?name violated]
    [SAY [apply eval_message ?message]]
    [SAY 'Abandoning current plan:']
    [NULL [apply show_plan ?plan]]
    [NOT plan ==]   ;;; will cause baseplan to be tried again
    [PAUSE]
    [RESTORE RULES solve_rules]
enddefine;

define :rule checks_done in check_rules
        [plan ??plan] [plans ??plans];
    ;;; If no constraint violations were detected by previous rules,
    ;;; restore normal rules to continue searching for a solution.
    ;;; Also set up plan

    [DEL 1 2]
    [SAY 'storing new extension to current base plan']
    [NULL [apply show_plan ?plan]]
    [plans ??plans ?plan]
    [NOT == isat ==]
    [NOT state == ]
    [RESTORE RULES solve_rules]
enddefine;


;;; Set up goal state. This will be initial database item.
vars goal_state =
    [goal
        [[man isat right]
        [fox isat right]
        [chicken isat right]
        [grain isat right]]];

psys_run(psys_rules, [^goal_state]);


;;; Or equivalently
psys_run(psys_rules, [[goal [[NOT = isat left]] ]]);

;;; It should also be able to achieve the following goal
psys_run(psys_rules, [[goal [[man isat left] [grain isat right]] ]]);


--- C.all/teach/psysriver
--- Copyright University of Sussex 1990. All rights reserved. ----------