%
%  patdef(Tipo, Estimulo, Resposta)
%
%  "Codigo-fonte" dos padroes de reacao (estimulo-resposta) que regem o compor-
%  tamento de Eliza. Cada patdef/3 sera processado por prepare(xpatdef) na geracao de
%  um respectivo xpatdef/3 (eXpanded patdef), que eh o predicado diretamente u-
%  sado por Eliza em pattern/2.
%
%  Argumentos:
%
%   . Estimulo: casa com a entrada do usuario, representada no formato
%     <entrada como lista de atomos, exceto ponto final>:<ponto final>. A lis-
%     ta em questao, na especificacao de um padrao de estimulo, pode conter ele-
%     mentos especiais no formato {L}, que representam sublistas L de qualquer
%     comprimento, inclusive 0. Dessa forma, [i, {L}, you] casa com [i, love,
%     you] - L = [love] - ou [i, cant, put, up, with, you] - L = [cant, put,
%     up, with] - ou [i, you] - L = []. Para maiores informacoes, vide
%     buildMatcher/3 e prepare(xpatdef);
%
%   . Resposta: a "pre-resposta" de Eliza, no formato <lista de strings e ato-
%     mos em varios niveis>:<ponto final>. Uma resposta final de Eliza sera ob-
%     tida pelo "achatamento" de uma pre-resposta e "inversao do sentido do
%     discurso" (vide exchange/2 e fixReply/2);
%
%   . Tipo: representa o que sera feito do padrao de reacao caso ele seja o
%     gerador da resposta corrente. Os possiveis valores de Tipo sao os seguin-
%     tes:
%
%      . once  - padrao deve ser retirado da base;
%      . fifo  - padrao deve ser retirado da base e, em seguida, inserido como
%                o ultimo, diminuindo a ocorrencia de repeticao direta (Eliza
%                aplica sempre o primeiro padrao casado);
%      . fixed - padrao deve permanecer onde esta.
%

%
%  Tratamento de saudacoes
%

patdef(once, [Bye| _]:_, [bye]:_) :-
  elem(Bye, [bye, stop, halt, finish, cheerio]).

patdef(once, [Hi| _]:_, [$hello! how can i help you$]:'?') :-
  elem(Hi, [hi, hey, hello]).

patdef(once, [Hi| _]:_, [$again? is it a kind of hobby$]:'?') :-
  elem(Hi, [hi, hey, hello]).

patdef(fixed, [Hi| _]:_, [$(looking at you, puzzled)$]:' ') :-
  elem(Hi, [hi, hey, hello]).

%
%  Tratamento de falta-de-educacao
%
%  Compare com o tratamento de saudacoes (acima) em termos de eficiencia.
%

patdef(fixed, X:_, _) :-
  elem(Word, X),
  badWord(Word),
  assert(badWordAlarmOn),
  fail.

patdef(once, _, [$please rephrase it! Bad language is not allowed here$]:'.') :- retract(badWordAlarmOn).

patdef(once, _, [$why do you feel the need to be so hostile$]:'?') :- retract(badWordAlarmOn).

patdef(once, _, [$cut the foul language, you S.O.B.$]:'!') :- retract(badWordAlarmOn).

patdef(once, _, [$i give up trying to correct your language. Do as you wish$]:'...') :- retract(badWordAlarmOn).

patdef(fixed, _, _) :- retract(badWordAlarmOn), fail.
 

%
%  Tratamento de conversa mais educada
%

patdef(once, [i, X, my| Rest]:_, [$do you always have these feelings of$, X, $towards your$, Rest, $often$]:'?') :-
  feeling(X).

patdef(once, [i, {X}, you| _]:_, [$why do you say that you$, X, $ me$]:'?').

patdef(once, [they, {X}, me]:_, [$what makes you say that they$, X, $ you$]:'?').

patdef(once , [this, is| X]:_, [$why do you say that this is$| X]:'?').

patdef(once, [my| X]:_, [$ your$| X]:'...').

