/*****************************************************************************/
/* ELIZA in Prolog                                                           */
/*                                                                           */
/*    Viren Patel                                                            */
/*    Artificial Intelligence Programs                                       */
/*    University of Georgia, Athens, Georgia                                 */
/*    Email: vpatel@aisun1.ai.uga.edu                                        */
/*                                                                           */
/*    minor changes by Frank Schilder (FS)                                   */
/*    Email: schilder@informatik.uni-hamburg.de                              */
/* Reference                                                                 */
/*                                                                           */
/*    Weizenbaum, J., (1966) ELIZA - A computer program for the study of     */
/*    natural language communication between man and machine. Communications */
/*    of the ACM, 9.1:36-45.                                                 */
/*                                                                           */
/* Acknowledgments                                                           */
/*                                                                           */
/*    read_atomics/1 and suporting clauses are courtesy of Dr. Michael A.    */
/*    Covington, AI Programs, University of Georgia, Athens, Georgia from    */
/*    his forthcoming book, Natural language processing for Prolog           */
/*    programmers.                                                           */
/*                                                                           */
/*    match/2 and its supporting clauses make up the pattern matcher. The    */
/*    basic code for the pattern matcher was obtained from the book by       */
/*    R. A. O'Keefe, The craft of Prolog.                                    */
/*                                                                           */
/* Requires: Quintus Prolog                                                  */
/* changed version runs on SWI-PROLOG                                        */
/*                                                                           */
/* To run:  ?- consult(eliza).                                               */
/* To stop: > quit (`>' is the Eliza prompt)                                 */
/*                                                                           */
/* Last Revised: April 10, 1992                                              */
/*                                                                           */
/*****************************************************************************/

/*****************************************************************************/
% simplification rules

sr([do,not|X],[dont|Y],X,Y).
sr([can,not|X],[cant|Y],X,Y).
sr([cannot|X],[cant|Y],X,Y).
sr([will,not|X],[wont|Y],X,Y).
sr([dreamed|X],[dreamt|Y],X,Y).
sr([dreams|X],[dream|Y],X,Y).
sr([how|X],[what|Y],X,Y).
sr([when|X],[what|Y],X,Y).
sr([alike|X],[dit|Y],X,Y).
sr([same|X],[dit|Y],X,Y).
sr([certainly|X],[yes|Y],X,Y).
sr([maybe|X],[perhaps|Y],X,Y).
sr([deutsch|X],[xfremd|Y],X,Y).
sr([francais|X],[xfremd|Y],X,Y).
sr([espanol|X],[xfremd|Y],X,Y).
sr([machine|X],[computer|Y],X,Y).
sr([machines|X],[computer|Y],X,Y).
sr([computers|X],[computer|Y],X,Y).
sr([am|X],[are|Y],X,Y).
sr([your|X],[my|Y],X,Y).
sr([were|X],[was|Y],X,Y).
sr([me|X],[you|Y],X,Y).
sr([you,are|X],[im|Y],X,Y).      % im = i'm = i am
sr([i,am|X],[youre|Y],X,Y).      % youre = you're = you are =\= your
sr([myself|X],[yourself|Y],X,Y).
sr([yourself|X],[myself|Y],X,Y).
sr([mom|X],[mother|Y],X,Y).
sr([dad|X],[father|Y],X,Y).
sr([i|X],[you|Y],X,Y).
sr([you|X],[i|Y],X,Y).
sr([my|X],[your|Y],X,Y).
sr([everybody|X],[everyone|Y],X,Y).
sr([nobody|X],[everyone|Y],X,Y).


/*****************************************************************************/
% Make the rule base modifiable
%    this is specific to Quintus Prolog

:- dynamic(rules/1).


/*****************************************************************************/
% The rule base
%    The format of the rules is:
%
% rules([[keyword, importance of keyword],[
%         [pattern #, [the pattern], last response used,
%             [response 1],
%             [response 2],
%             ...
%             [response n]]]]).

rules([[sorry,0],[
	[1,[_],0,
		[please,do,not,apologize,.],
		[apologies,are,not,necessary,.],
		[what,feelings,do,you,have,when,you,apologize,?],
		['I',have,told,you,that,apologies,are,not,required,.]]]]).

