% File:    /u4/peter/prolog/ks299/int
% Author:  Original by Steven Hardy. Reworked by Peter Ross.
% Updated: 6 Sep 84 by Peter Ross
% Purpose: a simple rule interpreter in the style of KS-300

% Original code courtesy of Teknowledge Inc. - so don't make use of it
% without acknowledging them.

% The rule base is made up of assertions of the form
%	RULE: if PREMISE then CONCLUSION.
% where	RULE is an atom,
%	PREMISE is a simple proposition of the form
%			THING = VALUE
%		     or THING is known
%		     or THING is unknown
%		or is a combination of simple propositions
%		   built up using "and" and "or", where "or"
%		   binds tighter than "and",
%       CONCLUSION is a simple conclusion of the form
%			THING = VALUE
%		     or THING = VALUE cf CONFIDENCE
%		or is a combination of simple conclusions
%		   built up using "and" only.
% THING and VALUE can be any Prolog term of precedence less than 600.
% An operator 'of' has been defined for convenience; it has precedence 599.
% It allows you to have THINGs of the form   ATTRIBUTE of OBJECT.
% CONFIDENCE should be a number between 0 (no confidence at all) and 1000
% (completely sure) inclusive.
%
% You must also provide assertions of the form
%	QUESTION finds THING.
% where QUESTION is an atom giving a question to ask the user to get a value
% for the attribute. A question mark will be supplied by the system. If the
% system can ask the user for a value, he will be asked as soon as the need is
% found, and only once. Valid replies are:
%	why.
% asking for a MYCIN-like justification in terms of the goal tree, or
%	show THING.
% asking for what is known about a THING, or
%	show RULE.
% asking to see the rule identified by the given tag, or
%	:- Command.
% asking for some arbitrary Prolog command to be run, or
% anything else, which the system will assume to be the value sought, with cf
% 1000 because you said so.
%
% There are three extra useful predicates:
%	watch		switches on printing of the recording of attribute
%			values
%	nowatch		turns it off
%	tidy(Old,New)	reads file Old and writes file New (not equal)
%			so that New contains a nicley laid out version of the
%			rule base in Old.

:- op(980, fx,  [sought, find, invoke, seek]).
:- op(980, xfy, [concludes, uses, refersto]).
:- op(975, xfy, :).
:- op(950, fx,  if).
:- op(949, xfy, then).
:- op(948, xfy, because).
:- op(800, xfy, and).
:- op(750, xfy, or).
:- op(725, xfy, cf).	% cf => certainty factor
:- op(600, xfy, finds).
:- op(600, fx,  show).
:- op(599, xfy, of).

find THING :-
	prompt(Old, ' ==>> '),
	abolish(active,1),
	abolish(sought,1),
	abolish(because,2),
	seek THING,
	show THING.

seek THING :-
	sought THING,
	!.
seek THING :-
	QUESTION finds THING,
	write(QUESTION),
	write('?'), nl,
	read(REPLY),
	( REPLY = why
	    ->	why,
		seek THING
	; REPLY = help
	    ->  help,
		seek THING
	; REPLY = show SOMETHING
	    ->  show SOMETHING,
		seek THING
	; REPLY = (:- COMMAND)
	    ->	do_without_fail(COMMAND),
		seek THING
	; assert(sought THING),
	  note(THING = REPLY cf 1000 because ['you said so'])
	),
	!.
seek THING :-
	assert(sought THING),
	( nonrecursive(RULE, THING)
	; recursive(RULE, THING)
	),
	notice(RULE),
	invoke RULE,
	fail.
seek THING.

do_without_fail(COMMAND) :-
	COMMAND,
	!.
do_without_fail(_).

invoke RULE :-
	RULE : if PREMISE then CONCLUSION,
	PREMISE cf CONFIDENCE,
	( CONFIDENCE < 200
	; note(CONCLUSION cf CONFIDENCE because [RULE])
	),
	!.

notice(RULE) :-
	(watching -> write('****** Invoking '), write(RULE),nl; true),
	asserta(active(RULE)).
notice(RULE) :-
	retract(active(RULE)),
	fail.