patdef(once, [it, is| X]:_, [$so you feel that it is$, X, $, dont you$]:'?').

patdef(fifo, [i, am| X]:_, [$how long have you been$| X]:'?').

patdef(fifo, [i, like| X]:_, [$does anyone you know like$| X]:'?').

patdef(fifo, [i, feel| _]:_, [$do you often feel that way$]:'?').

patdef(once, [help| _]:_, [$what sort of help do you think you need$]:'?').

patdef(once, X:_, [$do you like animals, I mean pets and suchlike$]:'?') :-
  elem(Word, X),
  animal(Word).

patdef(once, X:_, [$you seem rather unsure of yourself$]:'...') :-
  elem(Word, X),
  uncertain(Word).

patdef(once, X:_, [$do computers frighten you$]:'?') :-
  elem(Word, X),
  important(Word, computers).

patdef(once, X:_, [$how close are you to your$, Word]:'?') :-
  elem(Word, X),
  important(Word, family).

patdef(once, X:_, [$is your$, Word, $very important to you as a friend$]:'?') :-
  elem(Word, X),
  important(Word, friends),
  not((Word = friends; Word = friend)).

patdef(once, X:_, [$how no you get on with friends in general$]:'?') :-
  elem(Word, X),
  important(Word, friends).

patdef(once, X:_, [$please try to be more positive about things! Tell me something good that happened to you recently$]:'. ') :-
  elem(Word, X),
  badFeeling(Word).

patdef(once, X:_, [$cheer up, you miserable wretch$]:'!') :-
  elem(Word, X),
  badFeeling(Word).

patdef(once, [X]:_, [$dont be so short with me! what does$, X, $mean here$]:'?') :-
  yesOrNo(X).

patdef(fifo, [X]:_, [$too short again$]:'...') :-
  yesOrNo(X).

patdef(fifo, [X]:_, [$i am sure you can give me more$]:'...') :-
  yesOrNo(X).

patdef(once, []:_, [$tell me about your family$]:'. ').

patdef(once, []:_, [$i am still listening$]:'...').

patdef(once, []:_, [$come on$]:'!').

patdef(once, []:_, [$i am not a telepath, so i cant help you if you dont speak$]:'...').

patdef(once, []:_, [$ok, it is up to you. Take your time$]:'...').

patdef(fixed, []:_, [$(waiting)$]:' ').

patdef(fifo, [X]:_, [$what do you mean$, X]:'?').

%
%  important(Item, Context) - Item eh importante em Context.
%

important(mum, family).
important(dad, family).
important(father, family).
important(mother, family).
important(sister, family).
important(brother, family).
important(son, family).
important(daughter, family).
important(family, family).
important(boyfriend, friends).
important(girlfriend, friends).
important(friend, friends).
important(friends, friends).
important(mate, friends).
important(byte, computers).
important(prolog, computers).
important(printer, computers).
important(computers, computers).
important(computer, computers).
important(pc, computers).
 

%
%  badWord(X) - X eh um palavrao.
%

badWord(bastard).
badWord(sod).
badWord(bloody).
badWord(fuck).
badWord(fucking).
badWord(shit).
 

%
%  uncertain(X) - X expressa incerteza.
%

uncertain(may).
uncertain(might).
uncertain(perhaps).
uncertain(maybe).
uncertain(possibly).
uncertain(probably).
 

%
%  yesOrNo(X) - X eh 'sim' ou 'nao'.
%

yesOrNo(yes).
yesOrNo(no).
 

%
%  feeling(X) - X esta ligado a sentimentos.
%

feeling(X) :-
  goodFeeling(X).

feeling(X) :-
  badFeeling(X).
 

%
%  goodFeeling(X) - X esta ligado a um bom sentimento.
%

goodFeeling(like).
goodFeeling(likes).
goodFeeling(happy).
goodFeeling(love).
goodFeeling(loves).
 

%
%  badFeeling(X) - X esta ligado a um mau sentimento.
%

