Re: small demo of string replacement by keywords (still in progress)

[bplus]

good morning bplus...

once again i thank you - now i have learned the importance and the differences between GLOBAL DIM SHARED variables and DIM variables for MAIN  and DIM  variables inside SUBS and FUNCTIONS it finally makes sense to me!

and i think i understood your solutions...

how ever the program changes only one keyword every time and i was hoping it would change all keywords and in case the same keyword appears twice or more it will will replace it every time with a different replay...

once again i thank you for teaching me...
ron77

Hi Ron,

Yes, "the scope" of variables is important concept, where can the variables be seen, SHARED makes them Global and they can be seen and used in every SUB, FUBCTION and MAIN section, otherwise DIM acts locally in SUB, FUNCTION or Main. There is another keyword COMMON for when you use more than one file. COMMON SHARED allows access across all, the most Global.

I needed to do one keyword at time at least for testing, remove the EXIT FOR and it will check for all the keywords, replace the Replace sub back to what it was also, see if any bugs creep into a working program.

In meantime, last night I reworked the problem with a very nice tool that treats strings like arrays and was able to cut program size down. Item$ picks out the Nth comma delimited item in a string, so for us all the keywords are in item #1 and all the replys for it follow in the data string. Again you can count the number items the string has by the number of commas, only remember they start at item #2 because the keyword is item #1

To access an Item in a comma delimited string:
if i is the data string index
      the i keyword = Item$(D(i), 1)
and the replies are = Item$(D(i), N) 'N= 2 to number of replies.

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "POET ASSISTENT V2-4 w Item$" ' B+ 2019-08-28
3.  
4. 'globals seen inside SUBs and FUNCTIONs because SHARED
5. DIM SHARED topDIndex AS INTEGER '<< this is how many keywords we have
6. 'VVVV REDIM means dynamic arrays, so can change at setup
7. REDIM SHARED D(1 TO topDIndex) AS STRING, lastReply(1 TO topDIndex) AS INTEGER, replyCount(1 TO topDIndex) AS INTEGER
8.  
9. 'locals for main code
10. DIM text$, i AS INTEGER
11. RANDOMIZE TIMER
12. setup
13. DO
14.     INPUT "(q to quit) enter text: ", text$
15.     IF LCASE$(text$) = "q" THEN END
16.     PRINT "output text:-----"
17.     FOR i = 1 TO topDIndex
18.         IF INSTR(text$, Item$(D(i), 1)) > 0 THEN
19.             lastReply(i) = lastReply(i) + 1
20.             IF lastReply(i) > replyCount(i) THEN lastReply(i) = 2 '1 is the keyword so replys start at 2
21.             Replace text$, Item$(D(i), 1), Item$(D(i), lastReply(i))
22.             EXIT FOR 'just one replace please!
23.         END IF
24.     NEXT i
25.     PRINT text$
26. LOOP
27.  
28. '' test load and access of data
29. 'FOR i = 1 TO topDIndex
30. '    DIM j
31. '    j = 1
32. '    WHILE Item$(D(i), j) <> ""
33. '        PRINT Item$(D(i), j)
34. '        j = j + 1
35. '    WEND
36. '    PRINT: PRINT "press any to continue... "
37. '    SLEEP
38. '    CLS
39. 'NEXT i
40.  
41. SUB setup
42.     REDIM D(1 TO 10) AS STRING '< need this when have more than 10 lines
43.     D(1) = "sun ,at high noon ,happy like the fish ,sadness falls on me ,when we were young ,summer promissed us eternity "
44.     D(2) = "mom ,i love you mother ,my happiness is to see you smile ,the woman that gave me life "
45.     D(3) = "sea ,the place of eternal bliss ,to cross you like a ship over the ocean ,swim in the sun "
46.     D(4) = "family ,i still think of you ,you are in my heart forever ,i shell always be greatful "
47.     D(5) = "cat ,i called you mine but you were free ,winter's nights we used to cuttle "
48.     D(6) = "moon ,you are magic to me ,king of the night ,our closest planet "
49.     D(7) = "love ,that whitch is divine in us ,god's flower ,the most inportent thing "
50.     D(8) = "hate ,do not waste your time on resentments ,let it pass... let go of it "
51.     D(9) = "sorrow ,do not cry for yesterday ,we all suffer but love always return in new forms "
52.     D(10) = "life ,the gift of love ,cherished and sacrat ,everyday's anigma "
53.  
54.     topDIndex = 10 '<<<<<<<<<< set this after each edit of lines above
55.     REDIM lastReply(1 TO topDIndex), replyCount(1 TO topDIndex)
56.     DIM i AS INTEGER
57.     FOR i = 1 TO topDIndex 'setup reply counts and lastReply arrays
58.         replyCount(i) = CommaCount(D(i)) + 1 'amount of keyword + replys for keyword
59.         lastReply(i) = INT(RND * replyCount(i)) + 2 'replys start at 2 because 1 is the keyword
60.     NEXT
61. END SUB
62.  
63. FUNCTION CommaCount% (s$)
64.     DIM c AS INTEGER, i AS INTEGER
65.     FOR i = 1 TO LEN(s$)
66.         IF MID$(s$, i, 1) = "," THEN c = c + 1
67.     NEXT
68.     CommaCount% = c
69. END FUNCTION
70.  
71. 'The more I use this in this app the more I like a dedicated , delim  so dont have to say in call
72. ' so the following is specialized for comma delimited strings.
73. FUNCTION Item$ (s$, nItem AS INTEGER)
74.     DIM c AS INTEGER, d AS INTEGER, lastd AS INTEGER
75.     IF LEN(s$) = 0 THEN Item$ = "": EXIT FUNCTION
76.     lastd = 1: d = INSTR(lastd, s$, ",")
77.     WHILE d > 0
78.         c = c + 1
79.         IF c = nItem THEN
80.             Item$ = MID$(s$, lastd, d - lastd): EXIT FUNCTION
81.         ELSE
82.             lastd = d + 1: d = INSTR(lastd, s$, ",")
83.         END IF
84.     WEND
85.     c = c + 1
86.     IF c <> nItem THEN Item$ = "" ELSE Item$ = MID$(s$, lastd, LEN(s$))
87. END FUNCTION
88.  
89. 'just do replace once!!
90. SUB Replace (text$, old$, new$) 'can also be used as a SUB without the count assignment
91.     DIM find, last$, first$
92.     find = INSTR(text$, old$) 'find location of a word in text
93.     IF find THEN
94.         first$ = LEFT$(text$, find - 1) 'text before word including spaces
95.         last$ = RIGHT$(text$, LEN(text$) - (find + LEN(old$) - 1)) 'text after word
96.         text$ = first$ + new$ + last$
97.     END IF
98. END SUB
99.  