rules([[remember,5],[
	[1,[_,you,remember,Y],0,
		[do,you,often,think,of,Y,?],
		[does,thinking,of,Y,bring,anything,else,to,mind,?],
		[what,else,do,you,remember,?],
		[why,do,you,remember,Y,just,now,?],
		[what,in,the,present,situation,reminds,you,of,Y,?],
		[what,is,the,connection,between,me,and,Y,?]],
	[2,[_,do,i,remember,Y],0,
		[did,you,think,'I',would,forget,Y,?],
		[why,do,you,think,i,should,recall,Y,now,?],
		[what,about,Y,?],
		[equal,[what,0]],
		[you,mentioned,Y,.]],
	[3,[_],0,
		[newkey]]]]).

rules([[if,3],[
	[1,[_,if,Y],0,
		[do,you,think,it,is,likely,that,Y,?],
		[do,you,wish,that,Y,?],
		[what,do,you,think,about,Y,?],
		[really,',',if,Y,?]]]]).

rules([[dreamt,4],[
	[1,[_,you,dreamt,Y],0,
		[really,',',Y,?],
		[have,you,ever,fantasied,Y,while,you,were,awake,?],
		[have,you,dreamt,Y,before,?],
                [equal,[dream,3]],
		[newkey]]]]).

rules([[dream,3],[
	[1,[_],0,
		[what,does,that,dream,suggest,to,you,?],
		[do,you,dream,often,?],
		[what,persons,appear,in,your,dreams,?],
		[do,you,believe,that,dreaming,has,something,to,do,with,your,problem,?],
		[newkey]]]]).

rules([[none,0],[
	[1,[_],0,
		['I',am,not,sure,'I',understand,you,fully,.],
		[please,go,on,.],
		[what,does,that,suggest,to,you,?],
		[do,you,feel,strongly,about,discussing,such,things,?]]]]).

rules([[perhaps,0],[
	[1,[_],0,
		[you,do,not,seem,quite,certain,.],
		[why,the,uncertain,tone,?],
		[can,you,not,be,more,positive,?],
		[you,are,not,sure,?],
		[do,you,not,know,?]]]]).

rules([[name,15],[
	[1,[_],0,
		['I',am,not,interested,in,names,.],
		['I',have,told,you,before,',','I',do,not,care,about,names,.],
		[please,continue,.]]]]).

rules([[xfremd,75],[
	[1,[_],0,
		['I',am,sorry,',','I',only,speak,'English',.]]]]).

rules([[hello,0],[
	[1,[_],0,
		[how,do,you,do,'.','Please',state,your,problem,.]]]]).

rules([[computer,50],[
	[1,[_],0,
		[do,computers,worry,you,?],
		[why,do,you,mention,computers,?],
		[what,do,you,think,machines,have,to,do,with,your,problem,?],
		[do,you,not,think,computers,can,help,people,?],
		[what,about,machines,worries,you,?],
		[what,do,you,think,about,machines,?]]]]).

rules([[are,0],[
	[1,[_,are,you,Y],0,
		[do,you,believe,you,are,Y,?],
		[would,you,want,to,be,Y,?],
		[you,wish,'I',would,tell,you,you,are,Y,?],
                [what,would,it,mean,if,you,were,Y,?],
		[equal,[what,0]]],
	[2,[_,are,i,Y],0,
		[why,are,you,interested,in,whether,'I',am,Y,or,not,?],
		[would,you,prefer,if,'I',were,not,Y,?],
		[perhaps,'I',am,Y,in,your,fantasies,.],
                [do,you,sometimes,think,'I',am,Y,?],
		[equal,[what,0]]],
	[3,[_,are,Y],0,
		[did,you,think,they,might,not,be,Y,?],
		[would,you,like,it,if,they,were,not,Y,?],
		[what,if,they,were,not,Y,?],
		[possibly,they,are,Y,.]],
	[4,[_],0,
		[why,do,you,say,am,?],
		['I',do,not,understand,that,.]]]]).


rules([[my,0],[
	[1,[_,my,Y],0,
		[why,are,you,concerned,over,my,Y,?],
		[what,about,your,own,Y,?],
		[are,you,worried,about,someone,elses,Y,?],
		[really,',',my,Y,?]]]]).

