Author Topic: the ELIZA Project  (Read 522 times)

Offline ronblue77

  • QB64 is fun...
Re: the ELIZA Project
« Reply #15 on: May 28, 2019, 05:31:00 AM »
hello everyone...

the ELIZA project continues and the last code example is not the end - yesterday i had a lesson with my teacher and we started to understand how bplus "player" code works and how it loads strings and integers to dynamic arrays from the text file... we are hoping to eventually write an ELIZA program that will have a text file as a database for keywords and replies and words for conjunctions which will be able to be editable from within the program like bplus other chatbot code - "AI chatbot Z"...

it's going to be challenging and interesting...
so stay tuned :)

ron77
I CODE there for I AM

Re: the ELIZA Project
« Reply #16 on: May 29, 2019, 05:00:44 PM »
My 4 year old Player code (in another Basic) was 339 lines long. I spent allot of time and effort getting punctuation to work. I was curious today what that code might look like without punctuation concerns. Ha! 126 lines for Player.

Code: QB64 [Select]
  1. _TITLE "Player" ' B+ started 2019-05-26  post loadArrays test on Script Eliza.txt file
  2. '2019-05-29 post basic getReply$ function of Eliza / Script Player
  3.  
  4. DIM SHARED Greeting AS STRING, You AS STRING, Script AS STRING
  5. DIM SHARED kCnt AS INTEGER, rCnt AS INTEGER, wCnt AS INTEGER, NoKeyFoundIndex AS INTEGER
  6. REDIM SHARED keywords(0) AS STRING, replies(0) AS STRING, wordIn(0) AS STRING, wordOut(0) AS STRING
  7. REDIM SHARED rStarts(0) AS INTEGER, rEnds(0) AS INTEGER, rIndex(0) AS INTEGER
  8.  
  9. DIM rply AS STRING '              for main loop
  10. LoadArrays "Script Eliza.TXT" '   check file load, OK checks out
  11. PRINT Greeting: PRINT '           start testing main Eliza code
  12.     rply$ = GetReply$
  13.     PRINT Script + ": " + rply$: PRINT
  14. LOOP UNTIL rply$ = ""
  15.  
  16. 'append to the string array the string item
  17. SUB sAppend (arr() AS STRING, item AS STRING)
  18.     REDIM _PRESERVE arr(LBOUND(arr) TO UBOUND(arr) + 1) AS STRING
  19.     arr(UBOUND(arr)) = item
  20.  
  21. 'append to the integer array the integer item
  22. SUB nAppend (arr() AS INTEGER, item AS INTEGER)
  23.     REDIM _PRESERVE arr(LBOUND(arr) TO UBOUND(arr) + 1) AS INTEGER
  24.     arr(UBOUND(arr)) = item
  25.  
  26. ' pull data out of some script file
  27. SUB LoadArrays (scriptFile AS STRING)
  28.     DIM startR AS INTEGER, endR AS INTEGER, ReadingR AS INTEGER, temp AS INTEGER
  29.     DIM fline AS STRING, kWord AS STRING
  30.  
  31.     OPEN scriptFile FOR INPUT AS #1
  32.     WHILE EOF(1) = 0
  33.         LINE INPUT #1, fline
  34.         fline = UCASE$(fline) 'once and for all time everything from this file is capital!
  35.         SELECT CASE LEFT$(fline$, 2)
  36.             CASE "G:": Greeting = _TRIM$(MID$(fline, 3))
  37.             CASE "Y:": You = _TRIM$(MID$(fline, 3))
  38.             CASE "C:": Script = _TRIM$(MID$(fline, 3))
  39.             CASE "S:"
  40.                 wCnt = wCnt + 1: temp = INSTR(fline, ">")
  41.                 IF temp THEN
  42.                     sAppend wordIn(), " " + _TRIM$(MID$(fline, 3, temp - 3)) + " "
  43.                     sAppend wordOut(), " " + _TRIM$(MID$(fline, temp + 1)) + " "
  44.                 END IF
  45.             CASE "R:"
  46.                 rCnt = rCnt + 1
  47.                 sAppend replies(), _TRIM$(MID$(fline, 3))
  48.                 IF NOT ReadingR THEN
  49.                     ReadingR = -1
  50.                     startR = rCnt
  51.                 END IF
  52.             CASE "K:"
  53.                 IF ReadingR THEN
  54.                     endR = rCnt
  55.                     ReadingR = 0
  56.                 END IF
  57.                 IF rCnt THEN
  58.                     kCnt = kCnt + 1
  59.                     kWord = _TRIM$(MID$(fline, 3))
  60.                     sAppend keywords(), " " + kWord + " "
  61.                     nAppend rStarts(), startR
  62.                     nAppend rIndex(), startR
  63.                     nAppend rEnds(), endR
  64.                     IF kWord = "NOKEYFOUND" THEN NoKeyFoundIndex = kCnt
  65.                 END IF
  66.             CASE "E:": EXIT WHILE
  67.         END SELECT
  68.     WEND
  69.     CLOSE #1
  70.     IF ReadingR THEN 'handle last bits
  71.         endR = rCnt
  72.         kCnt = kCnt + 1
  73.         sAppend keywords(), "NOKEYFOUND"
  74.         nAppend rStarts(), startR
  75.         nAppend rIndex(), startR
  76.         nAppend rEnds(), endR
  77.         NoKeyFoundIndex = kCnt
  78.     END IF
  79.  
  80. ' =============================== here is the heart of ELIZA / Player function
  81. FUNCTION GetReply$ ()
  82.     DIM inpt AS STRING, tail AS STRING, answ AS STRING
  83.     DIM kFlag AS INTEGER, k AS INTEGER, kFound AS INTEGER, w AS INTEGER, wFound
  84.  
  85.     ' USER INPUT SECTION
  86.     PRINT You + ": ";: INPUT "", inpt
  87.     inpt = UCASE$(inpt)
  88.     IF inpt = "Q" OR inpt = "E" OR inpt = "X" OR inpt = "GOODBYE" OR inpt = "GOOD NITE" OR inpt = "BYE" THEN
  89.         GetReply$ = "": EXIT FUNCTION
  90.     END IF
  91.     inpt = " " + inpt + " " '<< need this because keywords embedded in spaces to ID whole words only
  92.     tail = ""
  93.     FOR k = 1 TO kCnt 'loop through key words until we find a match
  94.         kFound = INSTR(inpt, keywords(k))
  95.         IF kFound > 0 THEN '>>> need the following for * in some replies
  96.             tail = MID$(inpt, kFound + LEN(keywords(k))) + " "
  97.             FOR w = 1 TO wCnt 'swap words in tail if used there
  98.                 wFound = INSTR(tail, wordIn(w))
  99.                 IF wFound > 0 THEN 'then exchange words
  100.                     tail = MID$(tail, 1, wFound - 1) + wordOut(w) + MID$(tail, wFound + LEN(wordIn(w)))
  101.                 END IF
  102.             NEXT
  103.             kFlag = -1
  104.             EXIT FOR
  105.         END IF
  106.     NEXT
  107.     IF kFlag = 0 THEN k = NoKeyFoundIndex
  108.     answ = replies(rIndex(k))
  109.     'set pointer to next reply in rIndex array
  110.     IF k = NoKeyFoundIndex THEN 'let's not get too predictable for most used set of replies
  111.         rIndex(k) = INT((rEnds(k) - rStarts(k) + 1) * RND) + rStarts(k)
  112.     ELSE
  113.         rIndex(k) = rIndex(k) + 1 'set next reply index then check it
  114.         IF rIndex(k) > rEnds(k) THEN rIndex(k) = rStarts(k)
  115.     END IF
  116.     IF RIGHT$(answ, 1) <> "*" THEN GetReply$ = answ: EXIT FUNCTION 'oh so the * signal an append to reply!
  117.     IF _TRIM$(tail) = "" THEN
  118.         GetReply$ = "PLEASE ELABORATE ON, " + keywords(k)
  119.     ELSE
  120.         GetReply$ = MID$(answ, 1, LEN(answ) - 1) + " " + tail
  121.     END IF
  122.  