Update: OK I just ran a few tests with the EXIT FOR commented out and the old Replace SUB put back in and it looks to add a rich extension of alternating variations specially text using mom that has other keywords in replys. :)

[SMcNeill]

Having a little free time today, I thought I'd toss my hat into the ring and have a little fun with this idea.  What I came up with was the following:

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(640, 480, 32)
2. DEFLNG A-Z
3.  
4. $CONSOLE
5. _CONSOLE ON
6. CONST StoryFolder = ".\Stories\"
7. DIM SHARED WordList AS STRING
8. DIM SHARED Stories(21) AS STRING
9. LoadWordList
10. LoadStories
11.  
12.  
13. FOR i = 1 TO 21
14.     CLS
15.     PRINT i
16.     WordWrap Stories(i), 1
17.     NewStory$ = FindAndReplace$(Stories(i))
18.     _ECHO NewStory$
19.     _ECHO "*********************************************"
20.     SLEEP
21. NEXT
22.  
23.  
24. FUNCTION FindAndReplace$ (temp$)
25.     text$ = temp$
26.     FOR i = 1 TO LEN(text$)
27.         m$ = MID$(text$, i, 1)
28.         SELECT CASE m$
29.             CASE "A" TO "Z", "a" TO "z"
30.                 IF word$ = "" THEN wordstart = i
31.                 word$ = word$ + m$
32.             CASE ELSE
33.                 IF word$ <> "" THEN
34.                     p = INSTR(WordList, "*" + word$ + "*")
35.                     IF p THEN
36.                         qualifer$ = MID$(WordList, p + LEN(word$) + 3)
37.                         qualifer$ = _TRIM$(LEFT$(qualifer$, INSTR(qualifer$, CHR$(13) + CHR$(10)) - 1)) '13/10 since my file has windows line endings encoded in it
38.                         n = 0: s = 0 ' number of matches
39.                         DO
40.                             s = INSTR(s + 1, WordList, qualifer$)
41.                             IF s <> 0 THEN n = n + 1
42.                         LOOP UNTIL s = 0
43.                         ReplaceWith = INT(RND * n) + 1
44.                         r = FindOccurance(WordList$, qualifer$, ReplaceWith)
45.                         r1 = _INSTRREV(r, WordList$, CHR$(10)) + 2
46.                         Replace$ = MID$(WordList$, r1, r - r1)
47.                         Replace$ = LEFT$(Replace$, INSTR(Replace$, "*") - 1)
48.                         text$ = LEFT$(text$, wordstart - 1) + Replace$ + MID$(text$, wordstart + LEN(word$))
49.                     END IF
50.                 END IF
51.                 word$ = ""
52.         END SELECT
53.     NEXT
54.     FindAndReplace$ = text$
55. END SUB
56.  
57.  
58. SUB LoadStories
59.     'No error messages coded into this.  I assume if you have the word list, you also have the stories in the same place.
60.     'If not, then MEH!  Sort it out and then try it.  :P
61.     FOR i = 1 TO 21 '21 AEsop Fables in the story folder
62.         OPEN StoryFolder + "Story#" + _TRIM$(STR$(i)) + ".txt" FOR BINARY AS #1
63.         Stories(i) = SPACE$(LOF(1))
64.         GET #1, , Stories(i)
65.         CLOSE
66.     NEXT
67. END SUB
68.  
69.  
70.  
71. SUB LoadWordList
72.     OPEN StoryFolder + "WordParts.txt" FOR BINARY AS #1
73.     IF LOF(1) THEN
74.         WordList = SPACE$(LOF(1))
75.         GET #1, , WordList
76.     ELSE
77.         PRINT "Folder structure wrong.  WordParts.txt was not found.  Please check paths."
78.         END
79.     END IF
80.     CLOSE
81.     REDIM _PRESERVE Words(i)
82. END SUB
83.  
84. SUB WordWrap (text AS STRING, newline)
85.     DIM BreakPoint AS STRING
86.     BreakPoint = ",./- ;:!" 'I consider all these to be valid breakpoints.  If you want something else, change them.
87.  
88.     w = _WIDTH
89.     pw = _PRINTWIDTH(text)
90.     x = POS(0): y = CSRLIN
91.     IF _PIXELSIZE <> 0 THEN x = x * _FONTWIDTH
92.     firstlinewidth = w - x + 1
93.     IF pw <= firstlinewidth THEN
94.         PRINT text;
95.         IF newline THEN PRINT
96.     ELSE
97.         'first find the natural length of the line
98.         FOR i = 1 TO LEN(text)
99.             p = _PRINTWIDTH(LEFT$(text, i))
100.             IF ASC(text, i) = 10 THEN 'CRLF character in the text.  It's a hard coded break point.
101.                 PRINT LEFT$(text, i)
102.                 WordWrap MID$(text, i + 1), newline
103.                 EXIT SUB
104.             END IF
105.             IF p > firstlinewidth THEN EXIT FOR
106.         NEXT
107.         lineend = i - 1
108.         t$ = RTRIM$(LEFT$(text, lineend)) 'at most, our line can't be any longer than what fits the screen.
109.         FOR i = lineend TO 1 STEP -1
110.             IF INSTR(BreakPoint, MID$(text, i, 1)) THEN 'We have a break point
111.                 lineend = i: EXIT FOR
112.             END IF
113.         NEXT
114.         PRINT LEFT$(text, lineend)
115.         WordWrap LTRIM$(MID$(text, lineend + 1)), newline
116.     END IF
117. END SUB
118.  
119. FUNCTION FindOccurance (text$, search$, occurance)
120.     FOR i = 1 TO occurance
121.         p = INSTR(p + 1, text$, search$)
122.     NEXT
123.     FindOccurance = p
124. END FUNCTION

