FUNCTION Replace$() - roll your own and share it

[FellippeHeitor]

Here's my contribution. I wrote this one and it is part of InForm - accessible from every program that uses the library and now also available here.

As discussed here, this is the type of function that usually makes more sense to each one who's written their own version for their own use, but you never know when your approach can be useful to others.

This one takes:
- a TempText$ string variable, which will be searched.
- A subString$ which will be looked for inside TempText$
- a NewString$ which will be the replacement.
- the CaseSensitive parameters indicates whether the search should be - you guessed it - case sensitive. Zero is false, Any non-zero value is true. And finally
- a TotalReplacements parameter which is actually used to return the number of occurrences that were replaced. You can ignore this one by passing a zero or, if you want to use this information, pass it a LONG variable that will return the total of replacements.
- The result of the replacements is returned by the function itself.

All that said, this is how one would use it:

Code: QB64: [Select]

1. text$ = "The cats and dogs where playing, even though dogs don't like cats."
2. newText$ = Replace$(text$, "cats", "monkeys", 0, total&)
3.  
4. PRINT "We replaced 'cats' with 'monkeys' in text$. Here's the original string$:"
5. COLOR 4: PRINT text$
6. COLOR 15: PRINT "Here's the result:"
7. COLOR 10: PRINT newText$: PRINT
8. COLOR 7: PRINT "Total occurrences: "; total&

  [ You are not allowed to view this attachment ]  

Code: QB64: [Select]

1. FUNCTION Replace$ (TempText$, SubString$, NewString$, CaseSensitive AS _BYTE, TotalReplacements AS LONG)
2.     DIM FindSubString AS LONG, Text$
3.  
4.     IF LEN(TempText$) = 0 THEN EXIT SUB
5.  
6.     Text$ = TempText$
7.     TotalReplacements = 0
8.     DO
9.         IF CaseSensitive THEN
10.             FindSubString = INSTR(FindSubString + 1, Text$, SubString$)
11.         ELSE
12.             FindSubString = INSTR(FindSubString + 1, UCASE$(Text$), UCASE$(SubString$))
13.         END IF
14.         IF FindSubString = 0 THEN EXIT DO
15.         Text$ = LEFT$(Text$, FindSubString - 1) + NewString$ + MID$(Text$, FindSubString + LEN(SubString$))
16.         TotalReplacements = TotalReplacements + 1
17.     LOOP
18.  
19.     Replace$ = Text$
20. END FUNCTION

There's no option in this for "Whole word", as it wasn't something I personally needed. Looking forward to you guys' implementations.

[bplus]

Here is my "plain" one, need to make sure the new l's don't get replaced again and again in infinite loop:

Code: QB64: [Select]

1. _TITLE "strReplace$ test" 'b+ 2019-12-28     check to see that new l's don't get more replacements
2. PRINT strReplace$("hello all", "ll", "l")
3. PRINT strReplace$("hello all", "l", "lllll")
4. PRINT strReplace$("lots of luck", "l", "lllll")
5.  
6. FUNCTION strReplace$ (s$, replace$, new$) 'case sensitive
7.     strReplace$ = s$
8.     p = INSTR(s$, replace$)
9.     WHILE p
10.         strReplace$ = MID$(strReplace$, 1, p - 1) + new$ + MID$(strReplace$, p + LEN(replace$))
11.         p = INSTR(p + LEN(new$), strReplace$, replace$)
12.     WEND
13. END FUNCTION
14.  

[FellippeHeitor]

True! I hadn't thought of corner cases like that.

[bplus]

True! I hadn't thought of corner cases like that.

Yes I see ;-))

Code: QB64: [Select]

1. _TITLE "strReplace$ test" 'b+ 2019-12-28     check to see that new l's don't get more replacements
2. PRINT fellReplace$("hello all", "ll", "l", -1, totreplace)
3. PRINT fellReplace$("hello all", "l", "lllll", -1, totreplace)
4. PRINT fellReplace$("lots of luck", "l", "lllll", -1, totreplace)
5.  
6. FUNCTION strReplace$ (s$, replace$, new$) 'case sensitive
7.     strReplace$ = s$
8.     p = INSTR(s$, replace$)
9.     WHILE p
10.         strReplace$ = MID$(strReplace$, 1, p - 1) + new$ + MID$(strReplace$, p + LEN(replace$))
11.         p = INSTR(p + LEN(new$), strReplace$, replace$)
12.     WEND
13. END FUNCTION
14.  
15. FUNCTION fellReplace$ (TempText$, SubString$, NewString$, CaseSensitive AS _BYTE, TotalReplacements AS LONG)
16.     DIM FindSubString AS LONG, Text$
17.  
18.     IF LEN(TempText$) = 0 THEN EXIT SUB
19.  
20.     Text$ = TempText$
21.     TotalReplacements = 0
22.     DO
23.         IF CaseSensitive THEN
24.             FindSubString = INSTR(FindSubString + 1, Text$, SubString$)
25.         ELSE
26.             FindSubString = INSTR(FindSubString + 1, UCASE$(Text$), UCASE$(SubString$))
27.         END IF
28.         IF FindSubString = 0 THEN EXIT DO
29.         Text$ = LEFT$(Text$, FindSubString - 1) + NewString$ + MID$(Text$, FindSubString + LEN(SubString$))
30.         PRINT Text$
31.         TotalReplacements = TotalReplacements + 1
32.     LOOP
33.  
34.     fellReplace$ = Text$
35. END FUNCTION
36.  