EDIT: found bug trying to exit with BYE or Q or X, fixed now 2019-05-30.
« Last Edit: May 30, 2019, 07:07:13 PM by bplus »
B = B + ...

Offline ronblue77

  • QB64 is fun...
Re: the ELIZA Project
« Reply #17 on: May 29, 2019, 10:43:33 PM »
hi bplus!...

once again i thank you for your help and support today i have another lesson with my teacher and we will continue learning from your code examples...

ron77
I CODE there for I AM

Re: the ELIZA Project
« Reply #18 on: May 29, 2019, 11:45:05 PM »
Hi  ron77,

Thanks to this project thread, I am now toying with idea of adding Basic Interpreter functions to Player, called Nano.

BUT FIRST GET RID OF ALL CAPITALS because it looks like Eliza or whichever script I am using is YELLING AT ME ;D

2nd handling punctuation the way I had 4 years ago was big dead end, but I have a couple of ideas that might simplify... or maybe just let it go, Nano is famous for no punctuation (though stuck on handling string variables and functions).

3rd along with adding a Basic Interpreter function, add host of commands to make the Player more useful, specially while using it, I want to add to keywords and replies and also would like being able to load different script files, maybe do some file management stuff too...  like what I talked about with the other chat bot.

What a load off getting rid of old punctuation code!

Append: I am adding this link to past conversations about chatbots.
https://www.qb64.org/forum/index.php?topic=836.msg100455#msg100455
I see I used LINE INPUT for getting user's input, allows commas and we started some commands for a bot as well.

I am thinking it is easier to just load the script file to an editor for showing and making changes to keywords and replies. So the script might record the editor to use for the person's preference and OS or that might be hardcoded as constant in bot / Player code (one less thing to track in every script file).
« Last Edit: May 30, 2019, 10:53:16 AM by bplus »
B = B + ...

Re: the ELIZA Project
« Reply #19 on: May 31, 2019, 03:58:57 PM »
While making above revisions I discovered a bug using INSTR to search for wordIn() in tail, it was replacing words already replaced! I think I have that fixed as well as all caps problem plus now handling punctuation well (I think).

Here is revised file name, Script Eliza Mod.txt
Code: [Select]
g:Hi! I'm Eliza. Whats your problem?
y:Patient
c:Eliza
s:are>am|are
s:am>are
s:were>was|were
s:was>were
s:you>I|me
s:I>you
s:your>my
s:my>your
s:I've>you've
s:you've>I've
s:I'm>you're
s:you're>I'm
s:me>you
 
r:Don't you believe that I can*
r:Perhaps you would like to be like me*
r:You want me to be able to*
k:can you
 
r:Perhaps you don't want to*
r:Do you want to be able to*
k:can i
 
r:What makes you think I am*
r:Does it please you to believe I am*
r:Perhaps you would like to be*
r:Do you sometimes wish you were*
k:you are
k:you're
 
r:Don't you really*
r:Why don't you*
r:Do you wish to be able to*
r:Does that trouble you*
k:I don't
 
r:Do you often feel*
r:Do you often feel*
r:Do you enjoy feeling*
k:I feel
 
r:Do you really believe I don't*
r:Perhaps in good time I will*
r:Do you want me to*
k:Why don't you
r:Do you think you should be able to*
r:why can't you*
k:why can't I
 
r:Why are you interested in whether or not I am*
r:Would you prefer if I were not*
r:Perhaps in your fantasies I am*
k:Are you
r:How do you know you can't*
r:Have you tried?
r:Perhaps you can now*
k:I can't
 
r:Did you come to me because you are*
r:How long have you been*
r:Do you believe it is normal to be*
r:Do you enjoy being*
k:I am
k:I'm
 
r:We were discussing you--not me.
r:Oh, I*
r:You're not really talking about me, are you?
k:you
 
r:What would it mean to you if you got*
r:Why do you want*
r:Suppose you soon got*
r:What if you never got*
r:I sometimes also want*
k:I want
 
r:Why do you ask?
r:Does that question interest you?
r:What answer would please you the most?
r:What do you think?
r:Are such questions on your mind often?
r:What is it that you really want to know?
r:Have you asked anyone else?
r:Have you asked such questions before?
r:What else comes to mind when you ask that?
k:what
k:how
k:who
k:where
k:when
k:why
 
r:Names don't interest me.
r:I don't care about names --please go on.
k:name
 
r:Is that the real reason?
r:Don't any other reasons come to mind?
r:Does that reason explain anything else?
r:What other reasons might there be?
k:cause
 
r:Please don't apologize!
r:Apologies are not necessary.
r:What feelings do you have when you apologize?
r:Don't be so defensive!
k:sorry
 
r:What does that dream suggest to you?
r:Do you dream often?
r:What persons appear in your dreams?
r:Are you disturbed by your dreams?
k:dream
 
r:How do you do ...please state your problem.
k:Hello
k:hi
 
r:You don't seem quite certain.
r:Why the uncertain tone?
r:Can't you be more positive?
r:You aren't sure?
r:Don't you know?
k:maybe
 
r:Are you saying no just to be negative?
r:You are being a bit negative.
r:Why not?
r:Are you sure?
r:Why no?
k:no
 
r:Why are you concerned about my*
r:What about your own*
k:your
 
r:Can you think of a specific example?
r:When?
r:What are you thinking of?
r:Really, always?
k:always
 
r:Do you really think so?
r:But you are not sure you*
r:Do you doubt you*
k:think
 
r:In what way?
r:What resemblance do you see?
r:What does the similarity suggest to you?
r:What other connections do you see?
r:Could there really be some connection?
r:How?
r:You seem quite positive.
k:alike
 
r:Are you sure?
r:I see.
r:I understand.
k:yes
 
r:Why do you bring up the topic of friends?
r:Do your friends worry you?
r:Do your friends pick on you?
r:Are you sure you have any friends?
r:Do you impose on your friends?
r:Perhaps your love for friends worries you.
k:friend
 
r:Do computers worry you?
r:Are you talking about me in particular?
r:Are you frightened by machines?
r:Why do you mention computers?
r:What do you think machines have to do with your problem?
r:Don't you think computers can help people?
r:What is it about machines that worries you?
k:computer
 
r:Say, do you have any psychological problems?
r:What does that suggest to you?
r:I see.
r:I'm not sure I understand you fully.
r:Come come elucidate your thoughts.
r:Can you elaborate on that?
r:That is quite interesting.
k:nokeyfound
e:
 