rules([[was,2],[
	[1,[_,was,you,Y],0,
		[what,if,you,were,Y,?],
		[do,you,think,you,were,Y,?],
		[were,you,Y,?],
		[what,would,it,mean,if,you,were,Y,?],
                [what,does,Y,suggest,to,you,?],
		[equal,[what,0]]],
	[2,[_,you,was,Y],0,
		[were,you,really,?],
		[why,do,you,tell,me,you,were,Y,just,now,?],
		[perhaps,'I',already,knew,you,were,Y,.]],
	[3,[_,was,i,Y],0,
		[would,you,like,to,believe,'I',was,Y,?],
		[what,suggests,that,'I',was,Y,?],
		[what,do,you,think,?],
		[perhaps,'I',was,Y,.],
		[what,if,'I',had,been,Y,?]],
	[4,[_],0,
		[newkey]]]]).

rules([[im,0],[
        [1,[_,im,_],0,
		[equal,[i,0]]]]]).

rules([[youre,0],[
        [1,[_,youre,_],0,
		[equal,[you,0]]]]]).

rules([[you,0],[
	[1,[_,you,cant,Y],0,
		[how,do,you,know,you,can,not,Y,?],
		[have,you,tried,?],
		[perhaps,you,could,Y,now,?],
		[do,you,really,want,to,be,able,to,Y,?]],
	[2,[_,you,dont,Y],0,
		[do,you,not,really,Y,?],
		[why,do,you,not,Y,?],
		[do,you,wish,to,be,able,to,Y,?],
		[does,that,trouble,you,?]],
	[3,[_,you,feel,Y],0,
		[tell,me,more,about,such,feelings,.],
		[do,you,often,feel,Y,?],
		[do,you,enjoy,feeling,Y,?],
		[of,what,does,feeling,Y,remind,you,?]],
        [4,[_,you,was,_],0,
		[equal,[was,2]]],
	[5,[_,you,Y,i,_],0,
		[perhaps,in,your,fantasy,we,Y,each,other,?],
		[do,you,wish,to,Y,me,?],
		[you,seem,to,need,to,Y,me,.],
		[do,you,Y,anyone,else,?]],
	[6,[_,you,[*,want,need,_],Y],0,
		[what,would,it,mean,to,you,if,you,got,Y,?],
		[why,do,you,want,Y,?],
		[suppose,you,got,Y,soon,?],
		[what,if,you,never,got,Y,?],
		[what,would,getting,Y,mean,to,you,?],
		[what,does,wanting,Y,have,to,do,with,this,discussion,?]],
	[7,[_,you,[*,feel,think,believe,wish,_],you,Y],0,
		[do,you,really,think,so,?],
		[but,you,are,not,sure,you,Y,?],
		[do,you,really,doubt,you,Y,?]],
        [8,[_,you,_,[*,feel,think,believe,wish,_],_,i,_],0,
		[equal,[you,0]]],
	[9,[_,youre,_,[*,sad,unhappy,depressed,sick,M],_],0,
		['I',am,sorry,to,hear,you,are,M,.],
		[do,you,think,coming,here,will,help,you,not,to,be,M,?],
		['I',am,sure,it,is,not,pleasant,to,be,M,.],
		[can,you,explain,what,made,you,M,?]],
	[10,[_,youre,_,[*,happy,elated,glad,better,M],_],0,
		[how,have,'I',helped,you,to,be,M,?],
		[has,your,treatment,made,you,M,?],
		[what,makes,you,M,just,now,?],
		[can,you,explain,why,you,are,suddenly,M,?]],
	[11,[_,youre,Y],0,
		[is,it,because,you,are,Y,that,you,came,to,me,?],
		[how,long,have,you,been,Y,?],
		[do,you,believe,it,normal,to,be,Y,?],
		[do,you,enjoy,being,Y,?]],
	[12,[X],0,
		[you,say,X],
		[can,you,elaborate,on,that,?],
		[do,you,say,X,for,some,special,reason,?],
		[that,is,quite,interesting,.]]]]).

