Навигация
Главная
Поиск
Форум
FAQ's
Ссылки
Карта сайта
Чат программистов

Статьи
-Delphi
-C/C++
-Turbo Pascal
-Assembler
-Java/JS
-PHP
-Perl
-DHTML
-Prolog
-GPSS
-Сайтостроительство
-CMS: PHP Fusion
-Инвестирование

Файлы
-Для программистов
-Компонеты для Delphi
-Исходники на Delphi
-Исходники на C/C++
-Книги по Delphi
-Книги по С/С++
-Книги по JAVA/JS
-Книги по Basic/VB/.NET
-Книги по PHP/MySQL
-Книги по Assembler
-PHP Fusion MOD'ы
-by Kest
Professional Download System
Реклама
Услуги

Автоматическое добавление статей на сайты на Wordpress, Joomla, DLE
Заказать продвижение сайта
Программа для рисования блок-схем
Инженерный калькулятор онлайн
Таблица сложения онлайн
Популярные статьи
OpenGL и Delphi... 65535
Форум на вашем ... 65535
21 ошибка прогр... 65535
HACK F.A.Q 65535
Бип из системно... 65535
Гостевая книга ... 65535
Invision Power ... 65535
Пример работы с... 65535
Содержание сайт... 65535
ТЕХНОЛОГИИ ДОСТ... 65535
Организация зап... 65535
Вызов хранимых ... 65535
Создание отчето... 65535
Имитационное мо... 65535
Программируемая... 65535
Эмулятор микроп... 65535
Подключение Mic... 65535
Создание потоко... 65535
Приложение «Про... 65535
Оператор выбора... 65535
Реклама
Сейчас на сайте
Гостей: 9
На сайте нет зарегистрированных пользователей

Пользователей: 13,372
новичок: vausoz
Новости
Реклама
Выполняем курсовые и лабораторные по разным языкам программирования
Подробнее - курсовые и лабораторные на заказ
Delphi, Turbo Pascal, Assembler, C, C++, C#, Visual Basic, Java, GPSS, Prolog, 3D MAX, Компас 3D
Заказать программу для Windows Mobile, Symbian

Моделирование автовокзала + Отчет + Блок схема
Движение шарика в эллиптическои параболоиде на Delphi [OpenGL] + Блок схемы
Моделирование системы управления качеством производственного процесса на...

ПОСТРОЕНИЕ ЭКСПЕРТНЫХ СИСТЕМ НА ТУРБО ПРОЛОГЕ. Экспертная система медицинской диагностики
Описанные в разделах 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).



Опубликовал Kest April 05 2009 20:49:03 · 16 Комментариев · 18216 Прочтений · Для печати

• Не нашли ответ на свой вопрос? Тогда задайте вопрос в комментариях или на форуме! •


Комментарии
Серега May 28 2009 15:41:15
Возникли проблемы с компиляцией программы . Кто может помочь напишите IСQ или мейл.
Kest May 28 2009 15:45:32
В чем проблема?
Серега May 28 2009 16:15:38
#M
INCLUDE "MENU2.PRO"

вот в этом пишет ошибку .
если можно
Kest May 28 2009 16:22:23
MENU2.PRO - это файл которого нет (с меню).... Если найду дополню статью
Серега May 28 2009 16:24:14
спасибо !! жду файла.
Saint January 18 2010 19:32:05
А на каком Прологе написано сие чудо?
и можно ли выложить исходники?
Kest January 18 2010 19:36:19
Saint
А на каком Прологе написано сие чудо?
и можно ли выложить исходники?


