Тема 7. Консультуюча експертна система прогнозу повені і необхідності евакуації міста n.
Основними вхідними фактами (даними) є фактори погоди:
Рівень води.
Дощ в околицях міста і вище по ріці
Температура. Якщо температура висока і з гір у ріку розтануло багато снігу, а рівень води в річці високий, є небезпека повені.
Сніг. У розрахунок приймається кількість снігу в горах.
Тема 8. Діагностична медична експертна система.
Основними вхідними фактами (даними) є відповіді пацієнта на питання, що задаються експертною системою.
Пацієнт повинний виразити ступінь згоди на нижче перераховані твердження.
'У загальному я нервовий';
'Я дуже турбуюся про свою роботу';
'Я часто відчуваю нервову напругу';
'Моя повсякденна діяльність викликає велику напругу';
'Спілкуючись з людьми, я часто відчуваю нервову напругу';
'До кінця дня я зовсім виснажений фізично і психічно';
Ступінь згоди може бути виражена одним з наступних чотирьох варіантів:
1. "ТАК, ЗГОДНИЙ"
2. "СКОРІШЕ, ЗГОДНИЙ"
3. "СКОРІШЕ, НЕ ЗГОДНИЙ"
4. "НІ, НЕ ЗГОДНИЙ"
Кожен варіант відповіді має своя вагу відповідно до його порядкового номера, тобто дорівнює йому.
Система може видати два рішення:
1: Підвищена психоемоційна напруга.
2: Психоемоційна напруга в нормі.
Рішення видається на основі середньої ваги в такий спосіб:
якщо пацієнт чоловік і (A1+A2+A3+A4+A5+A6)/6<=2,
то 1 варіант рішення;
якщо пацієнт жінка і (A1+A2+A3+A4+A5+A6)/6<=1.83,
то 1 варіант рішення.
В всіх інших випадках видається другий варіант рішення.
Додаток Експертна система ідентифікації птахів Північної Америки.
Прототип даної експертної системи представлений на вебсайті … Він був перероблений на мову Visual Prolog з використанням VPI стратегії.
Особливості ЕС такі:
реалізований механізм зворотнього висновку;
оболонку ЕС можна використовувати для іншої подібної бази знань. Для цього можна включити нову базу знань в текст ЕС замість старої і заново побудувати проект.
інтерфейс користувача виконано з використанням VPI ( програма керується стандартними елементами управління – кнопки керування, елементи меню, діалогові вікна та ін.).
в інтерфейсі користувача застосована таблична форма діалогу.
дані представлені у вигляді пар атрибут-значення. База знань представляє собою набір правил для ієрархічних відносин. Правила для птахів відображають ознаки різних птахів і ієрархічної системи класифікації.
Р
ис.17.
На малюнку зображено вигляд вікна ЕС. Робота ЕС починається при виборі пункту верхнього меню Consult.
/***************************************************************************** Copyright (c) My Company
Project: BIRD
FileName: BIRD.PRO
Purpose: No description
Written by: Visual Prolog
Comments:
******************************************************************************/
include "bird.inc"
include "bird.con"
include "hlptopic.con"
%BEGIN_WIN Task Window
/***************************************************************************
Event handling for Task Window
***************************************************************************/
task_win_eh : EHANDLER
constants
%BEGIN Task Window, CreateParms, 19:24:53-30.1.2004, Code automatically updated!
task_win_Flags = [wsf_SizeBorder,wsf_TitleBar,wsf_Close,wsf_Maximize,wsf_Minimize,wsf_ClipSiblings]
task_win_Menu = res_menu(idr_task_menu)
task_win_Title = "bird"
task_win_Help = idh_contents
%END Task Window, CreateParms
domains
symb_list=symbol*
ref_symbol=reference symbol
ref_string=reference string
ref_str_list=ref_string*
str_list=string*
facts - known
known(string, string, string) % предикат запам'ятовує відповідь користувача.
%Має три аргументи: так/ні, атрибут, значення
multivalued(string) %предикат багатозначності, означає що даний атрибут
% може мати декілька значень
predicates
start
nondeterm family(string) % родина
nondeterm order(string) % підклас
nondeterm bird(string) % птах
nondeterm nostrils(string) %ніздрі
nondeterm live(string) % де живе
nondeterm bill(string) % дзьоб
nondeterm size(string) % розмір
nondeterm wings(string) % крила
nondeterm color(string) % колір
nondeterm voice(string) %голос
nondeterm feet(string) % лапи
nondeterm neck(string) % шия
nondeterm flight(string) % політ
nondeterm season(string) % пора року
nondeterm state(string) % штат
nondeterm head(string) % голова
nondeterm cheek(string) % щока
nondeterm eats(string) % що їсть
nondeterm feed(string) % харчується
nondeterm tail(string) % хвіст
nondeterm flight_profile(string) % профіль польоту
nondeterm throat(string) % горло
nondeterm province(string) % провінція (Канади)
nondeterm country(string) % країна
nondeterm region(string) % регіон
nondeterm member(string, str_list) % перевірка на належність елемента списку
nondeterm ask(string,ref_string) % предикат дозволяє спитати у користувача, чи вірна
%дана пара атрибут-значення
nondeterm analise(integer,string,ref_string) % предикат визначає як відповів користувач
%(так чи ні) і вставляє відповідний факт known у базу даних
nondeterm menuask(integer,string, string, str_list) % предикат аналогічний ask, але
% користувач вибирає відповідну ознаку (значення атрибуту) із списку
/* База знань експертної системи з ідентифікації птахів */
clauses
multivalued("голос").
multivalued("колір").
multivalued("їсть").
% order - підклас, nostrils - ніздрі, bill - дзьоб, feet - лапи
order("трубоніс") :- nostrils("зовнішні і трубчасті"), live("на морі"), bill("гачком").
order("водяна дичина") :- feet("перетинчаті"), bill("плоский").
order("соколоподібні") :- eats("м`ясо"), feet("криві кігті"), bill("гострий і кривий").
order("passerformes") :- feet("довгий задній палець").
% family - родина
family("альбатрос") :- order("трубоніс"), size("великий"), wings("довгі і вузькі").
family("лебідь") :- order("водяна дичина"), neck("довга"), color("білий"), flight("важкий").
family("гусак") :- order("водяна дичина"), size("повний"), flight("енергійний").
family("качка") :- order("водяна дичина"), feed("на поверхні води"), flight("рухливий").
family("гриф") :- order("соколоподібні"), feed("залишки їжі"), wings("широкі").
family("сокіл") :- order("соколоподібні"), wings("довгі і гострі"), head("велика"), tail("вузький на кінці").
family("flycatcher") :- order("passerformes"), bill("плоский"), eats("літаючих комах").
family("ластівка") :- order("passerformes"), wings("довгі і гострі"), tail("з розвилиною"), bill("короткий").
bird("laysan_альбатрос") :- family("альбатрос"), color("білий").
bird("чорноногий_альбатрос") :- family("альбатрос"), color("темний").
bird("fulmar") :- order("трубоніс"), size("середній"), flight("планування").
bird("лебідь_свистун") :- family("лебідь"), voice("приглушений_музичний_свист").
bird("лебідь_трубач") :- family("лебідь"), voice("гучний_трубний_звук").
bird("канадський_гусак") :- family("гусак"), season("зима"), % rules can be further broken down
country("сполучені_штати"), % to include regions and migration
head("чорна"), % patterns
cheek("біла").
bird("канадський_гусак") :- family("гусак"), season("літо"), country("канада"), head("чорна"), cheek("біла").
bird("сніжний_гусак") :- family("гусак"), color("білий").
bird("дика_качка") :- family("качка"), % different rules for male
voice("крякання"), head("зелена").
bird("дика_качка") :- family("качка"), % and female
voice("дика_качка"), color("крапчатий_коричневий").
bird("pintail") :- family("качка"), voice("короткий_свист").
bird("турецький_гриф") :- family("гриф"), flight_profile("v_подібна_форма").
bird("каліфорнійський_кондор") :- family("гриф"), flight_profile("плоский").
bird("горобиний_яструб") :- family("сокіл"), eats("комахи").
bird("сокіл_мандрівник") :- family("сокіл"), eats("птахи").
bird("гребенястий_flycatcher") :- family("flycatcher"), tail("довгий_кольору_іржі").
bird("попелястогорлий_flycatcher") :- family("flycatcher"), throat("біле").
bird("амбарна_ластівка") :- family("ластівка"), tail("з розвилиною").
bird("скеляста_ластівка") :- family("ластівка"), tail("плоский").
bird("фіолетова_ластівка") :- family("ластівка"), color("темний").
bird("Вибачте, відповіді немає").
country("сполучені_штати") :- region("нова_англія").
country("сполучені_штати") :- region("південний_схід").
country("сполучені_штати") :- region("середній_захід").
country("сполучені_штати") :- region("південний_захід").
country("сполучені_штати") :- region("північний_захід").
country("сполучені_штати") :- region("середня_атлантика").
country("канада") :- province("онтаріо").
country("канада") :- province("квебек").
country("канада") :- province("інші").
region("нова_англія") :- state(X), member(X, ["массачусетс", "вермонт", "інші"]).
region("південний_схід") :- state(X), member(X, ["флорида", "місісіпі", "інші"]).
region("канада") :- province(X), member(X, ["онтаріо","квебек","інші"]).
nostrils(X) :- ask("ніздрі",X).
live(X) :- ask("живе",X).
bill(X) :- ask("дзьоб",X).
size(X) :- menuask(4,"розмір",X,["великий","повний","середній","малий"]).
eats(X) :- ask("їсть",X).
feet(X) :- ask("ноги",X).
wings(X) :- ask("крила",X).
neck(X) :- ask("шия",X).
color(X) :- ask("колір",X).
flight(X) :- menuask(5,"політ",X,["енергійний","важкий","рухливий","планування","інший"]).
feed(X) :- ask("харчується",X).
head(X) :- ask("голова",X).
tail(X) :- menuask(5,"хвіст",X,["вузький на кінці","з розвилиною","довгий_кольору_іржі","плоский","інший"]).
voice(X) :- ask("голос",X).
season(X) :- menuask(2,"пора_року",X,["зима","літо"]).
cheek(X) :- ask("щока",X).
flight_profile(X) :- menuask(3,"профіль_польоту",X,["плоский","v_подібна_форма","інше"]).
throat(X) :- ask("горло",X).
state(X) :- menuask(5,"штат",X,["массачусетс","вермонт","флорида","місісіпі","інше"]).
province(X) :- menuask(3,"провінція",X,["онтаріо","квебек","інше"]).
/* Кінець бази знань експертної системи з ідентифікації птахів */
start:- retractall(_,known),
bird(X),
Title="Title",
dlg_Note(Title,X),!.
% процедура предикату ask спочатку перевіряє чи є в динамічній базі даних
% факт known і є він так чи ні, якщо немає задає питання користувачу
% Використовується стандартний предикат dlg_Ask.
ask(A, V):- % перше правило спрацьовує, якщо питання стосовно
known("yes", A, V), % даного атрибуту і даного значення уже задавалось і
!. % відповідь була - так
ask(A, V):- % друге правило спрацьовує, якщо питання стосовно
known(_, A, V), % даного атрибуту і даного значення уже задавалось
!, fail. % і відповідь була - ні
ask(Attribute,_):- % третє правило спрацьовує, якщо питання стосовно
% даного атрибуту уже задавалось, атрибут не багатозначний і
not (multivalued(Attribute)), %відповідь була - так
known("yes",Attribute,_), % fail if its some other value.
!, fail. % the cut in clause #1 ensures
% this is the wrong value
ask(A, V):-
bound (V),
concat(A," ",A1),
concat(A1,V,X),
concat(X,"?",Y),
_ANSWER = dlg_Ask("MyTitle", Y,["Yes", "No", "Cancel"]),
analise(_ANSWER, A, V).
analise(_ANSWER, A, V):-
_ANSWER = resp_default,
asserta(known("yes", A, V)). % remember it
analise(_ANSWER, A, V):-
_ANSWER = resp_2,
asserta(known("no", A, V)), fail. % remember it
% аналог ask, але користувачу надається можливість вибирати відповідь
% із списку значень. Використовується стандартний предикат dlg_ListSelect.
menuask(_,A, V, _) :-
known("yes", A, V),
!.
menuask(_,A, V, _) :-
known(_, A, V), % fail if false
!, fail.
% випадок, якщо у списку два значення
menuask(2, A, V, Menu) :-
not(known(_, A, _)),
Result = cast(string, A),
concat("What is the value for ",Result,Title), Menu=[Msg1,Msg2|_],
PreSel= 0, % menu(Menu),
%dlg_Note(Msg),
dlg_ListSelect(Title,[Msg1,Msg2], PreSel, _StrSel, _Index),
asserta( known("yes", A, _StrSel) ),
V=_StrSel.
% випадок, якщо у списку три значення і т. д.
menuask(3, A, V, Menu) :-
not(known(_, A, _)),
Result = cast(string, A),
concat("What is the value for ",Result,Title), Menu=[Msg1,Msg2,Msg3|_],
PreSel= 0, % menu(Menu),
%dlg_Note(Msg),
dlg_ListSelect(Title,[Msg1,Msg2,Msg3], PreSel, _StrSel, _Index),
%dlg_Ask("MyTitle", _StrSel,["Yes", "No", "Cancel"]),
asserta( known("yes", A, _StrSel) ),
V=_StrSel.
%menuask(A, V, ["large","plump","medium","small"]) :-
%asserta( known("no", A, V) ).
menuask(4, A, V, Menu) :-
not(known(_, A, _)),
Result = cast(string, A),
concat("What is the value for ",Result,Title), Menu=[Msg1,Msg2,Msg3,Msg4|_],
PreSel= 0, % menu(Menu),
%dlg_Note(Msg),
dlg_ListSelect(Title,[Msg1,Msg2,Msg3,Msg4], PreSel, _StrSel, _Index),
%dlg_Ask("MyTitle", _StrSel,["Yes", "No", "Cancel"]),
asserta( known("yes", A, _StrSel) ),
V=_StrSel.
menuask(5, A, V, Menu) :-
not(known(_, A, _)),
Result = cast(string, A),
concat("What is the value for ",Result,Title), Menu=[Msg1,Msg2,Msg3,Msg4,Msg5|_],
PreSel= 0, % menu(Menu),
%dlg_Note(Msg),
dlg_ListSelect(Title,[Msg1,Msg2,Msg3,Msg4,Msg5], PreSel, _StrSel, _Index),
%dlg_Ask("MyTitle", _StrSel,["Yes", "No", "Cancel"]),
asserta( known("yes", A, _StrSel) ),
V=_StrSel.
menuask(6, A, V, Menu) :-
not(known(_, A, _)),
Result = cast(string, A),
concat("What is the value for ",Result,Title), Menu=[Msg1,Msg2,Msg3,Msg4,Msg5,Msg6|_],
PreSel= 0, % menu(Menu),
%dlg_Note(Msg),
dlg_ListSelect(Title,[Msg1,Msg2,Msg3,Msg4,Msg5,Msg6], PreSel, _StrSel, _Index),
%dlg_Ask("MyTitle", _StrSel,["Yes", "No", "Cancel"]),
asserta( known("yes", A, _StrSel) ),
V=_StrSel.
% процедура допоміжного предикату member
member(X, [X|_]).
member(X, [_|H]) :- member (X, H).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%BEGIN Task Window, e_Create
task_win_eh(_Win,e_Create(_),0):-!,
%BEGIN Task Window, InitControls, 19:24:53-30.1.2004, Code automatically updated!
%END Task Window, InitControls
%BEGIN Task Window, ToolbarCreate, 19:24:53-30.1.2004, Code automatically updated!
tb_project_toolbar_Create(_Win),
tb_help_line_Create(_Win),
%END Task Window, ToolbarCreate
ifdef use_message
msg_Create(100),
enddef
!.
%END Task Window, e_Create
%MARK Task Window, new events
%BEGIN Task Window, id_consult
task_win_eh(_Win,e_Menu(id_consult,_ShiftCtlAlt),0):-!,
start, !. % При виборі пункту меню Consult починається робота ЕС
%END Task Window, id_consult
%BEGIN Task Window, id_help_contents
task_win_eh(_Win,e_Menu(id_help_contents,_ShiftCtlAlt),0):-!,
vpi_ShowHelp("bird.hlp"),
!.
%END Task Window, id_help_contents
%BEGIN Task Window, id_help_about
task_win_eh(Win,e_Menu(id_help_about,_ShiftCtlAlt),0):-!,
dlg_about_dialog_Create(Win),
!.
%END Task Window, id_help_about
%BEGIN Task Window, id_file_exit
task_win_eh(Win,e_Menu(id_file_exit,_ShiftCtlAlt),0):-!,
win_Destroy(Win),
!.
%END Task Window, id_file_exit
%BEGIN Task Window, e_Size
task_win_eh(_Win,e_Size(_Width,_Height),0):-!,
ifdef use_tbar
toolbar_Resize(_Win),
enddef
ifdef use_message
msg_Resize(_Win),
enddef
!.
%END Task Window, e_Size
%END_WIN Task Window
/***************************************************************************
Invoking on-line Help
***************************************************************************/
project_ShowHelpContext(HelpTopic):-
vpi_ShowHelpContext("bird.hlp",HelpTopic).
/***************************************************************************
Main Goal
***************************************************************************/
goal
ifdef use_mdi
vpi_SetAttrVal(attr_win_mdi,b_true),
enddef
ifdef ws_win
ifdef use_3dctrl
vpi_SetAttrVal(attr_win_3dcontrols,b_true),
enddef
enddef
vpi_Init(task_win_Flags,task_win_eh,task_win_Menu,"bird",task_win_Title).
%BEGIN_TLB Project toolbar, 19:24:53-30.1.2004, Code automatically updated!
/**************************************************************************
Creation of toolbar: Project toolbar
**************************************************************************/
clauses
tb_project_toolbar_Create(_Parent):-
ifdef use_tbar
toolbar_create(tb_top,0xC0C0C0,_Parent,
[tb_ctrl(id_file_new,pushb,idb_new_up,idb_new_dn,idb_new_up,"New;New file",1,1),
tb_ctrl(id_file_open,pushb,idb_open_up,idb_open_dn,idb_open_up,"Open;Open file",1,1),
tb_ctrl(id_file_save,pushb,idb_save_up,idb_save_dn,idb_save_up,"Save;File save",1,1),
separator,
tb_ctrl(id_edit_undo,pushb,idb_undo_up,idb_undo_dn,idb_undo_up,"Undo;Undo",1,1),
tb_ctrl(id_edit_redo,pushb,idb_redo_up,idb_redo_dn,idb_redo_up,"Redo;Redo",1,1),
separator,
tb_ctrl(id_edit_cut,pushb,idb_cut_up,idb_cut_dn,idb_cut_up,"Cut;Cut to clipboard",1,1),
tb_ctrl(id_edit_copy,pushb,idb_copy_up,idb_copy_dn,idb_copy_up,"Copy;Copy to clipboard",1,1),
tb_ctrl(id_edit_paste,pushb,idb_paste_up,idb_paste_dn,idb_paste_up,"Paste;Paste from clipboard",1,1),
separator,
separator,
tb_ctrl(id_help_contents,pushb,idb_help_up,idb_help_down,idb_help_up,"Help;Help",1,1)]),
enddef
true.
%END_TLB Project toolbar
%BEGIN_TLB Help line, 20:58:36-26.1.2004, Code automatically updated!
/**************************************************************************
Creation of toolbar: Help line
**************************************************************************/
clauses
tb_help_line_Create(_Parent):-
ifdef use_tbar
toolbar_create(tb_bottom,0xC0C0C0,_Parent,
[tb_text(idt_help_line,tb_context,452,0,4,10,0x0,"")]),
enddef
true.
%END_TLB Help line
%BEGIN_DLG About dialog
/**************************************************************************
Creation and event handling for dialog: About dialog
**************************************************************************/
constants
%BEGIN About dialog, CreateParms, 19:24:54-30.1.2004, Code automatically updated!
dlg_about_dialog_ResID = idd_dlg_about
dlg_about_dialog_DlgType = wd_Modal
dlg_about_dialog_Help = idh_contents
%END About dialog, CreateParms
predicates
dlg_about_dialog_eh : EHANDLER
clauses
dlg_about_dialog_Create(Parent):-
win_CreateResDialog(Parent,dlg_about_dialog_DlgType,dlg_about_dialog_ResID,dlg_about_dialog_eh,0).
%BEGIN About dialog, idc_ok _CtlInfo
dlg_about_dialog_eh(_Win,e_Control(idc_ok,_CtrlType,_CtrlWin,_CtrlInfo),0):-!,
win_Destroy(_Win),
!.
%END About dialog, idc_ok _CtlInfo
%MARK About dialog, new events
dlg_about_dialog_eh(_,_,_):-!,fail.
%END_DLG About dialog