rules([[i,0],[
        [1,[_,i,remind,you,of,_],0,
		[equal,[dit,10]]],
	[2,[_,im,Y],0,
		[what,makes,you,think,'I',am,Y,?],
		[does,it,please,you,to,believe,'I',am,Y,?],
		[do,you,sometimes,wish,you,were,Y,?],
		[perhaps,you,would,like,to,be,Y,?]],
	[3,[_,i,Y,you],0,
		[why,do,you,think,'I',Y,you,?],
		[you,like,to,think,'I',Y,you,',',do,you,not,?],
		[what,makes,you,think,'I',Y,you,?],
		[really,',','I',Y,you,.],
		[do,you,wish,to,believe,'I',Y,you,?],
		[suppose,'I',did,Y,you,',',what,would,that,mean,to,you,?],
		[does,someone,else,believe,'I',Y,you,?]],
	[4,[_,i,Y],0,
		[we,were,discussing,you,',',not,me,.],
		[oh,',',i,Y,.],
		[you,are,not,really,talking,about,me,',',are,you,?],
		[what,are,your,feelings,now,?]]]]).

rules([[yes,0],[
	[1,[_],0,
		[you,seem,quite,positive,.],
		[you,are,sure,?],
		[i,see,.],
		[i,understand,.]]]]).

rules([[no,0],[
	[1,[_],0,
		[are,you,saying,no,just,to,be,negative,?],
		[you,are,being,a,bit,negative,.],
		[why,not,?],
		[why,no,?]]]]).

rules([[your,2],[
	[1,[_,your,_,[*,mother,father,brother,sister,children,wife,M],Z],0,
		[tell,me,more,about,your,family,.],
		[who,else,in,your,family,Z,?],
		[your,M,?],
		[what,else,comes,to,mind,when,you,think,of,your,M,?]],
	[2,[_,your,Y],0,
		[your,Y,?],
		[why,do,you,say,your,Y,?],
		[does,that,suggest,anything,else,which,belongs,to,you,?],
		[is,it,important,to,you,that,your,Y,?]]]]).

rules([[memory,0],[
	[1,[_,your,Y],0,
		[lets,discuss,further,why,your,Y,.],
		[earlier,you,said,your,Y,.],
		[but,your,Y,?],
		[does,that,have,anything,to,do,with,the,fact,that,your,Y,?]]]]).

rules([[can,0],[
	[1,[_,can,i,Y],0,
		[you,believe,'I',can,Y,',',do,you,not,?],
		[equal,[what,0]],
		[you,want,me,to,be,able,to,Y,?],
		[perhaps,you,would,like,to,be,able,to,Y,yourself,?]],
	[2,[_,can,you,Y],0,
		[whether,or,not,you,can,Y,depends,on,you,more,than,on,me,.],
		[do,you,want,to,be,able,to,Y,?],
                [perhaps,you,do,not,want,to,Y,.],
		[equal,[what,0]]]]]).

rules([[what,0],[
	[1,[_],0,
		[why,do,you,ask,?],
		[does,that,question,interest,you,?],
		[what,is,it,you,really,want,to,know,?],
		[are,such,questions,much,on,your,mind,?],
		[what,answer,would,please,you,most,?],
		[what,do,you,think,?],
		[what,comes,to,your,mind,when,you,ask,that,?],
		[have,you,asked,such,questions,before,?],
		[have,you,asked,anyone,else,?]]]]).

rules([[because,0],[
	[1,[_],0,
		[is,that,the,real,reason,?],
		[do,any,other,reasons,not,come,to,mind,?],
		[does,that,reason,seem,to,explain,anything,else,?],
		[what,other,reasons,might,there,be,?]]]]).

rules([[why,0],[
	[1,[_,why,dont,i,Y],0,
		[do,you,believe,'I',do,not,Y,?],
		[perhaps,'I',will,Y,in,good,time,.],
		[should,you,Y,yourself,?],
                [you,want,me,to,Y,?],
		[equal,[what,0]]],
	[2,[_,why,cant,you,Y],0,
		[do,you,think,you,should,be,able,to,Y,?],
		[do,you,want,to,be,able,to,Y,?],
		[do,you,believe,this,will,help,you,to,Y,?],
                [have,you,any,idea,why,you,can,not,Y,?],
		[equal,[what,0]]]]]).

