🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: comp.lang.prolog
Article #171

debugging psychologist program.

#171
From: Peter Radonyi
Date: Fri, 10 Apr 1992 03:49
518 lines
13416 bytes
Hello,

I am writing an psychologist program in LPA-Prolog and having a problem 
debugging it. What happens when I read in the input line and make the 
comparison the values are written in as a list, and the comparison is
made on a list of lists. For example the source code below is meant to
catch profanites, like "hell" and "pissoff" etc, when this is read in 
from the input line it is read as 

[h,e,l,l] when the comparison is made it is [[h,e,l,l]], on [h,e,l,l].
So naturally the predicate means('hell',profanity) never gets instantiated
and falls through the net and is caught by

responseTo([_]) and gets caught as a one word response.

There are two programs here, the first one Matilda, will catch words, like
bye and correctly exit.

the second program called "eliza" which is a modified version of matilda,
does not even catch the word "bye" and I need to reboot the system to 
exit LPA-Prolog.

If anybody could give some insight on what the problem is many thanks in
advance. The source code is included below.  
Source code follows
===========================  Start of program Matilda =======================
/*
 The program is a big loop, getting a response from the user
 an 
d branching according to the user input. 
*/

matilda :-
  write('Gooday'),
  nl,
  write('Would you like to discuss your problem?'),
  nl,
  continue.                                  % initialisation.

continue :-                                  % main loop
  finished,                                  % exit flag
  tidyup ; 
  write('> ') , 
  getaphrase(Yourmessage) ,             
  respondTo(Yourmessage) , 
  continue.

getaphrase(Phrase) :-
  get0(C),
  skipto(C,Char),
  restofphrase(Char,Phrase).

  restofphrase(Char,[]) :-
     ending(Char),
     !.

restofphrase(Char,[Word|Rest]) :-
  (
   punctuation(Char) ,
   Word = [Char], 
   get0(C) , 
   skipto(C,Nextchar)
   ;
   digit(Char),
   geta(number,Char,Nextchar,Word)
   ;
   letter(Char),
   geta(word,Char,Nextchar,Word)
   ),
  restofphrase(Nextchar,Rest).     % recursive procedure.

geta(Type, Ch, Next, [Ch|Rest]) :-
   (
   Type == number, digit(Ch), !
   ;
   Type == word, letter(Ch), !
   ),
   get0(Chh), geta(Type, Chh, Next, Rest).

   geta(Type, Ch, Next, []) :-
       skipto(Ch, Next).


       skipto(Ch, Next) :-
       valid(Ch),
       Next = Ch;
       get0(C), 
       skipto(C, Next).

letter(Ch) :-
     96 < Ch,            % Ascii printable a - z lowercase
     Ch < 123;           % letters start from 97 thru 122.
     64 < Ch,            % Ascii uppercase A-Z letters
     Ch < 91.            % are from 65 - 90

digit(Ch) :-
          47 < Ch,       % Ascii digits 1-0 are in this range.
          Ch < 58.

ending(13).              % <CR>

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

valid(Ch) :-
     digit(Ch);
     letter(Ch);
     punctuation(Ch);
     ending(Ch).
/* 
Branch acccording to the different responses.
 1 no response
 2 one word response
 3 two word response
 4 response to a swear word
 5 respond to an exit bye 
 6 responding to a key word
 7 responding to a key phrase
 8 recalling an earlier point.
 9 IF ALL FAILS a CATCH ALL "Please tell me more ..."
The order above will not work,  because it responds to a one
word response before it looks at exit or bye. The problem with
this is that bye and one letter swear words will never be
instantiated because the program matches them in the first. A
trap for young players.
Correct order is
 1 no response
 2 respond to an exit "bye"
 3 respond to a swear word
 4 one word response
 5 two word response
 6 responding to a key word
 7 responding to a key phrase
 8 recalling an earlier point.
 9 IF ALL FAILS a CATCH ALL "Please tell me more ..."

*/




% 1 response to a no response.
respondTo([]) :- 
     write('Say something please.'),
     nl.

% 2 exit line
     respondTo(["bye"|_]) :-
     write('Thankyou for a very interesting talk.'), nl,
     write('I hope we will talk again, farewell for now ...'),
     nl,
     assert(finished).

% 3 response to a swearword.
respondTo(Yourmessage) :- 
     means([Word], profanity),      % ****
     member([Word], Yourmessage),   % ****
     write('Please do not use words like'), write(Word),
     write('.'),
     nl.

% 4 one word response.
respondTo([_]) :- 
     write('Please do not be so short with me.'),
     nl.

% 5 two word response. 
respondTo([_,_]) :- 
     write('That is not much to go on.'),
     nl.


     