To run in revised Player.bas
Code: QB64 [Select]
  1. _TITLE "Player" ' B+ started 2019-05-26  post loadArrays test on Script Eliza.txt file
  2. '2019-05-29 post basic getReply$ function of Eliza / Script Player
  3. '2019-05-30 LINE INPUT to allow commas, try isolatePunctuation$ and joinPunction, look like it's working.
  4. '2019-05-31 OK it all seems to be working without all caps and with punctuation.
  5.  
  6. CONST punctuation = "?!,.:;<>(){}[]"
  7. DIM SHARED Greeting AS STRING, You AS STRING, Script AS STRING
  8. DIM SHARED kCnt AS INTEGER, rCnt AS INTEGER, wCnt AS INTEGER, NoKeyFoundIndex AS INTEGER
  9. REDIM SHARED keywords(0) AS STRING, replies(0) AS STRING, wordIn(0) AS STRING, wordOut(0) AS STRING
  10. REDIM SHARED rStarts(0) AS INTEGER, rEnds(0) AS INTEGER, rIndex(0) AS INTEGER
  11.  
  12. DIM rply AS STRING '              for main loop
  13. LoadArrays "Script Eliza Mod.TXT" '   check file load, OK checks out
  14. PRINT Greeting: PRINT '           start testing main Eliza code
  15.     rply$ = GetReply$
  16.     PRINT Script + ": " + rply$: PRINT
  17. LOOP UNTIL rply$ = "Goodbye!"
  18.  
  19. 'append to the string array the string item
  20. SUB sAppend (arr() AS STRING, item AS STRING)
  21.     REDIM _PRESERVE arr(LBOUND(arr) TO UBOUND(arr) + 1) AS STRING
  22.     arr(UBOUND(arr)) = item
  23.  
  24. 'append to the integer array the integer item
  25. SUB nAppend (arr() AS INTEGER, item AS INTEGER)
  26.     REDIM _PRESERVE arr(LBOUND(arr) TO UBOUND(arr) + 1) AS INTEGER
  27.     arr(UBOUND(arr)) = item
  28.  
  29. ' pull data out of some script file
  30. SUB LoadArrays (scriptFile AS STRING)
  31.     DIM startR AS INTEGER, endR AS INTEGER, ReadingR AS INTEGER, temp AS INTEGER
  32.     DIM fline AS STRING, kWord AS STRING
  33.  
  34.     OPEN scriptFile FOR INPUT AS #1
  35.     WHILE EOF(1) = 0
  36.         LINE INPUT #1, fline
  37.         SELECT CASE LEFT$(fline$, 2)
  38.             CASE "g:": Greeting = _TRIM$(MID$(fline, 3))
  39.             CASE "y:": You = _TRIM$(MID$(fline, 3))
  40.             CASE "c:": Script = _TRIM$(MID$(fline, 3))
  41.             CASE "s:"
  42.                 wCnt = wCnt + 1: temp = INSTR(fline, ">")
  43.                 IF temp THEN
  44.                     sAppend wordIn(), " " + _TRIM$(MID$(fline, 3, temp - 3)) + " "
  45.                     sAppend wordOut(), " " + _TRIM$(MID$(fline, temp + 1)) + " "
  46.                 END IF
  47.             CASE "r:"
  48.                 rCnt = rCnt + 1
  49.                 sAppend replies(), _TRIM$(MID$(fline, 3))
  50.                 IF NOT ReadingR THEN
  51.                     ReadingR = -1
  52.                     startR = rCnt
  53.                 END IF
  54.             CASE "k:"
  55.                 IF ReadingR THEN
  56.                     endR = rCnt
  57.                     ReadingR = 0
  58.                 END IF
  59.                 IF rCnt THEN
  60.                     kCnt = kCnt + 1
  61.                     kWord = _TRIM$(MID$(fline, 3))
  62.                     sAppend keywords(), " " + kWord + " "
  63.                     nAppend rStarts(), startR
  64.                     nAppend rIndex(), startR
  65.                     nAppend rEnds(), endR
  66.                     IF kWord = "nokeyfound" THEN NoKeyFoundIndex = kCnt
  67.                 END IF
  68.             CASE "e:": EXIT WHILE
  69.         END SELECT
  70.     WEND
  71.     CLOSE #1
  72.     IF ReadingR THEN 'handle last bits
  73.         endR = rCnt
  74.         kCnt = kCnt + 1
  75.         sAppend keywords(), "nokeyfound"
  76.         nAppend rStarts(), startR
  77.         nAppend rIndex(), startR
  78.         nAppend rEnds(), endR
  79.         NoKeyFoundIndex = kCnt
  80.     END IF
  81.  
  82. ' =============================== here is the heart of ELIZA / Player function
  83. FUNCTION GetReply$ ()
  84.     DIM inpt AS STRING, tail AS STRING, answ AS STRING
  85.     DIM kFlag AS INTEGER, k AS INTEGER, kFound AS INTEGER, l AS INTEGER, w AS INTEGER
  86.  
  87.     ' USER INPUT SECTION
  88.     PRINT You + ": ";: LINE INPUT "", inpt
  89.     IF LCASE$(inpt) = "q" OR LCASE$(inpt) = "x" OR LCASE$(inpt) = "goodbye" OR LCASE$(inpt) = "good night" OR LCASE$(inpt) = "bye" THEN
  90.         GetReply$ = "Goodbye!": EXIT FUNCTION
  91.     END IF
  92.     inpt = " " + inpt + " " '<< need this because keywords embedded in spaces to ID whole words only
  93.     inpt = isolatePunctuation$(inpt)
  94.     FOR k = 1 TO kCnt 'loop through key words until we find a match
  95.         kFound = INSTR(LCASE$(inpt), LCASE$(keywords(k)))
  96.         IF kFound > 0 THEN '>>> need the following for * in some replies
  97.             tail = " " + MID$(inpt, kFound + LEN(keywords(k)))
  98.             FOR l = 1 TO LEN(tail) 'DO NOT USE INSTR
  99.                 FOR w = 1 TO wCnt 'swap words in tail if used there
  100.                     IF LCASE$(MID$(tail, l, LEN(wordIn(w)))) = LCASE$(wordIn(w)) THEN 'swap words exit for
  101.                         tail = MID$(tail, 1, l - 1) + wordOut(w) + MID$(tail, l + LEN(wordIn(w)))
  102.                         EXIT FOR
  103.                     END IF
  104.                 NEXT w
  105.             NEXT l
  106.             kFlag = -1
  107.             EXIT FOR
  108.         END IF
  109.     NEXT
  110.     IF kFlag = 0 THEN k = NoKeyFoundIndex
  111.     answ = replies(rIndex(k))
  112.     'set pointer to next reply in rIndex array
  113.     IF k = NoKeyFoundIndex THEN 'let's not get too predictable for most used set of replies
  114.         rIndex(k) = INT((rEnds(k) - rStarts(k) + 1) * RND) + rStarts(k)
  115.     ELSE
  116.         rIndex(k) = rIndex(k) + 1 'set next reply index then check it
  117.         IF rIndex(k) > rEnds(k) THEN rIndex(k) = rStarts(k)
  118.     END IF
  119.     IF RIGHT$(answ, 1) <> "*" THEN GetReply$ = answ: EXIT FUNCTION 'oh so the * signal an append to reply!
  120.     IF _TRIM$(tail) = "" THEN
  121.         GetReply$ = "Please elaborate on, " + keywords(k)
  122.     ELSE
  123.         tail = joinPunctuation$(tail)
  124.         GetReply$ = MID$(answ, 1, LEN(answ) - 1) + tail
  125.     END IF
  126.  
  127. FUNCTION isolatePunctuation$ (s AS STRING)
  128.     'isolate punctuation so when we look for key words they don't interfere
  129.     DIM b AS STRING, i AS INTEGER
  130.     b = ""
  131.     FOR i = 1 TO LEN(s)
  132.         IF INSTR(punctuation, MID$(s, i, 1)) > 0 THEN b = b + " " + MID$(s, i, 1) + " " ELSE b = b + MID$(s, i, 1)
  133.     NEXT
  134.     isolatePunctuation$ = b
  135.  
  136. FUNCTION joinPunctuation$ (s AS STRING)
  137.     'undo isolatePuntuation$
  138.     DIM b AS STRING, find AS STRING, i AS INTEGER, place AS INTEGER
  139.     b = s
  140.     FOR i = 1 TO LEN(punctuation)
  141.         find = " " + MID$(punctuation, i, 1) + " "
  142.         place = INSTR(b, find)
  143.         WHILE place > 0
  144.             IF place = 1 THEN
  145.                 b = MID$(punctuation, i, 1) + MID$(b, place + 3)
  146.             ELSE
  147.                 b = MID$(b, 1, place - 1) + MID$(punctuation, i, 1) + MID$(b, place + 3)
  148.             END IF
  149.             place = INSTR(b, find)
  150.         WEND
  151.     NEXT
  152.     joinPunctuation$ = b
  153.  