rules([[everyone,2],[
	[1,[_,[*,everyone,everybody,nobody,noone,M],_],0,
		[really,',',M,?],
		[surely,not,M,?],
		[can,you,think,of,anyone,in,particular,?],
		[who,',',for,example,?],
		[you,are,thinking,of,a,very,special,person,?],
		[who,',',may,i,ask,?],
		[someone,special,perhaps,?],
		[you,have,a,paticular,person,in,mind,',',do,you,not,?],
		[who,do,you,think,you,are,talking,about,?]]]]).

rules([[always,1],[
	[1,[_],0,
		[can,you,think,of,a,specific,example,?],
		[when,?],
		[what,incident,are,you,thinking,of,?],
		[really,',',always,?]]]]).

rules([[like,10],[
        [1,[_,[*,im,youre,am,is,are,was,_],_,like,_],0,
		[equal,[dit,10]]],
	[2,[_],0,
		[newkey]]]]).

rules([[dit,10],[
	[1,[_],0,
		[in,what,way,?],
		[what,resemblance,do,you,see,?],
		[what,does,that,similarity,suggest,to,you,?],
		[what,other,connections,do,you,see,?],
		[what,so,you,suppose,that,resemblance,means,?],
		[what,is,the,connection,',',do,you,suppose,?],
		[could,there,really,be,some,connection,?],
		[how,?]]]]).

rules([[quit,100],[
	[1,[_],0,
		[goodbye,.,'My',secretary,will,send,you,a,bill,.]]]]).


/*****************************************************************************/
% my_char_type(+Char,?Type)
%    Char is an ASCII code.
%    Type is whitespace, punctuation, numeric, alphabetic, or special.

my_char_type(46,period) :- !.
my_char_type(X,alphanumeric) :- X >= 65, X =< 90, !.
my_char_type(X,alphanumeric) :- X >= 97, X =< 123, !.
my_char_type(X,alphanumeric) :- X >= 48, X =< 57, !.
my_char_type(X,whitespace) :- X =< 32, !.
my_char_type(X,punctuation) :- X >= 33, X =< 47, !.
my_char_type(X,punctuation) :- X >= 58, X =< 64, !.
my_char_type(X,punctuation) :- X >= 91, X =< 96, !.
my_char_type(X,punctuation) :- X >= 123, X =< 126, !.
my_char_type(_,special).


/*****************************************************************************/
% lower_case(+C,?L)
%   If ASCII code C is an upper-case letter, then L is the
%   corresponding lower-case letter. Otherwise L=C.

lower_case(X,Y) :-
	X >= 65,
	X =< 90,
	Y is X + 32, !.

lower_case(X,X).


/*****************************************************************************/
% read_lc_string(-String)
%  Reads a line of input into String as a list of ASCII codes,
%  with all capital letters changed to lower case.

read_lc_string(String) :-
	get0(FirstChar),
	lower_case(FirstChar,LChar),
	read_lc_string_aux(LChar,String).

read_lc_string_aux(10,[]) :- !.  % end of line

read_lc_string_aux(-1,[]) :- !.  % end of file

read_lc_string_aux(LChar,[LChar|Rest]) :- read_lc_string(Rest).


/*****************************************************************************/
% extract_word(+String,-Rest,-Word) (final version)
%  Extracts the first Word from String; Rest is rest of String.
%  A word is a series of contiguous letters, or a series
%  of contiguous digits, or a single special character.
%  Assumes String does not begin with whitespace.

extract_word([C|Chars],Rest,[C|RestOfWord]) :-
	my_char_type(C,Type),
	extract_word_aux(Type,Chars,Rest,RestOfWord).

extract_word_aux(special,Rest,Rest,[]) :- !.
   % if Char is special, don't read more chars.

extract_word_aux(Type,[C|Chars],Rest,[C|RestOfWord]) :-
	my_char_type(C,Type), !,
	extract_word_aux(Type,Chars,Rest,RestOfWord).

extract_word_aux(_,Rest,Rest,[]).   % if previous clause did not succeed.


/*****************************************************************************/
% remove_initial_blanks(+X,?Y)
%   Removes whitespace characters from the
%   beginning of string X, giving string Y.

remove_initial_blanks([C|Chars],Result) :-
	my_char_type(C,whitespace), !,
	remove_initial_blanks(Chars,Result).

remove_initial_blanks(X,X).   % if previous clause did not succeed.


/*****************************************************************************/
% digit_value(?D,?V)
%  Where D is the ASCII code of a digit,
%  V is the corresponding number.

