TEACH PRBRIVER                                         A.Sloman Oct 1994
                                      Updated for new syntax, April 1996
Slightly revised 14 Oct 2000

An example of the use of LIB POPRULEBASE to solve a planning problem,
i.e. getting the farmer, fox, chicken and grain across a river.
See TEACH RIVER for a statement of the problem.

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

 -- Introduction
 -- A run of the depth-first search program
 -- A note on representation
 -- Introduction to the depth-first program
 -- The depth-first program
 -- -- Utilities for the depth first program
 -- -- Defining the rulesets for the depth first program
 -- -- Defining the rulefamily for the depth first program
 -- -- Running the depth first program
 -- Exercises on the depth first searching program
 -- Breadth-first approach to solving the river problem
 -- The breadth-first program
 -- -- Defining Utilities for the breadth first program
 -- -- Defining rulesets for the breadth first program
 -- -- Defining a rulefamily for the breadth first program
 -- -- Testing the breadth first program

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


This teach file gives examples of the use of LIB POPRULEBASE to search
for the solution to a problem, i.e. the problem of getting the farmer,
fox, chicken and grain across a river. See TEACH RIVER for a statement
of the problem.

This is an example of the use of LIB * POPRULEBASE to define a
production system that can solve a problem by creating a plan, as a
result of searching in a space of partial plans. (See TEACH TOWER,
TEACH SEARCHING, in the Birmingham extensions to Poplog.)

It is assumed that you have already read one or both of TEACH RULEBASE
and TEACH POPRULEBASE.

Expert readers may find it useful to refer to HELP POPRULEBASE for a
more detailed account of some of the features illustrated below.

This file shows how to use "define :ruleset" to create several rulesets,
and the format "define :rulefamily" to combine them into a single
"rulefamily", or "rulecluster", that can be given to prb_run, which then
switches between the rulesets in the family.

Each ruleset within the family can deal with a different phase of the
planning process, e.g. considering a move, checking a move, updating the
database after a move, restoring the database after an illegal move,
etc.

The examples below also show how LIB POPRULEBASE allows meta-rules to be
constructed, using information in the database corresponding to a
possible set of conditions, which a meta-rule can extract and run as if
it had those conditions. This means that different constraints can be
expressed as items in the database, and a single constraint checking
rule can check every constraint.

The problem to be solved 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 planners are presented below, one using a depth first search, and
one a breadth first search.

The first one does a depth first search from the initial state, set up
in the rule called "start". The rules 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 planner 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,
unless the program detects looping, as happens below in the constraint
checker.

However, if there is a solution the second strategy is guaranteed to
find the shortest plan.

The procedure prb_run can be given an optional integer as third argument
to limit the number of cycles attempted.

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 POPRULEBASE works, see HELP * POPRULEBASE
HELP * RULESYSTEM

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. (If
you run the program, it may do things in a slightly different sequence,
for instance if the code or the library has been changed since this
sample printout was produced.)

** [Possible rules start]
** [Setting up "solve" ruleset]
** THE WORLD
** [chicken fox grain man .....]        ;;; initial state
** [Possible rules move_thing]
** [Possible rules complete_move]
** [Trying [move chicken]]
** THE WORLD
** [fox grain ..... chicken man]        ;;; by luck the first move tried
                                        ;;; is a legal one.
?
** [Possible rules checks_ok]
** [Possible rules move_man]
** [Possible rules complete_move]
** [Trying [move man]]
** THE WORLD
** [fox grain man ..... chicken]        ;;; So is this. Note this state.
?
** [Possible rules checks_ok]
** [Possible rules move_thing]
** [Possible rules complete_move]
** [Trying [move fox]]
** THE WORLD
** [grain ..... chicken fox man]        ;;; Still no problem
?
** [Possible rules checks_ok]
** [Possible rules move_thing]
** [Possible rules complete_move]
** [Trying [move chicken]]
** THE WORLD
** [chicken grain man ..... fox]
?
** [Possible rules checks_ok]
** [Possible rules move_thing]
** [Possible rules complete_move]
** [Trying [move grain]]
** THE WORLD
** [chicken ..... fox grain man]
?
** [Possible rules checks_ok]
** [Possible rules move_thing]
** [Possible rules complete_move]
** [Trying [move fox]]              ;;; A very bad move!
                                    ;;; Has to be undone much later.
