Appendix G
Rule-based system: Program
% Metalocutionary rule-based system --
program
% David Novick
% October, 1988
ml_version(30).
% The state of a conversant's memory is
represented by a set of state
%
relations indexed by the conversant's name in Prolog's internal
%
database. These relations are of
the form:
%
%
state(Act_or_belief,Cycle_added,Cycle_deleted)
%
% The contents of the person's memory
consists of a set of acts and beliefs which
%
the person believes have some truth state. These relations are of the form:
%
%
<act-name>(Actor,Act,Belief_state).
%
%
When an agent performs a conversational act, the act is posted to the
active
%
memory of both conversants.
%
%
%%%%%
%%%%%
Program: major cycle
%%%%%
run :- %
Execute multiple cycles
open(full_trace,append,Stream_1), %
Begin by opening output streams
open(short_trace,append,Stream_2), %
First arg is filename
repeat, %
If any operator fires then do_cycle will fail
do_cycle(Stream_1,Stream_2), %
thus causing do_cycle to repeat
close(Stream_1), %
If do_cycle succeeds, then done
close(Stream_2). %
so close the output streams
do_cycle(Stream_1,Stream_2) :- % Perform one
conversational cycle for both agents
increment_cycle,
portray_active_memory(Stream_1), %
Stream_1 is full trace
person_this_cycle(adam,A_acts), %
Run the cycle for one agent
display_cycle_result(adam,A_acts,Stream_1,Stream_2), % and
output results
person_this_cycle(barney,B_acts), %
Run the cycle for the other agent
display_cycle_result(barney,B_acts,Stream_1,Stream_2), !, % Don't retry any
of this
A_acts = [], %
Succeed (thus ending repeat)
B_acts = []. % else force repeat
run_to_cycle(Cycle) :- %
I.e., run through given cycle and stop
open(full_trace,append,Stream_1), %
Begin by opening output streams
open(short_trace,append,Stream_2), %
First arg is filename
repeat, %
If any operator fires then do_cycle will fail
do_to_cycle(Cycle,Stream_1,Stream_2), %
Actually do run the system
close(Stream_1), %
Then close the output streams
close(Stream_2). %
when done
do_to_cycle(Cycle,Stream_1,Stream_2) :- % Cycle arg is
loop-test arg, not current cycle
increment_cycle, %
Increment loop index
portray_active_memory(Stream_1), % Stream_1 is full trace
person_this_cycle(adam,A_acts), %
Run the cycle for one agent
display_cycle_result(adam,A_acts,Stream_1,Stream_2), % and
output results
person_this_cycle(barney,B_acts), %
Run cycle for other agent
display_cycle_result(barney,B_acts,Stream_1,Stream_2), !, % Don't
retry above
cycle(Cycle). %
Succeed (and thus quit) if end-test val is current cycle
run_single_cycle :- %
Run system for one cycle for both agents
open(full_trace,append,Stream_1), %
Begin by opening output streams
open(short_trace,append,Stream_2), %
First arg is filename
do_single_cycle(Stream_1,Stream_2), %
Actually run the system; no repeat needed
close(Stream_1), %
Then close the output strreams
close(Stream_2).
do_single_cycle(Stream_1,Stream_2) :- !, %
Actually do mechanics of a cycle
increment_cycle,
portray_active_memory(Stream_1), %
Stream_1 is full trace
person_this_cycle(adam,A_acts), %
Run the cycle for one agent
display_cycle_result(adam,A_acts,Stream_1,Stream_2), % and
output results
person_this_cycle(barney,B_acts), %
Run cycle for other agent
display_cycle_result(barney,B_acts,Stream_1,Stream_2). % and
output results
display_cycle_result(Person,Ops,Stream_1,Stream_2)
:- !, %
Output results of a cycle
display_short_result(Person,Ops,user_output), % Send short trace to
terminal
display_full_result(Person,Ops,Stream_1), % Send full trace to
appropriate file
display_short_result(Person,Ops,Stream_2). % Send short trace to appropriate
file
display_short_result(Person,Ops,Stream)
:- !, %
Output summary of cycle results
cycle(Cycle), %
What cycle is this?
set_output(Stream), %
Send output to appropriate stream
format("~a's acts for cycle ~d:~n",[Person,Cycle]), %
Print header
list_ops_actions(Ops), %
Print the names of operators fired (if any)
set_output(user_output), nl. %
Send output back to terminal
display_full_result(Person,Ops,Stream) :-
!, %
Output full trace of a cycle
cycle(Cycle), %
What cycle is this?
set_output(Stream), %
Send output to appropriate stream
format("~2n~a's acts for cycle ~d:~n",[Person,Cycle]), %
Print header
portray_ops(Ops), %
Print full account of operators fired (if any)
set_output(user_output), nl. %
Send the output back to terminal
list_ops_actions([]) :- !. %
If no more operators to print then done
list_ops_actions([Op|Ops]) :- !, % Print the
name and actions of the first op of a list
get_attribute(name(Name),Op), %
Get the operator's name
format(" ~a
--~n",[Name]), %
Print it
list_actions(Op), %
Print any actions taken by the operator
list_ops_actions(Ops). %
Do the same thing for the rest of the list
list_actions(op(_,_,_,action(Actions),_,_))
:- % Print
any actions taken by an operator
list_actions_1(Actions). %
Simplify predicate
list_actions_1([]) :- !. %
If no more actions then done
list_actions_1([A|As]) :- %
Print a list of operator actions
format("
~w~n",[A]), %
Print the first action
list_actions_1(As). %
And then print the rest of the list
portray_ops([]) :- !. %
If no more operators to print, then done
portray_ops([Op|Ops]) :- !, %
Print the full Prolog form of a list of operators
portray_op(Op), %
Print the first operator
portray_ops(Ops). %
And the print the rest of the list
portray_op(op(if(I),not(N),test(T),action(A),effects(E),atts(Atts)))
:- !, % In
Prolog form
member(name(Name),Atts), %
Get the name of the operator from atts list
format("~nop( %
~a",[Name]), %
Print term-name and (as comment) operator name
portray_op_clause(if,I), %
Then print the various sub-terms which make up the op
portray_op_clause(not,N),
portray_op_clause(test,T),
portray_op_clause(action,A),
portray_op_clause(effects,E),
portray_last_op_clause(atts,Atts), %
atts term is special because it is the last one
format(" ).~n",[]). %
Finally, close off the op term
portray_op_clause(Label,[]) :- !, %
If arg list is empty
format("~n
~a([]),",[Label]). % then just print term with empty arg list
portray_op_clause(Label,[Term]) :- !, % If
term has arg list with one term in it
format("~n ~a([ ~w
]),",[Label,Term]). %
then print it accordingly
portray_op_clause(Label,[Term|Terms]) :-
!, % If
term has arg list with multiple terms
format("~n ~a([
~w,",[Label,Term]), %
then print term name and first arg,
portray_other_op_clause_terms(Terms), %
then print the rest of the args,
format(" ]),",[]). %
then close the list and the term
portray_last_op_clause(Label,[]) :- !, % This
predicate is like portray_op_clause
format("~n
~a([])",[Label]). %
except that it leaves off the trailing comma
portray_last_op_clause(Label,[Term]) :-
!, %
because the op term is ending
format("~n ~a([ ~w
])",[Label,Term]).
portray_last_op_clause(Label,[Term|Terms])
:- !,
format("~n ~a([
~w,",[Label,Term]),
portray_other_op_clause_terms(Terms),
format(" ])",[]).
portray_other_op_clause_terms([]) :- !. %
No more terms to print; so done
portray_other_op_clause_terms([Term]) :-
!, %
Print the last term in a list
format("~n
~w",[Term]).
portray_other_op_clause_terms([Term|Terms])
:- !, %
Print the tail of a list
format("~n
~w,",[Term]), %
by printing the first term of the tail
portray_other_op_clause_terms(Terms). %
and then the rest of the terms
%%
%% Clauses which perform the
match-resolve-execute cycle
%%
increment_cycle :- % Change the program to
increment the current cycle number
retract(cycle(C)),
D
is C + 1,
assert(cycle(D)).
person_this_cycle(Person,Selections) :-
!, %
Mechanics of a single cycle for one agent
match_ops(Person,Matches), %
Match the operators against the knowledge base
select_ops(Matches,Selections), %
Resolve conflicts among the matching operators
do_ops(Person,Selections). %
Then execute the selected operators
%
% Clauses which perform the
"execute" functions of the cycle
%
do_ops(_,[]) :- !. %
No ops to fire, so done
do_ops(Person,[op(_,_,_,action(A),effects(E),_)|Ops])
:- !, %
Fire a list of operators
do_acts(Person,A), %
For the first op, do the acts
do_effects(Person,E), %
do the effects
do_ops(Person,Ops). %
Then fire the rest of the ops
do_acts(Person,[]) :- !. %
No acts to do, so done
do_acts(Person,[Act|Acts]) :- %
To do a list of acts
do_act(Person,Act), %
Do the first act
do_acts(Person,Acts). %
Then do the rest of the acts
do_act(Person,Act) :- !, Do
an act; no need to retry
cycle(Cycle), %
What is the current cycle?
recorded(Person,state(conversants(Person,Other),0,-1),_), % Who are relevant
agents?
recorda(Person,state(Act,Cycle,-1),_), %
Add the act to each agent's knowledge base
recorda(Other,state(Act,Cycle,-1),_). %
indicating added current cycle and not deleted
do_effects(_,[]) :- !. %
No effects to do, so done
do_effects(Person,[Effect|Effects]) :- %
To do a list of effects
do_effect(Person,Effect), %
Do the first effect
do_effects(Person,Effects). %
Then do the rest of the effects
do_effect(_,[]). %
Base case for completeness
do_effect(Person,add(State)) :- %
Add a state to an agent's knowledge base
cycle(Cycle), %
What is the current cycle?
recorda(Person,state(State,Cycle,-1),_). %
Indicate added current cycle and not deleted
do_effect(Person,
cycle(Cycle), %
What is the current cycle?
recorded(Person,state(State,Cycle_added,_),Ref), % Remember the fact to be deleted
erase(Ref), %
Really delete it
recorda(Person,state(State,Cycle_added,Cycle),_). % Re-record, showing deletion cycle
add_state(Person,State) :- %
Used for initialization and debugging
del_if_exists(Person1,State), %
Delete possible duplicate
add(Person,State). %
Add the state on the current cycle
del_if_exists(Person1,act(Person2,Act,Truth_value))
:- %
Delete an act
del_if_exists(Person1,believe(Person2,Belief,Truth_value))
:- %
Delete a belief
del_if_exists(_,_). %
If nothing matches, succeed anyway
cycle(Cycle), %
What is the current cycle?
recorded(Person,state(State,Cycle_added,_),Ref), % Remember the fact to be deleted
erase(Ref), %
Really delete it
recorda(Person,state(State,Cycle_added,Cycle),_). % Re-record, showing deletion cycle
add(Person,State) :- %
Used for initialization and debugging
cycle(Cycle), %
What is the current cycle?
recorda(Person,state(State,Cycle,-1),_). %
Add the state on the current cycle
%
% Clauses which perform the
"resolve-conflicts" part of the cycle
%
select_ops([],[]) :- !. %
No ops matched, so nothing to do
select_ops(Possible_ops,Chosen_ops) :- %
To resolve conflicts among ops
check_for_opportunities(Possible_ops,Opp_ops), % Try to coordinate inter-level ops
check_consistent_effects(Opp_ops,Chosen_ops). % Make sure ops don't conflict
check_for_opportunities(P,P). %
Stubbed
check_consistent_effects(Ops1,Ops3) :- %
To make sure ops don't conflict
unique_levels(Ops1,Ops2), %
Discard multiple ops on any particular level
lowest_level_op(Ops2,Lowest,Others), %
Find the lowest-level op and key off it
most_consistent_effects([Lowest|Others],Ops3). % Discard ops whose effects conflict
unique_levels(Ops1,Ops2) :- !, %
Discard multiple ops on any particular level
unique_levels_1(Ops1,Ops2,[]). %
Set up predicate with empty list for level names
unique_levels_1([],[],_). %
No more ops to look at, so done
unique_levels_1([Op|Ops],Ops2,Levels) :- % To drop an op if
already have same level op
get_attribute(level(Level),Op), %
Get level of first op in list
member(Level,Levels), %
Do we already have an op at this level?
unique_levels_1(Ops,Ops2,Levels). %
If so, don't add this op to list returned
unique_levels_1([Op|Ops],[Op|Ops2],Levels)
:- %
Else op's level must be new
get_attribute(level(Level),Op), %
So get the op's level
unique_levels_1(Ops,Ops2,[Level|Levels]). % And add the new level to the list of
levels
lowest_level_op([Op],Op,[]) :- !. %
Only 1 op left, so must be lowest
lowest_level_op([Op1,Op2|Ops1],Op3,[Op2|Ops2])
:- % To
find lowest level op
lower_level_op(Op1,Op2), %
check order of first two ops in list
lowest_level_op(Ops1,Op3,Ops2). %
If lower, skip 2nd op & check rest
lowest_level_op([Op1,Op2|Ops1],Op3,[Op1|Ops2])
:- %
Else 2d op was lower
lowest_level_op([Op2|Ops1],Op3,Ops2). %
So skip first op & check rest
lower_level_op(op(_,_,_,_,_,atts(Atts1)),op(_,_,_,_,_,atts(Atts2)))
:- % Compare
ops
member(level(D1),Atts1), %
Get level of first op
member(level(D2),Atts2), %
Get level of second op
level_order(D2,D1). %
See if first level is higher than second
% level_order: as other levels are
created in ops, additional clauses
%
need to be added. Actually, a
more efficient system will be needed for this,
%
because the number of pairs will go up too fast. This could be changed, for
%
example, to check relative positions in a list.
level_order(domain,turn).
level_order(domain,information).
level_order(information,turn).
most_consistent_effects([Op|Rest],Consistent_ops)
:- !, % Assuming
first op has priority
most_consistent_effects_1(Op,Rest,Consistent_ops). % make sure rest
don't conflict
most_consistent_effects_1(Op,[],[Op]). %
Just one op, so must be ok
most_consistent_effects_1(Op1,[Op2|Ops],[Op2|Ok_ops])
:- % List
of ops is ok if
consistent_effects(Op1,Op2), %
First op is ok with priority op
most_consistent_effects_1(Op1,Ops,Ok_ops). % And the rest of the list is
pruned
most_consistent_effects_1(Op,[_|Ops],All_ok_ops)
:- %
If first op is not ok
most_consistent_effects_1(Op,Ops,All_ok_ops). % Skip it and prune rest of list
consistent_effects(op(_,_,_,action(A1),effects(E1),_), % 2
ops are consistent
op(_,_,_,action(A2),effects(E2),_)) :- %
if
combine_acts_and_effects(A1,E1,C1), %
taking first op's acts & effects together
combine_acts_and_effects(A2,E2,C2), %
taking 2d op's acts & effects together
consistent_effects_1(C1,C2). %
there isn't any conflict among them
combine_acts_and_effects(A,E,C1) :- % To
combine acts and effects into a list
actions_format(A,S), %
put the acts into same format as effects
append(S,E,C1). %
and then just append them
actions_format([],[]) :- !. %
No more actions left, so done
actions_format([A|As],[add(A)|Rest]) :- % An act is always added,
so wrap with add code
actions_format(As,Rest). %
Then format the rest of the acts
consistent_effects_1([],_). No
more effects left to check, so done
consistent_effects_1([E1|R1],E2) :- %
E2 is list of effects from 2d op
consistent_effect(E1,E2), %
Check first effect of first op against all effects of 2d op
consistent_effects_1(R1,E2). %
Check rest of effects of first op
consistent_effect(_,[]). %
No more effects to check, so done
consistent_effect(add(S),[
consistent_effect(
consistent_effect(E1,[_|R2]) :- %
Else effects are consistent so far
consistent_effect(E1,R2). %
so check against rest of list of effects of 2d op
%
% Clauses which perform the
"match" part of the cycle
%
match_ops(Person,Ops) :- %
For a given person, there is a set of ops
cycle(Cycle), %
which for the current cycle
bagof(Op,op_premises_true_for_cycle(Person,Op,Cycle),Ops). % matches in
kb
match_ops(_,[]) :- !. %
Else no matches, so return empty set
op_premises_true_for_cycle(Person, %
To match a particular op
op(if(I),not(N),test(T),action(A),effects(E),atts(Atts)),Cycle) :-
op(if(I),not(N),test(T),action(A),effects(E),atts(Atts)), % Find an
op in memory
check_ifs(Person,I,Cycle), %
Check the op's if clauses
check_nots(Person,N,Cycle), %
Check the op's not clauses
check_tests(T). %
Check the op's test clauses
check_ifs(_,[],_) :- !. %
No more if clauses to check, so done
check_ifs(Person,[If_clause|Rest],Cycle)
:- %
To check if clauses
recorded(Person,state(If_clause,Cycle_added,Cycle_deleted),Key), % match kb
true_for_cycle(Cycle_added,Cycle_deleted,Cycle), % make sure clause is currently true
check_ifs(Person,Rest,Cycle). %
and check the rest of the clauses
true_for_cycle(Cycle_added,Cycle_deleted,Cycle)
:- % A fact is
true on a given cycle if
Cycle_added < Cycle, %
it was added before this cycle
(Cycle_deleted =:= -1 ; Cycle < Cycle_deleted ). % and
hasn't been deleted yet
check_nots(_,[],_) :- !. %
No more 'not' clauses to check, so done
check_nots(Person,[Not_clause|Rest],Cycle)
:- %
A 'not' clause should succeed
\+ (recorded(Person,state(Not_clause,_,_),Key)), % if matching fact never posted to kb
check_nots(Person,Rest,Cycle). %
Then check rest of 'not' clauses
check_nots(Person,[Not_clause|Rest],Cycle)
:- % If a
matching fact had been posted
recorded(Person,state(Not_clause,Cycle_added,Cycle_deleted),Key), !,
not(true_for_cycle(Cycle_added,Cycle_deleted,Cycle)), % 'not' ok if
not true now
check_nots(Person,Rest,Cycle). %
Then check rest of 'nots'
check_tests([]) :- !. %
No more tests to check, so done
check_tests([H|L]) :- !, H,
check_tests(L). %
Eval test, then check rest
get_attribute(Att,op(_,_,_,_,_,atts(Atts)))
:- To
get an attribute of an op
member(Att,Atts). %
match against the ops atts list
%%%%%
%%%%%
Development aids
%%%%%
reinitialize :- %
To set the simulation to its initial state
reinitialize_ops, %
make sure the ops are all up to date
reinitialize_memory. %
and reinitialize the knowledge base
reinitialize_ops :- %
To get all ops up to date
abolish(op,6), %
erase all op clauses in the system
consult([ml1do,ml1mo]). %
and read them in from their files
reinitialize_memory :- %
To reinitialize memory
current_key(_,Key), %
find any key to the knowledge base
erase_facts_for_key(Key), %
erase all the facts for that key
fail. %
and force trying of some other key
reinitialize_memory :- !, %
All keys must have been used, so kb is blank
consult(ml1si). %
So read in initial state from its file
erase_facts_for_key(Key) :- %
To erase all facts in kb for a given key
recorded(Key,_,Ref), %
match agains the kb
erase(Ref), %
erase that fact
fail. %
and force rematches to erase other facts
erase_facts_for_key(_) :- !. % Must
have erased all facts for this key, so done
memory :- %
To display the entire knowlege base for all agents
current_key(_,Key), %
find any key in the kb (will be an agent's name)
display_facts_for_key(Key), %
display all the facts for that agent
fail. %
and force rematch of key for other agents
memory :- !. %
Must have matched all keys, so done
display_facts_for_key(Key) :- %
To display the kb for a given agent
recorded(Key,Term,Ref), %
find any fact for that agent
format("~n~a: ~w~n {~w}",[Key,Term,Ref]), %
print it
fail. %
and force rematches to print rest of facts
display_facts_for_key(_) :- !. %
Must have printed all facts for agent, so done
active_memory :- %
To display active facts in kb for all agents
cycle(Cycle), %
get the current cycle
current_key(_,Key), %
find any key in the kb (will be agent)
display_facts_for_key_and_cycle(Key,Cycle), % display all the facts for agent this cycle
fail. %
and force rematch of key for other agents
active_memory :- !. Must
have matched all keys, so done
display_facts_for_key_and_cycle(Key,Cycle)
:- % To
display kb for agent on cyle
recorded(Key,state(S,Cycle_added,Cycle_deleted),Ref), %
find any fact
Cycle_added < Cycle, %
that was added before the cycle
(Cycle_deleted = -1 ;Cycle_deleted >= Cycle), % and not deleted until after cycle
format("~n~a: ~w~n
{~w}",[Key,state(S,Cycle_added,Cycle_deleted),Ref]), % print it
fail. %
and force rematches of facts to print rest
display_facts_for_key_and_cycle(_) :- !. % Must
have printed all facts, so done
portray_active_memory(Stream) :- % To send display
of active facts in kb to a stream
set_output(Stream), %
direct output to the steam
cycle(Cycle), %
get current cycle
current_key(_,Key), nl, nl, %
find any agent, print some blank lines
portray_facts_for_key_and_cycle(Key,Cycle), % display the facts for that
agent
fail. %
and force rematch of key for other agents
portray_active_memory(_) :- Must
have matched all keys
set_output(user_output), !. %
so redirect output to terminal
portray_facts_for_key_and_cycle(Key,Cycle)
:- %
Like display_facts, but
recorded(Key,state(S,Cycle_added,Cycle_deleted),_), % slightly
simpler output
Cycle_added < Cycle,
(Cycle_deleted = -1 ;Cycle_deleted >= Cycle),
format("~a: ~w~n",[Key,state(S,Cycle_added,Cycle_deleted)]),
fail.
portray_facts_for_key_and_cycle(_) :- !. % Must have
matched all facts, so done
back_to_cycle(Cycle) :- % To return
the system to its state at start of some cycle
erase_facts_added_from(Cycle), %
erase all the facts added on and after that cycle
undelete_facts_deleted_from(Cycle), %
restore the facts deleted on and after that cycle
reset_cycle(Cycle), %
change the state of the cycle index
format("{ Cycle is now ~D }",[Cycle]). % and tell user
we've done it
reset_cycle(New_cycle) :- !, %
To change the system's cycle index
retract(cycle(_)), %
erase the current index
assert(cycle(New_cycle)). %
and assert the new value
erase_facts_added_from(Cycle) :- % To
erase all facts added on and after cycle
current_key(_,Key), %
find any key in the kb
recorded(Key,state(_,Cycle_added,_),Ref), % find any fact with
that key
Cycle_added >= Cycle, %
check if fact added on or after the cycle
erase(Ref), %
if so, erase it from kb
fail. %
and force rematch of facts and keys
erase_facts_added_from(_) :- !. % Must have
matched all keys and facts, so done
undelete_facts_deleted_from(Cycle) :- % To restore
facts deleted on and after cycle
current_key(_,Key), %
find any key
recorded(Key,state(State,Cycle_added,Cycle_deleted),Ref), % find any fact with the
key
Cycle_deleted >= Cycle, %
check if key deleted on or after the cycle
erase(Ref), %
if so, erase the fact and
recorda(Key,state(State,Cycle_added,-1),_), % set
fail. %
and force rematch of facts and keys
undelete_facts_deleted_from(_) :- !. % Must have
matched all keys and facts, so done
check_op(Person,Name) :- %
See if named op will match on this cycle
cycle(Cycle), %
Get the cycle
op(if(I),not(N),test(T),_,_,atts(Atts)), %
Get an op
member(name(Name),Atts), %
Make sure its the right one
undo(notrace), %
On backtrack turn off trace mode
trace, %
Turn on trace mode
check_ifs(Person,I,Cycle), %
Look at system checking 'ifs' against memory
check_nots(Person,N,Cycle), %
Look at system checking 'nots' against memory
check_tests(T). %
Look at system checking tests against memory
do_cycle :- %
To run a single cycle
increment_cycle, %
increment the cycle index
person_this_cycle(adam,A_acts), %
run the cycle for adam
display_cycle_result(adam,A_acts,user_output), % show the
results
person_this_cycle(barney,B_acts), %
run the cycle for barney
display_cycle_result(barney,B_acts,user_output), !, %
show the results
A_acts = [], %
succeed (thus ending any repeat)
B_acts = []. % when both have nothing to do
display_named_op(Name) :- %
To print a named operator
op(I,N,T,A,E,atts(Atts)), %
get an op
member(name(Name),Atts), %
make sure its the right one
portray_op(op(I,N,T,A,E,atts(Atts))). %
and print it out