Листинг

Раздел описания доменов является аналогом раздела описания типов в обычных императивных языках программирования и начинается с ключевого слова 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.