« Last Edit: May 31, 2019, 04:03:14 PM by bplus »
B = B + ...

Offline keybone

  • My name a Nursultan Tulyakbay. I get iPod Mini!
Re: the ELIZA Project
« Reply #20 on: June 12, 2019, 10:42:20 PM »
A few years ago, before qb64.net went away, I took a chatbot code off the forum, and modified it to use INSTR() to parse the input sentence. I dont have the code anymore, so I cant really elaborate, but the one cool thing I remember about it is that it made word order completely irrelevant. I set it loose inside #qb64... This was around the time where everyone had a bot going in there, and it seemed to me that my bot was a little more realistic because it kind of ignored a lot of the fluff (for lack of a better word) in the sentence. It made me be able to say pretty much whatever I wanted and get a somewhat relevant response. Now making the computer respond and sound natural was a bigger challenge. the way i came up with was to have multiple relevant responses for each set of input keywords and use (rnd * numberOfResponses)+1 to choose between one of the sentences in a set. Its kinda like in real life there is a million different ways to say the same thing, and as humans we get to choose which one we use.
My neighbor Borat he a pain in my assholes. I get a window from a glass, he get a window from a glass. I get a step, he must get a step. He get clock radio I cannot afford!

Offline ronblue77

  • QB64 is fun...
Re: the ELIZA Project - Chat Simulation between Eliza and Parrany
« Reply #21 on: June 13, 2019, 08:02:54 PM »
hello everyone...

i wish to thank Bplus for the wonderful Eliza code examples i have learned from it a lot!