[FellippeHeitor]

It's FUNCTION merge time, it seems 😉.

[bplus]

@FellippeHeitor  Yours is simple fix just replace 1 with len(replacement$) in INSTR arguments.

[bplus]

TempodiBasic made a point about checking the source string and the string to replace for length but replacing with nothing seems OK:

Code: QB64: [Select]

1. _TITLE "strReplace$ test" 'b+ 2019-12-28     check to see that new l's don't get more replacements
2. ' mod 2020-07-26 check for string lengths on source$ and replace$ but replacement new$ can be ""
3. PRINT strReplace$("hello all", "ll", "l")
4. PRINT strReplace$("hello all", "l", "lllll")
5. PRINT strReplace$("lots of luck", "l", "lllll")
6. PRINT strReplace$("hello all", "ll", "")
7.  
8. FUNCTION strReplace$ (s$, replace$, new$) 'case sensitive
9.     DIM p AS LONG
10.     IF LEN(s$) = 0 OR LEN(replace$) = 0 THEN BEEP: EXIT FUNCTION
11.     strReplace$ = s$
12.     p = INSTR(s$, replace$)
13.     WHILE p
14.         strReplace$ = MID$(strReplace$, 1, p - 1) + new$ + MID$(strReplace$, p + LEN(replace$))
15.         p = INSTR(p + LEN(new$), strReplace$, replace$)
16.     WEND
17. END FUNCTION

[SMcNeill]

Somewhere around here, I have an over-engineered super-Steve Replace function.  Life's just been hectic as all get out here recently, and between everything in general, and swapping files and such from the old PC to the new one, I don't have a clue where it's at currently.

The way my extreme version works is more or less:

SUB Replace (text$, delimiter$, prefix$, search$, postfix$, replace$)

The idea is:
1) You give it a text string.   "Cats eat cat-food, not cat food.  That would be acatastrophy!"
2) You choose a given delimiter.  "*"
3) You choose a search string, making use of the delimiter$.  "cat*"
4) You can choose a prefix or postfix to modify your work.  postfix$ = "-"
5) You give it a replacement string.  "dog"

The routine then searches your text$ for search$ (minus any delimiters, which would be "cat", from above). 
The first "Cats" gets changed to "Dogs".  That "*" in "cat*" in the search string says we ignore any character after the "cat".
The "cat-food" doesn't change, as we have a postfix saying keep "cat" if a "-" occurs after it.
The next "cat" changes.
The final "acatastrophy" doesn't change.  There's no open delimiter before the "cat" in our search string, like the "*" is after it, so that leading "a" prevents it from being altered.

The final result would be "Dogs eat cat-food, not dog food.  That would be acatastrophy!"


Now, if I can just sort out where the heck that routine actually went to in all this mess, I'll share it sometime....

[TempodiBasic]

Hi
about REPLACE$ a string with a null string

what do you think of this result?

Code: QB64: [Select]

1. _TITLE "strReplace$ test" 'b+ 2019-12-28     check to see that new l's don't get more replacements
2. ' mod 2020-07-26 check for string lengths on source$ and replace$ but replacement new$ can be ""
3. COLOR 0,7
4. PRINT strReplace$("hello all", "ll", "l")
5. 'PRINT strReplace$("hello all", "l", "lllll")
6. 'PRINT strReplace$("lots of luck", "l", "lllll")
7. 'PRINT strReplace$("hello all", "ll", "")
8. PRINT strReplace$("111111111", "1", "")
9.  
10. FUNCTION strReplace$ (s$, replace$, new$) 'case sensitive
11.     DIM p AS LONG
12.     IF LEN(s$) = 0 OR LEN(replace$) = 0 THEN BEEP: EXIT FUNCTION
13.     strReplace$ = s$
14.     p = INSTR(s$, replace$)
15.     WHILE p
16.         strReplace$ = MID$(strReplace$, 1, p - 1) + new$ + MID$(strReplace$, p + LEN(replace$))
17.         p = INSTR(p + LEN(new$), strReplace$, replace$)
18.     WEND
19. END FUNCTION
20.  