You'll need the little zip file below for the stories and word list, so without them, the demo above is rather worthless.

A screen shot is attached.

[bplus]

Hi Steve,

Ha! now I bedtime stories and nightmares both! :D

Update: Oh hey! I see the 2nd advantage to using Console, an extra Window Free of charge!

[bplus]

hi steve thank you for the stories :)

good morning bplus...

I commented the "EXIT FOR" AND NOW THE PROGRAM CHANGES each keyword once and that's all. I was hoping we can bring it to change every keywords everytime it appears but each time with a different replay…

I need to study your code with the new item$ function and I hope to have a lesson sometime soon with my teacher so he could explain what I don't quite understand or have difficulty in understanding…

once again thank you

ron77

Hi Ron,

At the end of reply #64 I had appended this:

Update: OK I just ran a few tests with the EXIT FOR commented out and the old Replace SUB put back in and it looks to add a rich extension of alternating variations specially text using mom that has other keywords in replys. :)

You probably missed it?

So you did comment out the EXIT FOR but did you put back in the old Replace SUB?

I have moved onto making a set of cds Tools for working with Comma Delimited Strings, so now I can edit, append and remove items in a data line (the D() string array) item by item in the lines. I started an editor for this you can menu out from the TEXT gathering loop to change your data lines. But then imaging hundreds of D() strings, I decided to use my array selection scroll box control after I revise it with Steve's recommended screen state savings and restoring device.

