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. Программа, имитирующая разговор психотерапевта с пациентом
Закрыть окно