:-dynamic
      no_of_exchanges/1.


pattern([you,1],['We',should,talk,about,you,',', not,me]).
pattern([i,am,1,'.'],['How',long,have,you,been,1,?]).
pattern([1,you,2,me,'.'],['What',makes,you,think,'I',2,you,?]).
pattern([i,love,1,'.'],['Does',anyone,else,in,your,family,love,1,?]).
pattern([i,feel,1],['Do',you,often,feel,that,way,?]).

pattern3([1,X,2],['Can',you,tell,me,more,about,your, X,?]) :- important(X).
  important(father).      important(mother).      important(son).
  important(sister).      important(brother).     important(daughter).

pattern([why,1],['Let',me,ask,the,questions,'.']).
pattern([1,'?'], ['I','will',ask,the,questions,if,you,please,'!']).
pattern([X,'.'],['Please',do,not,be,so,terse,'.']).
pattern([bye,'.'],['Goodbye']):- !,fail.
pattern([1,'.'],['Please',go,on]).

pattern1(X,['Please', do, not, be, so, negative]):- element_of(not,X).
pattern1([no,'.'],['Elucidate',and,do,not,be,so,negative]).

pattern2([i,hate,1,'.'], response1, 3).
  respond(response1,1,['You',should,not,talk,that,way,about,1]).
  respond(response1,2,['You',should,not,use,the,'h-word']).
  respond(response1,3,['Nice',people,do,not,hate,',',not,even,1]).

                                      % If Preference is 'like' or 'hate' and
                                      % and preferred thing is in concept_class.  
pattern4([i, Preference,X,'.'], ['What', do, you, think, about, Y,?]):-
       (Preference=like;Preference=dislike),
       concept_class(Z, List),
       element_of(X, List),
       element_of(Y,List),
       not(X=Y),
       not_previously_mentioned(Y).
                              %  If all instances in a concept_class have been mentioned.  
pattern4([i, Preference,X,'.'], ['You',seem,to, talk, a, lot, about, C, ',', why,is,that,?]):-
       (Preference=dislike; Preference=like),
       concept_class(C, List),
       element_of(X, List).

concept_class(cars, [fords, chevys, volvos, bmws]).

pattern5([X, is, Y,'.'], ['Does',that,mean,that,you,believe,that,X,is,Z,?]):-
       store(i,_,[all,Y, W, are,Z,'.']),
       not_previously_uttered(i, [X,is,Z,'.']).
pattern5([X, is, a, Y1,'.'], ['Does',that,mean,that,you,believe,that,X,is,a,Z1,?]):-
       store(i,_,[all,Y2,are,Z2,'.']),
       plural2(Y1,Y2),
       plural1(Z1,Z2),
       not_previously_uttered(i, [X,is,a,Z1,'.']).
pattern5([all,X,are,Y,'.'], ['Does',that,mean,that,you,believe,that,all, X,are,Z,?]):-
       store(i,_,[all,Y,are,Z,'.']),
       not_previously_uttered(i, [all,X,are, Z,'.']).
pattern5([all,Y,are,Z,'.'], ['Does',that,mean,that,you,believe,that,all, X,are,Z,?]):-
       store(i,_,[all,X,are,Y,'.']),
       not_previously_uttered(i, [all,X,are, Z,'.']).
pattern5([all,Y,are,Z,'.'], ['Does',that,mean,that,you,believe,that,all, Y,are,Z,?]).

stock_answer('Could you please tell me some more?').
stock_answer('Please do not be shy. Say more that if you can.').
stock_answer('Could we change topics? Can we talk about your day?').
stock_answer('You are being a little boring, I am afraid.').


/*  ------------------------------------------------------------- */
/*  Don't change anything below here!                              */
plural2(A,B):-
       concat2(A,s,B).
plural1(A,B):-
       concat1(A,s,B).  
     
eliza:- cls,
        write('Hello, my name is Eliza.  I am a therapist.'),nl,
        write('Please tell me something about yourself and I'),nl,
        write('will try to help you.  Keep things simple,'),nl,
        write('one sentence at a time.'),nl,nl,
        write('Now go ahead...'),nl,
        eliza1.
eliza([bye,'.']) :- 
        write('Goodbye.  I sincerely hope that I helped you.').        



                                    /* Cls doesn't work in SWI Prolog */             

cls:- true.

:- dynamic 
   no_of_exchanges/1,        %ISO standard for dynamic clauses
   store/3.

no_of_exchanges(1).


eliza1 :-  read_in(Input1),
          uncapitalize_list(Input1,Input),
          nl,
          eliza(Input),!.
eliza1 :-  eliza1.
 
eliza([]) :-  eliza1.

  

                                   /*No internal pattern matching */