** THE WORLD
** [chicken fox man ..... grain]
?
** [Possible rules checks_ok]
** [Possible rules move_thing]
** [Possible rules complete_move]
** [Trying [move chicken]]          ;;; Another bad move.
                                    ;;; See what happens
** THE WORLD
** [fox ..... chicken grain man]
?
** [Possible rules checks_ok]
** [Possible rules move_thing]
** [Possible rules complete_move]
** [Trying [move grain]]
** THE WORLD
** [fox grain man ..... chicken]        ;;; Back to the noted state
?
;;; Constraints are checked after every move.
** [Possible rules check_constraints]
;;; This time a problem is noted.
;;; 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]]]
** [Possible rules undo]
** [undoing [move grain]]
;;; When a constraint violation is detected, the last move has to be
;;; undone, and the world restored to its previous state, also the
;;; current plan. But the record of moves tried is left, so that the
;;; same useless move is not repeated.
** THE WORLD
** [fox ..... chicken grain man]
** [Restored previous state]
** [plan is [[move chicken]
             [move man]
             [move fox]
             [move chicken]
             [move grain]
             [move fox]
             [move chicken]]]
?
;;; So now it tries a different move from this situation, i.e.
;;; moving the man alone.
** [Possible rules move_man]
** [Possible rules complete_move]
** [Trying [move man]]
** THE WORLD
** [fox man ..... chicken grain]        ;;; OOPS!
?
;;; The constraints are checked again, and ....
** [Possible rules check_constraints]
** [Constraint Eat violated]
** [chicken can eat grain GO BACK]
;;; So it has to go back to the previous state yet again
** [Possible rules undo]
** [undoing [move man]]
** THE WORLD
** [fox ..... chicken grain man]
** [Restored previous state]
** [plan is [[move chicken]
             [move man]
             [move fox]
             [move chicken]
             [move grain]
             [move fox]
             [move chicken]]]
?
;;; But now there are no more moves available in this state, as all
;;; possible moves have been tried, and they all violated constraints.
;;; So it has to go back to an even earlier state. It remembers the
;;; move it made in the previous state, and what that state was.
;;; This state will also prove to be useless.
** [Possible rules goback]
** [no more options - retracing]
** [Possible rules undo]
** [undoing [move chicken]]         ;;; Finally undoes the "bad" move
** THE WORLD
** [chicken fox man ..... grain]
** [Restored previous state]        ;;; This was the state where
                                    ;;; it tried moving the chicken
                                    ;;; after having just moved the fox
                                    ;;; Here's the plan before that:
** [plan is [[move chicken]
             [move man]
             [move fox]
             [move chicken]
             [move grain]
             [move fox]]]
?
;;; Now it tries another move in that situation, but still
;;; not a good one!
** [Possible rules move_man]
** [Possible rules complete_move]
** [Trying [move man]]
** THE WORLD
** [chicken fox ..... grain man]
?
** [Possible rules check_constraints]
** [Constraint Eat violated]
** [fox can eat chicken GO BACK]
** [Possible rules undo]
** [undoing [move man]]
** THE WORLD
** [chicken fox man ..... grain]        ;;; Back here for the third time
** [Restored previous state]
** [plan is [[move chicken]
             [move man]
             [move fox]
             [move chicken]
             [move grain]
             [move fox]]]
?
** [Possible rules goback]
;;; It still cannot do anything in that state, so it has to go back
;;; even further.
** [no more options - retracing]
** [Possible rules undo]
** [undoing [move fox]]             ;;; Finally undoes the first bad move
** THE WORLD
** [chicken ..... fox grain man]
** [Restored previous state]
** [plan is [[move chicken]
             [move man]
             [move fox]
             [move chicken]
             [move grain]]]
?
** [Possible rules move_man]        ;;; Much better!
** [Possible rules complete_move]
** [Trying [move man]]
** THE WORLD
** [chicken man ..... fox grain]    ;;; Easy from here
?
** [Possible rules checks_ok]
** [Possible rules move_thing]
** [Possible rules complete_move]
** [Trying [move chicken]]
** THE WORLD
** [..... chicken fox grain man]    ;;; At last
?
** [Possible rules checks_ok]
** [Possible rules done]
** [Goal state achieved]
** THE WORLD
** [..... chicken fox grain man]
** [THE SUCCESSFUL PLAN WAS]
** [[[move chicken]
     [move man]
     [move fox]
     [move chicken]
     [move grain]
     [move man]
     [move chicken]]]
?
** [Everything successfully moved over]
** [Stopped solve_rules]