Там же в заголовке статьи написано Turbo Prolog
А это чем не исходники?
Saint January 19 2010 07:06:20
Тем что в турбопрологе не работал ни разу
так что если есть возможность буду благодарен за выложенный в архиве проект можно и на аську 436480306
Kest January 19 2010 12:30:11
2Saint
Статья - это все что есть, а выделить, скопировать и вставить в блокнот это ты уже сам smiley
Катя May 26 2012 13:53:03
Здравствуйте, я не могу откомпилировать эту программу. Компилятор указывает на строку menu(ROW,COL,ATTR,ATTR,STRINGLIST,STRING,INTEGER,INTEGER)
И еще, что должно быть написано в файлах "tdoms.pro"
и "tpreds.pro"? Спасибо
Kest May 26 2012 14:39:48
посмотрите ранее в этом разделе
sabadash May 26 2012 15:46:20
Про файлы tdoms.pro"
и "tpreds.pro" не нашла ничего. А почему на строку menu(ROW....) ругается?
sabadash May 26 2012 22:53:14
скажите, какую часть файла menu2 надо скопировать в блокнот, чтобы заработала программа medikal&
sabadash May 27 2012 03:13:05
Я нашла ошибку в файле menu2.pro в строке
menu2(down,_,MAXROW,ROW,NEXTROW,cont):-NEXTROW=ROW+1,NEXTROW как ее исправить?
sabadash May 27 2012 12:41:34
Привет, я исправила ошибку menu2(down,_,MAXROW,ROW,NEXTROW,cont):-NEXTROW=ROW+1,NEXTROW<MAXROW,!.
Теперь у меня программа не хочет связываться с базой знаний. Ответьте мне, пожалуйста))))
Pavel May 20 2014 11:59:15
ребят, кто может помочь с решением задачи в турбопролеге 2.0 отпишите плиз на мылоsolopov@ya.ru
Добавить комментарий
Имя:



smiley smiley smiley smiley smiley smiley smiley smiley smiley
Запретить смайлики в комментариях

Введите проверочный код:* =
Рейтинги
Рейтинг доступен только для пользователей.

Пожалуйста, залогиньтесь или зарегистрируйтесь для голосования.

Нет данных для оценки.
Гость
Имя

Пароль



Вы не зарегистрированны?
Нажмите здесь для регистрации.

Забыли пароль?
Запросите новый здесь.
Поделиться ссылкой
Фолловь меня в Твиттере! • Смотрите канал о путешествияхКак приготовить мидии в тайланде?
Загрузки
Новые загрузки
iChat v.7.0 Final...
iComm v.6.1 - выв...
Visual Studio 200...
CodeGear RAD Stud...
Шаблон для новост...

Случайные загрузки
Run
C++ для начинающих
CS:Source - монит...
Email
mmmJlabel
index.php + мод ...
Интерактивный инт...
Indy in Depth Глу...
Калькулятор [Исхо...
Dreamsoft Progres...
NotePad Pro [Исхо...
Delphi на примерах
Алгоритм DES шифр...
Text effect
RAS
AUTOWEB
Распознавание тек...
База предприятий ...
Архив программ
Длинный заголовок...

Топ загрузок
Приложение Клие... 100774
Delphi 7 Enterp... 97839
Converter AMR<-... 20268
GPSS World Stud... 17014
Borland C++Buil... 14194
Borland Delphi ... 10293
Turbo Pascal fo... 7374
Калькулятор [Ис... 5984
Visual Studio 2... 5207
Microsoft SQL S... 3661
Случайные статьи
Limpel-ziv алгорит...
Полоса погрешностей
Модули DTD или схемы
Семантика UNIX 445
Суммирование элем...
SET ORDER TO TAG L...
Определяя переменн...
Друзья на высоких ...
Сущность эффекта и...
СТРУКТУРА МОДУЛЯ L...
Сегменты, использу...
Explorer для клиен...
Малая вирусная энц...
Принципы работы ск...
Играть в автоматы,...
Перехват сеанса
Основы поисковой о...
Установка для эксп...
Символы, используе...
Определение функци...
Сведения, которые ...
В случае схемы с о...
Что делают маршрут...
Игровые автоматы. ...
Кабель с перекрест...
Статистика



Друзья сайта
Программы, игры


Полезно
В какую объединенную сеть входит классовая сеть? Суммирование маршрутов Занимают ли таблицы память маршрутизатора?