(P1 or P2) cf CONFIDENCE :-
	P1 cf C1,
	( C1 = 1000
	    -> CONFIDENCE = C1
	; P2 cf C2,
	  ( C1 > C2 -> CONFIDENCE = C1 ; CONFIDENCE = C2 )
	),
	!.

(P1 and P2) cf CONFIDENCE :-
	P1 cf C1,
	( C1 < 200
	    -> CONFIDENCE = C1
	; P2 cf C2,
	  ( C1 < C2 -> CONFIDENCE = C1 ; CONFIDENCE = C2 )
	),
	!.

THING = VALUE cf CONFIDENCE :-
	seek THING,
	( THING = VALUE cf CONFIDENCE because REASON
	; CONFIDENCE = 0
	),
	!.

THING is known cf CONFIDENCE :-
	seek THING,
	( ( THING = VALUE cf C because REASON, C > 200 )
	    ->	CONFIDENCE = 1000
	; CONFIDENCE = 0
	),
	!.

THING is unknown cf CONFIDENCE :-
	( THING is known cf 1000
	    -> CONFIDENCE = 0
	; CONFIDENCE = 1000
	),
	!.

nonrecursive(RULE, THING) :-
	RULE concludes THING,
	not(RULE uses THING).

recursive(RULE, THING) :-
	RULE concludes THING,
	RULE uses THING.

RULE concludes THING :-
	RULE : if PREMISE then CONCLUSION,
	CONCLUSION refersto THING.

RULE uses THING :-
	RULE : if PREMISE then CONCLUSION,
	PREMISE refersto CONCLUSION.

note((P1 and P2) cf CONFIDENCE because REASON) :-
	note(P1 cf CONFIDENCE because REASON),
	note(P2 cf CONFIDENCE because REASON).
note(THING = (VALUE1 and VALUE2) cf CONFIDENCE because REASON) :-
	note(THING = VALUE1 cf CONFIDENCE because REASON),
	note(THING = VALUE2 cf CONFIDENCE because REASON).
note(THING = (VALUE cf CONFIDENCE1) cf CONFIDENCE2 because REASON) :-
	note((THING = VALUE) cf CONFIDENCE1 cf CONFIDENCE2 because REASON).
note((PROPOSITION cf CONFIDENCE1) cf CONFIDENCE2 because REASON) :-
	note(PROPOSITION cf CONFIDENCE1 cf CONFIDENCE2 because REASON).
note(THING = (VALUE cf CONFIDENCE1) cf CONFIDENCE2 because REASON) :-
	note(THING = VALUE cf CONFIDENCE1 cf CONFIDENCE2 because REASON).
note(THING is unknown cf CONFIDENCE because REASON).
note(PROPOSITION cf C1 cf C2 because REASON) :-
	C3 is (C1 * C2)/1000,
	note(PROPOSITION cf C3 because REASON).
note(PROPOSITION cf C1 because [REASON1]) :-
	remove(PROPOSITION cf C2 because REASON2),
	!,
	C3 is C1 + C2 - (C1 * C2)/1000,
	add(PROPOSITION cf C3 because [REASON1|REASON2]).
note(PROPOSITION cf C1 because [REASON1]) :-
	add(PROPOSITION cf C1 because [REASON1]).

remove(Item) :-
	retract(Item),
	(watching -> write('--- deleted '), write(Item), nl; true).

add(Item) :-
	assert(Item),
	(watching -> write('+++ added '), write(Item), nl; true).

why :-
	listof(R,active(R), [CURRENT|OTHERS]),
 	tab(8),
 	write('Your answer to this question will help me determine if the'),
 	nl,
 	tab(16),
 	write('following rule is applicable:'),
 	nl,
 	show CURRENT,
 	( OTHERS = []
 	; nl,
 	  tab(8),
 	  write('Other relevant rules are: '),
 	  write(OTHERS),
 	  nl
 	).

