% A simple version of ELIZA
% PWG

:-[library(lists)].   % need member
:- dynamic standard_response/1.

prompt_and_read(Message,Reply) :-
     write(Message),nl,
     read(Reply).


eliza :-
    prompt_and_read('Welcome to Eliza. Tell me your problem',        
    Reply),
    eliza(Reply).

eliza(bye) :-
      write('I hope this has helped'),nl.

eliza(Input) :-
           convert_to_words(Input,InputWords),
           get_match(InputWords,Response),
           prompt_and_read(Response,Reply),!,
           eliza(Reply).


/* no matches or keywords found */ 
eliza(Input) :-
          retract(standard_response(SResp)),
          prompt_and_read(SResp,Reply),!,
	  assertz(standard_response(SResp)),
           eliza(Reply).

get_match(InputWords,Response) :-
          exact_match(InputWords,Response),!.

get_match(InputWords,Response) :-
          split(InputWords,Patt,Slot),
          template(Patt,Rep1,Rep2),
          fix_and_grammar(Slot,FGSlot),
          words_to_string(FGSlot,StrSlot),
          join(Rep1,StrSlot,Rep2,Response).

get_match(InputWords,Response) :-
          split(InputWords,Patt1,Slot,Patt2),
          template(Patt1,Patt2,Rep1,Rep2),
          fix_and_grammar(Slot,FGSlot),
          words_to_string(FGSlot,StrSlot),
          join(Rep1,StrSlot,Rep2,Response).

 
/* look for keywords - take first you come across */

get_match(InputWords,Response) :-
         member(KW,InputWords),
         keyword(KW,Response). 

% stringof/2
stringof( ListOfChars, Atom ):-
  atom( Atom ),
  !,
  name( Atom, ListOfBytes ),
  bytes_to_chars( ListOfBytes, ListOfChars ).
stringof( ListOfChars, Atom ):-
  bytes_to_chars( ListOfBytes, ListOfChars ),
  atmbyt( Atom0, ListOfBytes ),
  Atom = Atom0.

bytes_to_chars( [], [] ).
bytes_to_chars( [Byte|Bytes], [Char|Chars] ):-
  name( Char, [Byte] ),
  bytes_to_chars( Bytes, Chars ).

           
convert_to_words(Str,WordLst) :-
           stringof(StrChrs,Str),
           convert_chrstr_to_words(StrChrs,WordLst).

convert_chrstr_to_words([],[]).
convert_chrstr_to_words([Ch],[]) :-
                         member(Ch,[' ',',','.','?','!']).   /* remove separators */

convert_chrstr_to_words([Ch],[Ch]).

convert_chrstr_to_words([SepChr|Rst],Wds) :-
                    member(SepChr,[' ',',','.','?','!']),!,   /* remove separators */
                    convert_chrstr_to_words(Rst,Wds).

convert_chrstr_to_words([Chr,SepChr|Rst],[Chr|Wds]) :-
                    member(SepChr,[' ',',','.','?','!']),!,   /* remove separators */
                    convert_chrstr_to_words(Rst,Wds).

convert_chrstr_to_words([Chr|Rst],[Fst|RWds]) :-
                    convert_chrstr_to_words(Rst,[OFst|RWds]),
                    concat(Chr,OFst,Fst).

words_to_string([],'').
words_to_string([Str],Str) :-!.
words_to_string([FstW|RstW],Str) :-
        words_to_string(RstW,RStr),
         concat(' ',RStr,RStr1),
         concat(FstW,RStr1,Str).
                    


/* exact matches */
exact_match(['I',hate,computers],'I really like them').

/* templates of the form <pattern><slot> */

template(['I','don\'t',like],'Why don\'t you like','').
template(['I',love],'I love','as well').
template(['I',am],'I was','once').

/* templates of form <pattern><slot><pattern> */

template([my],['doesn\'t',like,me],'Thats a shame. Why doesn\'t your','like you?').

/* keyword match only */

keyword(mother,'Tell me more about your mother').

keyword(Pet,Reply) :-
	      pet(Pet),
       concat('What food do you give your ',Pet,Reply).

pet(dog).
pet(cat).
pet(hamster).

standard_response('Please go on!').
standard_response('Really, tell me more!').
standard_response('I find that hard to believe, can you expand?').


concat(X,Y,Z) :- atom_concat(X,Y,Z).

  /* utilities for eliza */

split(Input,Fst,Last) :-
      append(Fst,Last,Input).

split(Input,Fst,Mid,Last) :-
     append(Fst,MidLast,Input),
     append(Mid,Last,MidLast).

join(Str1,Str2,Str3,Str) :-
     concat(Str1,' ',NStr1),
     concat(Str2,' ',NStr2),
     concat(NStr1,NStr2,NStr12),
     concat(NStr12,Str3,Str).

/* fix pronouns you -> me etc */

fix_word(you,me).
fix_word(me,you).
fix_word('I',you).
fix_word(X,X).

fix([],[]).
fix([TW,you|Rst],[TW,'I'|FRst]) :-
         member(TW,[that,where,what]),!,
         fix(Rst,FRst).
fix([TW,'I'|Rst],[TW,you|FRst]) :-
         member(TW,[that,where,what]),!,
         fix(Rst,FRst).
fix([X|Xs],[FX|FXs]) :-
        fix_word(X,FX),
        fix(Xs,FXs).


 

/* grammar -fixes grammar errors in verb to be */

grammar([],[]).

grammar([you,am|Rst],[you,are|GRst]) :-
            !,grammar(Rst,GRst).
grammar(['I',are|Rst],['I',am|GRst]) :-
            !,grammar(Rst,GRst).
grammar([X|Xs],[X|GXs]) :-
            grammar(Xs,GXs).

/* fix then use grammar in that order */

fix_and_grammar(L,FGL) :-
          fix(L,FL),
          grammar(FL,FGL).