% 6 responding to a keyword.
respondTo(Yourmessage) :-
     means(Word, Meaning),
     member(Word, Yourmessage),
     respond(Word, Meaning, Response),
     printphrase(Response), nl,
     asserta(memorised(Yourmessage)).

% 7 finding a key phrase and responding.
respondTo(Yourmessage) :-
     subphrase(Pattern, Meaning),
     disect(Yourmessage, First, Pattern, Second),
     construct(First, Meaning, Second, Response),
     printphrase(Response),
     nl.

% 8 recalling an earlier point.
respondTo(_) :-
     memorised(Message),
     write('You said that: '), printphrase(Message),
     nl,
     retract(memorised(Message)).



% 9 If all else has failed.
respondTo(_) :-
     write('Please tell me more.'),
     nl.

     tidyup :-
          retractall(memorised(Message));    
               true.
     disect(U, F, P, S) :-
          conc(P, S, L),
          conc(F, L, U).

construct(First, iFeel, Second,
     ["do", "you","often","feel" | Second]).
construct(First, hatesMe, Second,
     ["how","do","you","relate","to"|First]).

respond(Word,family,
["tell","me","more","about","your", Word]).

respond(Word, worry,
["are","you","doing","anything","about", "the", Word, "?"]).

means("hell",profanity).
means("piss",profanity).

subphrase(["i", "feel"], iFeel).
subphrase(["hates", "me"], hatesMe).

% I don't understand the next line
'?ERROR?'(2,_) :-
!, fail.

conc([], L, L).
conc([E1|reset], Lis, [E1|Both]) :-
     conc(Rest, Lis, Both).
/*
     printaphrase/1 prints a phrase expressed as ascii 
     characters
*/
printphrase([]) :- !.
printphrase([Head|Tail]) :-
     writeword(Head),
     printrest(Tail).

printrest([]).
printrest([Head|Tail]) :-
     writeout(Head),
     printrest(Tail).

     writeout(Word) :-
         Word = [Ch],
         punctuation(Ch),
         put(Ch)
         ;
         tab(1),
         writeword(Word).

         writeword([]).
         writeword([Head|Tail]) :-
            put(Head),
            writeword(Tail).

============================= End of Source Code Matilda =====================

The next program is a modified version of the above program reading in the
characters as a string of characters rather than a list.

============================ Start of Program Code Eliza =====================
/*
 The program is a big loop, getting a response from the user
 an 
d branching according to the user input. 
*/

eliza :-
  write('Gooday'),
  nl,
  write('Would you like to discuss your problem?'),
  nl,
  continue.                                  % initialisation.

continue :-                                  % main loop
  finished,                                  % exit flag
  tidyup ; 
  write('> ') , 
  getaphrase(Yourmessage) ,             
  respondTo(Yourmessage) , 
  continue.

getaphrase(Phrase) :-
  get0(C),
  skipto(C,Char),
  restofphrase(Char,Phrase).

  restofphrase(Char,[]) :-
     ending(Char),
     !.

restofphrase(Char,[Word|Rest]) :-
  (
   punctuation(Char) ,
   String = [Char], 
   name(Word, String),
   get0(C) , 
   skipto(C,Nextchar)
   ;
   digit(Char),
   geta(number,Char,Nextchar,String),
   name(Word, String)
   ;
   letter(Char),
   geta(word,Char,Nextchar,String),
   name(Word, String)
   ),
  restofphrase(Nextchar,Rest).     % recursive procedure.

geta(Type, Ch, Next, [Ch|Rest]) :-
   (
   Type == number, digit(Ch), !
   ;
   Type == word, letter(Ch), !
   ),
   get0(Chh), geta(Type, Chh, Next, Rest).

   geta(Type, Ch, Next, []) :-
       skipto(Ch, Next).


       skipto(Ch, Next) :-
       valid(Ch),
       Next = Ch;
       get0(C), 
       skipto(C, Next).

letter(Ch) :-
     96 < Ch,            % Ascii printable a - z lowercase
     Ch < 123;           % letters start from 97 thru 122.
     64 < Ch,            % Ascii uppercase A-Z letters
     Ch < 91.            % are from 65 - 90

digit(Ch) :-
          47 < Ch,       % Ascii digits 1-0 are in this range.
          Ch < 58.

ending(13).              % <CR>

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

valid(Ch) :-
     digit(Ch);
     letter(Ch);
     punctuation(Ch);
     ending(Ch).