Is it better  a dedicated flag to transform a string into a null string? Moreover you can choose between a BASIC type of null string and a C type null string (that ends with CHR$(0)...) with a flag, in this plain function you must put CHR$(0) as string to put into sourceString.
Moreover if you want cancel a character you can use space character...o null character

What do you think about?

[phred]

Something I worked on a couple of years ago modeling Microsoft's function, which may or may not already be up here.
phred

Code: QB64: [Select]

1. a$ = "Visit Microsoft!" 'original string
2. b$ = "microsoft" 'search string
3. c$ = "W3Schools" 'replacement string
4.  
5. a$ = "001x002X003x004x005"
6. b$ = "x"
7. c$ = "z"
8.  
9. 'f$ = "-1"
10. 'f$ = "0"
11.  
12. PRINT a$
13. d$ = replacesub$(a$, b$, c$, d$, e$, f$, g$)
14. PRINT d$
15. END
16.  
17. FUNCTION replacesub$ (expression$, find$, replacewith$, start$, count$, compare$, exact$)
18.     IF start$ = "" THEN start = 1 ELSE start = VAL(start$)
19.     IF count$ = "" THEN count = -1 ELSE count = VAL(count$)
20.     IF compare$ = "" THEN compare = 0 ELSE compare = VAL(compare$) 'default is for case sensitve
21.  
22.     IF find$ = "" OR replacewith$ = "" OR count = 0 THEN replacesub$ = expression$: EXIT FUNCTION
23.     IF expression$ = "" OR start > LEN(expression$) THEN replacesub$ = "": EXIT FUNCTION
24.  
25.     IF exact$ <> "" THEN 'pad values to isolate whole word
26.         find$ = " " + find$ + " "
27.         replacewith$ = " " + replacewith$ + " "
28.     END IF
29.  
30.     working$ = expression$
31.     start2 = start
32.  
33.     rl = LEN(find$)
34.     tally = 0
35.     IF compare <> 0 THEN
36.         working$ = LCASE$(working$)
37.         find$ = LCASE$(find$)
38.     END IF
39.     rf = INSTR(start, working$, find$)
40.     DO WHILE rf
41.         tmp1$ = MID$(working$, 1, rf - 1) 'copy mid$ from start to beginning of found replacement
42.         tmp2$ = MID$(working$, rf + rl) 'then copy from end of replacement to end of the text string (rf + rl)
43.         working$ = tmp1$ + replacewith$ + tmp2$
44.         start = rf
45.         rf = INSTR(start, working$, find$)
46.         tally = tally + 1: IF tally = count THEN EXIT DO
47.     LOOP
48.     working$ = MID$(working$, start2)
49.     replacesub$ = working$
50. END FUNCTION
51.  
52.  
53. 'VB - Replace$(expression, find, replacewith[, start[, count[, compare]]])
54. 'Arguments
55.  
56. 'expression
57. '    Required. String expression containing substring to replace.
58. 'find
59. '    Required. Substring being searched for.
60. 'replacewith
61. '    Required. Replacement substring.
62. 'start
63. '    Optional. Position within expression where substring search is to begin. If omitted, 1 is assumed. Must be used in conjunction with count.
64. 'count
65. '    Optional. Number of substring substitutions to perform. If omitted, the default value is -1, which means make all possible substitutions. Must be used in conjunction with start.
66. 'compare
67. '    Optional. Numeric value indicating the kind of comparison to use when evaluating substrings. See Settings section for values. If omitted, the default value is 0, which means perform a binary comparison.
68. '
69. 'if find = "" or replacewith = "" or count = 0 then return expression
70. 'if expression = "" or start > len(expression) return ""
71.  

[FellippeHeitor]

@FellippeHeitor  Yours is simple fix just replace 1 with len(replacement$) in INSTR arguments.

I wonder if using _INSTRREV would make up for having to use LEN()... I'll look into that.

@phred thanks for sharing. Why strings for numeric input?

[FellippeHeitor]

@bplus Using _INSTRREV... both my cats/monkeys and your LLLLL tests:

Code: QB64: [Select]

