CONSTANTS /* раздел описания констант */
separators=[' ', ',', '.', ';']
/* символы-разделители (пробел,
запятая, точка, точка с запятой
и т.д.) */
DOMAINS /* раздел описания доменов */
i=integer
s=string
ls=s* /* список слов */
lc=char* /* список символов */
DATABASE /* раздел описания предикатов базы данных */
Important(s)
PREDICATES /* раздел описания предикатов */
member(s,ls) /* проверяет принадлежность строки списку
строк */
member(char,lc) /* проверяет принадлежность символа списку
символов */
lower_rus(char,char) /* преобразует прописную русскую
букву в строчную букву */
del_sep(s,s) /* удаляет из начала строки
символы-разделители */
first_word(s,s,s) /* делит строку на первое слово
и остаток строки */
str_w_list(s,ls) /* преобразует строку в список слов */
read_words(ls) /* читает строку с клавиатуры, возвращает
список слов, входящих в строку*/
recognize(ls,i) /* сопоставляет списку слов число,
кодирующее шаблон */
answ(ls) /* выводит ответ человеку */
eliz /* основной предикат */
repeat
CLAUSES /* раздел описания предложений */
eliz:–
repeat,
read_words(L), /* читаем строку с клавиатуры,
преобразуем ее в список слов L */
recognize(L,I), /* сопоставляем списку слов L номер
шаблона I */
answ(I),nl, /* выводим ответ, соответствующий номеру
шаблона I */
I=0 /* номер шаблона I, равный нулю, означает,
что человек попрощался */.
read_words(L):–
readln(S), /* читаем строку */
str_w_list(S,L). /* преобразуем строку
в список слов */
recognize(L,0):–
member("пока",L),!;
member("свидания",L),!.
recognize(L,1):–
member("испытываю",L),!.
recognize(L,2):–
member("любовь",L),!;
member("чувства",L),!.
recognize(L,3):–
member("секс",L),!.
recognize(L,4):–
member("бешенство",L),!;
member("гнев",L),!;
member("ярость",L),!.
recognize(L,5):–
L=["да"],!;
L=["нет"],!.
recognize(L,6):–
member("комплекс",L),!;
member("фиксация",L),!.
recognize(L,7):–
member("всегда",L),!.
recognize(L,8):–
member("мать",L),assert(important("своей матери")),!;
member("мама",L),assert(important("своей маме")),!;
member("отец",L),assert(important("своем отце")),!;
member("папа",L),assert(important("своем папе")),!;
member("муж",L),assert(important("своем муже")),!;
member("жена",L),assert(important("своей жене")),!;
member("брат",L),assert(important("своем брате")),!;
member("сестра",L),assert(important("своей сестре")),!;
member("дочь",L),assert(important("своей дочери")),!;
member("сын",L),assert(important("своем сыне")),!.
recognize(_,9):–
important(_),!.
recognize(_,10).
answ(0):–
write("До свидания"),nl,
write("Надеюсь наше общение помогло Вам").
answ(1):–
write("Как давно Вы это испытываете?").
answ(2):–
write("Вас пугают эмоции?").
answ(3):–
write("Это представляется важным").
answ(4):–
write("А что Вы испытываете сейчас?").
answ(5):–
write("Расскажите об этом подробнее").
answ(6):–
write("Слишком много игр").
answ(7):–
write("Вы можете привести какой–нибудь пример?").
answ(8):–
write("Расскажите мне подробнее о своей семье").
answ(9):–
important(X),!,
write("Ранее Вы упомянули о ",X),
retract(X).
answ(10):–
write("Продолжайте, пожалуйста").
repeat.
repeat:–
repeat.
member(X,[X|_]):–!.
member(X,[_|S]):–member(X,S).
lower_rus(C,C1):–
'А'<=C,C<='П',!, /* символ C лежит между
буквами 'А' и 'П' */
char_int(C,I), /* I — код символа C */
I1=I+(160–128), /* 160 — код буквы 'а',
128 — код буквы 'А'*/
char_int(C1,I1). /* C1 — символ с кодом I1 */
lower_rus(C,C1):–
'Р'<=C,C<='Я',!, /* символ C лежит между
буквами 'Р' и 'Я' */
char_int(C,I), /* I — код символа C */
I1=I+(224–144), /* 224 — код буквы 'р',
144 — код буквы 'Р'*/
char_int(C1,I1). /* C1 — символ с кодом I1 */
lower_rus(C,C). /* символ C отличен от прописной русской
буквы и, значит, мы не должны его
изменять */
del_sep("",""):–!.
del_sep(S,S1):–
frontchar(S,C,R),
/* C — первый символ строки,
R — остальные символы */
member(C,separators),!,
/* если C является
символом-разделителем, */
del_sep(R,S1). /* то переходим
к рассмотрению остатка
строки */
del_sep(S,S) . /* если первый символ строки не является
символом-разделителем, то удалять
нечего */
str_w_list("",[]):–!.
/* пустой строке соответствует пустой список
слов, входящих в нее */
str_w_list(S,[H|T]):–
first_word(S,H,R),!,
/* H — первое слово строки S, R —
оставшиеся символы строки S */
str_w_list(R,T).
/* T — список, состоящий из слов,
входящих в строку R */
first_word("","",""):–!. /* из пустой строки можно
выделить только пустые
подстроки */
first_word(S,W,R):– /* W — первое слово строки S, R —
остальные символы исходной строки S */
frontchar(S,C,R1),
/* C — первый символ строки S,
R1 — остальные символы */
not(member(C,separators)),!,
/* символ C не является
символом-разделителем */
first_word(R1,S1,R),
/* S1 — первое слово строки R1,
R — оставшиеся символы
строки R1 */
lower_rus(C,C1),
/* если C — прописная русская
буква , то C1 — соответствующая
ей строчная буква, иначе символ
C1 не отличается от символа C */
frontchar(W,C1,S1).
/* W — результат "приклеивания"
символа C1 в начало
строки S1 */
first_word(S,"",R):– /* в случае, если первый символ
оказался символом-разделителем, */
frontchar(S,_,R). /* его нужно
выбросить, */
GOAL /* раздел описания цели */
write("Расскажите, в чем заключается Ваша проблема"),nl,
eliz,
readchar(_). |
Листинг 14.1. Программа, имитирующая разговор психотерапевта с пациентом |
| Закрыть окно |