Сохранение трассы вывода при доказательстве цели

Как мы уже отмечали, огромным достоинством экспертных систем является их умение отвечать на вопрос «как был получен этот результат?».

Для сохранения истории логического вывода будем сохранять трассу подцелей, сгенерированных системой во время сеанса.

Например, для сенбернара эта трасса будет выглядеть так:

«dog» ®

«длинношерстная» ®

«сенбернар».

Добавим к предикату go еще один аргумент — HISTORY, в котором по принципу стека будем сохранять номера правил текущей трассы:

go(HISTORY,Mygoal):-

rule(N,Mygoal,My,Cond),

check(N,Cond),

go([N|HISTORY],My).

Ответ на вопрос «как был получен этот результат?» будет выглядеть примерно так:

dog

было доказано «длинношерстная»

(было сказано «имеет длинную шерсть»)

было доказано «сенбернар»

(было сказано

«низкопосаженный хвост»

«добродушный характер»

«вес > 100 фунтов»)

Аналогично можно ответить на вопрос пользователя «зачем нужно знать эту информацию?», восстанавливая по желанию пользователя трассу от текущей подцели до главного запроса. Этот процесс выглядит так: вначале восстанавливается предыдущая подцель, затем пользователь еще раз спрашивает «зачем?», восстанавливается подцель на один уровень выше и т.д.

/* Dog Expert. Файл: dog.pro */

domains

CONDITIONS = BNO *

HISTORY = RNO *

RNO, BNO = INTEGER

CATEGORY = SYMBOL

database

/* Предикаты базы знаний */

rule(RNO, CATEGORY, CATEGORY, CONDITIONS)

cond(BNO, STRING)

yes(BNO)

no(BNO)

topic(string)

predicates

/* Предикаты системы пользовательского интерфейса */

do_expert_job

show_menu

do_consulting

process(integer)

info(CATEGORY)

goes(CATEGORY)

listopt

clear

eval_reply(HISTORY,char)

printr(HISTORY)

printc(CONDITIONS)

/* Предикаты механизма вывода */

go(HISTORY, CATEGORY)

check(RNO, HISTORY, CONDITIONS)

inpq(HISTORY, RNO, BNO, STRING)

do_answer(HISTORY, RNO, STRING, BNO, INTEGER)

goal

clear,

do_expert_job.

clauses

/* База знаний (БЗ) */

topic("dog").

topic("короткошерстная собака").

topic("длинношерстная собака").

rule(1, "dog", "короткошерстная собака", [1]).

rule(2, "dog", "длинношерстная собака", [2]).

rule(3, "короткошерстная собака","английский бульдог",[3,5,7]).

rule(4, "короткошерстная собака","гончая",[3,6,7]).

rule(5, "короткошерстная собака","датский дог", [5,6,7,8]).

rule(6, "короткошерстная собака","американский фокстерьер",[4,6,7]).

rule(7, "длинношерстная собака", "коккер-спаниэль", [3,5,6,7]).

rule(8, "длинношерстная собака", "ирландский сеттер", [4,6]).

rule(9, "длинношерстная собака", "колли", [4,5,7]).

rule(10, "длинношерстная собака", "сенбернар", [5,7,8]).

cond(1, "короткошерстная собака").

cond(2, "длинношерстная собака").

cond(3, "рост менее 22 дюймов").

cond(4, "рост менее 30 дюймов").

cond(5, "низкопосаженный висячий хвост").

cond(6, "длинные уши").

cond(7, "добродушный характер").

cond(8, "вес более 100 фунтов").

/* Система пользовательского интерфейса */

do_expert_job:-

makewindow(1,63,7," DOG EXPERT SYSTEM ",0,0,25,80),

show_menu,

nl,write(" Нажмите пробел. "),

readchar(_),

save("dog.dat"),

exit.

show_menu:-

write(" "),nl,

write(" * * * * * * * * * * * * * * "),nl,

write(" * DOG EXPERT * "),nl,