/* 
Branch acccording to the different responses.
 1 no response
 2 one word response
 3 two word response
 4 response to a swear word
 5 respond to an exit bye 
 6 responding to a key word
 7 responding to a key phrase
 8 recalling an earlier point.
 9 IF ALL FAILS a CATCH ALL "Please tell me more ..."
The order above will not work,  because it responds to a one
word response before it looks at exit or bye. The problem with
this is that bye and one letter swear words will never be
instantiated because the program matches them in the first. A
trap for young players.
Correct order is
 1 no response
 2 respond to an exit "bye"
 3 respond to a swear word
 4 one word response
 5 two word response
 6 responding to a key word
 7 responding to a key phrase
 8 recalling an earlier point.
 9 IF ALL FAILS a CATCH ALL "Please tell me more ..."

*/




% 1 response to a no response.
respondTo([]) :- 
     write('Say something please.'),
     nl.

% 2 exit line
     respondTo(["bye"|_]) :-
     write('Thankyou for a very interesting talk.'), nl,
     write('I hope we will talk again, farewell for now ...'),
     nl,
     assert(finished).

% 3 response to a swearword.
respondTo(Yourmessage) :- 
     means([Word], profanity),      % ****
     member([Word], Yourmessage),   % ****
     write('Please do not use words like'), write(Word),
     write('.'),
     nl.

% 4 one word response.
respondTo([_]) :- 
     write('Please do not be so short with me.'),
     nl.

% 5 two word response. 
respondTo([_,_]) :- 
     write('That is not much to go on.'),
     nl.


     
% 6 responding to a keyword.
respondTo(Yourmessage) :-
     means(Word, Meaning),
     member(Word, Yourmessage),
     respond(Word, Meaning, Response),
     printphrase(Response), nl,
     asserta(memorised(Yourmessage)).

% 7 finding a key phrase and responding.
respondTo(Yourmessage) :-
     subphrase(Pattern, Meaning),
     disect(Yourmessage, First, Pattern, Second),
     construct(First, Meaning, Second, Response),
     printphrase(Response),
     nl.

% 8 recalling an earlier point.
respondTo(_) :-
     memorised(Message),
     write('You said that: '), printphrase(Message),
     nl,
     retract(memorised(Message)).



% 9 If all else has failed.
respondTo(_) :-
     write('Please tell me more.'),
     nl.

     tidyup :-
          retractall(memorised(Message));    
               true.
     disect(U, F, P, S) :-
          conc(P, S, L),
          conc(F, L, U).

construct(First, iFeel, Second,
     ["do", "you","often","feel" | Second]).
construct(First, hatesMe, Second,
     ["how","do","you","relate","to"|First]).

respond(Word,family,
["tell","me","more","about","your", Word]).

respond(Word, worry,
["are","you","doing","anything","about", "the", Word, "?"]).

means("hell",profanity).
means("piss",profanity).

subphrase(["i", "feel"], iFeel).
subphrase(["hates", "me"], hatesMe).

% I don't understand the next line
'?ERROR?'(2,_) :-
!, fail.

conc([], L, L).
conc([E1|reset], Lis, [E1|Both]) :-
     conc(Rest, Lis, Both).
/*
     printaphrase/1 prints a phrase expressed as ascii 
     characters
*/
printphrase([]) :- !.
printphrase([Head|Tail]) :-
     write(Head),
     printrest(Tail).

printrest([]).
printrest([Head|Tail]) :-
     writeout(Head),
     printrest(Tail).

     writeout(Word) :-
         Word = [Ch],
         punctuation(Ch),
         put(Ch)
         ;
         tab(1),
         writeword(Word).

         writeword([]).
         writeword([Head|Tail]) :-
            put(Head),
            writeword(Tail).
============================== End of Source Code Eliza ========================

Thanks for any light you can throw on these two programs.


Regards Peter Radonyi
Technical Details
Message-ID: <2476@loki.une.edu.au>
Path: arc1-ca.pugleaf.net!sparky!uunet!munnari.oz.au!mel.dit.csiro.au!mineng.dmpe.CSIRO.AU!dmssyd.syd.dms.CSIRO.AU!metro!grivel!loki!peter

Show Full Headers
Complete Article Headers
Path: arc1-ca.pugleaf.net!sparky!uunet!munnari.oz.au!mel.dit.csiro.au!mineng.dmpe.CSIRO.AU!dmssyd.syd.dms.CSIRO.AU!metro!grivel!loki!peter
From: peter@loki.une.edu.au (Peter Radonyi)
Newsgroups: comp.lang.prolog
Subject: debugging psychologist program.
Keywords: prolog
Message-ID: <2476@loki.une.edu.au>
Date: 10 Apr 92 03:49:53 GMT
Organization: University of New England - Northern Rivers, (Lismore)
Lines: 518