Листинг

Раздел описания доменов является аналогом раздела описания типов в обычных императивных языках программирования и начинается с ключевого слова DOMAINS:

 

DOMAINS

CONDITIONS = BNO *

HISTORY = RNO *

RNO, BNO, FNO = INTEGER

CATEGORY = SYMBOL

 

Начинается раздел описания предикатов внутренней базы данных с зарезервированного слова DATABASE и описываются в нем те предикаты, которые можно в процессе выполнения программы добавлять во внутреннюю базу данных или удалять оттуда:

 

DATABASE

rule(RNO, CATEGORY, CATEGORY,CONDITIONS)

cond(BNO, STRING)

yes(BNO)

no(BNO)

topic(string)

 

В разделе, озаглавленном зарезервированным словом PREDICATES, содержатся описания определяемых пользователем предикатов. В традиционных языках программирования подобными разделами являются разделы описания заголовков процедур и функций. Домены аргументов должны быть либо стандартными, либо объявленными в разделе описания доменов. Один предикат может иметь несколько описаний. Это используется, когда нам нужно, чтобы предикат работал с аргументами различной природы.

 

PREDICATES

do_expert_job

show_menu

do_consulting

process(integer)

info(CATEGORY)

goes(CATEGORY)

listopt

erase

clear

eval_reply(char)

go(HISTORY, CATEGORY)

check(RNO, HISTORY, CONDITIONS)

notes(BNO)

inpo(HISTORY, RNO, BNO, STRING)

do_answer(HISTORY, RNO, STRING, BNO, INTEGER)

goal

do_expert_job.

 

Все предикаты, которые применяются в этом разделе и не являются стандартными предикатами, должны быть описаны в разделе описания предикатов или в разделе описания предикатов базы данных. Начинается этот раздел со служебного слова CLAUSES.

Предложения, у которых в заголовке указан один и тот же предикат, должны идти друг за другом. Такой набор предложений называется процедурой. Программу на Прологе принято оформлять по следующим правилам:

• между процедурами пропускается пустая строка;
• тело правила записывается со следующей строки, после строки, в которой был заголовок, с отступом;
• каждую подцель записывают на отдельной строке, одну под другой.

Эти правила не являются обязательными, но они делают программу более "читабельной":

 

CLAUSES

topic("dog").

topic("short-haired dog").

topic("long-haired dog").

rule(1, "dog", "short-haired dog", [1]).

rule(2, "dog", "long-haired dog", [2]).

rule(3, "short-haired dog","English Bulldog ", [3,5,7]).

rule(4, "short-haired dog","Beagle", [3,6,7]).

rule(5, "short-haired dog","Great Dane", [5,6,7,8]).

rule(6, "short-haired dog","American Foxhound",[4,6,7]).

rule(7, "long-haired dog", "Cocker Spaniel", [3,5,6,7]).

rule(8, "long-haired dog", "Irish Setter", [4,6]).

rule(9, "long-haired dog", "Collie", [4,5,7]).

rule(9, "long-haired dog", "St. Bernard", [5,7,8]).

cond(1, "short-haired").

cond(2, "long-haired").

cond(3, "height under 22 inches").

cond(4, "height under 30 inches").

cond(5, "low-set tail").

cond(6, "longer ears").

cond(7, "good natured personality").

cond(8, "weight over 100 lb").

do_expert_job:-

makewindow(1,7,7," DOG EXPERT SYSTEM ",0,0,25,80),

show_menu,

nl,write(" Press space bar. "),

readchar(_), exit.

show_menu:-

write(" "),nl,

write(" * * * * * * * * * * * * * * * * * * "),nl,

write(" * DOG EXPERT * "),nl,

write(" * * "),nl,

write(" * 1. Consultation * "),nl,

write(" * 2. Exit the system * "),nl,

write(" * * "),nl,

write(" * * * * * * * * * * * * * * * * * * "),nl,

write(" "),nl,

write("Please enter your choice: 1 or 2: "),nl,

readint(Choice),

process (Choice).

process(1):- do_consulting.

process(2):-

removewindow, exit.

do_consulting:-

goes(Mygoal), go([],Mygoal),!.

do_consulting:-

nl, write(" Sorry I can't help you."), clear.

do_consulting.

goes(Mygoal):-

clear, clearwindow,

nl,nl, write(" "),nl,

write(" WELCOME TO THE DOG EXPERT SYSTEM "),nl,

write(" "),nl,

write("This is a dog identification system. "),nl,

write("To begin the process of choosing a "),nl,

write("dog, please type in 'dog'. If you "),nl,

write("wish to see the dog types, please "),nl,

write("type in a question mark (?). "),nl,

write(" "),nl,

readln(Mygoal), info(Mygoal),!.

info("?"):-

clearwindow, write("Reply from the KBS."),nl,

listopt, nl,write("Please any key. "),

readchar(_), clearwindow,

exit.

info(X):- X >< "?".

listopt:-

write("The dog types are: "),nl,nl, topic(Dog),

write(" ",Dog),nl, fail.

listopt.

inpo(HISTORY,RNO,BNO,TEXT):-

write("Question:- ",TEXT,"? "),

makewindow(2,7,7,"Response",10,54,7,20),

write("Type 1 for 'yes',"),nl,

write("Type 2 for 'no': "),nl,

readint(RESPONSE), clearwindow,

shiftwindow(1),

do_answer(HISTORY,RNO,TEXT,BNO,RESPONSE).

eval_reply('y'):-

write(" I hope you have found this helpful!").

eval_reply('n'):-

write(" I am sorry I can't help you!").

go(_,Mygoal):-

not(rule(_,Mygoal,_,_)),!,

nl,write(" The dog you have indicated is a(n) ",

Mygoal,"."),nl,

write("Is a dog you would like to have (y/n)?"),

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,"not",COND),

frontchar(COND,_,COND),

cond(BNO1,COND),

notes(BNO1),!,

check(RNO,HISTORY,REST).

check(_,_,[BNO|_]):-

cond(BNO,NCOND),

fronttoken(NCOND,"not",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(_,_,[]).

notes(BNO):- no(BNO),!.

notes(BNO):- not(yes(BNO)),!.

do_answer(_,_,_,_,0):- exit.

do_answer(_,_,_,BNO,1):-

assert(yes(BNO)),

shiftwindow(1),

write(yes),nl.

do_answer(_,_,_,BNO,2):-

assert(no(BNO)), write(no),nl, fail.

erase:- retract(_),fail.

erase.

clear:- retract(yes(_)),retract(no(_)),fail,!.

clear.