digit_value(48,0).
digit_value(49,1).
digit_value(50,2).
digit_value(51,3).
digit_value(52,4).
digit_value(53,5).
digit_value(54,6).
digit_value(55,7).
digit_value(56,8).
digit_value(57,9).


/*****************************************************************************/
% string_to_number(+S,-N)
%  Converts string S to the number that it
%  represents, e.g., "234" to 234.
%  Fails if S does not represent a nonnegative integer.

string_to_number(S,N) :-
	string_to_number_aux(S,0,N).

string_to_number_aux([D|Digits],ValueSoFar,Result) :-
	digit_value(D,V),
	NewValueSoFar is 10*ValueSoFar + V,
	string_to_number_aux(Digits,NewValueSoFar,Result).

string_to_number_aux([],Result,Result).


/*****************************************************************************/
% string_to_atomic(+String,-Atomic)
%  Converts String into the atom or number of
%  which it is the written representation.

string_to_atomic([C|Chars],Number) :-
	string_to_number([C|Chars],Number), !.

string_to_atomic(String,Atom) :- name(Atom,String).
  % assuming previous clause failed.


/*****************************************************************************/
% extract_atomics(+String,-ListOfAtomics) (second version)
%  Breaks String up into ListOfAtomics
%  e.g., " abc def  123 " into [abc,def,123].

extract_atomics(String,ListOfAtomics) :-
	remove_initial_blanks(String,NewString),
	extract_atomics_aux(NewString,ListOfAtomics).

extract_atomics_aux([C|Chars],[A|Atomics]) :-
	extract_word([C|Chars],Rest,Word),
	string_to_atomic(Word,A),       % <- this is the only change
	extract_atomics(Rest,Atomics).

extract_atomics_aux([],[]).


/*****************************************************************************/
% clean_string(+String,-Cleanstring)
%  removes all punctuation characters from String and return Cleanstring

clean_string([C|Chars],L) :-
	my_char_type(C,punctuation),
	clean_string(Chars,L), !.
clean_string([C|Chars],[C|L]) :-
	clean_string(Chars,L), !.
clean_string([C|[]],[]) :-
	my_char_type(C,punctuation), !.
clean_string([C|[]],[C]).


/*****************************************************************************/
% read_atomics(-ListOfAtomics)
%  Reads a line of input, removes all punctuation characters, and converts
%  it into a list of atomic terms, e.g., [this,is,an,example].

read_atomics(ListOfAtomics) :-
	read_lc_string(String),
	clean_string(String,Cleanstring),
	extract_atomics(Cleanstring,ListOfAtomics).


/****************************************************************************/
% isalist(+List)
%    checks if List is actually a list

isalist([_|_]).


/****************************************************************************/
% member(?Element,+List)
%    checks if Element is in List
% (FS) SWI-Prolog built-in predicate

%member(X,[X|_]).
%member(X,[_|T]) :- member(X,T).


/****************************************************************************/
% append(?List1, ?List2, ?List3)
%    appends List2 on the end of List1 and returns it as List3
% (FS) SWI-Prolog built-in predicate

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


/****************************************************************************/
% flatten(+List,-FlatList)
%    flattens List with sublists into FlatList
% (FS) SWI-Prolog built-in predicate

%flatten([],[]).
%flatten([H|T],[H|T2]) :- \+ isalist(H),
%                         flatten(T,T2).
%flatten([H|T],L) :- isalist(H),
%                    flatten(H,A),
%                    flatten(T,B),
%                    append(A,B,L).


/****************************************************************************/
% last_member(-Last,+List)
%    returns the last element of List in Last

last_member(End,List) :- append(_,[End],List).


/****************************************************************************/
% findnth(+List,+Number,-Element)
%    returns the Nth member of List in Element

findnth([E|_],1,E).
findnth([_|T],N,T1) :- V is N - 1,
                       findnth(T,V,T1).


/****************************************************************************/
% replace(+Element1,+List1,+Element2,-List2)
%    replaces all instances of Element1 in List1 with Element2 and returns
%       the new list as List2
%    does not replace variables in List1 with Element1

replace(_,[],_,[]).
replace(X,[H|T],A,[A|T2]) :- nonvar(H), H = X, !, replace(X,T,A,T2).
replace(X,[H|T],A,[H|T2]) :- replace(X,T,A,T2).