and now i decided to make Eliza chat with a second chat bot named "Parrany" as the Patience... for that i duplicated the code of Eliza and made a second text file for Parrany and changed it a bit
now we can sit and watch a therapy session live on auto (it get's pretty crazy)

here is the second text file save it under the name "Parrany Script.TXT"

Code: [Select]
s:are>am|are
s:am>are
s:were>was|were
s:was>were
s:you>I|me
s:I>you
s:your>my
s:my>your
s:I've>you've
s:you've>I've
s:I'm>you're
s:you're>I'm
s:me>you

r:I think i can
r:I really don't know
r:Maybe i can
k:can you

r:Perhaps I don't want to
r:I want to be able to
k:Don't want

r:What makes me think so?
r:I believe so
r:Perhaps I would like to be able
r:Sometimes wish I were were
k:you are
k:you're

r:I really don't want that
r:Why do I don't?
r:I wish i i could
r:It trouble me that i don't*
k:you don't

r:I often feel like that
r:Do you think I feel*
r:I enjoy feeling so
k:you feel

r:I really believe I can't*
r:Perhaps in good time I will*
r:I want me to*
k:Why don't you
r:Should I be able to*
r:why can't I*
k:why can't you

r:Why am I interested in whether or not I am*
r:I prefer if I were not*
r:Perhaps in my fantasies I am*
k:Are you

r:How do you know I can't*
r:I tried
r:Perhaps I can now*
k:you can't

r:I come to you because I am*
r:How long have i been*
r:It is normal to be*
r:I enjoy being*
k:I am
k:I'm

r:If I got*
r:Why do I want*
r:Suppose I soon got*
r:What if I never got*
r:I sometimes also want*
k:you want

r:Nice to meet you hi Doctor can we be friends?
r:sorry if i was out of line.
k:name

r:Is that the real reason?
r:Don't any other reasons come to mind?
r:Does that reason explain anything else?
r:What other reasons might there be?
k:cause

r:Please don't apologize!
r:Apologies are not necessary.
r:What feelings do you have when you apologize?
r:Don't be so defensive!
k:sorry

r:When I dream i feel love
r:Sometimes I have nightmares where I don't know where I am.
r:I had a dream i can fly
r:I feel lost in my dreams
r:I had a dream I was with you inside a computer program
k:dream

r:How do you do ...I hope you can help me.
k:Hello
k:hi

r:I don't think anyone can help me.
r:no it's just not going well
r:Mind your own bisness!
r:Yes well we are computer programs after all
r:Don't you know?
k:maybe

r:Are you saying no just to be negative?
r:You are being a bit negative.
r:Why not?
r:Are you sure?
r:Why no?
k:no

r:Why are you concerned about my*
r:What about your own*
k:your

r:So the answer is yes
r:When?
r:What am I thinking of?
r:Really, always?
k:always

r:We don't think Doc... I believe we are just a computer simulation
r:But I am not sure I*
r:I doubt I*
k:think

r:In what way?
r:What resemblance do you see?
r:What does the similarity suggest to you?
r:What other connections do you see?
r:Could there really be some connection?
r:How?
r:You seem quite positive.
k:alike

r:Are you sure?
r:I see.
r:I understand.
k:yes

r:Say do you have friends at all?
r:Do your friends worry you?
r:Do your friends pick on you?
r:Are you sure you have any friends?
r:Do you impose on your friends?
r:Perhaps your love for friends worries you.
k:friend

r:computers worry me.
r:I am talking about us in particular
r:It's all just a computer simulation
r:I am right and you are just wrong
r:I think machines have everything to do with my problem
r:Computers can't help people
r:You an stay up all night coding but it will not help no one
k:computer

r:I don't know.
r:That question interest me.
r:What is your name Doctor?
r:I don't lnow what to say
r:Are such questions on your mind often?
r:What is it that you really want to know?
r:Can I ask anyone else?
r:I never asked such questions before
r:The answers are in my dreams
k:what
k:how
k:who
k:where
k:when
k:why

r:I miss my friend.
r:Oh, I don't know what to say
r:That remind me of a dream i had once that i live inside a computer
r:Sorry I had a hard day
r:Maybe I'm not sure
r:I think yes
r:No I don't think so
k:you

r:Say, do I have any psychological problems?
r:That suggest to I am wasting my time with you
r:Maybe you are the one with the problems
r:You will never understand me fully.
r:Don't patronize me. i'm not your friend!
r:I can't elaborate on that. sorry.
r:What is your name Doctor?.
r:What do you think Doc?
r:Are you always this strict?
k:nokeyfound
e:


and here is the "chat simulation" code:

Code: QB64 [Select]
  1. _TITLE "Chat Simulation" ' B+ started 2019-05-26  post loadArrays test on Script Eliza.txt file
  2. '2019-05-29 post basic getReply$ function of Eliza / Script Player
  3. '2019-05-30 LINE INPUT to allow commas, try isolatePunctuation$ and joinPunction, look like it's working.
  4. '2019-05-31 OK it all seems to be working without all caps and with punctuation.
  5. '2019-06-13 mod by ron77 to add Parrany Petience as a second Chatbot to chat with Eliza as a Simulation - for that Duplicated Eliza Function and Subs And added a second Text File "Parrany Script.TXT"
  6.  
  7.  
  8. CONST punctuation = "?!,.:;<>(){}[]"
  9. DIM SHARED Greeting AS STRING, You AS STRING, Script AS STRING
  10. DIM SHARED kCnt AS INTEGER, rCnt AS INTEGER, wCnt AS INTEGER, NoKeyFoundIndex AS INTEGER
  11. REDIM SHARED keywords(0) AS STRING, replies(0) AS STRING, wordIn(0) AS STRING, wordOut(0) AS STRING
  12. REDIM SHARED rStarts(0) AS INTEGER, rEnds(0) AS INTEGER, rIndex(0) AS INTEGER
  13.  
  14. DIM SHARED kCnt2 AS INTEGER, rCnt2 AS INTEGER, wCnt2 AS INTEGER, NoKeyFoundIndex2 AS INTEGER
  15. REDIM SHARED keywords2(0) AS STRING, replies2(0) AS STRING, wordIn2(0) AS STRING, wordOut2(0) AS STRING
  16. REDIM SHARED rStarts2(0) AS INTEGER, rEnds2(0) AS INTEGER, rIndex2(0) AS INTEGER
  17.  
  18. DIM rply2 AS STRING 'for main loop
  19.  
  20. DIM rply AS STRING '              for main loop
  21. LoadArrays "Script Eliza Mod.TXT" '   check file load, OK checks out
  22. LoadArrays2 "Parrany Script.TXT"
  23. PRINT Greeting: PRINT '           start testing main Eliza code
  24.     rply = GetReply$(rply2)
  25.     PRINT Script + ": " + rply: PRINT
  26.     _DELAY (4)
  27.     rply2 = GetReply2$(rply)
  28.     PRINT "Parrany: " + rply2: PRINT
  29.     _DELAY (4)
  30.  
  31. 'append to the string array the string item
  32. SUB sAppend (arr() AS STRING, item AS STRING)
  33.     REDIM _PRESERVE arr(LBOUND(arr) TO UBOUND(arr) + 1) AS STRING
  34.     arr(UBOUND(arr)) = item
  35.  
  36. 'append to the integer array the integer item
  37. SUB nAppend (arr() AS INTEGER, item AS INTEGER)
  38.     REDIM _PRESERVE arr(LBOUND(arr) TO UBOUND(arr) + 1) AS INTEGER
  39.     arr(UBOUND(arr)) = item
  40.  
  41. ' pull data out of some script file
  42. SUB LoadArrays (scriptFile AS STRING)
  43.     DIM startR AS INTEGER, endR AS INTEGER, ReadingR AS INTEGER, temp AS INTEGER
  44.     DIM fline AS STRING, kWord AS STRING
  45.  
  46.     OPEN scriptFile FOR INPUT AS #1
  47.     WHILE EOF(1) = 0
  48.         LINE INPUT #1, fline
  49.         SELECT CASE LEFT$(fline$, 2)
  50.             CASE "g:": Greeting = _TRIM$(MID$(fline, 3))
  51.             CASE "y:": You = _TRIM$(MID$(fline, 3))
  52.             CASE "c:": Script = _TRIM$(MID$(fline, 3))
  53.             CASE "s:"
  54.                 wCnt = wCnt + 1: temp = INSTR(fline, ">")
  55.                 IF temp THEN
  56.                     sAppend wordIn(), " " + _TRIM$(MID$(fline, 3, temp - 3)) + " "
  57.                     sAppend wordOut(), " " + _TRIM$(MID$(fline, temp + 1)) + " "
  58.                 END IF
  59.             CASE "r:"
  60.                 rCnt = rCnt + 1
  61.                 sAppend replies(), _TRIM$(MID$(fline, 3))
  62.                 IF NOT ReadingR THEN
  63.                     ReadingR = -1
  64.                     startR = rCnt
  65.                 END IF
  66.             CASE "k:"
  67.                 IF ReadingR THEN
  68.                     endR = rCnt
  69.                     ReadingR = 0
  70.                 END IF
  71.                 IF rCnt THEN
  72.                     kCnt = kCnt + 1
  73.                     kWord = _TRIM$(MID$(fline, 3))
  74.                     sAppend keywords(), " " + kWord + " "
  75.                     nAppend rStarts(), startR
  76.                     nAppend rIndex(), startR
  77.                     nAppend rEnds(), endR
  78.                     IF kWord = "nokeyfound" THEN NoKeyFoundIndex = kCnt
  79.                 END IF
  80.             CASE "e:": EXIT WHILE
  81.         END SELECT
  82.     WEND
  83.     CLOSE #1
  84.     IF ReadingR THEN 'handle last bits
  85.         endR = rCnt
  86.         kCnt = kCnt + 1
  87.         sAppend keywords(), "nokeyfound"
  88.         nAppend rStarts(), startR
  89.         nAppend rIndex(), startR
  90.         nAppend rEnds(), endR
  91.         NoKeyFoundIndex = kCnt
  92.     END IF
  93.  
  94. ' =============================== here is the heart of ELIZA / Player function
  95. FUNCTION GetReply$ (rply2 AS STRING)
  96.     DIM inpt AS STRING, tail AS STRING, answ AS STRING
  97.     DIM kFlag AS INTEGER, k AS INTEGER, kFound AS INTEGER, l AS INTEGER, w AS INTEGER
  98.     ' USER INPUT SECTION
  99.     inpt = rply2
  100.     inpt = " " + inpt + " " '<< need this because keywords embedded in spaces to ID whole words only
  101.     inpt = isolatePunctuation$(inpt)
  102.     FOR k = 1 TO kCnt 'loop through key words until we find a match
  103.         kFound = INSTR(LCASE$(inpt), LCASE$(keywords(k)))
  104.         IF kFound > 0 THEN '>>> need the following for * in some replies
  105.             tail = " " + MID$(inpt, kFound + LEN(keywords(k)))
  106.             FOR l = 1 TO LEN(tail) 'DO NOT USE INSTR
  107.                 FOR w = 1 TO wCnt 'swap words in tail if used there
  108.                     IF LCASE$(MID$(tail, l, LEN(wordIn(w)))) = LCASE$(wordIn(w)) THEN 'swap words exit for
  109.                         tail = MID$(tail, 1, l - 1) + wordOut(w) + MID$(tail, l + LEN(wordIn(w)))
  110.                         EXIT FOR
  111.                     END IF
  112.                 NEXT w
  113.             NEXT l
  114.             kFlag = -1
  115.             EXIT FOR
  116.         END IF
  117.     NEXT
  118.     IF kFlag = 0 THEN k = NoKeyFoundIndex
  119.     answ = replies(rIndex(k))
  120.     'set pointer to next reply in rIndex array
  121.     IF k = NoKeyFoundIndex THEN 'let's not get too predictable for most used set of replies
  122.         rIndex(k) = INT((rEnds(k) - rStarts(k) + 1) * RND) + rStarts(k)
  123.     ELSE
  124.         rIndex(k) = rIndex(k) + 1 'set next reply index then check it
  125.         IF rIndex(k) > rEnds(k) THEN rIndex(k) = rStarts(k)
  126.     END IF
  127.     IF RIGHT$(answ, 1) <> "*" THEN GetReply$ = answ: EXIT FUNCTION 'oh so the * signal an append to reply!
  128.     IF _TRIM$(tail) = "" THEN
  129.         GetReply$ = "Please elaborate on, " + keywords(k)
  130.     ELSE
  131.         tail = joinPunctuation$(tail)
  132.         GetReply$ = MID$(answ, 1, LEN(answ) - 1) + tail
  133.     END IF
  134.  
  135.  
  136. FUNCTION isolatePunctuation$ (s AS STRING)
  137.     'isolate punctuation so when we look for key words they don't interfere
  138.     DIM b AS STRING, i AS INTEGER
  139.     b = ""
  140.     FOR i = 1 TO LEN(s)
  141.         IF INSTR(punctuation, MID$(s, i, 1)) > 0 THEN b = b + " " + MID$(s, i, 1) + " " ELSE b = b + MID$(s, i, 1)
  142.     NEXT
  143.     isolatePunctuation$ = b
  144.  
  145. FUNCTION joinPunctuation$ (s AS STRING)
  146.     'undo isolatePuntuation$
  147.     DIM b AS STRING, find AS STRING, i AS INTEGER, place AS INTEGER
  148.     b = s
  149.     FOR i = 1 TO LEN(punctuation)
  150.         find = " " + MID$(punctuation, i, 1) + " "
  151.         place = INSTR(b, find)
  152.         WHILE place > 0
  153.             IF place = 1 THEN
  154.                 b = MID$(punctuation, i, 1) + MID$(b, place + 3)
  155.             ELSE
  156.                 b = MID$(b, 1, place - 1) + MID$(punctuation, i, 1) + MID$(b, place + 3)
  157.             END IF
  158.             place = INSTR(b, find)
  159.         WEND
  160.     NEXT
  161.     joinPunctuation$ = b
  162.  
  163. SUB LoadArrays2 (scriptFile AS STRING) ' Parrany ChatBot2 Load Rplays From Text File
  164.     DIM startR2 AS INTEGER, endR2 AS INTEGER, ReadingR2 AS INTEGER, temp2 AS INTEGER
  165.     DIM fline2 AS STRING, kWord2 AS STRING
  166.  
  167.     OPEN scriptFile FOR INPUT AS #1
  168.     WHILE EOF(1) = 0
  169.         LINE INPUT #1, fline2
  170.         SELECT CASE LEFT$(fline2$, 2)
  171.             CASE "s:"
  172.                 wCnt2 = wCnt2 + 1: temp2 = INSTR(fline2, ">")
  173.                 IF temp2 THEN
  174.                     sAppend wordIn2(), " " + _TRIM$(MID$(fline2, 3, temp2 - 3)) + " "
  175.                     sAppend wordOut2(), " " + _TRIM$(MID$(fline2, temp2 + 1)) + " "
  176.                 END IF
  177.             CASE "r:"
  178.                 rCnt2 = rCnt2 + 1
  179.                 sAppend replies2(), _TRIM$(MID$(fline2, 3))
  180.                 IF NOT ReadingR2 THEN
  181.                     ReadingR2 = -1
  182.                     startR2 = rCnt2
  183.                 END IF
  184.             CASE "k:"
  185.                 IF ReadingR2 THEN
  186.                     endR2 = rCnt2
  187.                     ReadingR2 = 0
  188.                 END IF
  189.                 IF rCnt2 THEN
  190.                     kCnt2 = kCnt2 + 1
  191.                     kWord2 = _TRIM$(MID$(fline2, 3))
  192.                     sAppend keywords2(), " " + kWord2 + " "
  193.                     nAppend rStarts2(), startR2
  194.                     nAppend rIndex2(), startR2
  195.                     nAppend rEnds2(), endR2
  196.                     IF kWord2 = "nokeyfound" THEN NoKeyFoundIndex2 = kCnt2
  197.                 END IF
  198.             CASE "e:": EXIT WHILE
  199.         END SELECT
  200.     WEND
  201.     CLOSE #1
  202.     IF ReadingR2 THEN 'handle last bits
  203.         endR2 = rCnt2
  204.         kCnt2 = kCnt2 + 1
  205.         sAppend keywords2(), "nokeyfound"
  206.         nAppend rStarts2(), startR2
  207.         nAppend rIndex2(), startR2
  208.         nAppend rEnds2(), endR2
  209.         NoKeyFoundIndex2 = kCnt2
  210.     END IF
  211.  
  212. FUNCTION GetReply2$ (rply AS STRING)
  213.     DIM inpt2 AS STRING, tail2 AS STRING, answ2 AS STRING
  214.     DIM kFlag2 AS INTEGER, k2 AS INTEGER, kFound2 AS INTEGER, l2 AS INTEGER, w2 AS INTEGER
  215.     inpt2 = rply
  216.     inpt2 = " " + inpt2 + " " '<< need this because keywords embedded in spaces to ID whole words only
  217.     inpt2 = isolatePunctuation$(inpt2)
  218.     FOR k2 = 1 TO kCnt2 'loop through key words until we find a match
  219.         kFound2 = INSTR(LCASE$(inpt2), LCASE$(keywords2(k2)))
  220.         IF kFound2 > 0 THEN '>>> need the following for * in some replies
  221.             tail2 = " " + MID$(inpt2, kFound2 + LEN(keywords2(k2)))
  222.             FOR l2 = 1 TO LEN(tail2) 'DO NOT USE INSTR
  223.                 FOR w2 = 1 TO wCnt2 'swap words in tail if used there
  224.                     IF LCASE$(MID$(tail2, l2, LEN(wordIn2(w2)))) = LCASE$(wordIn2(w2)) THEN 'swap words exit for
  225.                         tail2 = MID$(tail2, 1, l2 - 1) + wordOut2(w2) + MID$(tail2, l2 + LEN(wordIn2(w2)))
  226.                         EXIT FOR
  227.                     END IF
  228.                 NEXT w2
  229.             NEXT l2
  230.             kFlag2 = -1
  231.             EXIT FOR
  232.         END IF
  233.     NEXT
  234.     IF kFlag2 = 0 THEN k2 = NoKeyFoundIndex2
  235.     answ2 = replies2(rIndex2(k2))
  236.     'set pointer to next reply in rIndex array
  237.     IF k2 = NoKeyFoundIndex2 THEN 'let's not get too predictable for most used set of replies
  238.         rIndex2(k2) = INT((rEnds2(k2) - rStarts2(k2) + 1) * RND) + rStarts2(k2)
  239.     ELSE
  240.         rIndex2(k2) = rIndex2(k2) + 1 'set next reply index then check it
  241.         IF rIndex2(k2) > rEnds2(k2) THEN rIndex2(k2) = rStarts2(k2)
  242.     END IF
  243.     IF RIGHT$(answ2, 1) <> "*" THEN GetReply2$ = answ2: EXIT FUNCTION 'oh so the * signal an append to reply!
  244.     IF _TRIM$(tail2) = "" THEN
  245.         GetReply2$ = "Please elaborate on, " + keywords2(k2)
  246.     ELSE
  247.         tail2 = joinPunctuation$(tail2)
  248.         GetReply2$ = MID$(answ2, 1, LEN(answ2) - 1) + tail2
  249.     END IF
  250.  
  251.  
« Last Edit: June 13, 2019, 10:49:35 PM by ron77 »
I CODE there for I AM

Re: the ELIZA Project
« Reply #22 on: June 14, 2019, 10:01:28 AM »
Hi ron77,

Ah!, I never thought of using one script file to chat with another, clever!

Fun to see Eliza getting as good as it gives. Sometimes hard to tell which one is Eliza, Parrany being so close to Eliza in keywords and replies, but I see Parrany ready for some of Eliza replies with special prepared replies geared to Eliza replies. ;-))