eliza(Input):-
       
       pattern1(Input,Output),
       write('>> '),
       reply(Output),
       no_of_exchanges(N),
       retract(no_of_exchanges(N1)),
       N2 is N+1,
       assertz(no_of_exchanges(N2)),       
       assertz(store(i,N,Input)),
       assertz(store(o,N,Output)),
       eliza1.

eliza(Input):-
       
       pattern4(Input,Output),
       write('>> '),
       reply(Output),
       no_of_exchanges(N),
       retract(no_of_exchanges(N1)),
       N2 is N+1,
       assertz(no_of_exchanges(N2)),       
       assertz(store(i,N,Input)),
       assertz(store(o,N,Output)),
       eliza1.
eliza(Input):-
       
       pattern5(Input,Output),
       write('>> '),
       reply(Output),
       no_of_exchanges(N),
       retract(no_of_exchanges(N1)),
       N2 is N+1,
       assertz(no_of_exchanges(N2)),       
       assertz(store(i,N,Input)),
       assertz(store(o,N,Output)),
       eliza1.

                                 /*Randomized Response to patterns */
eliza(Input) :-
        
        pattern2(Stimulus,Response_set,No),
        match(Stimulus,Dictionary,Input),
        Y is random(No)+1,
        respond(Response_set, Y,Output1),
        match(Output1,Dictionary,Output),
        write('>> '),
        reply(Output),
        no_of_exchanges(N),
        retract(no_of_exchanges(N1)),
        N2 is N+1,
        assertz(no_of_exchanges(N2)),       
        assertz(store(i,N,Input)),
        assertz(store(o,N,Output)),
        eliza1.

eliza(Input) :- 
        
        pattern3(Stimulus,Response),
        match(Stimulus,Dictionary,Input),
        match(Response,Dictionary,Output),
        write('>> '),
        reply(Output),
        no_of_exchanges(N),
        retract(no_of_exchanges(N1)),
        N2 is N+1,
        assertz(no_of_exchanges(N2)),       
        assertz(store(i,N,Input)),
        assertz(store(o,N,Output)),
        eliza1.

                                 /* Normal pattern matching  */
eliza(Input) :- 
        
        pattern(Stimulus,Response),
        match(Stimulus,Dictionary,Input),
        match(Response,Dictionary,Output),
        write('>> '),
        reply(Output),
        no_of_exchanges(N),
        retract(no_of_exchanges(N1)),
        N2 is N+1,
        assertz(no_of_exchanges(N2)),       
        assertz(store(i,N,Input)),
        assertz(store(o,N,Output)),
        eliza1.
eliza(Input) :- 
        stock_answer1(Stock),
        write('>> '), 
        write(Stock), nl,
        no_of_exchanges(N),
        retract(no_of_exchanges(N1)),
        N2 is N+1,
        assertz(no_of_exchanges(N2)),       
        assertz(store(i,N,Input)),
        assertz(store(o,N,[Stock])),
        eliza1.
eliza(Input) :- 
        Stock='Go on',
        write('>> '), 
        write(Stock), nl,
        no_of_exchanges(N),
        retract(no_of_exchanges(N1)),
        N2 is N+1,
        assertz(no_of_exchanges(N2)),       
        assertz(store(i,N,Input)),
        assertz(store(o,N,[Stock])),
        eliza1.


stock_answer1(Stock):-
        stock_answer(Stock),
        unused_stock(Stock).

unused_stock(Stock):-
        store(o,_,[Stock]),
        !, fail.
unused_stock(_).

history:-
        store(X,Y,Z),
        write(store(X,Y,Z)),nl,
        fail.
history:- true.
clear_history:-
        store(X,Y,Z),
        not(Y=0),
        retract(store(X,Y,Z)),
        fail.
clear_history:- true.

print_it:-
        tell(lpt1),
        store(X,N,Y),
        write(N),
        ((X=i, write('Client: '));
         (X=o, write('Eliza:  ')); true),
        reply(Y),
        fail.
print_it:- told.

store_it(File):-
        tell(File),
        store(X,N, Y),
        write(N),
        ((X=i, write('Client: '));
         (X=o, write('Eliza:  '))),
        reply(Y),
        fail.
store_it(_):- told.
 

not_previously_mentioned(Word):-
        store(_,_,List),
        element_of(Word,List),
        !, fail.
not_previously_mentioned(_).

not_previously_uttered(IO, List):-
        store(IO,_,List),
        !,fail.
not_previously_uttered(_,_).
        

store(i,0,[]).                      %  Weirdly required for SWI Prolog to start

 
match([N|Pattern],Dictionary,Target) :- 
        integer(N),
        lookup( N, Dictionary, LeftTarget),
        append( LeftTarget, RightTarget, Target),
        match( Pattern, Dictionary, RightTarget).
