Author Topic: Re: small demo of string replacement by keywords (still in progress)  (Read 3868 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

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

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. :)
« Last Edit: August 29, 2019, 09:44:56 am by bplus »

Offline SMcNeill

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

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.
* Stories.7z (Filesize: 24.11 KB, Downloads: 43)
Word Replace.jpg
* Word Replace.jpg (Filesize: 147.79 KB, Dimensions: 1080x878, Views: 87)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: small demo of string replacement by keywords (still in progress)
« Reply #32 on: August 29, 2019, 12:50:34 pm »
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!
« Last Edit: August 29, 2019, 03:55:08 pm by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: small demo of string replacement by keywords (still in progress)
« Reply #33 on: August 30, 2019, 09:15:16 am »
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:
Quote
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

« Last Edit: August 30, 2019, 09:24:44 am by bplus »

Offline bplus

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