On the other hand, I've been thinking it is just plain easier to edit the data lines by going back into the QB64 IDE and rewriting the D() array in the setup sub which was the original idea for the whole thing. But at least now I have cds tools looking for a job. Something in User Defined Type setups that need an array or 2 but can't have them because it's QB64, perfect for that situation!!! Sorry Ron, you probably have no idea what I am talking about.

Plenty to keep me busy and that is if Ken's man in amaze thing doesn't completely capture my heart and imagination. Ah yeah, and stories my Steve's moder! :D

[bplus]

Hi Ron, As per conversation on IRC here is possible fix to alter keyword replies in same text:

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "POET ASSISTENT V-3-1" 'b+ mod fix get more substitutions for same or different keywords altering as go
3.  
4. '              Globals seen inside SUBs and FUNCTIONs because SHARED
5. DIM SHARED topKeyIndex AS INTEGER '<< this is how many keywords we have
6. 'VVVV REDIM means dynamic arrays, so can change at setup
7. REDIM SHARED keywords(1 TO topKeyIndex) AS STRING, replys(1 TO topKeyIndex) AS STRING ''' , replyCouter(1 TO topKeyIndex)
8. REDIM SHARED replyCount(1 TO topKeyIndex) AS INTEGER 'new found Ron's good! changed name alittle
9.  
10. setup '<<< sets a Global topKeyIndex so have to run this to DIM local variables that use topKeyindex
11.  
12. '                   list local variables under global so bplus doesn't have to look all over for them
13. '          Locals for main code only, can only be seen in main code section
14. REDIM myList$(1 TO 1)
15. DIM lastReply(1 TO topKeyIndex) AS INTEGER ' NEW save the lastReply place we made\
16. DIM i AS INTEGER, text$ 'only variables the main code needs
17.  
18. 'start main code except "setup" already called
19. DO
20.     INPUT "(q quits) enter text: ", text$ '<<< B+ added q note because user doesn't know this
21.     IF LCASE$(text$) = "q" THEN END
22.     PRINT "output text:-----"
23.     FOR i = 1 TO topKeyIndex
24.  
25.         WHILE INSTR(text$, keywords(i)) > 0
26.             split replys(i), myList$()
27.             IF lastReply(i) = 0 THEN lastReply(i) = 1 ELSE lastReply(i) = lastReply(i) + 1
28.             IF lastReply(i) > replyCount(i) THEN lastReply(i) = 1
29.             Replace text$, keywords(i), myList$(lastReply(i)) '<<<<changed this  'myList$(INT(RND * UBOUND(mylist$) + 1)) B+ changed it some more
30.  
31.             'B+ get out of here after we replace one keyword !!!!!! otherwise things get too complicted
32.             'EXIT FOR ' <<<<<<<<<<<<< B+
33.  
34.         WEND ' AND IT DOSEN'T WORK AS EXPECTED :(  B+ NOW IT DOES :D
35.     NEXT i
36.     PRINT text$
37. LOOP
38.  
39. SUB setup
40.  
41.     DIM d(1 TO 10) AS STRING 'this is local to sub, not sharing anywhere else
42.     d(1) = "sun =at high noon ,happy like the fish ,sadness falls on me ,when we were young ,summer promissed us eternity "
43.     d(2) = "mom =i love you mother ,my happiness is to see you smile ,the woman that gave me life "
44.     d(3) = "sea =the place of eternal bliss ,to cross you like a ship over the ocean ,swim in the sun "
45.     d(4) = "family =i still think of you ,you are in my heart forever ,i shell always be greatful "
46.     d(5) = "cat =i called you mine but you were free ,winter's nights we used to cuttle "
47.     d(6) = "moon =you are magic to me ,king of the night ,our closest planet "
48.     d(7) = "love =that whitch is divine in us ,god's flower ,the most inportent thing "
49.     d(8) = "hate =do not waste your time on resentments ,let it pass... let go of it "
50.     d(9) = "sorrow =do not cry for yesterday ,we all suffer but love always return in new forms "
51.     d(10) = "life =the gift of love ,cherished and sacrat ,everyday's anigma "
52.  
53.     'local variables to sub
54.     DIM i AS INTEGER, j AS INTEGER, count AS INTEGER
55.  
56.     topKeyIndex = 10
57.     REDIM keywords(1 TO topKeyIndex), replys(1 TO topKeyIndex), replyCount(1 TO topKeyIndex)
58.     FOR i = 1 TO topKeyIndex 'load keywords and replies
59.         keywords(i) = leftOf$(d(i), "=")
60.         replys(i) = rightOf$(d(i), "=")
61.         'B+ count commas and add 1
62.         count = 0
63.         FOR j = 1 TO LEN(replys(i))
64.             IF MID$(replys(i), j, 1) = "," THEN count = count + 1
65.         NEXT
66.         replyCount(i) = count + 1 'number of replies = number of commas + 1
67.     NEXT
68.  
69. END SUB
70.  
71. 'design a tool box sub routine for splitting comma delimited strings
72. SUB split (myCommaLoadedString$, myListArray$())
73.     REDIM myListArray$(LBOUND(mylistarray$) TO LBOUND(mylistarray$)) ' replyCouter(1 TO topKeyIndex)
74.     IF INSTR(myCommaLoadedString$, ",") = 0 THEN myListArray$(LBOUND(mylistarray$)) = myCommaLoadedString$: EXIT SUB
75.  
76.     DIM first$, tail$
77.     first$ = leftOf$(myCommaLoadedString$, ",")
78.     myListArray$(LBOUND(mylistarray$)) = first$
79.     tail$ = rightOf$(myCommaLoadedString$, ",")
80.     WHILE INSTR(tail$, ",") > 0
81.         first$ = leftOf$(tail$, ",")
82.         sAppend myListArray$(), first$
83.         tail$ = rightOf$(tail$, ",")
84.     WEND
85.     sAppend myListArray$(), tail$
86. END SUB
87.  
88. FUNCTION leftOf$ (source$, of$)
89.     IF INSTR(source$, of$) > 0 THEN leftOf$ = MID$(source$, 1, INSTR(source$, of$) - 1)
90. END FUNCTION
91.  
92. FUNCTION rightOf$ (source$, of$)
93.     IF INSTR(source$, of$) > 0 THEN rightOf$ = MID$(source$, INSTR(source$, of$) + LEN(of$))
94. END FUNCTION
95.  
96. 'find sAppend toolbox code and paste below, need it to add a string to and array
97. 'append to the string array the string item
98. SUB sAppend (arr() AS STRING, item AS STRING)
99.     REDIM _PRESERVE arr(LBOUND(arr) TO UBOUND(arr) + 1) AS STRING
100.     arr(UBOUND(arr)) = item
101. END SUB
102.  
103. ' B+ BIG CHANGE HERE!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
104. 'just do replace once!!  To avoid unexpected results  B+ edited all the extra finding
105. SUB Replace (text$, old$, new$) 'can also be used as a SUB without the count assignment
106.     DIM find, last$, first$
107.     find = INSTR(text$, old$) 'find location of a word in text
108.     IF find THEN
109.         first$ = LEFT$(text$, find - 1) 'text before word including spaces
110.         last$ = RIGHT$(text$, LEN(text$) - (find + LEN(old$) - 1)) 'text after word
111.         text$ = first$ + new$ + last$
112.     END IF
113. END SUB
114.  
115. 'SUB Replace (text$, old$, new$) 'can also be used as a SUB without the count assignment
116. '    DIM find, start, count, last$, first$
117. '    DO
118. '        find = INSTR(start + 1, text$, old$) 'find location of a word in text
119. '        IF find THEN
120. '            count = count + 1
121. '            first$ = LEFT$(text$, find - 1) 'text before word including spaces
122. '            last$ = RIGHT$(text$, LEN(text$) - (find + LEN(old$) - 1)) 'text after word
123. '            text$ = first$ + new$ + last$
124. '        END IF
125. '        start = find
126. '    LOOP WHILE find
127. '    'Replace = count 'function returns the number of replaced words. Comment out in SUB
128. 'END SUB
129.  
130.  

EDIT removed unused variables I was testing.