Eliza, the computer psychiatrist by Jolly Roger ( with Speech )

[pistol350]

Hi all!

For those of you who knew Eliza, the computer psychiatrist,
you will be glad to start to chat with her now that she can speak with her charming voice 
By the way, she is still as simple minded as before, so you are welcome to help her get smarter 

Code Select Expand


'Simple version of Eliza the AI psyschiatrist
'IBPro console programme
'Jolly Roger April 2005
'Speech added on April 2008 ^^_

AUTODEFINE "OFF"

IDispatch speech
string text[10]

speech = CreateComObject("Sapi.SpVoice","")
if speech <> NULL
goto startprog
else
PRINT "Sapi object not available"
do:until inkey$ <> ""
END
endif

label startprog

DEF inputtext$,response$:STRING
DEF pronounsearchstring$[100],pronounreplacement$[100],responsestartphrase$[100]:STRING
DEF randomresponse$[100],keyphrase$[100],keyphraseresponse$[100]:STRING
DEF preprocesssearchstring$[100],preprocessreplacement$[100]:STRING
DEF previousresponses$[10],lastinputtext$:STRING
DEF numberofpronounreplacementstrings,numberofpreprocessstrings:UINT
DEF numberofrandomresponses,numberofkeyphrases,nextrandomresponse,n:UINT
DEF numberofresponsestartphrases,repetition:UINT
nextrandomresponse=0
lastinputtext$=""
FOR n=0 TO 9
  previousresponses$[n]=""
NEXT n
OPENCONSOLE
GOSUB readdata

text = "Type what you want to say then press return."
textTospeech(text)

text = "Press return without entering any text to exit."
textTospeech(text)
PRINT:PRINT
text = "Hello, I am Eliza your computer psychiatrist. How can I help you?"
textTospeech(text)

DO
  INPUT inputtext$
  'Strip spaces from start and end
  inputtext$=LTRIM$(RTRIM$(inputtext$))
  'Check if user entered the same text last time
  repetition=0
  IF inputtext$=lastinputtext$ and inputtext$<>""
text = "You just said that."
     
textTospeech(text)
     repetition=1
  ENDIF
  lastinputtext$=inputtext$
  IF inputtext$<>"" & repetition=0
    'Preprocess inputtext$ so easier to analyse
    GOSUB preprocessinputtext
    'Try to find response based on keyphrase
    response$=searchforkeyphrases()
    IF response$=""
       'Can't find response related to user input so use random response
       'Use these in order to avoid repetition
       response$=randomresponse$[nextrandomresponse]
       nextrandomresponse=nextrandomresponse+1
       IF nextrandomresponse>numberofrandomresponses-1 THEN nextrandomresponse=0
    ENDIF
    'Print the response
    'PRINT LTRIM$(response$)
text = LTRIM$(response$)
textTospeech(text)
    'Update the list of the ten most recent responses
    FOR n=8 TO 0 STEP -1
       previousresponses$[n+1]=previousresponses$[n]
    NEXT n
    previousresponses$[0]=response$
  ENDIF
UNTIL inputtext$=""
textTospeech("bye bye!")
speech->release()
CLOSECONSOLE
END

SUB preprocessinputtext
   'Pre process inputtext$ to make analysis easier
   DEF searchstring,position,charactercode,searchstringlength:UINT
   'Remove all characters bar numbers and letters from end of inputtext$
   FOR position=LEN(inputtext$) TO 1 STEP -1
      charactercode=ASC(MID$(UCASE$(inputtext$),position,1))
      IF (charactercode<48 | (charactercode>57 & charactercode<65) | charactercode>90)
         'Found non alphanumeric character
         inputtext$=LEFT$(inputtext$,LEN(inputtext$)-1)
      ELSE
         position=1
      ENDIF
   NEXT position
   'Add space to beginning and end (required for string searches)
   inputtext$=" "+inputtext$+" "
   'Replace all characters bar numbers,letters or apostrophe with space+character+space
   position=1
   DO
      charactercode=ASC(MID$(UCASE$(inputtext$),position,1))
      IF charactercode<48 | (charactercode>57 & charactercode<65) | charactercode>90
         'Found non alphanumeric character
         IF charactercode<>39
           'Character isn't an apostrophe so replace
           inputtext$=LEFT$(inputtext$,position-1)+" "+CHR$(charactercode)+" "+MID$(inputtext$,position+1)
           position=position+2
         ENDIF
      ENDIF
      position=position+1
   UNTIL position>LEN(inputtext$)
   'Replace all double spaces with a single space
   DO
     position=INSTR(inputtext$,"  ")
     IF position>0
        inputtext$=LEFT$(inputtext$,position)+MID$(inputtext$,position+2)
     ENDIF
   UNTIL position=0
  'Find any preprocessing search strings and replace them
  position=1
  DO
    FOR searchstring=0 TO numberofpreprocessstrings-1
       searchstringlength=LEN(preprocesssearchstring$[searchstring])
       IF MID$(UCASE$(inputtext$),position,searchstringlength)=preprocesssearchstring$[searchstring]
          'Found a search string.Replace it with corresponding replacement string
          inputtext$=LEFT$(inputtext$,position-1)+preprocessreplacement$[searchstring]+RIGHT$(inputtext$,(LEN(inputtext$)-searchstringlength-position+1))
          position=position+LEN(preprocessreplacement$[searchstring])-2
          searchstring=numberofpreprocessstrings-1 :'Leave FOR-NEXT loop when get to NEXT
       ENDIF
    NEXT searchstring
    position=INSTR(inputtext$," ",position+1)
  UNTIL position=0 :'No more spaces
