[comp.lang.prolog] A simple forward chaining system 182 LINES

ken@aiai.ed.ac.uk (Ken Johnson) (06/13/90)

This is a VERY simple forward chaining system that works over Prolog
like rules and facts.  For example:

fc ?- foo(A) :- bar(A), wub(_).
fc ?- wub(plonk).
fc ?- bar(fred).

will infer `foo(fred)'.  Share and enjoy.  Comments and ideas welcome!
(For anyone who does not know: a Forward chaining system infers facts by
applying rules as it goes along -- it does not wait for you to give it a
proposition to prove.  Try it, you'll soon see the idea.)

Handling of non-ground `facts' is a bit iffy.  The code uses assertz/2
and clause/3 so it may be a bit too Edinburgh-specific for some tastes. 

            If you are going to follow-up this posting,
            please reduce the net.confusion.quotient by
-------->   changing the `182 LINES' warning in the Subject:
            line, unless of course your follow-up actually
            is 182 lines long. 

% Forward chaining system.
% --------------------------------------------------------
% 
% Top level: type `fc'.  To quit, type end-of-file.  There is a
% ``consult'' mechanism: type [File1,File2,...].  Put rules in before
% facts! No attempt is made to fire new rules as they are added and there
% is no way to retract rules or facts. 
% 
% During consultation, facts are displayed as they are read in.  All
% inferences are displayed as they are made, prefixed by ->
% 
% -- Ken Johnson 12 June 1990
% 
% You may copy this software freely.  As far as I know it works but I
% would be interested to hear any comments you have.  Mail them to
% ken@aiai.uucp or ken@aiai.ed.ac.uk

% The top level

fc :-
	repeat,
		write('fc ?- '),		% prompt and get a term
		read(T),
		(
			T = end_of_file		% quit
		;
			T = [File|Files],	% consult
			consult_files([File|Files]),
			fail
		;
			\+ T = [_|_],		% anything else
			in(T),
			fail
		).


in((Head :- Body)) :-				% New Rule
	!,
	assertz((Head :- Body),Ref),		% Add to data base
	note_body_clauses(Body,Ref).		% Index its clauses

in(Fact) :-					% New Fact
	recordz(new_fact,Fact,_),		% Record it in queue
	repeat,
		make_inferences,		% Draw inferences from it
		\+ recorded(new_fact,_,_),	% Go on til queue is
	!.					% empty

make_inferences :-
	recorded(new_fact,Fact,R1),		% Find one recorded fact
	erase(R1),				% Remove from queue
	\+ known(Fact),				% If known already, ignore
	assertz(Fact),				% Add to fact base
		write('-> '), write(Fact), nl,	% Tell user
	functor(Fact,Functor,_),		% Find relevant rule by
	recorded(Functor,refers(Fact,N,Ref),_),	% looking in the index
	clause(Head,Body,Ref),			% Create instance of rule
	satisfy(1,N,Fact,Body),			% Satisfy rule if poss
	\+ known(Head),				% If head is known, ignore
	recordz(new_fact,Head,_),		% Else put inference on queue
	fail.					% and loop

make_inferences.				% success!

% When satisfying a rule, given (say) P1 and knowing the rule H :- M,P,Q
% we instantiate the rule a bit by unifying P=P1 (thus avoiding some
% backtracking) then search for instances of M and Q. The index tells
% us that P1 will match the 2nd clause of this rule

% Args I=1 initially, N=Nth arg matches Fact

satisfy(I,N,Fact,Body) :-
	satisfy_given_bit(I,N,Fact,Body),
	satisfy_rest(I,N,Body).

satisfy_given_bit(I,N,Fact,(_,B)) :-	% Go to the bit we know
	I < N,				% matches and make the
	J is I + 1,			% unification
	satisfy_given_bit(J,N,Fact,B).

satisfy_given_bit(N,N,Fact,(Fact,_)).	% Make the unification
					% (two possibilities because of
satisfy_given_bit(N,N,Fact,Fact).	% the way the comma works)


satisfy_rest(N,N,Body) :-		% Then go through looking for matches
	J is N + 1,			% to every other clause of the
	satisfy_rest(J,N,Body).		% rule. This clause says ``ignore
					% the clause we know matched''
satisfy_rest(I,N,(A,B)) :-		% Match a clause. May find more
	I =\= N,			% than one match on backtracking
	J is I + 1,
	known(A),
	satisfy_rest(J,N,B).

satisfy_rest(I,N,A) :-			% Match last clause
	I =\= N,
	\+ (A = (_,_)),
	known(A).

known(Fact) :-				% Fact is known to be true if
	clause(Fact,true).		% it is asserted or if it is
					% in the inferences queue
known(Fact) :-
	recorded(new_fact,Fact,_).


% Indexing

note_body_clauses(Clause,Ref) :-
	note_body_clauses(1,Clause,Ref).

note_body_clauses(N,(A,B),Ref) :-
	!,
	note_1_clause(N,A,Ref),
	N1 is N + 1,
	note_body_clauses(N1,B,Ref).

note_body_clauses(N,Body,Ref) :-
	note_1_clause(N,Body,Ref).

note_1_clause(N,Clause,Ref) :-		% To reduce searching, use functor
	functor(Clause,Functor,_),	% of clause as d/base key.
	record(Functor,refers(Clause,N,Ref),_).


consult_files(Files) :-			% A simple consult loop
	seeing(S),			% `Reconsult' does not make
	consult_files_1(Files),		% sense in a simple system
	see(S).				% that has no truth maintenance

consult_files_1([]).

consult_files_1([H|T]) :-
	see(H),
	!,
	consult_1_file,
	seen,
	consult_files_1(T).
	
consult_files_1([H|T]) :-
	consult_files_1([H|T]).

consult_1_file :-
	repeat,
		read(T),
		(
			T == end_of_file,
			!
		;
			write('fc: '), write(T), nl,
			in(T),
			fail
		).
-- 
Ken Johnson, AI Applications Institute, 80 South Bridge, Edinburgh EH1 1HN
E-mail ken@aiai.ed.ac.uk, phone 031-225 4464 extension 212
`I have read your article, Mr Johnson, and I am no wiser now than when I
started'.  -- `Possibly not, sir, but far better informed.'