match([Word|Pattern],Dictionary,[Word|Target]) :- 
        atom(Word),match(Pattern,Dictionary,Target).
match([],Dictionary,[]).
 
/* I added the nonvar's to lookup.  Without them it built a bigger and
bigger list of pair of uninstantiated variable. */
 
lookup( Key, [(Key,Value)|Dictionary], Value).
lookup( Key, [(Key1,Value1)|Dictionary], Value) :- 
        nonvar(Key1), nonvar(Value1),
        Key \== Key1, lookup( Key, Dictionary, Value).
 

 
reply([Head|Tail]) :- write(Head), write(' '),reply(Tail).
reply([]) :- nl.
 
%    Sept 14, 1994       read_list.pro, extracted from logic-m.pro  */

capitalize(H,Cap):-
      name(H,[H1|T]),
      H1 > 96,
      H1 < 123,!,
      H2 is H1-32,
      name(Cap, [H2|T]).
capitalize(H,H).

uncapitalize(H, Little):-
     name(H,[H1|T]),
     H1 > 64,
     H1 < 92,!,
     H2 is H1+32,
     name(Little,[H2|T]).
uncapitalize(H,H).

uncapitalize_list([],[]).
uncapitalize_list([H1|T1], [H2|T2]):-
     uncapitalize(H1,H2),
     uncapitalize_list(T1,T2).

                                   /*  Converts list of ASCC codes
                                        to list of letters   */
name_list([],[]).
name_list([H1|T1], [H2|T2]):-
      name(H2,[H1]),
      name_list(T1,T2).




/*                                        General Utilities  */    
      
element_of(Head, [Head|_]).
element_of(X, [_|Tail]) :-
        element_of(X, Tail).

number_of_elements_of(1, [X]):- !.
number_of_elements_of(N, [_|X]):-
        number_of_elements_of(X),
        N is X+1.

append([], List, List).
append([X|L1], L2, [X|L3]) :- append(L1, L2, L3).

append3(L1,L2,L3,L):-
       not(var(L)),!,
       append(Lx,L3,L),
       append(L1,L2,Lx).
append3(L1,L2,L3,L):-
       append(L1,L2,Lx),
       append(Lx,L3,L).
append4(L1,L2,L3,L4,L):-
       not(var(L)),!,
       append(Lx,L4,L),
       append3(L1,L2,L3,Lx).
append4(L1,L2,L3,L4,L):-
       append3(L1,L2,L3,Lx),
       append(Lx,L4,L).
append5(L1,L2,L3,L4,L5,L):-
       not(var(L)),!,
       append(Lx,L5,L),
       append4(L1,L2,L3,L4,Lx).
append5(L1,L2,L3,L4,L5,L):-
       append4(L1,L2,L3,L4,Lx),
       append(Lx,L5,L).
append6(L1,L2,L3,L4,L5,L6,L):-
       not(var(L)),!,
       append(Lx,L6,L),
       append5(L1,L2,L3,L4,L5,Lx).
append6(L1,L2,L3,L4,L5,L6,L):-
       append5(L1,L2,L3,L4,L5,Lx),
       append(Lx,L6,L).
%                                   concat2(ins,ins,Var/ins)
concat2(First_string, Second_string,Result):-
        name(First_string, First_list),
        name(Second_string, Second_list),
        append(First_list, Second_list, Result_list),
        name(Result, Result_list).
%                                   concat1(ins/Var,ins/Var, ins)
concat1(First_string,Second_string,Result):-
        name(Result,Result_list),
        append(First_list,Second_list, Result_list),
        name(First_string,First_list),
        name(Second_string,Second_list).


concat_list([X],X):- !.
concat_list([H1| T], Result):-
        concat_list(T,M1),
        concat2(H1,M1, Result).

read_list_in(X, Error):-
       read_line(0,Z),
       atom_string(Z1,Z),
       name(Z1,List),
       rl_process(List,[],X1),!,
       replace_rule_name(X1,X2,Error),!,
       trans_arist_list_top(X2,X),!.
       
read_in([W|Ws]):- get0(C), read_word(C,W,C1), rest_sent(W,C1,Ws).


% Given a word and the next character, read in the rest of the sentence

rest_sent(W,_,[]) :- lastword(W),!.
rest_sent(W,C,[W1|Ws]) :- read_word(C,W1,C1),
    rest_sent(W1,C1,Ws).

read_word(C,W,C1) :- single_character(C),!,name(W,[C]), get0(C1).
read_word(C,W,C2) :- in_word(C,NewC),!, get0(C1),
                    rest_word(C1,Cs,C2), name(W,[NewC|Cs]).
read_word(C,W,C2) :- get0(C1), read_word(C1,W,C2).

