Hi, i have a problem.
I wrote an expert system for a school project.
My teacher said that what I did is not enough, that i need some more features in it.
For now my expert system only gets yes, no and why, and in the end it shows how it got to the solution.
I need ideas for some more features and if posible also how to write them.
The program was written in lpa win prolog 4.04
This is the code:
shell.pl
:- op(900, xfx, :
.
:- op(800, xfx, was).
:- op(870, fx, if).
:- op(880, xfx, then).
:- op(550, xfy, or).
:- op(540, xfy, and).
:- op(300, fx, 'derived by').
:- op(600, xfx, from).
:- op(600, xfx, by).
% Procedure
%
% explore(Goal, Trace, Answer)
%
% finds Answer to a given Goal. Trace is a chain of ancestor
% goals and rules. 'explore' tends to find a positive answer
% to a question. Answer is 'false' only when all the possibilities
% have been investigated and they all resulted in 'false'.
explore(Goal, Trace, Goal is true was 'found as a fact') :-
fact :: Goal.
% Assume only one rule about each type of goal.
explore(Goal, Trace, Goal is TruthValue was 'derived by' Rule from Answer) :-
Rule :: if Condition then Goal, % Rule relevant to Goal.
explore(Condition, [Goal by Rule|Trace], Answer),
truth(Answer, TruthValue).
explore(Goal1 and Goal2, Trace, Answer) :- !,
explore(Goal1, Trace, Answer1),
continue(Answer1, Goal1 and Goal2, Trace, Answer).
explore(Goal1 or Goal2, Trace, Answer) :-
exploreyes(Goal1, Trace, Answer) % Positive answer to Goal1.
;
exploreyes(Goal2, Trace, Answer). % Positive answer to Goal2.
explore(Goal1 or Goal2, Trace, Answer1 and Answer2) :- !,
not exploreyes(Goal1, Trace, _),
not exploreyes(Goal2, Trace, _), % No positive answer.
explore(Goal1, Trace, Answer1), % Answer1 must be negative.
explore(Goal2, Trace, Answer2). % Answer2 must be negative.
explore(Goal, Trace, Goal is Answer was told) :-
useranswer(Goal, Trace, Answer). % user-supplied answer.
exploreyes(Goal, Trace, Answer) :-
explore(Goal, Trace, Answer),
positive(Answer).
continue(Answer1, Goal1 and Goal2, Trace, Answer) :-
positive(Answer1),
explore(Goal2, Trace, Answer2),
(positive(Answer2),
Answer = Answer1 and Answer2
;
negative(Answer2),
Answer = Answer2
).
continue(Answer1, Goal1 and Goal2, _, Answer1) :-
negative(Answer1).
truth(Question is TruthValue was Found, TruthValue) :- !.
truth(Answer1 and Answer2, TruthValue) :-
truth(Answer1, true),
truth(Answer2, true), !,
TruthValue = true
;
TruthValue = false.
positive(Answer) :-
truth(Answer, true).
negative(Answer) :-
truth(Answer, false).
getreply(Reply) :-
read(Answer),
means(Answer, Reply), ! % Answer means something?
;
nl, write('Answer unknown, try again please'), nl, % No.
getreply(Reply).
means(yes, yes).
means(y, yes).
means(no, no).
means(n, no).
means(why, why).
means(w, why).
% Procedure
%
% useranswer(Goal, Trace, Answer)
%
% generates, trough backtracking, user-supplied solutions to Goal.
% Trace is a chain of ancestor goals and rules used for 'why' explanation.
useranswer(Goal, Trace, Answer) :-
askable(Goal, _), % May be asked of the user.
freshcopy(Goal, Copy), % variables in Goal renamed.
useranswer(Goal, Copy, Trace, Answer, 1).
% Do not ask again about an instantiated goal
useranswer(Goal, _, _, _, N) :-
N > 1, % Repeated question?
instantiated(Goal), !, % No variables in Goal.
fail. % Do not ask again.
% Is Goal implied true, neutral or false for all instantiations?
useranswer(Goal, Copy, _, Answer, _) :-
wastold(Copy, Answer, _),
instance_of(Copy, Goal), !. % Answer to goal implied.
% Retrieve known solutions, indexed from N on, for Goal.
useranswer(Goal, _, _, true, N) :-
wastold(Goal, true, M),
M >= N.
% Has everything already been said about Goal?
useranswer(Goal, Copy, _, Answer, _) :-
end_answers(Copy),
instance_of(Copy, Goal), !, % Everything was already said about Goal.
fail.
% Ask the user for (more) solutions.
useranswer(Goal, _, Trace, Answer, N) :-
askuser(Goal, Trace, Answer, N). % Try again.
askuser(Goal, Trace, Answer, N) :-
askable(Goal, ExternFormat),
format(Goal, ExternFormat, Question, [], Variables), % Get question format.
ask(Goal, Question, Variables, Trace, Answer, N).
ask(Goal, Question, Variables, Trace, Answer, N) :-
nl,
(Variables = [], !,
write('Is it true: ') % Introduce question.
;
write('Any (more) solutions to: ') % Introduce question.
),
write(Question), write('? '),
getreply(Reply), !, % Reply = yes/no/maybe/why.
process(Reply, Goal, Question, Variables, Trace, Answer, N).
process(why, Goal, Question, Variables, Trace, Answer, N) :-
showtrace(Trace),
ask(Goal, Question, Variables, Trace, Answer, N).
process(yes, Goal, _, Variables, Trace, true, N) :-
nextindex(Next), % Get new free index for 'wastold'.
Next1 is Next + 1,
(askvars(Variables),
assertz(wastold(Goal, true, Next)) % Record solution.
;
freshcopy(Goal, Copy), % Copy of Goal.
useranswer(Goal, Copy, Trace, Answer, Next1)
).
process(no, Goal, _, _, _, false, N) :-
freshcopy(Goal, Copy),
wastold(Copy, true, _), !, % 'no' means: no more solutions.
assertz(end_answers(Goal)), % Mark end of answers.
fail
;
nextindex(Next), % Next free index for 'wastold'.
assertz(wastold(Goal, false, Next)). % 'no' means: no solution.
format(Var, Name, Name, Vars, [Var/Name|Vars]) :-
var(Var), !.
format(Atom, Name, Atom, Vars, Vars) :-
atomic(Atom), !,
atomic(Name).
format(Goal, Form, Question, Vars0, Vars) :-
Goal =.. [Functor|Args1],
Form =.. [Functor|Forms],
formatall(Args1, Forms, Args2, Vars0, Vars),
Question =.. [Functor|Args2].
formatall([], [], [], Vars, Vars).
formatall([X|XL], [F|FL], [Q|QL], Vars0, Vars) :-
formatall(XL, FL, QL, Vars0, Vars1),
format(X, F, Q, Vars1, Vars).
askvars([]).
askvars([Variable/Name|Variables]) :-
nl, write(Name), write(' = '),
read(Variable),
askvars(Variables).
showtrace([]) :-
nl, write('This was your question'), nl.
showtrace([Goal by Rule|Trace]) :-
nl, write('To investigate, by '),
write(Rule), write(', '),
write(Goal),
showtrace(Trace).
instantiated(Term) :-
numbervars(Term, 0, 0). % No variables in Term.
% instance_of(T1, T2): instance of T1 is T2; that is,
% term T1 is more general than T2 or equally general as T2.
instance_of(Term, Term1) :- % instance of Term is Term1.
freshcopy(Term1, Term2), % Copy of Term1 with fresh set of variables.
numbervars(Term2, 0, _), !,
Term = Term2. % This succeeds if Term1 is instance of Term.
freshcopy(Term, FreshTerm) :- % Make a copy of Term with variables renamed.
asserta(copy(Term)),
retract(copy(FreshTerm)), !.
nextindex(Next) :-
retract(lastindex(Last)), !,
Next is Last + 1,
assert(lastindex(Next)).
% Initialize dynamic procedures lastindex/1, wastold/3, end_answers/1.
:-
assertz(lastindex(0)),
assertz(wastold(dummy, false, 0)),
assertz(end_answers(dummy)).
% Displaying the conclusion of a consultation and 'how' explanation.
present(Answer) :-
nl, showconclusion(Answer),
nl, write('Would you like to see how?'),
getreply(Reply),
(Reply = yes, !,
show(Answer) % Show solution tree.
;
true
).
showconclusion(Answer1 and Answer2) :- !,
showconclusion(Answer1), write(' and '),
showconclusion(Answer2).
showconclusion(Conclusion was Found) :-
write(Conclusion).
% 'show' displays a complete solution tree.
show(Solution) :-
nl, show(Solution, 0), !. % Indent by 0.
show(Answer1 and Answer2, H) :- !, % Indent by H.
show(Answer1, H),
tab(H), write('and'), nl,
show(Answer2, H).
show(Answer was Found, H) :- % Indent by H.
tab(H), writeans(Answer), % Show conclusion.
nl, tab(H),
write('was '),
show1(Found, H). % Show evidence.
show1(Derived from Answer, H) :- !,
write(Derived), write(' from '), % Show rule name.
nl, H1 is H + 4,
show(Answer, H1). % Show antecedent.
show1(Found, _) :- % Found = 'told' or 'found as fact'.
write(Found), nl.
writeans(Goal is true) :- !,
write(Goal). % Omit 'is true' on output.
writeans(Answer) :- % This is negative answer.
write(Answer).
% Top-level driving procedure
expert :-
getquestion(Question), % Input user's question.
(answeryes(Question) % Try to find positive answers.
;
answerno(Question) % Else find negative answers.
).
answeryes(Question) :- % Look for positive answers to Question.
markstatus(negative), % No positive answer yet.
explore(Question, [], Answer), % Trace is empty.
positive(Answer), % Look for positive answers.
markstatus(positive), % Positive answer found.
present(Answer), nl,
write('More solutions?'),
getreply(Reply), % Read user's reply.
Reply = no. % Otherwise backtrack to 'explore'.
answerno(Question) :- % Look for negative answer to Question.
retract(no_positive_answer_yet), !, % Has there been no positive answer?
explore(Question, [], Answer),
negative(Answer),
present(Answer), nl,
write('More negative solutions?'),
getreply(Reply),
Reply = no. % Otherwise backtrack to 'explore'.
markstatus(negative) :-
assert(no_positive_answer_yet).
markstatus(positive) :-
retract(no_positive_answer_yet), !
;
true.
getquestion(Question) :-
nl, write('Question, please'), nl,
read(Question).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
database.pl
:- op(100, xfx, [has, 'is named', isa, can, 'originates from', 'color is',
inhabits, 'size is', 'lifespan is', eats, lacks, enjoys,
lays, prefers, swims, 'is a', 'is part of']).
:- op(200, xf, [squeaks, spawns, family, subfamily]).
'part of anabantoid family' ::
if
Fish can 'live in water lacking oxygen'
and
Fish can 'build a nest of floating bubbles and mucus'
and
Fish spawns
then
Fish 'is part of' anabantoid family.
'part of catfish family' ::
if
Fish can 'breath air'
and
Fish lays eggs
then
Fish 'is part of' catfish family.
'part of loache family' ::
if
Fish 'is a' 'bottom dwelling scavenger'
and
Fish has 'a small mouth'
and
Fish inhabits 'rapid moving streams'
and
Fish has 'a slender body'
and
Fish lacks 'true scales'
and
Fish has 'spines beneath the eye'
then
Fish 'is part of' loache family .
'part of belontiidae subfamily' ::
if
Fish 'is part of' anabantoid family
and
Fish inhabits freshwater
then
Fish 'is part of' belontiidae subfamily.
'part of helostomatidae subfamily' ::
if
Fish 'is part of' anabantoid family
and
Fish lacks 'threadlike pelvic fins'
then
Fish 'is part of' helostomatidae subfamily.
'part of callichthyidae subfamily' ::
if
Fish 'is part of' catfish family
and
Fish has 'bony armor'
then
Fish 'is part of' callichthyidae subfamily.
'part of schilbeidae subfamily' ::
if
Fish 'is part of' catfish family
and
Fish has 'dorsal fins with short base'
and
Fish has '1 spine'
and
Fish inhabits 'the freshwater'
and
Fish lacks 'nasal barbels'
then
Fish 'is part of' schilbeidae subfamily.
'part of auchenipteridae subfamily' ::
if
Fish 'is part of' catfish family
and
Fish has 'pectoral fins'
and
Fish has 'dorsal fins'
and
Fish has 'a strong spine'
and
Fish has 'a bony head plate'
and
Fish has 'naked flanks'
then
Fish 'is part of' auchenipteridae subfamily.
'part of loricariidae subfamily' ::
if
Fish 'is part of' catfish family
and
Fish has 'bony plates'
and
Fish has 'sharp spines'
and
Fish has 'a sucker shaped mouth'
then
Fish 'is part of' loricariidae subfamily.
'part of ariidae subfamily' ::
if
Fish 'is part of' catfish family
and
(Fish inhabits 'the tropical waters'
or
Fish inhabits 'the subtropical waters')
then
Fish 'is part of' ariidae subfamily.
'part of pimelodidae subfamily' ::
if
Fish 'is part of' catfish family
and
Fish has 'a forked tail'
and
Fish inhabits 'flowing waters'
and
Fish has 'three pairs of barbels'
and
Fish has 'a naked body'
then
Fish 'is part of' pimelodidae subfamily.
'part of mochokidae subfamily' ::
if
Fish 'is part of' catfish family
and
Fish squeaks
and
Fish has 'feathered barbels'
then
Fish 'is part of' mochokidae subfamily.
'part of cobitidae subfamily' ::
if
Fish 'is part of' loache family
and
Fish has '3-6 pairs barbels'
and
Fish has 'erectile spine below eye'
and
Fish has 'mucus on body'
and
Fish lays eggs
then
Fish 'is part of' cobitidae subfamily.
'a betta' ::
if
Fish 'is part of' belontiidae subfamily
and
Fish has 'brilliant coloration'
and
Fish has 'long flowing fins'
and
(Fish 'originates from' cambodia
or
Fish 'originates from' thailand)
and
Fish 'size is' '7 cm'
and
Fish 'lifespan is' '2-3 years'
and
(Fish eats 'live foods'
or
Fish eats flakes
or
Fish eats 'frozen foods')
then
Fish 'is named' betta.
'a three spot gourami' ::
if
Fish 'is part of' belontiidae subfamily
and
Fish 'color is' 'silvery blue'
and
Fish can 'change colors with their moods'
and
(Fish 'originates from' malaysia
or
Fish 'originates from' thailand
or
Fish 'originates from' burma
or
Fish 'originates from' vietnam)
and
Fish 'size is' '10 cm'
and
Fish 'lifespan is' '4 years'
and
Fish eats 'most foods'
then
Fish 'is named' 'three spot gourami'.
'a dwarf gourami' ::
if
Fish 'is part of' belontiidae subfamily
and
Fish 'color is' 'orange red'
and
Fish has 'turquoise blue vertical stripes'
and
(Fish 'originates from' ganges
or
Fish 'originates from' gumna
or
Fish 'originates from' bramaputra)
and
Fish 'size is' '7 cm'
and
Fish 'lifespan is' '4 years'
and
Fish eats algae
then
Fish 'is named' 'dwarf gourami'.
'a honey gourami' ::
if
Fish 'is part of' belontiidae subfamily
and
Fish 'color is' gold
and
Fish 'originates from' bangladesh
and
Fish 'size is' '5 cm'
and
Fish 'lifespan is' '4 years'
and
Fish eats 'most foods'
then
Fish 'is named' 'honey gourami'.
'a kissing gourami' ::
if
Fish 'is part of' helostomatidae subfamily
and
(Fish 'originates from' thailand
or
Fish 'originates from' java)
and
(Fish 'color is' pink
or
Fish 'color is' flesh
or
Fish 'color is' 'silver green')
and
Fish 'size is' '15-30 cm'
and
Fish 'lifespan is' '5 years'
and
Fish eats 'most foods'
then
Fish 'is named' 'kissing gourami'.
'a moonlight gourami' ::
if
Fish 'is part of' belontiidae subfamily
and
Fish 'color is' silvery
and
Fish has 'slightly greenish hue'
and
(Fish 'originates from' thailand
or
Fish 'originates from' cambodia)
and
Fish 'size is' '15 cm'
and
Fish 'lifespan is' '4 years'
and
Fish eats 'most foods'
then
Fish 'is named' 'moonlight gourami'.
'a pearl gourami' ::
if
Fish 'is part of' belontiidae subfamily
and
Fish 'color is' pearl
and
Fish has 'brown flecks'
and
(Fish 'originates from' malaysia
or
Fish 'originates from' borneo
or
Fish 'originates from' sumatra)
and
Fish 'size is' '10 cm'
and
Fish 'lifespan is' '8 years'
and
Fish eats 'most foods'
then
Fish 'is named' 'pearl gourami'.
'a adolfos cory' ::
if
Fish 'is part of' callichthyidae subfamily
and
Fish 'originates from' brazil
and
Fish 'size is' '6 cm'
and
Fish 'lifespan is' '5 years'
and
Fish eats 'most foods'
and
Fish enjoys 'live food'
then
Fish 'is named' 'adolfos cory'.
'a debauwi cat' ::
if
Fish 'is part of' schilbeidae subfamily
and
(Fish 'originates from' africa
or
Fish 'originates from' nigeria)
and
Fish 'size is' '8 cm'
and
Fish 'lifespan is' '8 years'
and
Fish eats 'most foods'
then
Fish 'is named' 'debauwi cat'.
'a albino driftwood catfish' ::
if
Fish 'is part of' auchenipteridae subfamily
and
Fish 'originates from' 'south america'
and
Fish 'size is' '15 cm'
and
Fish 'lifespan is' '8 years'
and
Fish eats 'eats most foods'
then
Fish 'is named' 'albino driftwood catfish'.
'a bandit cory' ::
if
Fish 'is part of' callichthyidae subfamily
and
Fish 'originates from' colombia
and
Fish 'size is' '5 cm'
and
Fish 'lifespan is' '5 years'
and
Fish eats 'most foods'
then
Fish 'is named' 'bandit cory'.
'a blackfin cory' ::
if
Fish 'is part of' callichthyidae subfamily
and
(Fish 'originates from' colombia
or
Fish 'originates from' peru)
and
Fish 'size is' '4.5 cm'
and
Fish 'lifespan is' '5+ years'
and
Fish eats 'most foods'
then
Fish 'is named' 'blackfin cory'.
'a bronze cory' ::
if
Fish 'is part of' callichthyidae subfamily
and
(Fish 'originates from' argentina
or
Fish 'originates from' colombia
or
Fish 'originates from' venezuela)
and
Fish 'size is' '6 cm'
and
Fish 'lifespan is' '5 years'
and
Fish eats 'most foods'
and
(Fish 'color is' bronze
or
Fish 'color is' albino
or
Fish 'color is' black
or
Fish 'color is' green)
and
Fish has 'overlapping scales'
then
Fish 'is named' 'bronze cory'.
'a giant whiptail' ::
if
Fish 'is part of' loricariidae subfamily
and
(Fish 'originates from' colombia
or
Fish 'originates from' 'south america')
and
Fish 'size is' '22 cm'
and
Fish 'lifespan is' '10+ years'
and
Fish eats 'plants'
and
Fish eats 'at night'
then
Fish 'is named' 'giant whiptail'.
'a hog nosed brochis' ::
if
Fish 'is part of' callichthyidae subfamily
and
Fish 'originates from' ecuador
and
Fish 'size is' '8 cm'
and
Fish 'lifespan is' '10 years'
and
Fish eats 'most foods'
then
Fish 'is named' 'hog nosed brochis'.
'a jordans catfish' ::
if
Fish 'is part of' ariidae subfamily
and
(Fish 'originates from' california
or
Fish 'originates from' mexico
or
Fish 'originates from' colombia)
and
Fish 'size is' '35 cm'
and
Fish 'lifespan is' '10+ years'
and
Fish eats 'most foods'
then
Fish 'is named' 'jordans catfish'.
'a otocinclus' ::
if
Fish 'is part of' loricariidae subfamily
and
Fish 'originates from' 'southeastern brazil'
and
Fish 'size is' '4 cm'
and
Fish 'lifespan is' '5 years'
and
Fish eats 'plants'
then
Fish 'is named' otocinclus.
'a pictus catfish' ::
if
Fish 'is part of' pimelodidae subfamily
and
(Fish 'originates from' colombia
or
Fish 'originates from' 'south america')
and
Fish 'size is' '11 cm'
and
Fish 'lifespan is' '8 years'
and
Fish eats 'most foods'
then
Fish 'is named' 'pictus catfish'.
'a redtail catfish' ::
if
Fish 'is part of' pimelodidae subfamily
and
(Fish 'originates from' brazil
or
Fish 'originates from' 'rio negro'
or
Fish 'originates from' venezuela)
and
Fish 'size is' 'up to 60 cm'
and
Fish 'lifespan is' '15 years'
and
Fish eats fish
then
Fish 'is named' 'redtail catfish'.
'a royal pleco' ::
if
Fish 'is part of' loricariidae subfamily
and
Fish 'originates from' 'southern colombia'
and
Fish 'size is' '25 cm'
and
Fish 'lifespan is' '10+ years'
and
Fish eats 'plants'
and
Fish prefers algae
then
Fish 'is named' 'royal pleco'.
'a upside down catfish' ::
if
Fish 'is part of' mochokidae subfamily
and
(Fish 'originates from' zaire
or
Fish 'originates from' 'niger river basin')
and
Fish 'size is' '20 cm'
and
Fish 'lifespan is' '5+ years'
and
Fish eats 'most foods'
and
Fish swims 'upside down'
and
Fish has 'large eyes'
and
Fish has 'a large adipose fin'
and
Fish has 'a forked tail'
and
Fish has 'three pairs of barbels'
and
Fish 'color is' 'light brown'
and
Fish has 'dark brown blotches'
then
Fish 'is named' 'upside down catfish'.
'a clown loach' ::
if
Fish 'is part of' cobitidae subfamily
and
(Fish 'originates from' indonesia
or
Fish 'originates from' sumatra
or
Fish 'originates from' borneo)
and
Fish 'size is' '15 cm'
and
Fish 'lifespan is' '15+ years'
and
Fish eats 'most foods'
and
Fish has 'orange and black stripes'
and
Fish has 'red fins'
then
Fish 'is named' 'clown loach'.
'a weather loach' ::
if
Fish 'is part of' cobitidae subfamily
and
(Fish 'originates from' asia
or
Fish 'originates from' china
or
Fish 'originates from' korea
or
Fish 'originates from' japan)
and
Fish 'size is' '30 cm'
and
Fish 'lifespan is' '10 years'
and
Fish eats 'most foods'
and
Fish can 'predict the weather'
and
(Fish 'color is' olive
or
Fish 'color is' gold)
and
(Fish has 'stripes from head to tail'
or
Fish has 'many spots')
and
Fish has 'Ten sensitive barbels around the mouth'
and
Fish inhabits freshwaters
then
Fish 'is named' 'weather loach'.
fact :: X isa fish :-
member(X, [betta, 'three spot gourami', 'dwarf gourami', 'honey gourami', 'kissing gourami',
'moonlight gourami', 'pearl gourami', 'adolfos cory', 'debauwi cat', 'albino driftwood catfish',
'bandit cory', 'blackfin cory', 'bronze cory', 'giant whiptail', 'hog nosed brochis', 'jordans catfish',
otocinclus, 'pictus catfish', 'redtail catfish', 'royal pleco', 'upside down catfish', 'clown loach',
'weather loach']).
askable(_ 'color is' _, 'Fish' 'color is' 'What').
askable(_ has _, 'Fish' has 'Something').
askable(_ can _, 'Fish' can 'What').
askable(_ spawns, 'Fish' spawns).
askable(_ 'originates from' _, 'Fish' 'originates from' 'Where').
askable(_ inhabits _, 'Fish' inhabits 'Somewhere').
askable(_ 'size is' _, 'Fish' 'size is' 'What').
askable(_ 'lifespan is' _, 'Fish' 'lifespan is' 'What').
askable(_ eats _, 'Fish' eats 'Something').
askable(_ lacks _,'Fish' lacks 'What').
askable(_ enjoys _, 'Fish' enjoys 'Something').
askable(_ lays eggs, 'Fish' lays eggs).
askable(_ prefers _, 'Fish' prefers 'What').
askable(_ squeaks, 'Fish' squeaks).
askable(_ swims _, 'Fish' swims 'How').
askable(_ 'is a' _, 'Fish' 'is a' 'Something').
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
You need to type: expert.
and than:
X isa fish and dj 'is named' X.
to see what it does.
Please help me
Thanks,
gadtab
I wrote an expert system for a school project.
My teacher said that what I did is not enough, that i need some more features in it.
For now my expert system only gets yes, no and why, and in the end it shows how it got to the solution.
I need ideas for some more features and if posible also how to write them.
The program was written in lpa win prolog 4.04
This is the code:
shell.pl
:- op(900, xfx, :
.:- op(800, xfx, was).
:- op(870, fx, if).
:- op(880, xfx, then).
:- op(550, xfy, or).
:- op(540, xfy, and).
:- op(300, fx, 'derived by').
:- op(600, xfx, from).
:- op(600, xfx, by).
% Procedure
%
% explore(Goal, Trace, Answer)
%
% finds Answer to a given Goal. Trace is a chain of ancestor
% goals and rules. 'explore' tends to find a positive answer
% to a question. Answer is 'false' only when all the possibilities
% have been investigated and they all resulted in 'false'.
explore(Goal, Trace, Goal is true was 'found as a fact') :-
fact :: Goal.
% Assume only one rule about each type of goal.
explore(Goal, Trace, Goal is TruthValue was 'derived by' Rule from Answer) :-
Rule :: if Condition then Goal, % Rule relevant to Goal.
explore(Condition, [Goal by Rule|Trace], Answer),
truth(Answer, TruthValue).
explore(Goal1 and Goal2, Trace, Answer) :- !,
explore(Goal1, Trace, Answer1),
continue(Answer1, Goal1 and Goal2, Trace, Answer).
explore(Goal1 or Goal2, Trace, Answer) :-
exploreyes(Goal1, Trace, Answer) % Positive answer to Goal1.
;
exploreyes(Goal2, Trace, Answer). % Positive answer to Goal2.
explore(Goal1 or Goal2, Trace, Answer1 and Answer2) :- !,
not exploreyes(Goal1, Trace, _),
not exploreyes(Goal2, Trace, _), % No positive answer.
explore(Goal1, Trace, Answer1), % Answer1 must be negative.
explore(Goal2, Trace, Answer2). % Answer2 must be negative.
explore(Goal, Trace, Goal is Answer was told) :-
useranswer(Goal, Trace, Answer). % user-supplied answer.
exploreyes(Goal, Trace, Answer) :-
explore(Goal, Trace, Answer),
positive(Answer).
continue(Answer1, Goal1 and Goal2, Trace, Answer) :-
positive(Answer1),
explore(Goal2, Trace, Answer2),
(positive(Answer2),
Answer = Answer1 and Answer2
;
negative(Answer2),
Answer = Answer2
).
continue(Answer1, Goal1 and Goal2, _, Answer1) :-
negative(Answer1).
truth(Question is TruthValue was Found, TruthValue) :- !.
truth(Answer1 and Answer2, TruthValue) :-
truth(Answer1, true),
truth(Answer2, true), !,
TruthValue = true
;
TruthValue = false.
positive(Answer) :-
truth(Answer, true).
negative(Answer) :-
truth(Answer, false).
getreply(Reply) :-
read(Answer),
means(Answer, Reply), ! % Answer means something?
;
nl, write('Answer unknown, try again please'), nl, % No.
getreply(Reply).
means(yes, yes).
means(y, yes).
means(no, no).
means(n, no).
means(why, why).
means(w, why).
% Procedure
%
% useranswer(Goal, Trace, Answer)
%
% generates, trough backtracking, user-supplied solutions to Goal.
% Trace is a chain of ancestor goals and rules used for 'why' explanation.
useranswer(Goal, Trace, Answer) :-
askable(Goal, _), % May be asked of the user.
freshcopy(Goal, Copy), % variables in Goal renamed.
useranswer(Goal, Copy, Trace, Answer, 1).
% Do not ask again about an instantiated goal
useranswer(Goal, _, _, _, N) :-
N > 1, % Repeated question?
instantiated(Goal), !, % No variables in Goal.
fail. % Do not ask again.
% Is Goal implied true, neutral or false for all instantiations?
useranswer(Goal, Copy, _, Answer, _) :-
wastold(Copy, Answer, _),
instance_of(Copy, Goal), !. % Answer to goal implied.
% Retrieve known solutions, indexed from N on, for Goal.
useranswer(Goal, _, _, true, N) :-
wastold(Goal, true, M),
M >= N.
% Has everything already been said about Goal?
useranswer(Goal, Copy, _, Answer, _) :-
end_answers(Copy),
instance_of(Copy, Goal), !, % Everything was already said about Goal.
fail.
% Ask the user for (more) solutions.
useranswer(Goal, _, Trace, Answer, N) :-
askuser(Goal, Trace, Answer, N). % Try again.
askuser(Goal, Trace, Answer, N) :-
askable(Goal, ExternFormat),
format(Goal, ExternFormat, Question, [], Variables), % Get question format.
ask(Goal, Question, Variables, Trace, Answer, N).
ask(Goal, Question, Variables, Trace, Answer, N) :-
nl,
(Variables = [], !,
write('Is it true: ') % Introduce question.
;
write('Any (more) solutions to: ') % Introduce question.
),
write(Question), write('? '),
getreply(Reply), !, % Reply = yes/no/maybe/why.
process(Reply, Goal, Question, Variables, Trace, Answer, N).
process(why, Goal, Question, Variables, Trace, Answer, N) :-
showtrace(Trace),
ask(Goal, Question, Variables, Trace, Answer, N).
process(yes, Goal, _, Variables, Trace, true, N) :-
nextindex(Next), % Get new free index for 'wastold'.
Next1 is Next + 1,
(askvars(Variables),
assertz(wastold(Goal, true, Next)) % Record solution.
;
freshcopy(Goal, Copy), % Copy of Goal.
useranswer(Goal, Copy, Trace, Answer, Next1)
).
process(no, Goal, _, _, _, false, N) :-
freshcopy(Goal, Copy),
wastold(Copy, true, _), !, % 'no' means: no more solutions.
assertz(end_answers(Goal)), % Mark end of answers.
fail
;
nextindex(Next), % Next free index for 'wastold'.
assertz(wastold(Goal, false, Next)). % 'no' means: no solution.
format(Var, Name, Name, Vars, [Var/Name|Vars]) :-
var(Var), !.
format(Atom, Name, Atom, Vars, Vars) :-
atomic(Atom), !,
atomic(Name).
format(Goal, Form, Question, Vars0, Vars) :-
Goal =.. [Functor|Args1],
Form =.. [Functor|Forms],
formatall(Args1, Forms, Args2, Vars0, Vars),
Question =.. [Functor|Args2].
formatall([], [], [], Vars, Vars).
formatall([X|XL], [F|FL], [Q|QL], Vars0, Vars) :-
formatall(XL, FL, QL, Vars0, Vars1),
format(X, F, Q, Vars1, Vars).
askvars([]).
askvars([Variable/Name|Variables]) :-
nl, write(Name), write(' = '),
read(Variable),
askvars(Variables).
showtrace([]) :-
nl, write('This was your question'), nl.
showtrace([Goal by Rule|Trace]) :-
nl, write('To investigate, by '),
write(Rule), write(', '),
write(Goal),
showtrace(Trace).
instantiated(Term) :-
numbervars(Term, 0, 0). % No variables in Term.
% instance_of(T1, T2): instance of T1 is T2; that is,
% term T1 is more general than T2 or equally general as T2.
instance_of(Term, Term1) :- % instance of Term is Term1.
freshcopy(Term1, Term2), % Copy of Term1 with fresh set of variables.
numbervars(Term2, 0, _), !,
Term = Term2. % This succeeds if Term1 is instance of Term.
freshcopy(Term, FreshTerm) :- % Make a copy of Term with variables renamed.
asserta(copy(Term)),
retract(copy(FreshTerm)), !.
nextindex(Next) :-
retract(lastindex(Last)), !,
Next is Last + 1,
assert(lastindex(Next)).
% Initialize dynamic procedures lastindex/1, wastold/3, end_answers/1.
:-
assertz(lastindex(0)),
assertz(wastold(dummy, false, 0)),
assertz(end_answers(dummy)).
% Displaying the conclusion of a consultation and 'how' explanation.
present(Answer) :-
nl, showconclusion(Answer),
nl, write('Would you like to see how?'),
getreply(Reply),
(Reply = yes, !,
show(Answer) % Show solution tree.
;
true
).
showconclusion(Answer1 and Answer2) :- !,
showconclusion(Answer1), write(' and '),
showconclusion(Answer2).
showconclusion(Conclusion was Found) :-
write(Conclusion).
% 'show' displays a complete solution tree.
show(Solution) :-
nl, show(Solution, 0), !. % Indent by 0.
show(Answer1 and Answer2, H) :- !, % Indent by H.
show(Answer1, H),
tab(H), write('and'), nl,
show(Answer2, H).
show(Answer was Found, H) :- % Indent by H.
tab(H), writeans(Answer), % Show conclusion.
nl, tab(H),
write('was '),
show1(Found, H). % Show evidence.
show1(Derived from Answer, H) :- !,
write(Derived), write(' from '), % Show rule name.
nl, H1 is H + 4,
show(Answer, H1). % Show antecedent.
show1(Found, _) :- % Found = 'told' or 'found as fact'.
write(Found), nl.
writeans(Goal is true) :- !,
write(Goal). % Omit 'is true' on output.
writeans(Answer) :- % This is negative answer.
write(Answer).
% Top-level driving procedure
expert :-
getquestion(Question), % Input user's question.
(answeryes(Question) % Try to find positive answers.
;
answerno(Question) % Else find negative answers.
).
answeryes(Question) :- % Look for positive answers to Question.
markstatus(negative), % No positive answer yet.
explore(Question, [], Answer), % Trace is empty.
positive(Answer), % Look for positive answers.
markstatus(positive), % Positive answer found.
present(Answer), nl,
write('More solutions?'),
getreply(Reply), % Read user's reply.
Reply = no. % Otherwise backtrack to 'explore'.
answerno(Question) :- % Look for negative answer to Question.
retract(no_positive_answer_yet), !, % Has there been no positive answer?
explore(Question, [], Answer),
negative(Answer),
present(Answer), nl,
write('More negative solutions?'),
getreply(Reply),
Reply = no. % Otherwise backtrack to 'explore'.
markstatus(negative) :-
assert(no_positive_answer_yet).
markstatus(positive) :-
retract(no_positive_answer_yet), !
;
true.
getquestion(Question) :-
nl, write('Question, please'), nl,
read(Question).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
database.pl
:- op(100, xfx, [has, 'is named', isa, can, 'originates from', 'color is',
inhabits, 'size is', 'lifespan is', eats, lacks, enjoys,
lays, prefers, swims, 'is a', 'is part of']).
:- op(200, xf, [squeaks, spawns, family, subfamily]).
'part of anabantoid family' ::
if
Fish can 'live in water lacking oxygen'
and
Fish can 'build a nest of floating bubbles and mucus'
and
Fish spawns
then
Fish 'is part of' anabantoid family.
'part of catfish family' ::
if
Fish can 'breath air'
and
Fish lays eggs
then
Fish 'is part of' catfish family.
'part of loache family' ::
if
Fish 'is a' 'bottom dwelling scavenger'
and
Fish has 'a small mouth'
and
Fish inhabits 'rapid moving streams'
and
Fish has 'a slender body'
and
Fish lacks 'true scales'
and
Fish has 'spines beneath the eye'
then
Fish 'is part of' loache family .
'part of belontiidae subfamily' ::
if
Fish 'is part of' anabantoid family
and
Fish inhabits freshwater
then
Fish 'is part of' belontiidae subfamily.
'part of helostomatidae subfamily' ::
if
Fish 'is part of' anabantoid family
and
Fish lacks 'threadlike pelvic fins'
then
Fish 'is part of' helostomatidae subfamily.
'part of callichthyidae subfamily' ::
if
Fish 'is part of' catfish family
and
Fish has 'bony armor'
then
Fish 'is part of' callichthyidae subfamily.
'part of schilbeidae subfamily' ::
if
Fish 'is part of' catfish family
and
Fish has 'dorsal fins with short base'
and
Fish has '1 spine'
and
Fish inhabits 'the freshwater'
and
Fish lacks 'nasal barbels'
then
Fish 'is part of' schilbeidae subfamily.
'part of auchenipteridae subfamily' ::
if
Fish 'is part of' catfish family
and
Fish has 'pectoral fins'
and
Fish has 'dorsal fins'
and
Fish has 'a strong spine'
and
Fish has 'a bony head plate'
and
Fish has 'naked flanks'
then
Fish 'is part of' auchenipteridae subfamily.
'part of loricariidae subfamily' ::
if
Fish 'is part of' catfish family
and
Fish has 'bony plates'
and
Fish has 'sharp spines'
and
Fish has 'a sucker shaped mouth'
then
Fish 'is part of' loricariidae subfamily.
'part of ariidae subfamily' ::
if
Fish 'is part of' catfish family
and
(Fish inhabits 'the tropical waters'
or
Fish inhabits 'the subtropical waters')
then
Fish 'is part of' ariidae subfamily.
'part of pimelodidae subfamily' ::
if
Fish 'is part of' catfish family
and
Fish has 'a forked tail'
and
Fish inhabits 'flowing waters'
and
Fish has 'three pairs of barbels'
and
Fish has 'a naked body'
then
Fish 'is part of' pimelodidae subfamily.
'part of mochokidae subfamily' ::
if
Fish 'is part of' catfish family
and
Fish squeaks
and
Fish has 'feathered barbels'
then
Fish 'is part of' mochokidae subfamily.
'part of cobitidae subfamily' ::
if
Fish 'is part of' loache family
and
Fish has '3-6 pairs barbels'
and
Fish has 'erectile spine below eye'
and
Fish has 'mucus on body'
and
Fish lays eggs
then
Fish 'is part of' cobitidae subfamily.
'a betta' ::
if
Fish 'is part of' belontiidae subfamily
and
Fish has 'brilliant coloration'
and
Fish has 'long flowing fins'
and
(Fish 'originates from' cambodia
or
Fish 'originates from' thailand)
and
Fish 'size is' '7 cm'
and
Fish 'lifespan is' '2-3 years'
and
(Fish eats 'live foods'
or
Fish eats flakes
or
Fish eats 'frozen foods')
then
Fish 'is named' betta.
'a three spot gourami' ::
if
Fish 'is part of' belontiidae subfamily
and
Fish 'color is' 'silvery blue'
and
Fish can 'change colors with their moods'
and
(Fish 'originates from' malaysia
or
Fish 'originates from' thailand
or
Fish 'originates from' burma
or
Fish 'originates from' vietnam)
and
Fish 'size is' '10 cm'
and
Fish 'lifespan is' '4 years'
and
Fish eats 'most foods'
then
Fish 'is named' 'three spot gourami'.
'a dwarf gourami' ::
if
Fish 'is part of' belontiidae subfamily
and
Fish 'color is' 'orange red'
and
Fish has 'turquoise blue vertical stripes'
and
(Fish 'originates from' ganges
or
Fish 'originates from' gumna
or
Fish 'originates from' bramaputra)
and
Fish 'size is' '7 cm'
and
Fish 'lifespan is' '4 years'
and
Fish eats algae
then
Fish 'is named' 'dwarf gourami'.
'a honey gourami' ::
if
Fish 'is part of' belontiidae subfamily
and
Fish 'color is' gold
and
Fish 'originates from' bangladesh
and
Fish 'size is' '5 cm'
and
Fish 'lifespan is' '4 years'
and
Fish eats 'most foods'
then
Fish 'is named' 'honey gourami'.
'a kissing gourami' ::
if
Fish 'is part of' helostomatidae subfamily
and
(Fish 'originates from' thailand
or
Fish 'originates from' java)
and
(Fish 'color is' pink
or
Fish 'color is' flesh
or
Fish 'color is' 'silver green')
and
Fish 'size is' '15-30 cm'
and
Fish 'lifespan is' '5 years'
and
Fish eats 'most foods'
then
Fish 'is named' 'kissing gourami'.
'a moonlight gourami' ::
if
Fish 'is part of' belontiidae subfamily
and
Fish 'color is' silvery
and
Fish has 'slightly greenish hue'
and
(Fish 'originates from' thailand
or
Fish 'originates from' cambodia)
and
Fish 'size is' '15 cm'
and
Fish 'lifespan is' '4 years'
and
Fish eats 'most foods'
then
Fish 'is named' 'moonlight gourami'.
'a pearl gourami' ::
if
Fish 'is part of' belontiidae subfamily
and
Fish 'color is' pearl
and
Fish has 'brown flecks'
and
(Fish 'originates from' malaysia
or
Fish 'originates from' borneo
or
Fish 'originates from' sumatra)
and
Fish 'size is' '10 cm'
and
Fish 'lifespan is' '8 years'
and
Fish eats 'most foods'
then
Fish 'is named' 'pearl gourami'.
'a adolfos cory' ::
if
Fish 'is part of' callichthyidae subfamily
and
Fish 'originates from' brazil
and
Fish 'size is' '6 cm'
and
Fish 'lifespan is' '5 years'
and
Fish eats 'most foods'
and
Fish enjoys 'live food'
then
Fish 'is named' 'adolfos cory'.
'a debauwi cat' ::
if
Fish 'is part of' schilbeidae subfamily
and
(Fish 'originates from' africa
or
Fish 'originates from' nigeria)
and
Fish 'size is' '8 cm'
and
Fish 'lifespan is' '8 years'
and
Fish eats 'most foods'
then
Fish 'is named' 'debauwi cat'.
'a albino driftwood catfish' ::
if
Fish 'is part of' auchenipteridae subfamily
and
Fish 'originates from' 'south america'
and
Fish 'size is' '15 cm'
and
Fish 'lifespan is' '8 years'
and
Fish eats 'eats most foods'
then
Fish 'is named' 'albino driftwood catfish'.
'a bandit cory' ::
if
Fish 'is part of' callichthyidae subfamily
and
Fish 'originates from' colombia
and
Fish 'size is' '5 cm'
and
Fish 'lifespan is' '5 years'
and
Fish eats 'most foods'
then
Fish 'is named' 'bandit cory'.
'a blackfin cory' ::
if
Fish 'is part of' callichthyidae subfamily
and
(Fish 'originates from' colombia
or
Fish 'originates from' peru)
and
Fish 'size is' '4.5 cm'
and
Fish 'lifespan is' '5+ years'
and
Fish eats 'most foods'
then
Fish 'is named' 'blackfin cory'.
'a bronze cory' ::
if
Fish 'is part of' callichthyidae subfamily
and
(Fish 'originates from' argentina
or
Fish 'originates from' colombia
or
Fish 'originates from' venezuela)
and
Fish 'size is' '6 cm'
and
Fish 'lifespan is' '5 years'
and
Fish eats 'most foods'
and
(Fish 'color is' bronze
or
Fish 'color is' albino
or
Fish 'color is' black
or
Fish 'color is' green)
and
Fish has 'overlapping scales'
then
Fish 'is named' 'bronze cory'.
'a giant whiptail' ::
if
Fish 'is part of' loricariidae subfamily
and
(Fish 'originates from' colombia
or
Fish 'originates from' 'south america')
and
Fish 'size is' '22 cm'
and
Fish 'lifespan is' '10+ years'
and
Fish eats 'plants'
and
Fish eats 'at night'
then
Fish 'is named' 'giant whiptail'.
'a hog nosed brochis' ::
if
Fish 'is part of' callichthyidae subfamily
and
Fish 'originates from' ecuador
and
Fish 'size is' '8 cm'
and
Fish 'lifespan is' '10 years'
and
Fish eats 'most foods'
then
Fish 'is named' 'hog nosed brochis'.
'a jordans catfish' ::
if
Fish 'is part of' ariidae subfamily
and
(Fish 'originates from' california
or
Fish 'originates from' mexico
or
Fish 'originates from' colombia)
and
Fish 'size is' '35 cm'
and
Fish 'lifespan is' '10+ years'
and
Fish eats 'most foods'
then
Fish 'is named' 'jordans catfish'.
'a otocinclus' ::
if
Fish 'is part of' loricariidae subfamily
and
Fish 'originates from' 'southeastern brazil'
and
Fish 'size is' '4 cm'
and
Fish 'lifespan is' '5 years'
and
Fish eats 'plants'
then
Fish 'is named' otocinclus.
'a pictus catfish' ::
if
Fish 'is part of' pimelodidae subfamily
and
(Fish 'originates from' colombia
or
Fish 'originates from' 'south america')
and
Fish 'size is' '11 cm'
and
Fish 'lifespan is' '8 years'
and
Fish eats 'most foods'
then
Fish 'is named' 'pictus catfish'.
'a redtail catfish' ::
if
Fish 'is part of' pimelodidae subfamily
and
(Fish 'originates from' brazil
or
Fish 'originates from' 'rio negro'
or
Fish 'originates from' venezuela)
and
Fish 'size is' 'up to 60 cm'
and
Fish 'lifespan is' '15 years'
and
Fish eats fish
then
Fish 'is named' 'redtail catfish'.
'a royal pleco' ::
if
Fish 'is part of' loricariidae subfamily
and
Fish 'originates from' 'southern colombia'
and
Fish 'size is' '25 cm'
and
Fish 'lifespan is' '10+ years'
and
Fish eats 'plants'
and
Fish prefers algae
then
Fish 'is named' 'royal pleco'.
'a upside down catfish' ::
if
Fish 'is part of' mochokidae subfamily
and
(Fish 'originates from' zaire
or
Fish 'originates from' 'niger river basin')
and
Fish 'size is' '20 cm'
and
Fish 'lifespan is' '5+ years'
and
Fish eats 'most foods'
and
Fish swims 'upside down'
and
Fish has 'large eyes'
and
Fish has 'a large adipose fin'
and
Fish has 'a forked tail'
and
Fish has 'three pairs of barbels'
and
Fish 'color is' 'light brown'
and
Fish has 'dark brown blotches'
then
Fish 'is named' 'upside down catfish'.
'a clown loach' ::
if
Fish 'is part of' cobitidae subfamily
and
(Fish 'originates from' indonesia
or
Fish 'originates from' sumatra
or
Fish 'originates from' borneo)
and
Fish 'size is' '15 cm'
and
Fish 'lifespan is' '15+ years'
and
Fish eats 'most foods'
and
Fish has 'orange and black stripes'
and
Fish has 'red fins'
then
Fish 'is named' 'clown loach'.
'a weather loach' ::
if
Fish 'is part of' cobitidae subfamily
and
(Fish 'originates from' asia
or
Fish 'originates from' china
or
Fish 'originates from' korea
or
Fish 'originates from' japan)
and
Fish 'size is' '30 cm'
and
Fish 'lifespan is' '10 years'
and
Fish eats 'most foods'
and
Fish can 'predict the weather'
and
(Fish 'color is' olive
or
Fish 'color is' gold)
and
(Fish has 'stripes from head to tail'
or
Fish has 'many spots')
and
Fish has 'Ten sensitive barbels around the mouth'
and
Fish inhabits freshwaters
then
Fish 'is named' 'weather loach'.
fact :: X isa fish :-
member(X, [betta, 'three spot gourami', 'dwarf gourami', 'honey gourami', 'kissing gourami',
'moonlight gourami', 'pearl gourami', 'adolfos cory', 'debauwi cat', 'albino driftwood catfish',
'bandit cory', 'blackfin cory', 'bronze cory', 'giant whiptail', 'hog nosed brochis', 'jordans catfish',
otocinclus, 'pictus catfish', 'redtail catfish', 'royal pleco', 'upside down catfish', 'clown loach',
'weather loach']).
askable(_ 'color is' _, 'Fish' 'color is' 'What').
askable(_ has _, 'Fish' has 'Something').
askable(_ can _, 'Fish' can 'What').
askable(_ spawns, 'Fish' spawns).
askable(_ 'originates from' _, 'Fish' 'originates from' 'Where').
askable(_ inhabits _, 'Fish' inhabits 'Somewhere').
askable(_ 'size is' _, 'Fish' 'size is' 'What').
askable(_ 'lifespan is' _, 'Fish' 'lifespan is' 'What').
askable(_ eats _, 'Fish' eats 'Something').
askable(_ lacks _,'Fish' lacks 'What').
askable(_ enjoys _, 'Fish' enjoys 'Something').
askable(_ lays eggs, 'Fish' lays eggs).
askable(_ prefers _, 'Fish' prefers 'What').
askable(_ squeaks, 'Fish' squeaks).
askable(_ swims _, 'Fish' swims 'How').
askable(_ 'is a' _, 'Fish' 'is a' 'Something').
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
You need to type: expert.
and than:
X isa fish and dj 'is named' X.
to see what it does.
Please help me
Thanks,
gadtab