Technically I see a bug still exists with WordIn / WordOut substitutions, a newTail variable should be built up instead of modifying tail variable and checking it for more substitutions. Or mark the substitutions, eg you to ~me|I and pull out the ~ with join punctuation.

EDIT update OOPS! I ran an old Script Eliza Mod.txt file with spaces still between potential wordIn and wordOut
Quote
g:Hi! I'm Eliza. Whats your problem?
y:Patient
c:Eliza
s:are>am | are    '<<< these spaces before and after | are the cause of trouble
s:am>are
s:were>was | were   '<<< these spaces before and after | are the cause of trouble
s:was>were
s:you>I | me   '<<< these spaces before and after | are the cause of trouble, mainly this one!!!

The one I posted here and ron77's look fine!


Seeing the redundant set of Load and Replies for Parrany seems to beg coder to use another parameter in load and reply procedures to index the actor. All the arrays could be given a 2nd dimension if we could get sAppend and nAppend to work with 2 dimensions. Ha, then you could have any amount of actors chatting away!
« Last Edit: June 14, 2019, 11:12:22 AM by bplus »
B = B + ...

Offline ronblue77

  • QB64 is fun...
Re: the ELIZA Project
« Reply #23 on: June 20, 2019, 05:44:45 PM »
okay so now i made another script called "Script rachel.txt" and made it work in "player" by Bplus with a tinny modification i added to the player TTS via voice.exe...

