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 ;D
By the way, she is still as simple minded as before, so you are welcome to help her get smarter :D
'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
Peter,
Haven't seen Eliza for a long time - well resurrected!
Brian
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 ;D.
As i said, i hope to see her get Smarter ;)
Quote from: pistol350 on April 25, 2008, 01:02:17 PM
... i was a bit fed up with having the same anwsers over and over again when i chat with her...
Uhhh get a life! ;D
Larry
Pistol could you advise where to get the "Sapi.SpVoice" ComObject
Quote from: Larry McCaughn on April 25, 2008, 01:47:30 PM
Quote from: pistol350 on April 25, 2008, 01:02:17 PM
... i was a bit fed up with having the same anwsers over and over again when i chat with her...
Uhhh get a life! ;D
Larry
LOL ;D
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.
Mmmh, got this error at compile :
QuoteCompiling...
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
This problem may have been introduced with some of the work LarryS has been doing on the 64 bit version of the compiler.