Straberry prolog

[pilottt]

Создать экспертную систему, с двадцатью исходами.
Вот пример проги, только в ней меньше исходов:
/* Программа 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,RESP ONSE).
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