Описанные в разделах 2.1 и 2.2 программы являются про-
стейшими примерами экспертных систем, имеющими, тем не менее
все необходимые средства для обеспечения работы реальных
экспертных систем. Базы знаний в этих программах легко рас-
ширяются и могут включать в себя более сложные правила. Про-
грамма MEDICAL, предлагаемая в данном разделе является раз-
витием программы EXPERT2 применительно к области медицинской
диагностики. Экспертная система MEDICAL базируется на логике
и предназначена для определения вероятного диагноза по набору
предлагаемых симптомов.
Структура программы и назначение предикатов аналогичны
программе EXPERT2. Система меню обеспечивает пользователю
удобство работы с программой. Текст программы MEDICAL приво-
дится ниже.
#M
INCLUDE "MENU2.PRO"
DOMAINS
CONDITIONS = BNO*
HISTORY = RNO*
RNO, BNO, FNO = integer
CATEGORY = symbol
DATABASE
rule(RNO, string, CATEGORY, CONDITIONS)
cond(BNO, string)
yes(BNO)
no(BNO)
topic(string)
PREDICATES
do_expert_job
show_menu
do_consulting
process(integer)
evalans(char)
goes(CATEGORY)
go(HISTORY, CATEGORY)
check(RNO, HISTORY, CONDITIONS)
notest(BNO)
inpo(HISTORY, RNO, BNO, STRING)
do_answer(HISTORY, RNO, STRING, BNO, INTEGER)
erase
clear
GOAL
do_expert_job.
CLAUSES
do_expert_job :-
makewindow(1,$0B,$0B," МЕДИЦИНСКАЯ ДИАГНОСТИКА ",0,0,25,80),
show_menu,
nl, write("\tНажмите клавишу пробела ..."),
readchar(_),
exit.
show_menu :- repeat,
menu(5,20,$13,$13,
[" Загрузить базу знаний ",
" Консультация ",
" Сохранить базу знаний ",
" Завершение работы "],
"Основное меню", 1, Choice),
process (Choice),
Choice=0,!.
process(0).
process(1) :-
consult("illness.dba").
process(2) :-
do_consulting.
process(3) :-
save("illness.dba").
process(4) :-
exit.
do_consulting :-
goes(Mygoal),nl,nl,
go([], Mygoal), !.
do_consulting :-
write(" Извините, в базе знаний нет необходимой информации."),
nl,write("\tЯ не смогу Вам помочь ..."), clear.
goes("болезнь") :-
clear, clearwindow, nl,
write("\t\t\tЭКСПЕРТНАЯ СИСТЕМА"),nl,
write("\t\tВ ОБЛАСТИ МЕДИЦИНСКОЙ ДИАГНОСТИКИ"),nl,nl,
write("\tСистема позволяет по совокупности симптомов"),nl,
write("\tопределить наиболее вероятный диагноз для пациента"),nl,
write("\tВам необходимо всего лишь отвечать \"Да\" или \"Нет\" "),nl,
write("\tпри указании системой очередного симптома"),!.
go(_,Mygoal) :-
not(rule(_,Mygoal,_,_)),!,nl,
write("\tЯ думаю, что у пациента ",MYgoal,"."),nl,nl,
write("\tУстраивает ли Вас мой диагноз (д/н) ?"),
readchar(Answer), nl,
evalans(Answer).
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,NCOND),
fronttoken(NCOND,_,COND1),
frontchar(COND1,_,COND),
cond(BNO1,COND),
notest(BNO1),!,
check(RNO,HISTORY,REST).
check(_,_,[BNO|_]) :-
cond(BNO,NCOND),
fronttoken(NCOND,_,COND1),
frontchar(COND1,_,COND),
cond(BNO1,COND),
yes(BNO1),
!,fail.
check(RNO,HISTORY,[BNO|REST]) :-
cond(BNO,TEXT),
inpo(HISTORY,RNO,BNO,TEXT),
check(RNO,HISTORY,REST).
check(_,_,[]).
notest(BNO) :- no(BNO),!.
notest(BNO) :- not(yes(BNO)),!.
do_answer(_,_,_,_,0) :- exit.
do_answer(_,_,_,BNO,1) :-
assert(yes(BNO)),
shiftwindow(1),
write("да"),nl.
do_answer(_,_,_,BNO,2) :-
assert(no(BNO)),
assert(no(BNO)),
write("нет"),nl,
fail.
erase :- retract(_),fail.
erase.
clear :- retract(yes(_)),retract(no(_)),fail,!.
clear.
inpo(HISTORY,RNO,BNO,TEXT) :-
write(" ",TEXT," ? "),
menu(12,64,$13,$13,[" Да "," Нет "],"Ответ",1,RESPONSE),
shiftwindow(1),
do_answer(HISTORY,RNO,TEXT,BNO,RESPONSE).
evalans('д') :-
nl,write("\tНажмите клавишу пробела ..."),
readchar(_),
clearwindow,
show_menu.
evalans('н') :-
write("\tИзвините, я не могу вам больше ничем помочь."),nl,nl,
write("\tНажмите клавишу пробела ..."),
readchar(_),
clearwindow,
show_menu. #P
База данных экспертной системы MEDICAL находится в
файле ILLNESS.DBA
DOGS.DBA
topic("короткошерстная порода")
topic("длинношерстная прорда")
rule(1,"порода","короткошерстная порода",[1])
rule(2,"порода","длинношерстная прорда",[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,"длинношерстная прорда","СЕНБЕРНАР",[6,7,8])
cond(1,"короткошерстная")
cond(2,"длинношерстная")
cond(3,"рост менее 50 см")
cond(4,"рост менее 70 см")
cond(5,"короткий хвост")
cond(6,"длинные уши")
cond(7,"добродушный характер")
cond(8,"вес более 50 кг")
Файл MENU2.PRO
/****************************************************************
Copyright (c) 1986, 88 by Borland International, Inc.
menu
Implements a popup menu with at most 23 possible choices.
For more than 23 possible choices use longmenu.
The up and down arrow keys can be used to move the bar
RETURN or F10 will select an indicated item.
Pressing Esc aborts menu selection and returns zero.
The arguments to menu are:
menu(ROW,COL,WINDOWATTR,FRAMEATTR,STRINGLIST,HEADER,STARTCHOICE,SELECTION)
ROW and COL determines the position of the window
WATTR and FATTR determine the attributes for the window
and its frame - if FATTR is zero there
will be no frame around the window.
STRINGLIST is the list of menu items
HEADER is the text to appear at the top of the menu window
STARTCHOICE determines where the bar should be placed.
Ex: menu(5,5,7,7,[this,is,a,test],"select word",0,CHOICE)
****************************************************************/
/* remove comment to run */
include "tdoms.pro"
include "tpreds.pro"
PREDICATES
menu(ROW,COL,ATTR,ATTR,STRINGLIST,STRING,INTEGER,INTEGER)
menuinit(ROW,COL,ATTR,ATTR,STRINGLIST,STRING,ROW,COL)
menu1(SYMBOL,ROW,ATTR,STRINGLIST,ROW,COl,INTEGER)
menu2(KEY,STRINGLIST,ROW,ROW,ROW,SYMBOL)
CLAUSES
menu(ROW,COL,WATTR,FATTR,LIST,HEADER,STARTCHOICE,CHOICE) :-
menuinit(ROW,COL,WATTR,FATTR,LIST,HEADER,NOOFROW,LEN),
ST1=STARTCHOICE-1,max(0,ST1,ST2),MAX=NOOFROW-1,min(ST2,MAX,STARTROW),
menu1(cont,STARTROW,WATTR,LIST,NOOFROW,LEN,CHOICE),
removewindow.
menuinit(ROW,COL,WATTR,FATTR,LIST,HEADER,NOOFROW,NOOFCOL):-
maxlen(LIST,0,MAXNOOFCOL),
str_len(HEADER,HEADLEN),
HEADL1=HEADLEN+4,
max(HEADL1,MAXNOOFCOL,NOOFCOL),
listlen(LIST,LEN), LEN>0,
NOOFROW=LEN,
adjframe(FATTR,NOOFROW,NOOFCOL,HH1,HH2),
adjustwindow(ROW,COL,HH1,HH2,AROW,ACOL),
makewindow(81,WATTR,FATTR,HEADER,AROW,ACOL,HH1,HH2),
writelist(0,NOOFCOL,LIST).
menu1(cont,ROW,ATTR,LIST,MAXROW,NOOFCOL,CHOICE):-!,
reverseattr(ATTR,REV),
field_attr(ROW,0,NOOFCOL,REV),
cursor(ROW,0),
readkey(KEY),
field_attr(ROW,0,NOOFCOL,ATTR),
menu2(KEY,LIST,MAXROW,ROW,NEXTROW,CONT),
menu1(CONT,NEXTROW,ATTR,LIST,MAXROW,NOOFCOL,CHOICE).
menu1(esc,ROW,_,_,_,_,CHOICE):-!,CHOICE=ROW+1.
menu1(_,ROW,ATTR,_,_,NOOFCOL,CHOICE):-
CHOICE=ROW+1,
reverseattr(ATTR,REV),
field_attr(ROW,0,NOOFCOL,REV).
menu2(esc,_,_,_,-1,esc):-!.
menu2(fkey(10),_,_,ROW,ROW,stop):-!.
menu2(char(C),LIST,_,_,CH,selection):-tryletter(C,LIST,CH),!.
/*menu2(fkey(1),_,_,ROW,ROW,cont):-!,help. If a help system is used */
menu2(cr,_,_,ROW,CH,selection):-!,CH=ROW.
menu2(up,_,_,ROW,NEXTROW,cont):-ROW>0,!,NEXTROW=ROW-1.
menu2(down,_,MAXROW,ROW,NEXTROW,cont):-NEXTROW=ROW+1,NEXTROW
menu2(end,_,MAXROW,_,NEXT,cont):-!,NEXT=MAXROW-1.
menu2(pgdn,_,MAXROW,_,NEXT,cont):-!,NEXT=MAXROW-1.
menu2(home,_,_,_,0,cont):-!.
menu2(pgup,_,_,_,0,cont):-!.
menu2(_,_,_,ROW,ROW,cont).
/****************************************************************/
/* menu_repeat */
/* As menu but the window is not removed on return. */
/****************************************************************/
PREDICATES
nondeterm menu_repeat(ROW,COL,ATTR,ATTR,STRINGLIST,STRING,INTEGER,INTEGER)
nondeterm menu_repeat1(ROW,ATTR,STRINGLIST,ROW,COl,INTEGER)
nondeterm menu_repeat3(SYMBOL,ROW,ATTR,STRINGLIST,ROW,COl,INTEGER,INTEGER)
CLAUSES
menu_repeat(ROW,COL,WATTR,FATTR,LIST,HEADER,STARTCHOICE,CHOICE) :-
menuinit(ROW,COL,WATTR,FATTR,LIST,HEADER,NOOFROW,NOOFCOL),
ST1=STARTCHOICE-1,max(0,ST1,ST2),MAX=NOOFROW-1,min(ST2,MAX,STARTROW),
menu_repeat1(STARTROW,WATTR,LIST,NOOFROW,NOOFCOL,CHOICE).
menu_repeat(_,_,_,_,_,_,_,_):-removewindow,fail.
menu_repeat1(STARTROW,WATTR,LIST,NOOFROW,NOOFCOL,C):-
menu1(cont,STARTROW,WATTR,LIST,NOOFROW,NOOFCOL,C1),
menu_repeat3(cont,STARTROW,WATTR,LIST,NOOFROW,NOOFCOL,C1,C).
menu_repeat3(_,_,_,_,_,_,C,C):-C<>0.
menu_repeat3(cont,_,WATTR,LIST,NOOFROW,NOOFCOL,C1,C):-
C1<>0,
XX=C1-1,
menu_repeat1(XX,WATTR,LIST,NOOFROW,NOOFCOL,C).
|
Главная
Каталог файлов