RETURN
ENDSUB

SUB replacepronouns(texttoalter$:STRING),STRING
  'Replaces pronouns (eg I am->you are) in texttoalter$ to form end of response
  DEF currentposn,pronoun:UINT
  DEF pronounsearchstringlength,position:UINT
  DEF alteredtext$:STRING
  alteredtext$=texttoalter$
  'Check for a full stop-only use text before it
  position=INSTR(alteredtext$,".")
  IF position<>0 THEN alteredtext$=LEFT$(alteredtext$,position-1)
  'Scan alteredtext$ for pronouns
  currentposn=1
  DO
    FOR pronoun=0 TO numberofpronounreplacementstrings-1
       pronounsearchstringlength=LEN(pronounsearchstring$[pronoun])
       IF MID$(UCASE$(alteredtext$),currentposn,pronounsearchstringlength)=pronounsearchstring$[pronoun]
          'Found a pronoun search string.Replace it with corresponding replacement pronoun string
          alteredtext$=LEFT$(alteredtext$,currentposn-1)+pronounreplacement$[pronoun]+MID$(alteredtext$,currentposn+pronounsearchstringlength)
          currentposn=currentposn+LEN(pronounreplacement$[pronoun])-2
          pronoun=numberofpronounreplacementstrings-1 :'Leave FOR-NEXT loop when get to NEXT
       ENDIF
    NEXT pronoun
    currentposn=INSTR(alteredtext$," ",currentposn+1)
  UNTIL currentposn=0 | currentposn=LEN(alteredtext$):'No more spaces
  RETURN LTRIM$(alteredtext$)
ENDSUB

SUB searchforkeyphrases(),STRING
  DEF responsetext$:STRING
  DEF phrase,position,responserecentlyused,startphrase:UINT
  responsetext$=""
    FOR phrase=0 TO numberofkeyphrases-1
       position=INSTR(UCASE$(inputtext$),keyphrase$[phrase])
       IF position<>0
          'Found a keyphrase string
          IF LEFT$(keyphraseresponse$[phrase],1)=" "
             'Space at beginning means add a response start phrase here
             FOR startphrase=0 TO numberofresponsestartphrases-1
                responserecentlyused=0
                responsetext$=responsestartphrase$[startphrase]+keyphraseresponse$[phrase]
                'Check if this response been used recently
                FOR n=0 TO 9
                 IF INSTR(previousresponses$[n],responsetext$)
                   responserecentlyused=1:n=9:responsetext$=""
                 ENDIF
                NEXT n
                IF responserecentlyused=0 THEN startphrase=numberofresponsestartphrases-1:'Exit FOR-NEXT loop
             NEXT startphrase
          ELSE
             responsetext$=keyphraseresponse$[phrase]
             'Check if this response been used recently
             responserecentlyused=0
             FOR n=0 TO 9
               IF INSTR(previousresponses$[n],responsetext$)
                 responserecentlyused=1:n=9:responsetext$=""
               ENDIF
            NEXT n
          ENDIF
          IF responserecentlyused=0
            IF RIGHT$(keyphraseresponse$[phrase],1)=" "
              'Response uses part of inputtext$.Alter any pronouns in it
               responsetext$=responsetext$+replacepronouns(RIGHT$(inputtext$,(LEN(inputtext$)-position+2-LEN(keyphrase$[phrase]))))
               'Add question mark to end
               responsetext$=RTRIM$(responsetext$)
               responsetext$=responsetext$+"?"
            ENDIF
            phrase=numberofkeyphrases-1 :'Leave FOR-NEXT loop when get to NEXT
          ENDIF
       ENDIF
    NEXT phrase
RETURN responsetext$
ENDSUB