/****************************************************************************/
% simplify(+List,-Result)
%   implements non-overlapping simplification
%   simplifies List into Result

simplify(List,Result) :- sr(List,Result,X,Y), !,
			 simplify(X,Y).
simplify([W|Words],[W|NewWords]) :- simplify(Words,NewWords).
simplify([],[]).


/****************************************************************************/
% match(+MatchRule,+InputList)
%    matches the MatchRule with the InputList. If they match, the variables
%    in the MatchRule are instantiated to one of three things:
%       an empty list
%       a single word
%       a list of words

match(A,C) :- match_aux1(A,C),!.
match(A,C) :- match_aux2(A,C).

match_aux1(A,C) :-
	member([*|T],A),
	nonvar(T),
	member(Tm,T),
	nonvar(Tm),
	replace([*|T],A,Tm,B),
	match_aux2(B,C),
	!, last_member(L,T), L = Tm.

match_aux2([],[]).
match_aux2([Item|Items],[Word|Words]) :-
	match_aux3(Item,Items,Word,Words),!.
match_aux2([Item1,Item2|Items],[Word|Words]) :-
	var(Item1),
	nonvar(Item2),
	Item2 == Word,!,
	match_aux2([Item1,Item2|Items],[[],Word|Words]).
match_aux2([Item1,Item2|Items],[Word|Words]) :-
	var(Item1),
	var(Item2),!,
	match_aux2([Item1,Item2|Items],[[],Word|Words]).
match_aux2([[]],[]).

match_aux3(Word,Items,Word,Words) :-
	match_aux2(Items,Words), !.
match_aux3([Word|Seg],Items,Word,Words0) :-
	append(Seg,Words1,Words0),
	match_aux2(Items,Words1).


/****************************************************************************/
% makecomment(+KeyWordList,+InputList,-Comment)
%    returns ELIZA's Comment to the InputList based on the KeyWordList
%    takes care of special keywords 'your', and 'memory', which require
%       additional processing before a comment can be generated

makecomment([[your,2]|T],InputList,Comment) :-
	assertz(mem(InputList)),
	rules([[your,2],Reassembly]),
	mc_aux([[your,2]|T],Reassembly,InputList,Comment),!.
makecomment([[memory,0]|T],_,Comment) :-
	retract(mem(I2)),
	retractall(mem(I2)),
	rules([[memory,0],Reassembly]),
	mc_aux([[memory,0]|T],Reassembly,I2,Comment),!.
makecomment([[memory,0]|T],InputList,Comment) :-
	\+ retract(mem(_)),!,
	makecomment(T,InputList,Comment).
makecomment([Keyword|T],InputList,Comment) :-
	rules([Keyword,Reassembly]),
	mc_aux([Keyword|T],Reassembly,InputList,Comment),!.
makecomment([_|T],InputList,Comment) :-
	makecomment(T,InputList,Comment),!.


mc_aux(KeyWordList,[[DRuleNum,MatchRule,N|T]|_],InputList,Comment) :-
	match(MatchRule,InputList),
	mc_aux2(KeyWordList,DRuleNum,N,T,InputList,Comment),!.
mc_aux(KeyWordList,[_|T],InputList,Comment) :-
	mc_aux(KeyWordList,T,InputList,Comment).
mc_aux(_,[],_,_) :- !,fail.

mc_aux2(KeyWordList,DRuleNum,N,T,InputList,Comment) :-
	length(T,TLen),
	N < TLen, !,
	NewN is N + 1,
	findnth(T,NewN,Mn),
	mc_aux3(KeyWordList,DRuleNum,N,NewN,Mn,InputList,Comment).
mc_aux2(KeyWordList,DRuleNum,N,T,InputList,Comment) :-
	member(Mn,T),
	mc_aux3(KeyWordList,DRuleNum,N,0,Mn,InputList,Comment).


mc_aux3([Keyword|T],DRuleNum,N,NewN,[equal,MnT],InputList,Comment) :-
	!,
	updaterule(Keyword,DRuleNum,N,NewN),
	makecomment([MnT|T],InputList,Comment).
