domains
predicates
test1(symbol)
test2(symbol,symbol)
test3(symbol,symbol,symbol)
test4(symbol,symbol,symbol,symbol)
its(symbol)
confirm(symbol,symbol)
denied(symbol,symbol)
check_if(symbol,symbol)
remember(symbol,symbol,symbol)
find
guess
database
db_confirm(symbol,symbol)
db_denied(symbol,symbol)
have_found(symbol)
clauses
test1(m):- its(student),!.
test1(n).
test2(m,c):- confirm(have, english), asserta(have_found(sidorov)),!.
test2(m,f):- asserta(have_found(petrov)),!.
test2(n,w):- its(engineer),!.
test2(n,c):- asserta(have_found(ivanov)),!.
test3(n,w,f):- confirm(have,english),asserta(have_found(fedorov)),!.
test3(n,w,n):- not(confirm(have,english)),!.
test4(n,w,n,f):- confirm(have,guitar),asserta(have_found(pavlov)),!.
test4(n,w,n,c):- asserta(have_found(sergeev)),!.
guess:- not(find),have_found(V),write("Искомый человек - ",V),!.
guess:- have_found(V),write("Искомый человек - ",V).
find:- test1(X),test2(X,Y),test3(X,Y,Z),test4(X,Y,Z,W).
its(engineer):- confirm(have,diplom),!.
its(student):- confirm(have,stud_bilet),!.
confirm(X,Y):- db_confirm(X,Y),!.
confirm(X,Y):- not(denied(X,Y)),! and check_if(X,Y).
denied(X,Y):- db_denied(X,Y),!.
check_if(X,Y):- write("He ",X," ",Y," /n"),readln(Reply),remember(X,Y,Reply).
remember(X,Y,y):-asserta(db_confirm(X,Y)).
remember(X,Y,n):-asserta(db_denied(X,Y)),fail.
goal guess.
Задание № 4
Необходимо по заданным исходным данным о проблемной ситуации разработать экспертную систему.
Заданы сведения по лекарствам:
Тетрациклин - антибиотик. Цена - 5.75. Можно купить в аптеках:
Ленина 22, Очаковцев 34, Коммунистическая 38.
Валокордин (корвалол) - успокаивающее. Цена - 1.20. Можно купить в аптеках: Острякова 37, коммунистическая 38, Большая Морская 22.
Панадол - жаропонижающее. Цена - 1.20. Можно купить в аптеках: Гоголя 17, Горпищенко 15, фадеева 30.
Супрастин - противоаллергическое. Цена -4.47. Можно купить в аптеках: Восставших1, Хрюкина 4.
Разработать интерфейс на естественном языке для извлечения информации по ключевым словам - названиям лекарств.
Ниже приведённая программа представляет реализацию задания, но с некоторыми оговорками. Т.к. Turbo Prolog 2.0, обрабатывает исключительно латинский алфавит, то и экспертная система обрабатывает запросы сделанные на английском языке.
Варианты возможных вопросов
- How many costs <keyword> (Сколько стоит …)
- Were it is possible to find <keyword> (Где можно найти …)
- Give me the information about <keyword>
(Дайте мне информацию о …)
- I want to learn about <keyword> (Я хочу узнать о …)
где, -- <keyword> ключевое слово по которому и производится идентификация.
Программа
domains
list=symbol*
predicates
ind(symbol,symbol,symbol,list)
dsyn(symbol,symbol)
reject(symbol)
docdriver
getquery(list)
chengeform(symbol,list)
findref(symbol,list)
memberof(list,symbol)
produceans(symbol)
putflag
syn(symbol,symbol)
remflag
database
flag
clauses
ind("TETRATSECLIN","антибиотик","5.75",
["Ленина 22, Очаковцев 34, Коммунистическая 38"]).
ind("VOLOCARDIN","успокаивающее","1.2",
["Острякова 37, Коммунистическая 38, Большая Морская 22"]).
ind("PANADOL","жаропонижающее","1.2",
["Гоголя 17, Горпищенко 15, Фадеева 30"]).
ind("SUPRASTIN","антигистаминное","4.47",["Восставших 1, Хрюкина 4"]).
dsyn("VOLOCARDIN","CARVALOL").
reject("WHERE").
reject("HOW").
reject("COSTS").
reject("POSSIBLE").
reject("FIND").
reject("IT").
reject("I").
reject("WANT").
reject("LEARN").
reject("THE").
reject("ME").
reject("ABOUT").
reject("INFORMATION").
reject("TO").
reject("IS").
reject("GIVE").
reject("MANY").
docdriver:- nl, getquery(X), findref(Y,X),produceans(Y).
getquery(Y):- write("Please enter the question"), nl, readln(Z),
upper_lower(Y1,Z), chengeform(Y1,Y).
chengeform(S,[H|T]):- fronttoken(S,H,S1),!,
chengeform(S1,T).
chengeform(_,[]).
memberof([X|_],X).
memberof([_|Y],X):- memberof(Y,X).
findref(Y,X):- memberof(X,Y), not(reject(Y)),!.
produceans(X):- ind(X,X1,X2,X3), putflag,
write(X," - это ",X1," средство. Цена ",X2," гр. по адресам ",X3),nl.
produceans(X):- syn(X,Z), ind(Z,X1,X2,X3), putflag,
write(X," - это ",X1," средство. Цена ",X2," гр. по адресам ",X3),nl.
produceans(X):- not(flag), write("Информация o ",X," отсутствует."),nl.
produceans(_):- remflag.
putflag:- not(flag),asserta(flag),!.
putflag.
remflag:- flag, retract(flag),!.
remflag.
syn(X,Y) if dsyn(Y,X).
syn(Y,X) if dsyn(X,Y).
goal docdriver,!.