badFeeling(dislike).
badFeeling(dislikes).
badFeeling(despise).
badFeeling(unhappy).
badFeeling(sad).
badFeeling(hate).
badFeeling(hates).
badFeeling(depressed).
badFeeling(suicidal).
badFeeling(suicide).
badFeeling(kill).
badFeeling(murder).
badFeeling(death).
badFeeling(horrible).
badFeeling(awful).
badFeeling(dread).
 

%
%  exchange/2
%
%  "Codigo-fonte" dos padroes de substituicao para inversao do sentido do dis-
%  curso. Cada exchange/2 sera processado por prepare(exchange_dl) na geracao de
%  um respectivo exchange_dl/2 (exchange with Difference List), que eh o pre-
%  dicado diretamente usado por Eliza em fixReply_dl/2.
%

exchange([i, am], [you, are]).
exchange([you, are], [i, am]).
exchange([are, you], [am, i]).
exchange([am, i], [are, you]).

exchange([i, was], [you, were]).
exchange([you, were], [i, was]).
exchange([were, you], [was, i]).
exchange([was, i], [were, you]).

exchange([i], [you]).
exchange([me], [you]).
exchange([you], [me]).

exchange([my], [your]).
exchange([your], [my]).
exchange([mine], [yours]).
exchange([yours], [mine]).
 

%
%  miniEliza/0 - predicado principal
%

miniEliza :-
  tidyUp,
  therapy([$next$]:'!').
 

%
%  tidyUp/0
%
%  Prepara a base de dados para uma nova sessao de terapia.
%

tidyUp :-
  prepare(_).
 

%
%  therapy/1
%
%  Cada instancia de therapy/1 eh uma "rodada" da sessao, que consiste em Eliza
%  dizer alguma coisa (= unico argumento), ouvir a resposta do usuario e "cal-
%  cular" o que dizer a seguir.
%
%  Esse predicado tambem controla condicao de fim do programa.
%
 