mc_aux3([Keyword|T],DRuleNum,N,NewN,[newkey],InputList,Comment) :-
	!,
	updaterule(Keyword,DRuleNum,N,NewN),
	makecomment(T,InputList,Comment).
mc_aux3([Keyword|_],DRuleNum,N,NewN,Mn,_,Mn) :-
	updaterule(Keyword,DRuleNum,N,NewN).


/****************************************************************************/
% process_input(+Input_List,+[],?Output)
%     returns part of input after a comma, or
%             part of input before a period

process_input([],L,L).
process_input(['.'|_],L,L) :- findkeywords(L,K), length(K,Kl), Kl >= 3,!.
process_input(['.'|T],_,L) :- !, process_input(T,[],L).
process_input([','|_],L,L) :- findkeywords(L,K), length(K,Kl), Kl >= 3,!.
process_input([','|T],_,L) :- !, process_input(T,[],L).
process_input([H|T],S,L) :- append(S,[H],S2), process_input(T,S2,L).


/****************************************************************************/
% findkeywords(+InputList,?KeyWordList)
%    returns a list with the keywords in the input list
%    if no keywords are found returns a list with keywords 'memory' and 'none'

findkeywords([],[[memory,0],[none,0]]).
findkeywords([H|T],[[H,I]|T1]) :- rules([[H,I]|_]), !, findkeywords(T,T1).
findkeywords([_|T],T1) :- findkeywords(T,T1).


/****************************************************************************/
% sortkeywords(+KeyWordList,?SortedList)
%    returns a list with the keywords sorted according to their importance
%    this routine implements a simple bubble sort, customized for this
%    application

sortkeywords(X,Y) :- sort_aux(X,A,1), !, sortkeywords(A,Y).
sortkeywords(X,Y) :- sort_aux(X,Y,_).

sort_aux([],[],0).
sort_aux([X],[X],0).
sort_aux([[A,X],[B,Y]|T],[[B,Y],[A,X]|T],1) :- X < Y.
sort_aux([X,Y|T],[X|T2],S) :- sort_aux([Y|T],T2,S).


/****************************************************************************/
% updaterule(+KeyList,+DRuleNum,+N,+NewN)
%    updates a rule by changing the number of the reassembly rule associated
%       with a decomposition rule. The main rule to modify is indicated by
%       KeyList. The decomposition rule within the main rule is indicated by
%       DRuleNum. N is the previous reassembly rule used. NewN is the new
%       one used. N is updated to NewN so that next time a different reassembly
%       (actually the next in sequence) in used.

updaterule(KeyList,DRuleNum,N,NewN) :-
	retract(rules([KeyList,Rt])),
	replace([DRuleNum,A,N|T],Rt,[DRuleNum,A,NewN|T],Rt2),
	assertz(rules([KeyList,Rt2])).


/****************************************************************************/
% writecomment(+CommentList)
%    prints the elements of CommentList. First Characater of first element is
%       converted to uppercase befor printing

writecomment([]).
writecomment(['I'|T]) :- !, write('I'), writecomment_aux(T).
writecomment([H|T]) :- !,
	name(H,[C|L]),
	D is C - 32,
        name(Z,[D|L]),
	write(Z),
	writecomment_aux(T).

writecomment_aux([]).
writecomment_aux([H|T]) :-
	name(H,[C]),
	my_char_type(C,punctuation), !,
	write(H),
	writecomment_aux(T).
writecomment_aux([H|T]) :-
	write(' '),
	write(H),
	writecomment_aux(T).


/****************************************************************************/
% quittime(+InputList)
%    checks if the atom 'quit' is in the InputList

quittime(X) :- member('quit',X).


/****************************************************************************/
% eliza
%    main routine of ELIZA

eliza :-
%	reconsult('eliza.rls'),
	retractall(mem(_)),nl,nl,
        write('Hello. I am ELIZA. How can I help you?'),nl,write('> '),
	repeat,
	   read_atomics(Input),nl,
           process_input(Input,[],Input2),
           simplify(Input2,Input3),
           findkeywords(Input3,KeyWords),
           sortkeywords(KeyWords,KeyWords2),
           makecomment(KeyWords2,Input3,Comment),
           flatten(Comment,Comment2),
           writecomment(Comment2),nl,write('> '),
           quittime(Input3),
           !.


:- eliza,nl,nl.