help :-
	tab(8), write('When you get the prompt  ==>>  vaild replies are:'), nl,
	tab(16), write('- an answer to the question'), nl,
	tab(16), write('- why.             to get a justification'), nl,
	tab(16), write('- show RULE.       to have that rule printed'), nl,
	tab(16), write('- show THING.      to see what is known about it'), nl,
	tab(16), write('- (:- COMMAND).    to have a Prolog command run'), nl.

P1 and P2 refersto THING :-
	( P1 refersto THING
	; P2 refersto THING
	),
	!.
P1 or P2 refersto THING :-
	( P1 refersto THING
	; P2 refersto THING
	),
	!.
PROPOSITION cf CONFIDENCE refersto THING :-
	PROPOSITION refersto THING,
	!.
THING = VALUE refersto THING :-
	!.
THING is STATUS refersto THING :-
	!.

show RULE :-
	RULE : if PREMISE then CONCLUSION,
	!,
	tab(8), write(RULE), write(':'), nl,
	tab(10), write('if    '), pwrite(PREMISE, 16), nl,
	tab(10), write('then  '), pwrite(CONCLUSION, 16), nl.

pwrite(P1 and P2, Indent) :-
	!,
	pwrite(P1, Indent), nl,
	tab(Indent), write('and '), pwrite(P2, Indent).
pwrite(P, _) :-
	write(P).

show THING :-
	G = (THING = VALUE cf CONFIDENCE because R),
	listof([CONFIDENCE, G], G, GS),
	!,
	sort(GS, SGS),
	tab(8), write('This is what is known about '),
	write(THING), write(':'), nl,
	bwrite(SGS).
show THING :-
	sought(THING),
	!,
	tab(8), write(THING), write(' is unknown.'), nl.

watch :- 
	assert(watching).

nowatch :- 
	abolish(watching, 0).

bwrite([]).
bwrite([[A,B]|C]) :-
	bwrite(C),
	tab(16), write(B), nl.

tidy(OLD, NEW) :-
	(OLD == NEW -> write('Files must differ'), nl, fail; true),
	(exists(OLD) -> true; write('First file does not exist'), nl, fail),
	assert(rulenumber(1)),
	see(OLD),
	tell(NEW),
	repeat,
		read(FACT),
		tidyprocess(FACT),
	seen,
	told,
	abolish(rulenumber, 1).

tidyprocess(end_of_file).
tidyprocess(FACT) :-
	output(FACT),
	nl, nl,
	!,
	fail.

output(NAME : if PREMISE then CONCLUSION) :-
	retract(rulenumber(N)),
	succ(N,N1),
	assert(rulenumber(N1)),
	write(rule), write(N), write(':'), nl,
	tab(8), write('if    '), pwrite(PREMISE, 14), nl,
	tab(8), write('then  '), pwrite(CONCLUSION, 14), write('.'), nl.
output(QUESTION finds THING) :-
	write(''''), write(QUESTION), write(''''), nl,
	tab(4), write('finds '), write(THING), write('.'), nl, nl.
output(P) :-
	write(P), write('.'), nl.

% listof/3 behaves very like bagof/3, except that the collection of
% answers it comes up with will never be empty. It will fail instead.

listof(X,P,Set) :-
         bagof(X,P,Set),
         !,
         X \== [].

% sort/2 is a vrsion of Hoare's "Quicksort" algorithm designed to sort
% terms of the form   THING=VALUE cf CONFIDENCE because LIST   into
% decreasing order of CONFIDENCE. The only specific reference to this
% kind of term occurs within the definition of lesser/2, which succeeds
% only if its first argument is 'less' than its second. So, you could
% easily adapt sort/2 to many other sorting jobs.

sort(L,Sorted) :-
         sort(L,[],Sorted).

sort([X|L],R0,R) :-
         partition(L,X,L1,L2),
         sort(L2,R0,R1),
         sort(L1,[X|R1],R).
sort([],R,R).

partition([X|L],Y,[X|L1],L2) :-
         lesser(X,Y),
         !,
         partition(L,Y,L1,L2).
partition([X|L],Y,L1,[X|L2]) :-
         !,
         partition(L,Y,L1,L2).
partition([],_,[],[]).

lesser(X = _ cf C1 because _, X = _ cf C2 because _) :-
         C1 < C2.