rest_word(C,[NewC|Cs],C2) :- in_word(C,NewC), !, get0(C1), 
                        rest_word(C1,Cs,C2).
rest_word(C,[],C).

% These are single character words.

single_character(33).      % !
single_character(44).      % ,
single_character(46).      % .
single_character(58).      % :
single_character(59).      % ;
single_character(63).      % ?

% These characters can appear within a word.

in_word(C,C) :- C > 96, C < 123.               % a,b,...,z
in_word(C,L) :- C > 64, C < 91, L is C + 32.   % A,B,...,Z
in_word(C,C) :- C > 47, C < 58.                % 0,1,...,9
in_word(39,39).                                % '
in_word(45,45).                                % -

% These words terminate a sentence.

lastword('.').
lastword('!').
lastword('?').



                                  /*   Defines integers 1,2,3...   */
integer1(1).
integer1(X):-
    integer1(Y),
    X is Y+1.
integer_limit(X,L):-
    integer1(X),
    ((X>L,!,fail);
     true).
integer(X,Z):-
    integer1(Z),
    Z>X,!.
                                 /* int(Float,Integer)        */
int(X,I):-
    integer1(I1),
    I1 > X,!,
    I is I1-1.

                                        /* Leaves first element alone */
trans_arist_list_top([H|T1],[H|T2]):-
       trans_arist_list(T1,T2).

trans_arist_list([],[]):- !.
trans_arist_list([H1|T1],[H2|T2]):-
       current(arist),
       trans_arist(H1,H2),!,
       trans_arist_list(T1,T2).
trans_arist_list([H1|T1], [H2|T2]):-
       (current(prop);
        current(quant)),
       trans_prop(H1,H2),!,
       trans_arist_list(T1,T2).
trans_arist_list([H1|T1],[H1|T2]):-
       trans_arist_list(T1,T2).
              
replace_rule_name([''],[],no_error):-!.
replace_rule_name(X1,X2,no_error):-
       append(Begin1,End,X1),
       ((Begin1=[X], 
         rule_name(X),X2=X1,!);
        (capitalize_wl(Begin1,Begin2),
         other_rule_name1(Begin1, Begin2, Protocol),!,
         append(Protocol,End,X2))).     
replace_rule_name(X,X,error):-
       write('Not a valid rule name: '), write(X), nl,
       assertz(error(['Not a valid rule name: ',X])).


other_rule_name1(_,Begin2,[Y]):-
      rule_name(Y), capitalize_wl([Y],Begin2),!.
other_rule_name1(_,B,P):-
      other_rule_name(B,P).
other_rule_name(['PREMISS'], [pre]).
other_rule_name(['PREMISE'], [pre]).
other_rule_name(['HYPOTHESIS'],[hypoth]).
other_rule_name(['MODUS','PONENS'],[mp]).
other_rule_name(['INST'], ['inst']).

                                  /*Capitalize word list: [this, word,... ] */
capitalize_wl([],[]):- !.
capitalize_wl([H1|T1],[H2|T2]):-
     capitalize_all(H1,H2),
     capitalize_wl(T1,T2).
                                 /*Capitalize word or atom  */
capitalize_all(X,Y):-
     name(X,List1),
     capitalize_list(List1,List2),
     name(Y,List2).
capitalize_list([],[]):- !.
capitalize_list([H1|T1], [H2|T2]):-
     capitalize_char(H1,H2),
     capitalize_list(T1,T2).
capitalize_char(N1,N2):-
     N1>96,
     N1<123,
     N2 is N1-32,!.
capitalize_char(N,N).       
            /*  Inlist, Part_word-in,Part_word_out,On_going,Outlist  */
rl_process([],X,[Y]):-
       !,
       name(Y,X).
rl_process([H|T],[],X):-     /*  Break char but part-word already empty */
       break_char(H),
       rl_process(T,[],X),!.
rl_process([H|T],Part,[New|X]):-  /* Break char but part word  */
       break_char(H),
       name(New,Part),
       rl_process(T,[],X),!.
rl_process([H|T], Part, X):-
       append(Part,[H],New_part),!,
       rl_process(T,New_part,X),!.
       
break_char(32).  /*  Space.  */
break_char(44).	 /*  Comma   */
break_char(59).  /*  Semi-colon */
rl_process2([],X,[Y]):-
       !,
       name(Y,X).
rl_process2([H|T],[],X):-     /*  Break char but part-word already empty */
       break_char2(H),
       rl_process2(T,[],X),!.
rl_process2([H|T],Part,[New|X]):-  /* Break char but part word  */
       break_char2(H),
       name(New,Part),
       rl_process2(T,[],X),!.
rl_process2([H|T], Part, X):-
       append(Part,[H],New_part),!,
       rl_process2(T,New_part,X),!.
       
break_char2(32).  /*  Space.  */