therapy([bye]:_) :-
  !,
  say([$Ok. Just before you leave... What's it gonna be: cash, cheque or VISA$]:'?').

therapy(Output) :-
  talk(Output, Input),
  reply(Input, Reply),
  therapy(Reply).
 

%
%  talk/2, say/1, listenTo/1, read_atomlist/1, write_atomlist/1.
%
%  Predicados auxiliares de therapy, responsaveis por entrada e saida.
%
%  Obs.: se o usuario digitar, numa mesma fala, varias frases, listenTo/1 so
%  "ouvira" a primeira delas e descartara as demais, mesmo para as proximas
%

talk(Output, Input) :-
  say(Output),
  nl,
  listenTo(Input).
 

say(Output:Period) :-          %  <- apresenta a fala de Eliza.
  write($eliza: $),
  write_atomlist(Output),
  write(Period).
 

listenTo(Phrase) :-            %  <- le a primeira frase do usuario.
  write($you: $),
  read_atomlist(Atoms),
  firstPhrase(Atoms, Phrase).
 

read_atomlist(Atoms) :-        %  <- le lista de atomos.
  read_string(Line),
  string_tokens(Line, Atoms).
 

write_atomlist(List) :-        %  <- escreve lista de atomos, separados por ' '
  stringlist_concat(List, $ $, Str),
  write(Str).
 

%
%  period/1 - definicao dos delimitadores de frases (pontos finais)
%

period('. ').
period('.').
period('?').
period('!').
 

%
%  firstPhrase(Atoms, Phrase)
%
%  Isola a primeira frase, Phrase = <frase>:<ponto final>, encontrada em Atoms.
%

firstPhrase(Atoms, Phrase) :-
  firstPhrase(Atoms, Phrase, _).
 

firstPhrase(Atoms, Phrase:Period, Rest) :-
  conc(Phrase, [Period| Rest], Atoms),
  period(Period),
  !.

firstPhrase(Phrase, Phrase:'. ', []).
 

%
%  reply(Input, Reply)
%
%  Calcula, a partir da cadeia de entrada Input, a resposta final de Eliza,
%  Output. Ambos os argumentos estao no formato <frase como lista de atomos>:
%  <ponto final>.
%

reply(Input, Reply:Period) :-
  pattern(Input, PreReply:Period),
  fixReply1(PreReply, Reply).
 

%
%  pattern(Input, PreReply)
%
%  Acessa a base em busca do primeiro padrao de reacao que se aplica ao par
%  estimulo-resposta (Input, PreReply). PreReply ainda deve ser submetida a
%  achatamento e inversao de sentido do discurso.
%
%  Alem disso, pattern/2 atualiza a base de conhecimento quanto ao tipo do
%  padrao aplicado (vide patdef/2).
%

pattern(Input, PreReply) :-
  db_ref(xpatdef(PatType, Input, PreReply), Body, Ref),
  call(Body),
  !,
  onMatch(PatType, Ref).

pattern(_, LowPunch) :-           %  <- quando tudo mais falhar, jogue baixo.
  retract(lowPunch(LowPunch)),    %  <- evita repeticao direta do mesmo gol-
  !,                              %     pe baixo.
  assertz(lowPunch(LowPunch)).
 

lowPunch([$tell me more$]:'...'). %  <- golpes baixos: as respostas mais va-
lowPunch([$go on$]:'...').        %     zias possiveis.
lowPunch([$i see. And$]:'...').
lowPunch([$i see. But$]:'...').
lowPunch([]:'...').
 

%
%  onMatch(PatType, Ref)
%
%  Realiza a acao correspondente a PatType sobre a regra Prolog referenciada
%  por Ref.
%

onMatch(once, Ref) :-
  !,
  erase(Ref).

onMatch(fifo, Ref) :-
  !,
  db_ref(Head, Body, Ref),
  erase(Ref),
  assert((Head :- Body)).

onMatch(fixed, Ref).
 

%
%  Predicados classicos de manipulacao de listas
%

elem(X, [X| _]).      %  <- ocorrencia de elemento em lista.

elem(X, [_| Xs]) :-
  elem(X, Xs).
 

elem1(X, Xs) :-       %  <- 1a ocorrencia de elemento em lista.
  elem(X, Xs),
  !.
 

conc([], L, L).       %  <- conc(A, B, C) - concatenacao de duas listas A e B.

conc([X| L1], L2, [X| L]) :-
  conc(L1, L2, L).
 

%
%  join(Pred1, Pred2, AndPred)
%
%  Predicado auxiliar na geracao automatica de codigo Prolog. AndPred eh a con-
%  juncao dos predicados Pred1 e Pred2, nessa ordem. Tudo ocorre como na apli-
%  cacao direta do funtor ',', exceto pela eliminacao de chamadas a true, com o
%  objetivo de gerar codigo mais limpo e eficiente.
%

join(true, X, X) :-
  !.

join(X, true, X) :-
  !.

join(X, Y, (X, Y)).
 

%
%  buildMatcher(Source, Head, Pred)
%
%  "Compilador" de definicoes de padroes de estimulo.
%
%  Dada uma definicao "abstrata" de padrao de estimulo Source, buildMatcher/3
%  monta uma implementacao Prolog de reconhecedor do padrao definido, cons-
%  tituido pelo par (Head, Pred) e que deve ser aplicado da seguinte forma a
%  uma lista de entrada L:
%
%    1 - unificacao Head = L;
%    2 - avaliacao de Pred: call(Pred).
%
%  Se e somente se a sequencia de aplicacao tiver sido bem-sucedida, o padrao
%  de estimulo em questao foi detectado.
%
%  Exemplos de compilacao:
%
%    . definicao: [i, am, X, but| Y];
%    . resultado: Head = [i, am, X, but| Y],
%                 Pred = true;
%
%    . definicao: [i, am, {X}, but, {Y}, and| Z];
%    . resultado:  Head = [i, am| Rest1],
%                 Pred = (
%                   conc(X, [but| Rest2], Rest1),
%                   conc(Y, [and| Z], Rest2)
%                 );
%
%    . definicao: [i, am, {X}, but, {Y}, and, {Z}];
%    . resultado: Head = [i, am| Rest1],
%                 Pred = (
%                   conc(X, [but| Rest2], Rest1),
%                   conc(Y, [and| Rest3], Rest2),
%                   conc(Z, [], Rest3)
%                 ).
%
%  Obs.:
%
%    . os dois ultimos exemplos acima sao semanticamente equivalentes,
%      mas o primeiro gerou codigo mais eficiente. Moral: nao usar {L}
%      no fim de definicoes de padrao de estimulo;
%
%    . consulte prepare(xpatdef) para um bom exemplo de uso de buildMatcher.
%

buildMatcher(Var, Var, true) :-
  var(Var),
  !.

buildMatcher([], [], true) :-
  !.

buildMatcher([X| Xs], [X| Ys], Pred) :-
  var(X),
  !,
  buildMatcher(Xs, Ys, Pred).

buildMatcher([{L}| Tail], OpenTail, Pred) :-
  !,
  buildMatcher(Tail, NextHead, NextPred),
  join(conc(L, NextHead, OpenTail), NextPred, Pred).
 

buildMatcher([X| Xs], [X| Ys], Pred) :-
  buildMatcher(Xs, Ys, Pred).
 

%
%  list_dl(List, OpenDl)
%
%  Converte a lista convencional List na lista-diferenca aberta OpenDl e vice-
%  versa. Uma lista-diferenca aberta OpenL/Tail eh, em ultima analise, uma lis-
%  ta aberta OpenL a cuja cauda variavel - Tail - tem-se acesso direto.
%
%  Por exemplo, [a, b, c| X]/X eh a lista-diferenca aberta correspondente a [a,
%  b, c].
%

list_dl([], Xs/Xs) :-
  !.

list_dl([X| Xs], [X| Ys]/Zs) :-
  list_dl(Xs, Ys/Zs).
 

%
%  buildExchange_dl(X, Y, Exchange_dl).
%
%  A partir do par de substituicao-padrao X->Y, a ser obtido pelo acesso a
%  exchange/2, buildExchange_dl/3 monta o termo Exchange_dl correspondente, que
%  nao faz nada mais que agregar X e Y em versao lista-diferenca aberta.
%
%  Para que se tenha uma ideia da vantagem de se usar listas-diferenca abertas
%  nessa aplicacao, observe o seguinte exemplo: supondo que exista o par de
%  substituicao
%
%    [a, b, c, d, e| Resto1]/Resto1 -> [o, p, q, r| Resto2]/Resto2,
%    |<------- L1 -------->|           |<-- L2 ->|
%
%  e que se queira comecar a realizar substituicoes na sequencia L3, gerando
%  Rslt,
%
%    [a, b, c, d, e, f, g] -> Rslt
%    |<------ L3 ------->|
%
%  basta tentar unificar L1 = L3 e L2 = Rslt (operacoes bastante eficientes,
%  se comparadas com suas alternativas mais triviais). Caso ambas as unifica-
%  coes sejam bem-sucedidas, tem-se os seguintes efeitos colaterais:
%
%    . a presenca de [a, b, c, d, e] foi detectada no inicio de L1;
%
%    . Rslt eh igual a [o, p, q, r| Resto2], consumando a substituicao;
%
%    . Resto1 casou com [f, g]. Dessa forma, pode-se continuar o processamen-
%      to das substituicoes diretamente a partir de Resto1 e Resto2.
%
%  O uso de exchange_dl/2 pode ser observado em fixReply/2.
%

buildExchange_dl(X, Y, exchange_dl(DX, DY)) :-
  list_dl(X, DX),
  list_dl(Y, DY).
 

%
%  xlist/1 (eXtended list)
%
%  Verifica se seu unico argumento eh uma lista, vazia ou nao. Necessario por-
%  que o predicado pre-definido list/1 so se prova para listas nao vazias.
%

xlist(X) :-
  list(X),
  !.

xlist(X) :-
  X == [].
 

%
%  flatten/2
%
%  Predicado de achatamento de listas, com supressao de listas vazias, em ver-
%  sao que faz uso de listas-diferenca, muito mais eficiente que a versao in-
%  genua.
%
%  Apresentado para comparacao com fixReply/2, que agrega a funcao de flatten/2
%  com a de realizar substituicoes-padrao (vide exchange/2, fixReply/2).
%

flatten(Xs, Ys/[]).
 

flatten_dl([], Xs/Xs) :-
  !.

flatten_dl([X| Xs], Ys/Zs) :-
  xlist(X),
  !,
  flatten_dl(X, Ys/Ws),
  flatten_dl(Xs, Ws/Zs).

flatten_dl([X| Xs], [X| Ys]/Zs) :-
  flatten_dl(Xs, Ys/Zs).
 

%
%  fixReply(Pre, Final) (e fixReply1/2, sua versao deterministica)
%
%  Achata a lista de entrada Pre ao mesmo tempo que realiza as substituicoes-
%  padrao especificadas em exchange_dl/2, gerando Final. Ambas as operacoes
%  recorrem a listas-diferenca, com ganho em desempenho (vide flatten/2 e
%  buildExchange_dl/3).
%

fixReply1(Pre, Final) :-
  fixReply(Pre, Final),
  !.
 

fixReply(Pre, Final) :-
  fixReply_dl(Pre, Final/[]).
 

fixReply_dl([], Xs/Xs) :-
  !.

fixReply_dl([X| Xs], Ys/Zs) :-
  xlist(X),
  !,
  fixReply_dl(X, Ys/Ws),
  fixReply_dl(Xs, Ws/Zs).

fixReply_dl(As, Xs/Zs) :-
  exchange_dl(As/Bs, Xs/Ys),  %  <- uma vez casados os padroes, tem-se acesso
  !,                          %     direto ao restante ainda nao processado
  fixReply_dl(Bs, Ys/Zs).     %     das duas listas (Bs e Ys).

fixReply_dl([X| Xs], [X| Ys]/Zs) :-
  fixReply_dl(Xs, Ys/Zs).
 

%
%  prepare/1
%
%  Insere programa gerado automaticamente na base de conhecimento.
%

%
%  prepare(exchange_dl)
%
%  Gera o predicado exchange_dl/2 (vide buildExchange_dl/3) a partir de
%  exchange/2.
%

prepare(exchange_dl) :-
  retractall((exchange_dl(_, _) :- _)), % <- evita duplicacao.
  clause(exchange(X, Y), Body),
  buildExchange_dl(X, Y, Head),
  assert((Head :- Body)),
  fail.

%
%  prepare(xpatdef)
%
%  Gera o predicado xpatdef/3 a partir de patdef/3.
%
%  Exemplo de geracao (vide patdef/3, buildMatcher/3):
%
%    in:  patdef(once, [i, am, {X}, but| Y]:_, [$how come$, Y, $if you are$, X]:'?') :-
%           someTestOn(X).
%
%    out: xpatdef(once, [i, am| Rest1]:_, [$how come$, Y, $if you are$, X]:'?') :-
%           conc(X, [but| Y], Rest1),
%           someTestOn(X).
%
%  Observe como a unificacao torna possivel que as variaveis no padrao de esti-
%  mulo original "sejam as mesmas" que aparecem no reconhecedor montado por
%  buildMatcher/3, de forma que as ligacoes pre-estabelecidas com o estimulo
%  de resposta (3o argumento de (x)patdef) continuam a valer.
%

prepare(xpatdef) :-
  retractall((xpatdef(_, _, _) :- _)),                      % <- evita duplicacao.
  clause(patdef(PatType, PatDef:Period, Reply), PreBody),
  buildMatcher(PatDef, MatcherHead, MatcherPred),
  join(MatcherPred, PreBody, Body),
  assert((xpatdef(PatType, MatcherHead:Period, Reply) :- Body)),
  fail.

prepare(_).