=======================================================================

-- A note on representation -------------------------------------------

In this tutorial file, facts involving relations like "isat" are stored
in the Poprulebase database in this form:

    [?thing1 isat ?thing2]

e.g.
    [fox isat left]
    [chicken isat right]

However for many purposes it would be better (e.g. more efficient) to
put the relation word first, e.g

    [isat fox left]
    [isat chicken right]


A similar comment can be made regarding items of the form:

    [?thing1 can eat ?thing2]

These could be expressed as

    [can_eat ?thing1 ?thing2]

or, in a more general context:

    [possible [eat ?thing1 ?thing2]]

Changing the program is an exercise for the reader, in a later section.

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

The rule given below for checking constraints illustrates the way in
which LIB POPRULEBASE 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 are grouped into rulesets, starting with

    define :ruleset <name>

and ending with

    enddefine;

So convenient VED commands are available, like ved_mcp, ved_lcp, and
ESC c, to compile a whole ruleset.
(See HELP * MARK)

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


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

uses poprulebase;


true -> prb_copy_modify;   ;;; normally safer
false -> prb_walk;         ;;; Make this true for more interaction
false -> prb_chatty;       ;;; Make this true or an integer for tracing
false -> prb_show_conditions;  ;;; Make true for detailed tracing of
                            ;;; condition testing
false -> prb_allrules;     ;;; Always run the first applicable rule
true -> prb_repeating;     ;;; The rules do their own checking
true -> prb_pausing;       ;;; Make [PAUSE] actions work

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

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

/*
-- -- Utilities for the depth first program
*/


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

    lvars data;

    ;;; find all the [= isat =] items
    [%prb_foreach([= isat =], procedure(); prb_found endprocedure)%]
        -> data;

    ;;; Sort them into alphabetical order on the basis of the first word
    ;;; in each item
    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
    [%
        prb_foreach([?x isat left], procedure(); x endprocedure),
        '.....',
        prb_foreach([?x isat right], procedure(); x endprocedure)
    %] ==>

enddefine;

/*
-- -- Defining the rulesets for the depth first program
*/

