PROLOG
%%%%%%%%%% Rule Based Expert System Shell %%%%%%%%%%
%%%
%%% This is one of the example programs from the textbook:
%%%
%%% Artificial Intelligence:
%%% Structures and strategies for complex problem solving
%%%
%%% by George F. Luger and William A. Stubblefield
%%%
%%% Corrections by Christopher E. Davis (chris2d@cs.unm.edu)
%%%
%%% These programs are copyrighted by Benjamin/Cummings Publishers.
%%%
%%% We offer them for use, free of charge, for educational purposes only.
%%%
%%% Disclaimer: These programs are provided with no warranty whatsoever as to
%%% their correctness, reliability, or any other property. We have written
%%% them for specific educational purposes, and have made no effort
%%% to produce commercial quality computer programs. Please do not expect
%%% more of them then we have intended.
%%%
%%% This code has been tested with SWI-Prolog (Multi-threaded, Version 5.2.13)
%%% and appears to function as intended.
% solve(Goal)
% Top level call. Initializes working memory; attempts to solve Goal
% with certainty factor; prints results; asks user if they would like a
% trace.
solve(Goal) :-
init,
solve(Goal,C,[],1),
nl,write('Solved '),write(Goal),
write(' With Certainty = '),write(C),nl,nl,
ask_for_trace(Goal).
% init
% purges all facts from working memory.
init :- retractm(fact(X)), retractm(untrue(X)).
% solve(Goal,CF,Rulestack,Cutoff_context)
% Attempts to solve Goal by backwards chaining on rules; CF is
% certainty factor of final conclusion; Rulestack is stack of
% rules, used in why queries, Cutoff_context is either 1 or -1
% depending on whether goal is to be proved true or false
% (e.g. not Goal requires Goal be false in oreder to succeed).
solve(true,100,Rules,_).
solve(A,100,Rules,_) :-
fact(A).
solve(A,-100,Rules,_) :-
untrue(A).
solve(not(A),C,Rules,T) :-
T2 is -1 * T,
solve(A,C1,Rules,T2),
C is -1 * C1.
solve((A,B),C,Rules,T) :-
solve(A,C1,Rules,T),
above_threshold(C1,T),
solve(B,C2,Rules,T),
above_threshold(C2,T),
minimum(C1,C2,C).
solve(A,C,Rules,T) :-
rule((A :- B),C1),
solve(B,C2,[rule(A,B,C1)|Rules],T),
C is (C1 * C2) / 100,
above_threshold(C,T).
solve(A,C,Rules,T) :-
rule((A), C),
above_threshold(C,T).
solve(A,C,Rules,T) :-
askable(A),
not(known(A)),
ask(A,Answer),
respond(Answer,A,C,Rules).
% respond( Answer, Query, CF, Rule_stack).
% respond will process Answer (yes, no, how, why, help).
% asserting to working memory (yes or no)
% displaying current rule from rulestack (why)
% showing proof trace of a goal (how(Goal)
% displaying help (help).
% Invalid responses are detected and the query is repeated.
respond(Bad_answer,A,C,Rules) :-
not(member(Bad_answer,[help, yes,no,why,how(_)])),
write('answer must be either help, (y)es, (n)o, (h)ow or (w)hy'),nl,nl,
ask(A,Answer),
respond(Answer,A,C,Rules).
respond(yes,A,100,_) :-
assert(fact(A)).
respond(no,A,-100,_) :-
assert(untrue(A)).
respond(why,A,C,[Rule|Rules]) :-
display_rule(Rule),
ask(A,Answer),
respond(Answer,A,C,Rules).
respond(why,A,C,[]) :-
write('Back to goal, no more explanation possible'),nl,nl,
ask(A,Answer),
respond(Answer,A,C,[]).
respond(how(Goal),A,C,Rules) :-
respond_how(Goal),
ask(A,Answer),
respond(Answer,A,C,Rules).
respond(help,A,C,Rules) :-
print_help,
ask(A,Answer),
respond(Answer,A,C,Rules).
% ask(Query, Answer)
% Writes Query and reads the Answer. Abbreviations (y, n, h, w) are
% trnslated to appropriate command be filter_abbreviations
ask(Query,Answer) :-
display_query(Query),
read(A),
filter_abbreviations(A,Answer),!.
% filter_abbreviations( Answer, Command)
% filter_abbreviations will expand Answer into Command. If
% Answer is not a known abbreviation, then Command = Answer.
filter_abbreviations(y,yes).
filter_abbreviations(n,no).
filter_abbreviations(w,why).
filter_abbreviations(h(X),how(X)).
filter_abbreviations(X,X).
% known(Goal)
% Succeeds if Goal is known to be either true or untrue.
known(Goal) :- fact(Goal).
known(Goal) :- untrue(Goal).
% ask_for_trace(Goal).
% Invoked at the end of a consultation, ask_for_trace asks the user if
% they would like a trace of the reasoning to a goal.
ask_for_trace(Goal) :-
write('Trace of reasoning to goal ? '),
read(Answer),nl,
show_trace(Answer,Goal),!.
% show_trace(Answer,Goal)
% If Answer is ``yes'' or ``y,'' show trace will display a trace
% of Goal, as in a ``how'' query. Otherwise, it succeeds, doing nothing.
show_trace(yes,Goal) :- respond_how(Goal).
show_trace(y,Goal) :- respond_how(Goal).
show_trace(_,_).
% print_help
% Prints a help screen.
print_help :-
write('Exshell allows the following responses to queries:'),nl,nl,
write(' yes - query is known to be true.'),nl,
write(' no - query is false.'),nl,
write(' why - displays rule currently under consideration.'),nl,
write(' how(X) - if X has been inferred, displays trace of reasoning.'),nl,
write(' help - prints this message.'),nl,
write(' all commands ( except help ) may be abbreviated to first letter.'),nl,nl.
% display_query(Goal)
% Shows Goal to user in the form of a query.
display_query(Goal) :-
write(Goal),
write('? ').
% display_rule(rule(Head, Premise, CF))
% prints rule in IF...THEN form.
display_rule(rule(Head,Premise,CF)) :-
write('IF '),
write_conjunction(Premise),
write('THEN '),
write(Head),nl,
write('CF '),write(CF),
nl,nl.
% write_conjunction(A)
% write_conjunction will print the components of a rule premise. If any
% are known to be true, they are so marked.
write_conjunction((A,B)) :-
write(A), flag_if_known(A),!, nl,
write(' AND '),
write_conjunction(B).
write_conjunction(A) :- write(A),flag_if_known(A),!, nl.
% flag_if_known(Goal).
% Called by write_conjunction, if Goal follows from current state
% of working memory, prints an indication, with CF.
flag_if_known(Goal) :-
build_proof(Goal,C,_,1),
write(' ***Known, Certainty = '),write(C).
flag_if_known(A).
% Predicates concerned with how queries.
% respond_how(Goal).
% calls build_proof to determine if goal follows from current state of working
% memory. If it does, prints a trace of reasoning, if not, so indicates.
respond_how(Goal) :-
build_proof(Goal,C,Proof,1),
interpret(Proof),nl,!.
respond_how(Goal) :-
build_proof(Goal,C,Proof,-1),
interpret(Proof),nl,!.
respond_how(Goal) :-
write('Goal does not follow at this stage of consultation.'),nl.
% build_proof(Goal, CF, Proof, Cutoff_context).
% Attempts to prove Goal, placing a trace of the proof in Proof.
% Functins the same as solve, except it does not ask for unknown information.
% Thus, it only proves goals that follow from the rule base and the current
% contents of working memory.
build_proof(true,100,(true,100),_).
build_proof(Goal, 100, (Goal :- given,100),_) :- fact(Goal).
build_proof(Goal, -100, (Goal :- given,-100),_) :- untrue(Goal).
build_proof(not(Goal), C, (not(Proof),C),T) :-
T2 is -1 * T,
build_proof(Goal,C1,Proof,T2),
C is -1 * C1.
build_proof((A,B),C,(ProofA, ProofB),T) :-
build_proof(A,C1,ProofA,T),
above_threshold(C1,T),
build_proof(B,C2,ProofB,T),
above_threshold(C2,T),
minimum(C1,C2,C).
build_proof(A, C, (A :- Proof,C),T) :-
rule((A :- B),C1),
build_proof(B, C2, Proof,T),
C is (C1 * C2) / 100,
above_threshold(C,T).
build_proof(A, C, (A :- true,C),T) :-
rule((A),C),
above_threshold(C,T).
% interpret(Proof).
% Interprets a Proof as constructed by build_proof,
% printing a trace for the user.
interpret((Proof1,Proof2)) :-
interpret(Proof1),interpret(Proof2).
interpret((Goal :- given,C)):-
write(Goal),
write(' was given. CF = '), write(C),nl,nl.
interpret((not(Proof), C)) :-
extract_body(Proof,Goal),
write('not '),
write(Goal),
write(' CF = '), write(C),nl,nl,
interpret(Proof).
interpret((Goal :- true,C)) :-
write(Goal),
write(' is a fact, CF = '),write(C),nl.
interpret(Proof) :-
is_rule(Proof,Head,Body,Proof1,C),
nl,write(Head),write(' CF = '),
write(C), nl,write('was proved using the rule'),nl,nl,
rule((Head :- Body),CF),
display_rule(rule(Head, Body,CF)), nl,
interpret(Proof1).
% isrule(Proof,Goal,Body,Proof,CF)
% If Proof is of the form Goal :- Proof, extracts
% rule Body from Proof.
is_rule((Goal :- Proof,C),Goal, Body, Proof,C) :-
not(member(Proof, [true,given])),
extract_body(Proof,Body).
% extract_body(Proof).
% extracts the body of the top level rule from Proof.
extract_body((not(Proof), C), (not(Body))) :-
extract_body(Proof,Body).
extract_body((Proof1,Proof2),(Body1,Body2)) :-
!,extract_body(Proof1,Body1),
extract_body(Proof2,Body2).
extract_body((Goal :- Proof,C),Goal).
% Utility Predicates.
retractm(X) :- retract(X), fail.
retractm(X) :- retract((X:-Y)), fail.
retractm(X).
member(X,[X|_]).
member(X,[_|T]) :- member(X,T).
minimum(X,Y,X) :- X =< Y.
minimum(X,Y,Y) :- Y < X.
above_threshold(X,1) :- X >= 20.
above_threshold(X,-1) :- X =< -20.
Close Window