Форум программистов «Весельчак У»
  *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

  • Переходим на https. Просьба писать обо всех замеченных неисправностях.
  • Рекомендуем проверить настройки временной зоны в вашем профиле (страница "Внешний вид форума", пункт "Часовой пояс:").
  • У нас больше нет рассылок. Если вам приходят письма от наших бывших рассылок mail.ru и subscribe.ru, то знайте, что это не мы рассылаем.
   Начало  
Наши сайты
Помощь Поиск Календарь Почта Войти Регистрация  
 
Страниц: [1]   Вниз
  Печать  
Автор Тема: Straberry prolog Экспертная система  (Прочитано 5764 раз)
0 Пользователей и 1 Гость смотрят эту тему.
pilot
Гость
« : 15-06-2010 17:03 » 

Создать экспертную систему,как минимум с 2 исходами?

Вот пример, в нем исходов меньше:
Код:
/* Программа EXPERT2 */
#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)
trangoal(integer,CATEGORY)
info(CATEGORY)
goes(CATEGORY)
listopt
erase
clear
eval_reply(char)
/* Предикаты механизма вывода */
go(HISTORY, CATEGORY)
check(RNO, HISTORY, CONDITIONS)
notest(BNO)
inpo(HISTORY, RNO, BNO, STRING)
do_answer(HISTORY, RNO, STRING, BNO, INTEGER)
goal
do_expert_job.
clauses
/*------- Предикаты системы пользовательского интерфейса --------*/
do_expert_job :-
makewindow(1,$0A,$0B," СОБАКА - ДРУГ ЧЕЛОВЕКА ",
0,0,25,80),
show_menu,
nl,write(" Нажмите клавишу пробела ... "),
readchar(_),
exit.
show_menu :-
menu(10,20,$13,$13,
[" Консультация", " Выход из системы "],
"", 1,Choice),
process (Choice).
process(1) :-
consult("dogs.dba"),
do_consulting.
process(2) :-
removewindow,
exit.
do_consulting :-
goes(Mygoal),
go([],Mygoal),
!.
do_consulting :-
nl, write(" Извините, я не могу Вам помочь."),
clear.
do_consulting.
goes(Mygoal) :-
clear, clearwindow, nl,nl,
write("\tЭКСПЕРТНАЯ СИСТЕМА ПО ВЫБОРУ ПОРОДЫ СОБАКИ"),nl,nl,
write(" Эта система поможет вам выбрать породу собаки."),
write(" Система будет задавать Вам"),nl,
write(" вопросы относительно характеристик Вашего"),
write(" будущего друга. Вам необходимо"),nl,
write(" всего лишь ответить \"Да\" или \"Нет\""),nl,
menu(10,30,$13,$13,
["Выбор породы собаки", "Справка"],"",1,Choise),
trangoal(Choise,Mygoal),
info(Mygoal),!.
trangoal(1, "порода").
trangoal(2, "?").
info("?") :-
clearwindow,
write("Справка из базы знаний."),nl,
listopt,
nl,write("\tНажмите любую клавишу ... "),
readchar(_),
clearwindow,
exit.
info(X) :-
X >< "?".
listopt :-
write("Породы собак : "),nl,nl,
topic(Dog),
write(" ",Dog),nl,
fail.
listopt.
inpo(HISTORY,RNO,BNO,TEXT) :-
write(" ",TEXT," ? "),
menu(10,50,$13,$13,[" Да ", " Нет "],
"Ответ",1,RESPONSE),
do_answer(HISTORY,RNO,TEXT,BNO,RESPONSE).
eval_reply('д') :-
write(" Я надеюсь, что Вы будете довольны !").
eval_reply('н') :-
write(" Извините, я не могу Вам помочь !").
go(_,Mygoal) :-
not(rule(_,Mygoal,_,_)),!,
nl,write(" Вам необходима собака породы ",
Mygoal,"."),nl,
write("Вас удовлетворяет эта порода (д/н) ?"),
nl,readchar(R),
eval_reply(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,NCOND),
fronttoken(NCOND,_,COND),
frontchar(COND,_,COND1),
cond(BNO1,COND1),
notest(BNO1),!,
check(RNO,HISTORY,REST).
check(_,_,[BNO|_]) :-
cond(BNO,NCOND),
fronttoken(NCOND,_,COND),
frontchar(COND,_,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)),
write("нет"),nl,
fail.
erase :- retract(_),fail.
erase.
clear :- retract(yes(_)),retract(no(_)),fail,!.
clear. #P
Множество фактов БЗ хранится в файле базы данных DOGS.DBA.
#M
topic("порода")
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,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 кг") #P


Предикат topic определяет тип породы (короткошерстная или
длинношерстная). Предикат rule указывает название породы, поряд-
ковый номер породы (правила) и список номеров характеристик по-
род. В предикате cond определяются сами характеристики. Предика-
том, определяющим цель программы, является предикат do_exspert_
job, открывающий окно ЭС и задающий меню режимов работы
("начало консультаций"/"выход"). После выбора режима консультта-
ции пользователь может запросить классификацию, используемую в
ЭС, или начать процесс выбора. Последовательность ответов поль-
зователя фиксируется в предикатах базы данных yes и no. Правила
erase и clear выполняют очистку БД. Поиск данных по образцу, за-
данному пользователем, осуществляется при помощи правила check.
Организация диалога при помощи меню исключает возможные ошибки
пользователя. Результатом диалога - консультации будет либо со-
общение о выборе породы собаки, либо ответ о невозможности выбо-
ра при заданных пользователем требованиях.
« Последнее редактирование: 15-06-2010 17:06 от Алексей1153++ » Записан
Dimka
Деятель
Команда клуба

ru
Offline Offline
Пол: Мужской

« Ответ #1 : 16-06-2010 17:44 » new

Цитата: pilot
Создать экспертную систему,как минимум с 2 исходами?
Лучше не надо. Ну кому она будет нужна?..
Записан

Программировать - значит понимать (К. Нюгард)
Невывернутое лучше, чем вправленное (М. Аврелий)
Многие готовы скорее умереть, чем подумать (Б. Рассел)
Страниц: [1]   Вверх
  Печать  
 

Powered by SMF 1.1.21 | SMF © 2015, Simple Machines