SUB readdata
  DEF text$:STRING
  'Read preprocess strings (used in SUB preprocessinputtext)
  numberofpreprocessstrings=0
  DO
    GETDATA inputpreprocessdata,text$
    IF text$<>""
      preprocesssearchstring$[numberofpreprocessstrings]=" "+text$+" "
      GETDATA inputpreprocessdata,text$
      preprocessreplacement$[numberofpreprocessstrings]=" "+text$+" "
      numberofpreprocessstrings=numberofpreprocessstrings+1
    ENDIF
  UNTIL text$=""
  'Read pronoun replacement strings data (used in SUB replacepronouns)
  numberofpronounreplacementstrings=0
  DO
    GETDATA replacepronoundata,text$
    IF text$<>""
      pronounsearchstring$[numberofpronounreplacementstrings]=" "+text$+" "
      GETDATA replacepronoundata,text$
      pronounreplacement$[numberofpronounreplacementstrings]=" "+text$+" "
      numberofpronounreplacementstrings=numberofpronounreplacementstrings+1
    ENDIF
  UNTIL text$=""
  'Read keyphrase data (used in SUB searchforkeyphrases)
  numberofkeyphrases=0
  DO
    GETDATA keyphrasedata,text$
    IF text$<>""
      keyphrase$[numberofkeyphrases]=text$
      GETDATA keyphrasedata,text$
      keyphraseresponse$[numberofkeyphrases]=text$
      numberofkeyphrases=numberofkeyphrases+1
    ENDIF
  UNTIL text$=""
  'Read response start phrases (used in SUB searchforkeyphrases)
  numberofresponsestartphrases=0
  DO
    GETDATA responsestartphrasedata,text$
    IF text$<>""
      responsestartphrase$[numberofresponsestartphrases]=text$
      numberofresponsestartphrases=numberofresponsestartphrases+1
    ENDIF
  UNTIL text$=""
  'Read random responses (used in main loop)
  numberofrandomresponses=0
  DO
    GETDATA randomresponses,text$
    IF text$<>""
      randomresponse$[numberofrandomresponses]=text$
      numberofrandomresponses=numberofrandomresponses+1
    ENDIF
  UNTIL text$=""
RETURN
ENDSUB