write(" * * "),nl,

write(" * 1. Консультация * "),nl,

write(" * * "),nl,

write(" * * "),nl,

write(" * 2. Выход из системы * "),nl,

write(" * * "),nl,

write(" * * * * * * * * * * * * * * * "),nl,

write(" "),nl,

write("Ваш выбор - 1 or 2: "),nl,

readint(Choice),

process (Choice).

process(1):-

do_consulting,clear.

process(2):-

removewindow,

clear,

exit.

do_consulting:-

goes(Mygoal),

go([],Mygoal),

!.

do_consulting:-

nl, write(" Сожалею, не могу Вам помочь.").

goes(Mygoal):-

clear,

clearwindow,

nl,nl,

write(" "),nl,

write(" WELCOME TO THE DOG EXPERT SYSTEM "),nl,

write(" "),nl,

write(" Это - классификационная ЭС. "),nl,

write(" Для запуска процесса выбора собаки "),nl,

write(" наберите слово dog. Если Вы желаете "),nl,

write(" увидеть допустимые породы собак, "),nl,

write(" наберите знак вопроса?. "),nl,

write(" "),nl,

readln(Mygoal),

info(Mygoal),!.

info("?"):-!,

clearwindow,

listopt,

nl,write("Нажмите пробел. "),

readchar(_),

clearwindow,

exit.

info("dog"):-!.

info(_):-

write("Сожалею, но такой темы нет. "),

nl,write("Нажмите пробел. "),

readchar(_),

clearwindow,

exit.

listopt:-

write("Породы собак: "),nl,nl,

rule(N,_,Dog,_),

N>=3,

write(" ",Dog),nl,

fail.

listopt.

inpq(HISTORY,RNO,BNO,TEXT):-

write("Вопрос:- ",TEXT,"? "),

makewindow(2,7,7,"Response",10,54,9,24),

write("Введите 1, если 'да',"),nl,

write("Введите 2, если 'нет': "),nl,

readint(RESPONSE),

clearwindow,

shiftwindow(1),

do_answer(HISTORY,RNO,TEXT,BNO,RESPONSE).

eval_reply(HISTORY,'1'):-

printr(HISTORY),!.

eval_reply(_,_).

printr([]):-!.

printr([RNO|REST]):-

rule(RNO,_,_,LIST),

printc(LIST),

printr(REST).

printc([]):-!.

printc([BNO|REST]):-

cond(BNO,X),

write(X),nl,

printc(REST).

/* Механизм вывода */

go(HISTORY,Mygoal):-

not(rule(_,Mygoal,_,_)),!,

nl,write(" Этим качествам соответствует порода ", Mygoal,"."),nl,

write("Вам хотелось бы узнать, как был получен этот вывод?(1/2)"),

nl,readchar(R),

eval_reply(HISTORY,R).

go(HISTORY, Mygoal):-

rule(RNO,Mygoal,NY,COND),

check(RNO,HISTORY,COND),

go([RNO|HISTORY],NY).

check(RNO,HISTORY,[BNO|REST]):-

yes(BNO),!,

check(RNO,HISTORY,REST).

check(_,_,[BNO|_]):- no(BNO),!,fail.

check(RNO,HISTORY,[BNO|REST]):-

cond(BNO,TEXT),

inpq(HISTORY,RNO,BNO,TEXT),!,

check(RNO,HISTORY,REST).

check(_,_,[]).

do_answer(_,_,_,BNO,1):-

assert(yes(BNO)),

shiftwindow(1),

write(yes),nl.

do_answer(_,_,_,BNO,2):-

assert(no(BNO)),

write(no),nl,

fail.

clear:- retract(yes(_)),fail.

clear:- retract(no(_)),fail.

clear.

/* Конец программы */

Задание. Ввести в систему «Dog Expert» новую категорию знаний (topic): «человек, занимающийся политикой». Сконструировать утверждения типа rule для определения различных категорий данного объекта.