1. text$ = "The cats and dogs where playing, even though dogs don't like cats."
2. newText$ = Replace$(text$, "cats", "monkeys", 0, total&)
3.  
4. PRINT "We replaced 'cats' with 'monkeys' in text$. Here's the original string$:"
5. COLOR 4: PRINT text$
6. COLOR 15: PRINT "Here's the result:"
7. COLOR 10: PRINT newText$: PRINT
8. COLOR 7: PRINT "Total occurrences: "; total&
9.  
10. PRINT: PRINT "Press any key...": SLEEP
11.  
12. 'b+ 2019-12-28     check to see that new l's don't get more replacements
13. CLS
14. PRINT Replace$("hello all", "ll", "l", 0, total&);
15. PRINT total&
16. PRINT Replace$("hello all", "l", "lllll", 0, total&);
17. PRINT total&
18. PRINT Replace$("lots of luck", "l", "lllll", 0, total&);
19. PRINT total&
20.  
21. FUNCTION Replace$ (TempText$, SubString$, NewString$, CaseSensitive AS _BYTE, TotalReplacements AS LONG)
22.     DIM FindSubString AS LONG, Text$
23.  
24.     IF LEN(TempText$) = 0 OR LEN(SubString$) = 0 OR LEN(NewString$) = 0 THEN EXIT SUB
25.  
26.     Text$ = TempText$
27.     TotalReplacements = 0
28.     FindSubString = LEN(Text$)
29.     DO
30.         IF CaseSensitive THEN
31.             FindSubString = _INSTRREV(FindSubString - 1, Text$, SubString$)
32.         ELSE
33.             FindSubString = _INSTRREV(FindSubString - 1, UCASE$(Text$), UCASE$(SubString$))
34.         END IF
35.         IF FindSubString = 0 THEN EXIT DO
36.         Text$ = LEFT$(Text$, FindSubString - 1) + NewString$ + MID$(Text$, FindSubString + LEN(SubString$))
37.         TotalReplacements = TotalReplacements + 1
38.         IF FindSubString = 1 THEN EXIT DO
39.     LOOP
40.  
41.     Replace$ = Text$
42. END FUNCTION
43.  

[Richard]

@Steve

"Enhanced Replace All Routine"   (Feb 02,2014   Topic 11648)

[bplus]

Hi all

I was looking at TempodiBasic's post and realized you could do primitive math with strReplace$ !

So I set out to make a demo of that and it turns out I started a little library of str Functions. I also discovered my strReplace FUNCTION could actually cause unintended recursion so I fixed it again!

So here is the demo, remember when we first learned math with Stones or some other ubiquitous object?

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "strReplace$ test" 'b+ 2019-12-28     check to see that new l's don't get more replacements
3. ' mod 2020-07-26 check for string lengths on source$ and replace$ but replacement new$ can be ""
4. ' mod 2020-07-27 don't set strReplace$ = s$ because could cause unintented recursion.
5.  
6. DIM s$, stones$(1 TO 9), i AS INTEGER
7. s$ = "Stone "
8. stones$(9) = strCopies$(s$, 9)
9.  
10. FOR i = 1 TO 8
11.     stones$(i) = strCopies$(s$, i)
12.     PRINT "9 Stones MOD "; _TRIM$(STR$(i)); " Stone(s) is "; strEnclose$(strReplace$(stones$(9), stones$(i), ""), "{}")
13. NEXT
14.  
15.  
16. FUNCTION strReplace$ (s$, replace$, new$) 'case sensitive
17.     DIM p AS LONG, sCopy$
18.     IF LEN(s$) = 0 OR LEN(replace$) = 0 THEN BEEP: EXIT FUNCTION
19.     sCopy$ = s$
20.     p = INSTR(sCopy$, replace$)
21.     WHILE p
22.         sCopy$ = MID$(sCopy$, 1, p - 1) + new$ + MID$(sCopy$, p + LEN(replace$))
23.         p = INSTR(p + LEN(new$), sCopy$, replace$)
24.     WEND
25.     strReplace$ = sCopy$
26. END FUNCTION
27.  
28. FUNCTION strEnclose$ (s$, str1or2$) ' enclose with "" or {}, (), []...
29.     IF LEN(str1or2$) = 2 THEN
30.         strEnclose$ = LEFT$(str1or2$, 1) + s$ + RIGHT$(str1or2$, 1)
31.     ELSEIF LEN(str1or2$) = 1 THEN
32.         strEnclose$ = str1or2$ + s$ + str1or2$
33.     ELSE
34.         BEEP
35.     END IF
36. END FUNCTION
37.  
38. FUNCTION strCopies$ (s$, numberOfCopies AS INTEGER)
39.     DIM i AS INTEGER
40.     FOR i = 1 TO numberOfCopies
41.         strCopies$ = strCopies$ + s$
42.     NEXT
43. END FUNCTION
44.  
45.  
46.  

@FellippeHeitor  well your version looks a little more complex than it has to be

 IF FindSubString = 0 THEN EXIT DO
 IF FindSubString = 1 THEN EXIT DO

but as author of _INSTRREV, I can see why you might favor it. ;-))


Oh hey, if we count replacements we have the two elements for complete division report.

[TempodiBasic]

@bplus
great the stone math....
hey but you have found a bug of OPTION _EXPLICIT
... it lets's to use Subprograms without an END at the end of the main!
For my hobbist eyes it is horrible (I think because there is a voice of Pascal/TurboPascal into my mind)
would Pascal let you execute the main without closing it with END. ?
Would C let you execute the main without closing it with } ?
Also QB45 does this thing, but it has Subroutines first of the main and after the declaration of themselves.