'------------------------- DATA -----------------------------
  'Add more data to improve the programme but leave the last line (DATA "","") as it is the marker for the end of the data
  DATABEGIN inputpreprocessdata
     'If first phrase in pair is found it will be replaced with the second one
     DATA "DONT","don't", "DO NOT","don't"
     DATA "YOUR A","you are a", "YOUR AN","you are an", "YOURE","you are"
     DATA "I'M","I am", "IM","I am"
     DATA "THEYRE","they are", "THEY'RE","they are"
     DATA "CANNOT","can't", "CANT","can't"
     DATA "THEYLL","they will","THEY'LL","they will"
     DATA "THEYD","they would", "THEY'D","they would"
     DATA "YOULL","you will", "YOU'LL","you will"
     DATA "WE'RE","we are", "IVE","I have", "I'VE","I have"
     DATA "YOUD","you would", "YOU'D","you would"
     DATA "I'D","I would", "I'LL","I will"
     DATA "ITS","it is", "IT'S","it is", "SHES","she is"
     DATA "SHE'S","she is", "HE'S","he is", "HES","he is"
     DATA "SHE'LL","she will", "HE'LL","he will"
     DATA "MUM","mother", "DAD","father"
     DATA "",""
  DATAEND
  DATABEGIN replacepronoundata
    'First phrase in each pair (upper case) will be replaced by second phrase in each pair
    DATA "I AM","you are", "I WAS","you were"
    DATA "YOU ARE","I am", "ARE YOU","I am", "YOU WERE","I was"
    DATA "WE ARE","you're", "I","you", "ME","you"
    DATA  "MY","your", "YOUR","my"
    DATA "MINE","yours", "YOURS","mine", "OUR","your"
    DATA "OURS","yours", "YOU","me"
    DATA "MYSELF","yourself", "YOURSELF","myself", "AM","are"
    DATA "COLOR","colour"
    DATA "",""
  DATAEND
  DATABEGIN randomresponses
     DATA "Tell me more."
     DATA "Interesting. Go on."
     DATA "Please elaborate."
     DATA "What makes you say that?"
     DATA "I am not sure I understand you fully."
     DATA "",""
  DATAEND
  DATABEGIN responsestartphrasedata
    DATA "Why do you think","Does it worry you that","Are you sure that"
    DATA "What leads you to believe","How can you be sure"
    DATA "",""
  DATAEND
  DATABEGIN keyphrasedata
    'If first phrase (key phrase) is found then the response is the second phrase.
    'If the response (second) phrase ends with a space then the user input after the
    'keyphrase will have it's pronouns altered then will be added after it.
    'If the response phrase starts with a space then a response start phrase (see just above)
    'will be added before it.
    DATA " I WANT A ","Why do you think you'd be happy if you had a "
    DATA " I WANT TO BE ","Why do you think you'd be happier if you were "
    DATA " I WISH ","Be careful what you wish for."
    DATA " I AM ","How long have you been "
    DATA " DO YOU ","Why do you ask that?"
    DATA " I CAN'T ","Try harder."
    DATA " CAN YOU ","Do you wish that you could "
    DATA " I HATE ","Why do you hate "
    DATA " I NEED ","Why do you think you'd be happier if you had "
    DATA " I LOVE ","What do you love most about "
    DATA " MY GIRLFRIEND "," she "
    DATA " MY BOYFRIEND "," he "
    DATA " MUSIC","What sorts of music do you like?"  :'Because there is no space at the end  of the keyphrase it will detect "music","musician","musical" etc.
    DATA " SEX","It alway seems to come down to sex with you humans."
    DATA " DRUNK ","People often do foolish things when under the influence of alcohol."
    DATA " MY MOTHER ","Tell me about your relationship with your mother."
    DATA " MY FATHER ","Tell me about your relationship with your father."
    DATA " HE HATES ME ","Do you hate him?"
    DATA " SHE HATES ME ","Do you hate her?"
    DATA " YOU HATE ME ","I don't hate you."
    DATA " THEY HATE ME ","Why do you think that is?"
    DATA " LUCK","Some people believe we make our own luck."
    DATA " I WAS ","Do you wish you were still "
    DATA " YOU WERE ","Do you wish I was still "
    DATA " FOREVER ","Forever is a long time."
    DATA " NEVER ","Are you sure you mean never?"
    DATA " I LIKE "," you like "
    DATA " DREAM ","Do you often remember your dreams?"
    DATA " DREAM ","Dreams are a window into the subconscious."
    DATA " BAD DREAM","Do you often have bad dreams?"
    DATA " NIGHTMARE","Nightmares are often caused by unresolved issues in your subconscious."
    DATA " FANTASY ","Some fantasies are unhealthy."
    DATA " FANTASISE ","Perhaps you should concentrate more on the real world."
    DATA " I DON'T ","Why don't you "
    DATA " WHY DON`T YOU ","Why would you want me to "
    DATA " WHY CAN`T I ","What makes you think you should be able to "
    DATA " ARE YOU ","Why are you interested in whether I'm "
    DATA " ALWAYS ","Can you think of a specific example?"
    DATA " YOU ARE "," I am "
    DATA " YOUR ","Why are you concerned about my "
    DATA " BECAUSE ","Are you sure that's the reason?"
    DATA " ALIKE ","In what way?"
    DATA " I "," you "
    DATA " HE "," he "
    DATA " SHE "," she "
    DATA " THEY "," they "
    DATA " WE "," we "
    DATA "",""
  DATAEND

SUB textTospeech(string text$)
  PRINT text$
  CallObjectMethod(speech,".Speak(%s)",text$)
RETURN
ENDSUB


[Brian]

Peter,

Haven't seen Eliza for a long time - well resurrected!

Brian

[pistol350]

Thanks Brian!

Actually, the main reason why i resurrected her is that i was a bit fed up with having the same anwsers over and over again when i chat with her  .

As i said, i hope to see her get Smarter 

[LarryMc]

... i was a bit fed up with having the same anwsers over and over again when i chat with her...

Uhhh get a life!

Larry

[maurice1]

Pistol could you advise where to get the "Sapi.SpVoice" ComObject

[pistol350]

... i was a bit fed up with having the same anwsers over and over again when i chat with her...

Uhhh get a life!

Larry

LOL 

Hi maurice1!

To have the sound played you need the latest updates that came with the last release of Ebasic.
The "Sapi.SpVoice" ComObject came with the version 1.6 i think.

[h3kt0r]

Mmmh, got this error at compile :

Compiling...
Eliza.iwb
No Errors

Linking...
IWBasic Linker v1.11 Copyright © 2011 Ionic Wind Software
Unresolved external __imp__gmtime64
Error: C:\Program Files\iwbdev\libs\disphelper.lib\disphelper.obj - Unresolved extern __imp__gmtime64
Error: C:\Program Files\iwbdev\libs\disphelper.lib\disphelper.obj - Unresolved extern __imp__mktime64
Error: C:\Program Files\iwbdev\libs\disphelper.lib\disphelper.obj - Unresolved extern __imp__localtime64
Error(s) in linking C:\Documents and Settings\h3kt0r\Local Settings\Application Data\IonicWind\IWBasic2\examples\Eliza.exe

[LarryMc]

This problem may have been introduced with some of the work LarryS has been doing on the 64 bit version of the compiler.