;;; 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 :ruleset start_rules;

  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]]


    ;;; 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()]
    [EXPLAIN 'Setting up "solve" ruleset']
    [RESTORERULESET solve_rules]
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 :ruleset solve_rules;

  RULE complete_move  ;;; in solve_rules
    [complete_move ?move]
    [state ?state]
    [POP11 'Checking complete_move in solve_rules' => ]
    ==>
    [DEL 1 ]
    ;;; Extend the history - used for checking circularity
    [PUSH [?move ?state] history]
    ;;; Extend the plan
    [PUSH ?move plan]
    [SAY 'plan is' [popval rev(tl(prb_present([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]

    [RESTORERULESET check_rules] ;;; the check_rules ruleset is below


;;; 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.

  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]
    ;;; Reset the rulefamily to its starting state so that it can be
    ;;; used on another problem
    [RESTORERULESET start_rules]
    [STOP 'Everything successfully moved over']


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

  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
    ==>
    [SAY 'trying to move the' ?thing]
    [MODIFY 1 isat ?other]
    [MODIFY 2 isat ?other]
    [complete_move [move ?thing]]

  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
    ==>
    [SAY 'trying to move the man']
    [MODIFY 1 isat ?other]
    [complete_move [move man]]

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

  RULE goback  ;;; in solve_rules
    [history = ==]
    ==>
    [SAY 'no more options - retracing']
    [RESTORERULESET backtrack_rules]     ;;; defined below
enddefine;


;;; Now the backtracking ruleset

define :ruleset backtrack_rules;

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

  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']
    [SAY 'plan is' [popval rev(tl(prb_present([plan ==])))]]
    [PAUSE]
    [RESTORERULESET solve_rules]     ;;; solve_rules defined above
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 :ruleset check_rules;

  RULE check_constraints  ;;; in check_rules
    [constraint ?name ?checks ?message]
    [ALL ?checks]  ;;; (could be: [WHERE prb_allpresent(checks)] )
    ==>
    [SAY Constraint ?name violated]
    [SAY ??message]
    [RESTORERULESET backtrack_rules]     ;;; defined above

  RULE checks_ok  ;;; in check_rules
    ;;; If no constraint violations were detected by previous rules,
    ;;; restore normal rules to continue searching for a solution.
    ==>
    [RESTORERULESET solve_rules]
enddefine;

/*
-- -- Defining the rulefamily for the depth first program
*/

;;; This is now to combine several rulesets into a rulefamily.

define :rulefamily depth_first;
    ruleset: start_rules
    ruleset: solve_rules
    ruleset: backtrack_rules
    ruleset: check_rules
enddefine;

/*
-- -- Running the depth first program
*/


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


;;; It should be able to achieve the following goal easily
prb_run(depth_first, [[goal [[man isat left] [grain isat right]] ]]);


;;; Set up a more difficult goal state.
vars goal_state =
    [goal
        [[man isat right]
        [fox isat right]
        [chicken isat right]
        [grain isat right]]];


prb_run(depth_first, [^goal_state]);

;;; Or equivalently

prb_run(depth_first, [[goal [[NOT = isat left]] ]]);



-- Exercises on the depth first searching program ---------------------

1. Improve the format.

The set of planning rules presented above uses the format
    [X isat Y]

it is often both clearer and more efficient to represent propositions by
putting the predicate first, and following it with its arguments.

Try rewriting all the rules and utility procedures so that

    [X isat Y] becomes [isat X Y]

    [X can eat Y] becomes [possible [eat X Y]]

Make sure you check everything as you do it. If the program stops
working properly, you will have to learn to debug rule-based
programs. E.g. you may need to do this:

    true -> prb_show_conditions;
    true -> prb_chatty;
    true -> prb_walk;

to get a lot of useful trace print out, and frequent "Walk" pauses
during which you can interrogate the database by means of the command

    .data

2. (Difficult.) Is it possible to change the program so that it no
longer needs to backtrack, i.e. it always makes the right move?
What kind of knowledge would enable it to achieve that?
When you solve such problems can you avoid back tracking?
(See TEACH * TOWER, TEACH * SEARCHING).


-- 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 plan 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 --------------------------------------

This version is a lot more complex because it has to keep track of
several alternative ways of moving from each location, instead of
trying one and if that fails looking to see if there are any more, etc.
(See TEACH * SEARCHING)

It uses the notion of a baseplan, from which it creates all legal
extensions. Then each of the extensions is taken to be a baseplan from
which it tries all legal extensions. This is repeated until the goal is
achieved or the there are no more possibilities and the program fails.

    uses poprulebase;

This version of the planner, uses the following rulesets:

prb_rules      --   The initial, default, ruleset
check_rules    --   Rules for checking a newly extended plan
solve_rules    --   Rules for finding an extension to the current plan
complete_rules --   Rules for completing an action, after checking

true -> prb_copy_modify;   ;;; normally safer
false -> prb_walk;         ;;; Make this true for more interaction
true -> prb_chatty;        ;;; Make this true or an integer for tracing

false -> prb_show_conditions;   ;;; Make true to trace conditions

false -> prb_allrules;      ;;; Always run first runnable rule
true -> prb_repeating;      ;;; Don't try to avoid repeating a rule.

;;; (See HELP * POPRULEBASE for more on these)


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

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

/*
-- -- Defining Utilities for the breadth first program
*/


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

    lvars data;

    ;;; find all the "isat" data
    [%prb_foreach([= isat =], procedure(); prb_found endprocedure)%]
        -> data;

    ;;; sort it into alphabetical order
    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;     ;;; a pattern variable
    'THE WORLD' =>
    ;;; create a list and print it out
    [%
        prb_foreach([?x isat left], procedure(); x endprocedure),
        '.....',
        prb_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;
    printf('    ');
    sub_show(plan);
    pr(newline);
enddefine;


/*
-- -- Defining rulesets for the breadth first program
*/

;;; Rule start 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 :ruleset start_rules;

  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']
    [RESTORERULESET solve_rules]

    ;;; describe the goal as a list of patterns
    ;;; display initial state
    [POP11 display_data()]
enddefine;


;;; This is the biggest ruleset
define :ruleset solve_rules;

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

  RULE setup  ;;; in solve_rules
    [baseplan ?state ??rest] [NOT plan ==]
    ==>
    [NOT == isat ==]
    [plan ?state ??rest]
    [ADDALL ??state]
    [SAY '(Re-)starting from baseplan']
    [POP11 show_plan(rest); display_data()]


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

  RULE move_thing  ;;; in solve_rules

    [man isat ?place][->>Fact1]
    [?thing isat ?place][->>Fact2]
    [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 ?Fact1 isat ?other]
    [MODIFY ?Fact2 isat ?other]
    [state [apply thing_data]]
    [complete_move [move ?thing]]
    [RESTORERULESET complete_rules]


  RULE move_man  ;;; in solve_rules

    [NOT tried move man]
    [man isat ?place][->>Fact1]
    [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 ?Fact1 isat ?other]
    [state [apply thing_data]]
    [complete_move [move man]]
    [RESTORERULESET complete_rules]

;;; When there are no more ways of extending the current base plan,
;;; get a new one from the list [plans ....]

  RULE next_plan  ;;; in solve_rules
    [plans ?plan  ==]
    ==>
    [NOT baseplan ==]
    [baseplan ??plan]
    [SAY 'No more possibilities - starting new baseplan']
    ;;; This one will cause a lot of printing
    ;;;[SAY changed baseplan to [baseplan ??plan]]
    [POP11 show_plan(plan)]
    ;;; clean up database, ready for rule setup
    [NOT plan ==]
    [NOT tried ==]
    ;;; This one causes a lot of printing
    ;;; [SAY POPPING ?plan from [plans '...']]
    [PAUSE]
    [POP plans]

  RULE failed  ;;; in solve_rules
    [plans]
    ==>
    [SAY 'FAILED: No more plans in list of plans']
    [PAUSE]
    [STOP]
enddefine;

;;; The backtracking rules.

define :ruleset backtrack_rules;

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

    [history [?move ?oldstate] ??history]
    [state =][->>Fact2]
    ==>
    [SAY undoing ?move]
    [MODIFY ?Fact2 state ?oldstate]
    [NOT = isat = ]
    [POP history]       ;;; Remove latest addition to history
    [POP plan ]         ;;;   ... and to plan
    [ADDALL ??oldstate] ;;; Restore the previous [... isat ...] items
    [SAY 'Restored previous state']
    [POP11 display_data()]
    [PAUSE]
    [RESTORERULESET solve_rules]
enddefine;


;;; Rules for checking whether the goal has been achieved
;;; and if not whether the current state is legal.

define :ruleset check_rules;

;;; The first 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.

  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]
    ;;; Setup initial ruleset so that the rulefamily can be used on a
    ;;; new problem:
    [RESTORERULESET start_rules]
    [STOP 'Everything successfully moved over']


;;; 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
;;; described in the database, in the format
;;;     [constraint ?name ?checks ?message]

  RULE check_constraints  ;;; in check_rules

    [constraint ?name ?checks ?message]
    [ALL ?checks]  ;;; same as ( [WHERE prb_allpresent(checks)] )
    [plan ??plan]
    [state ==]
    ==>
    [SAY Constraint ?name violated]
    [SAY  ??message]
    [SAY 'Abandoning current plan:']
    [NULL [apply show_plan ?plan]]
    [NOT plan ==]   ;;; will cause baseplan to be tried again
    [PAUSE]
    [RESTORERULESET solve_rules]


  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']
    [POP11 show_plan(plan)]
    [plans ??plans ?plan]
    [NOT == isat ==]
    [NOT state == ]
    [RESTORERULESET solve_rules]

enddefine;


;;; When a move is legal, update the plan, history, etc.

define :ruleset complete_rules;

;;; 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

  RULE complete_move  ;;; in complete_rules

    [complete_move ?move][->>Fact1]
    [state ?state]
    ==>
    [DEL ?Fact1 ]
    ;;; 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]
    [RESTORERULESET check_rules]
enddefine;

/*
-- -- Defining a rulefamily for the breadth first program
*/

define :rulefamily breadth_first;
    ruleset: start_rules
    ruleset: solve_rules
    ruleset: backtrack_rules
    ruleset: check_rules
    ruleset: complete_rules
enddefine;


/*
-- -- Testing the breadth first program
*/

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


;;; It should also be able to achieve the following goal
;;; though it requires 19 pauses (if prb_pausing is true).
prb_run(breadth_first, [[goal [[man isat left] [grain isat right]] ]]);

;;; The following goal will produce far more trace printing, possibly
;;; a few hundred lines.

;;; 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]]];


prb_run(breadth_first, [^goal_state]);

;;; Or equivalently
prb_run(breadth_first, [[goal [[NOT = isat left]] ]]);


;;; Try a goal state that cannot be achieved, and see what happens.

/*
--- $poplocal/local/newkit/prb/teach/prbriver
--- Copyright University of Birmingham 1996. All rights reserved. ------
--- Copyright University of Birmingham 2000. All rights reserved. ------
*/