База знаний - книги на Прологе.
Исходный код программы:
% база знаний - книги
:- op(100,xfx,['читать','читают','читает','нравится','имеет','это']).
:- dynamic 'имеет'/2, 'нравится'/2, 'читает'/2, 'читают'/2, 'читать'/2.
X 'это' 'триллер':-
X 'имеет' 'драки'.
X 'это' 'триллер':-
X 'имеет' 'воров'.
X 'это' 'мелодрама':-
X 'имеет' 'любовь'.
X 'это' 'мелодрама':-
X 'читает' 'женское население'.
X 'это' 'детектив':-
X 'имеет' 'убийство'.
X 'это' 'детектив':-
X 'читает' 'мужское население'.
X 'это' 'роман':-
X 'имеет' 'романтику'.
X 'это' 'роман':-
X 'читают' 'женщины'.
X 'это' 'фантастика':-
X 'имеет' 'битву в космосе'.
X 'это' 'фантастика':-
X 'имеет' 'чудовищ'.
clause_cf(
X 'это' 'Общак',
(X 'это' 'триллер',
X 'имеет' 'криминал',
X 'нравится' 'мужчинам'),0.8).
clause_cf(
X 'это' 'Алмаз',
(X 'это' 'мелодрама',
X 'читать' 'интересно',
X 'нравится' 'женщинам'),0.8).
clause_cf(
X 'это' 'Эмануэль',
(X 'это' 'роман',
X 'читать' 'интересно',
X 'нравится' 'женщинам'),0.8).
clause_cf(
X 'это' 'Агата Кристи',
(X 'это' 'детектив',
X 'читать' 'интересно',
X 'читают' 'все'),0.9).
clause_cf(
X 'это' 'Нити смерти',
(X 'это' 'фантастика',
X 'имеет' 'много пожаров',
X 'имеет' 'много стрельбы'),0.6).
book(X,Y):-
member(Y,['Общак','Алмаз','Эмануэль','Агата Кристи','Нити смерти']),
X 'это' Y.
askable(_'читать'_).
askable(_'читают'_).
askable(_'читает'_).
askable(_'нравится'_).
askable(_'имеет'_).
system(member(_,_)).
/*explainThis(_'читать'_).
explainThis(_'читают'_).
explainThis(_'читает'_).
explainThis(_'нравится'_).
explainThis(_'имеет'_).
*/
explainThis(_'это'_).
Исходный код экпертной системы:
:- multifile system/1, askable/1, explainThis/1,clause_cf/3.
:- dynamic askable/1, clause_cf/3, untrue/1,explainThis/1.
% введем стартовый предикат
expert:-
write('Введите цель: '), read(X),
solve(X,[],C,Proof),nl,
write('доказано '), write(X), nl,
write('с уверенностью '),write(C),nl,
write('***************************************************'),nl,
write('Объясняем вывод: '),nl,
interpret(Proof), % объясняет как была доказана цель X
write('Продолжить работу экспертной системы? '),read(Z),
'выход'(Z).
'выход'(yes):-
expert.
'выход'(no):-
true.
solve(true,_,1,_):-!.
solve((A,B),Rules,C,(ProofA,ProofB)):-!,
solve(A,Rules,C1,ProofA),
solve(B,Rules,C2,ProofB),
C is min(C1,C2).
solve(not(A),Rules,1,'не доказуемо'(A)):-!,
not(solve(A,Rules,_,_)).
solve(A,Rules,C,(A:-Proof)):-
not(system(A)),
clause(A,B),
solve(B,[rule(A,B)|Rules],C,Proof).
solve(A,Rules,C,(A:-Proof)):-
not(system(A)),
clause_cf(A,B,C1),
solve(B,[rule(A,B)|Rules],C2,Proof),
C is C1*C2.
solve(A,_,1,(A:-true)):-
system(A),
A.
solve(A,Rules,C,(A:-_)):-
askable(A), % определяет какие вопросы будут заданы пользователю
not(known(A)), % надо избежать задания вопросов ответы на которые уже известны
ask(A,Answer), % ввод ответа пользователя
respond(Answer,A,Rules,C). % записывает ответы на вопросы
system(is(_,_)).%Некоторые системные предикаты
system(_=_).
system(_<_).
system(_>_).
system(member(_,_)).
system(write(_)).
system(read(_)).
system(nl).
ask(A,Answer):-
display_query(A),
read(Answer).
respond(yes,A,_,1):-
assert(A). % добавляем ответ yes на вопрос
respond(no,A,_,0):-
assert(untrue(A)),fail. % добавляем ответ no на вопрос
respond(why,A,Rules,C):-
var(Rules),!,
write(' хочу использовать ложность '),
write(A),nl,
ask(A,Answer), % ввод ответа пользователя
respond(Answer,A,[],C).
respond(why,A,[Rule|Rules],C):-
nl,write('*******************************************'),nl,
write(' хочу воспользоваться правилом:'),
display_rule(Rule),
ask(A,Answer), % ввод ответа пользователя
respond(Answer,A,Rules,C).
respond(why,A,[],C):-
write(' <-- возможности объяснения исчерпаны '),nl,
ask(A,Answer), % ввод ответа пользователя
respond(Answer,A,[],C).
% добавляем правила для respond
respond(C,A,_,C):- % C-вероятность события
number(C),C>0,
assert(clause_cf(A,true,C)).
respond(0,A,_,0):-
assert(untrue(A)),fail.
% добавляем правило для known
known(A):- % проверяет записан ли вопрос
clause_cf(A,true,_),!.
known(A):-A,!.
known(A):-
untrue(A).
display_query(A):- % вывод на экран вопроса
write(A),
write('?').
display_rule(rule(A,B)):- % вывод правила на экран
nl,write(' Если '),
write_conjunction(B),
write(' то '),
write(A),nl,
write('**********************************************'), nl.
write_conjunction((A,B)):-
!,write(A),write(' и '),nl,
write_conjunction(B).
write_conjunction(A):-
write(A),nl.
interpret((ProofA,ProofB)):-!,
interpret(ProofA),
interpret(ProofB).
interpret((A:-'как было сказано')):-!,
nl,write(A),write(' <= как было сказано'),nl.
interpret('не доказуемо'(A)):-!,
nl,write(A),write(' <= не доказуемо'),nl.
interpret(Proof):-
fact(Proof,Fact),
explainFact(Fact).
interpret(Proof):-
rule(Proof,Head,Body,Proof1),
explainRule(Head,Body),
interpret(Proof1).
rule((Goal:-Proof),Goal,Body,Proof):-
not(Proof=true),
extract_body(Proof,Body).
fact((Fact:-true),Fact).
extract_body((ProofA,ProofB),(BodyA,BodyB)):-
!,
extract_body(ProofA,BodyA),
extract_body(ProofB,BodyB).
extract_body((Goal:-_),Goal).
extract_body('не доказуемо'(B),not(B)).
explainFact(Fact):- % объяснять ли вывод факта
explainThis(Fact),!,
nl,write(Fact),write(' - это факт'),nl.
explainFact(_).
explainRule(Head,Body):-
explainThis(Head),!, % объяснять ли вывод предиката
write(Head),
write(' доказано с использованием правила: '),
display_rule(rule(Head,Body)).
explainRule(_,_).
explainThis(member(_,_)).
|
Главная
Каталог файлов