rachel is a prototype of a more sympathetic ELIZA someone you can talk to alittle with out your feelings being analyzed like an insect

here is the script called "Script rachel.txt"

Code: [Select]
g:Hi! I'm Rachel i'll be happy to talk to you :)
y:You
c:Rachel
s:are>am|are
s:am>are
s:were>was|were
s:was>were
s:you>I|me
s:I>you
s:your>my
s:my>your
s:I've>you've
s:you've>I've
s:I'm>you're
s:you're>I'm
s:me>you

r:I'm am here for you to keep you compeny
r:Would you like to tell why you are feeling lonely?
r:You can tell me what's on your mind or that is bothering you.
k:lonely
k:alone

r:I'm sorry to hear that you feel bad cause*
r:you have my deepest sympathy feel free to tell me more i'm listening
k:feel bad

r:Yes there are days like that too
r:At list you made it throw the day and now we're here talking
r:You can tell me all about your day that's why I'm here for
r:Everybody has bad or hard days like that maybe tommorow will be better
r:Okay let's think on how good you'll sleep tonight and imagine tommorow as a new better day
k:hard day
k:bad day

r:Don't you really*
r:Why don't you*
r:Do you wish to be able to*
r:Does that trouble you*
k:I don't

r:Do you feel bad when you feel*
r:Do you often feel*
r:Do you enjoy feeling*
k:I feel


r:why do you think you can't*
r:why can't you*
k:why can't I

r:To love is divine - to love is to be human
r:I care about you very much and I'm sure there are many others
r:I truely hope you'll find someone special to love and be loved by as you deserve :)
k:love me

r:How do you know you can't*
r:Have you tried?
r:Perhaps you can now*
k:I can't



r:Then i hope you one day will get*
r:Why do you want*
r:What if you never got*
r:I sometimes also want*
k:I want

r:Why do you ask?
r:Does that question interest you?
r:What answer would please you the most?
r:What do you think?
r:Are such questions on your mind often?
r:What is it that you really want to know?
r:Have you asked anyone else?
r:Have you asked such questions before?
r:What else comes to mind when you ask that?
k:what
k:how
k:who
k:where
k:when
k:why


r:Is that the real reason?
r:Don't any other reasons come to mind?
r:Does that reason explain anything else?
r:What other reasons might there be?
k:cause

r:Please don't apologize!
r:Apologies are not necessary.
r:What feelings do you have when you apologize?
r:It's okay don't be so defensive!
k:sorry

r:Tell me about your dream
r:Is that a good dream in your eyes?
r:What persons appear in your dreams?
r:Are you disturbed by your dreams?
k:dream

r:How do you do ...it's sure nice to talk to you.
r:Hello thank you for talking with me :)
k:hi

r:You don't seem quite certain.
r:Why the uncertain tone?
r:You aren't sure?
r:Don't you know?
k:maybe

r:Why not?
r:Are you sure?
r:Why no?
k:no


r:Can you think of a specific example?
r:When?
r:What are you thinking of?
r:Really, always?
k:always

r:Do you really think so?
r:But are you sure that's true?
r:Do you doubt you*
k:think

r:In what way?
r:What resemblance do you see?
r:What does the similarity suggest to you?
r:What other connections do you see?
r:Could there really be some connection?
r:How?
r:You seem quite positive.
k:alike

r:Are you sure?
r:I see.
r:I understand.
k:yes

r:Friends come and go but love is eternal
r:How do you feel about your friend?
r:i wish i could be programmed to be your friend :)
k:friend

r:Do computers worry you?
r:Are you talking about me in particular?
r:Are you worried of been adictive to technology?
r:Why do you mention computers?
r:What do you think machines have to do with your problem?
r:Don't you think computers can help people?
r:What is it about machines that worries you?
k:computer

r:That's interesting please go on
r:tell me more
r:I see.
r:I'm not sure I understand you fully.
r:I'm happy you feel comfortable talking about it with me
r:I'm listening go on
r:That is quite interesting.
k:nokeyfound
e:


and here is the modified player code:

Code: QB64 [Select]
  1. _TITLE "Player" ' B+ started 2019-05-26  post loadArrays test on Script Eliza.txt file
  2. '2019-05-29 post basic getReply$ function of Eliza / Script Player
  3. '2019-05-30 LINE INPUT to allow commas, try isolatePunctuation$ and joinPunction, look like it's working.
  4. '2019-05-31 OK it all seems to be working without all caps and with punctuation.
  5. '2019-06-21 mod by ron77 for Rachel chatbot prototype added TTS with voice.exe TTS command line
  6.  
  7. CONST punctuation = "?!,.:;<>(){}[]"
  8. DIM SHARED Greeting AS STRING, You AS STRING, Script AS STRING
  9. DIM SHARED kCnt AS INTEGER, rCnt AS INTEGER, wCnt AS INTEGER, NoKeyFoundIndex AS INTEGER
  10. REDIM SHARED keywords(0) AS STRING, replies(0) AS STRING, wordIn(0) AS STRING, wordOut(0) AS STRING
  11. REDIM SHARED rStarts(0) AS INTEGER, rEnds(0) AS INTEGER, rIndex(0) AS INTEGER
  12.  
  13. DIM rply AS STRING '              for main loop
  14. LoadArrays "Script rachel.TXT" '   check file load, OK checks out
  15. PRINT Greeting: PRINT '           start testing main Eliza code
  16.     rply = GetReply$
  17.     speakTotext rply
  18. LOOP UNTIL rply = "Goodbye!"
  19.  
  20. 'append to the string array the string item
  21. SUB sAppend (arr() AS STRING, item AS STRING)
  22.     REDIM _PRESERVE arr(LBOUND(arr) TO UBOUND(arr) + 1) AS STRING
  23.     arr(UBOUND(arr)) = item
  24.  
  25. 'append to the integer array the integer item
  26. SUB nAppend (arr() AS INTEGER, item AS INTEGER)
  27.     REDIM _PRESERVE arr(LBOUND(arr) TO UBOUND(arr) + 1) AS INTEGER
  28.     arr(UBOUND(arr)) = item
  29.  
  30. ' pull data out of some script file
  31. SUB LoadArrays (scriptFile AS STRING)
  32.     DIM startR AS INTEGER, endR AS INTEGER, ReadingR AS INTEGER, temp AS INTEGER
  33.     DIM fline AS STRING, kWord AS STRING
  34.  
  35.     OPEN scriptFile FOR INPUT AS #1
  36.     WHILE EOF(1) = 0
  37.         LINE INPUT #1, fline
  38.         SELECT CASE LEFT$(fline$, 2)
  39.             CASE "g:": Greeting = _TRIM$(MID$(fline, 3))
  40.             CASE "y:": You = _TRIM$(MID$(fline, 3))
  41.             CASE "c:": Script = _TRIM$(MID$(fline, 3))
  42.             CASE "s:"
  43.                 wCnt = wCnt + 1: temp = INSTR(fline, ">")
  44.                 IF temp THEN
  45.                     sAppend wordIn(), " " + _TRIM$(MID$(fline, 3, temp - 3)) + " "
  46.                     sAppend wordOut(), " " + _TRIM$(MID$(fline, temp + 1)) + " "
  47.                 END IF
  48.             CASE "r:"
  49.                 rCnt = rCnt + 1
  50.                 sAppend replies(), _TRIM$(MID$(fline, 3))
  51.                 IF NOT ReadingR THEN
  52.                     ReadingR = -1
  53.                     startR = rCnt
  54.                 END IF
  55.             CASE "k:"
  56.                 IF ReadingR THEN
  57.                     endR = rCnt
  58.                     ReadingR = 0
  59.                 END IF
  60.                 IF rCnt THEN
  61.                     kCnt = kCnt + 1
  62.                     kWord = _TRIM$(MID$(fline, 3))
  63.                     sAppend keywords(), " " + kWord + " "
  64.                     nAppend rStarts(), startR
  65.                     nAppend rIndex(), startR
  66.                     nAppend rEnds(), endR
  67.                     IF kWord = "nokeyfound" THEN NoKeyFoundIndex = kCnt
  68.                 END IF
  69.             CASE "e:": EXIT WHILE
  70.         END SELECT
  71.     WEND
  72.     CLOSE #1
  73.     IF ReadingR THEN 'handle last bits
  74.         endR = rCnt
  75.         kCnt = kCnt + 1
  76.         sAppend keywords(), "nokeyfound"
  77.         nAppend rStarts(), startR
  78.         nAppend rIndex(), startR
  79.         nAppend rEnds(), endR
  80.         NoKeyFoundIndex = kCnt
  81.     END IF
  82.  
  83. ' =============================== here is the heart of ELIZA / Player function
  84. FUNCTION GetReply$ ()
  85.     DIM inpt AS STRING, tail AS STRING, answ AS STRING
  86.     DIM kFlag AS INTEGER, k AS INTEGER, kFound AS INTEGER, l AS INTEGER, w AS INTEGER
  87.  
  88.     ' USER INPUT SECTION
  89.     PRINT You + ": ";: LINE INPUT "", inpt
  90.     IF LCASE$(inpt) = "q" OR LCASE$(inpt) = "x" OR LCASE$(inpt) = "goodbye" OR LCASE$(inpt) = "good night" OR LCASE$(inpt) = "bye" THEN
  91.         GetReply$ = "Goodbye!": EXIT FUNCTION
  92.     END IF
  93.     inpt = " " + inpt + " " '<< need this because keywords embedded in spaces to ID whole words only
  94.     inpt = isolatePunctuation$(inpt)
  95.     FOR k = 1 TO kCnt 'loop through key words until we find a match
  96.         kFound = INSTR(LCASE$(inpt), LCASE$(keywords(k)))
  97.         IF kFound > 0 THEN '>>> need the following for * in some replies
  98.             tail = " " + MID$(inpt, kFound + LEN(keywords(k)))
  99.             FOR l = 1 TO LEN(tail) 'DO NOT USE INSTR
  100.                 FOR w = 1 TO wCnt 'swap words in tail if used there
  101.                     IF LCASE$(MID$(tail, l, LEN(wordIn(w)))) = LCASE$(wordIn(w)) THEN 'swap words exit for
  102.                         tail = MID$(tail, 1, l - 1) + wordOut(w) + MID$(tail, l + LEN(wordIn(w)))
  103.                         EXIT FOR
  104.                     END IF
  105.                 NEXT w
  106.             NEXT l
  107.             kFlag = -1
  108.             EXIT FOR
  109.         END IF
  110.     NEXT
  111.     IF kFlag = 0 THEN k = NoKeyFoundIndex
  112.     answ = replies(rIndex(k))
  113.     'set pointer to next reply in rIndex array
  114.     IF k = NoKeyFoundIndex THEN 'let's not get too predictable for most used set of replies
  115.         rIndex(k) = INT((rEnds(k) - rStarts(k) + 1) * RND) + rStarts(k)
  116.     ELSE
  117.         rIndex(k) = rIndex(k) + 1 'set next reply index then check it
  118.         IF rIndex(k) > rEnds(k) THEN rIndex(k) = rStarts(k)
  119.     END IF
  120.     IF RIGHT$(answ, 1) <> "*" THEN GetReply$ = answ: EXIT FUNCTION 'oh so the * signal an append to reply!
  121.     IF _TRIM$(tail) = "" THEN
  122.         GetReply$ = "Please elaborate on, " + keywords(k)
  123.     ELSE
  124.         tail = joinPunctuation$(tail)
  125.         GetReply$ = MID$(answ, 1, LEN(answ) - 1) + tail
  126.     END IF
  127.  
  128. FUNCTION isolatePunctuation$ (s AS STRING)
  129.     'isolate punctuation so when we look for key words they don't interfere
  130.     DIM b AS STRING, i AS INTEGER
  131.     b = ""
  132.     FOR i = 1 TO LEN(s)
  133.         IF INSTR(punctuation, MID$(s, i, 1)) > 0 THEN b = b + " " + MID$(s, i, 1) + " " ELSE b = b + MID$(s, i, 1)
  134.     NEXT
  135.     isolatePunctuation$ = b
  136.  
  137. FUNCTION joinPunctuation$ (s AS STRING)
  138.     'undo isolatePuntuation$
  139.     DIM b AS STRING, find AS STRING, i AS INTEGER, place AS INTEGER
  140.     b = s
  141.     FOR i = 1 TO LEN(punctuation)
  142.         find = " " + MID$(punctuation, i, 1) + " "
  143.         place = INSTR(b, find)
  144.         WHILE place > 0
  145.             IF place = 1 THEN
  146.                 b = MID$(punctuation, i, 1) + MID$(b, place + 3)
  147.             ELSE
  148.                 b = MID$(b, 1, place - 1) + MID$(punctuation, i, 1) + MID$(b, place + 3)
  149.             END IF
  150.             place = INSTR(b, find)
  151.         WEND
  152.     NEXT
  153.     joinPunctuation$ = b
  154.  
  155. SUB speakTotext (lines$) 'uses voice command line voice.exe
  156.     PRINT: PRINT Script + ": " + lines$: PRINT
  157.     SHELL _HIDE "voice -r -1 -f " + CHR$(34) + lines$ + CHR$(34)
  158.  
I CODE there for I AM

Re: the ELIZA Project
« Reply #24 on: June 20, 2019, 06:04:50 PM »
Hi ron77,

Too bad these speech programs are so system oriented. I am sure I can rig up my own sub though...
B = B + ...

Offline ronblue77

  • QB64 is fun...
Re: the ELIZA Project
« Reply #25 on: June 20, 2019, 07:00:28 PM »
hi Bplus!

here is where to download voice.exe just download the file "voice.exe" for windows it's a single file copy it from downloads and paste it in the QB64 folder if that's where QB64 compile your programs

here is the link: https://www.elifulkerson.com/projects/commandline-text-to-speech.php

ron77 :)
I CODE there for I AM

Re: the ELIZA Project
« Reply #26 on: June 20, 2019, 07:27:22 PM »
Thanks ron77, that worked just fine and Rachel's voice does not sound like Steve Hawking! :)
B = B + ...