VB Replace function

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
vbmrupp
Posts: 26
Joined: Sep 29, 2010 3:39
Location: Columbia SC

VB Replace function

Post by vbmrupp »

I noticed that FB does not have a replace function..unless I have overlooked it by mistake. So I created one really quick. It only replaces the first occurrence of found substring;
I will enhance it to replace all occurrences when I can but here is what I have so far.

Code: Select all

function Replace(ByRef src as String,ByRef find As String,ByRef repl as String,start As Integer=1) as String
   Dim source As String,buf As String
   source = src
   buf = find
    
    Dim indx As Integer = InStr(start,source,buf)
    If indx=0 Then Return ""
    If indx = 1 Then Return repl & Mid(source,Len(buf)+1)
    Dim n As Integer = 0
    Dim tmp As String
    Do 
    	n+=1
    	If n=indx Then Exit do
    	tmp += Mid(source,n,1)
    Loop 
    Return tmp & repl & Mid(source,indx + Len(buf))
end Function
TJF
Posts: 3809
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Post by TJF »

You may be interessted in a shorter and faster version:

Code: Select all

SUB STRreplace(BYREF T AS STRING, BYREF I AS STRING, BYREF S AS STRING, BYVAL A AS INTEGER = 1)
  VAR p = INSTR(A, T, I), li = LEN(I), ls = LEN(S) : IF li = ls THEN li = 0
  WHILE p
    IF li THEN T = LEFT(T, p - 1) & S & MID(T, p + li) ELSE MID(T, p) = S
    p = INSTR(p + ls, T, I)
  WEND
END SUB
The result is passed back in the T variable to the calling code.

PS: I think this topic should be moved to Tips and Tricks.
xroot
Posts: 32
Joined: Aug 30, 2010 18:35

Autoit3 StringReplace

Post by xroot »

There is a command line entry to run one liners from Autoit3.
Here is the example:

"To execute a single line of code, use the command:
Run(@AutoItExe & ' /AutoIt3ExecuteLine "MsgBox(0, ''Hello world!'', ''Hi!'')"')"

Here is what I came up with in FB.

Code: Select all

#include once "clipboard.bi"

Const Au3="C:\Autoit\install\AutoIt3.exe"
Const IO="/AutoIt3ExecuteLine """

Dim as string S="Mississippi",F="i",C=""

Exec Au3,IO+"ClipPut(StringReplace('"+S+"','"+F+"','"+C+"'))"""

?GetClip
sleep
You can run alot of Au3 commands this way but I still like Com way better.
Have Fun!

Here is another simple way to get a Replace command to work without any need to code it yourself.

Code: Select all

#define UNICODE
#include Once "disphelper/disphelper.bi"

Dim shared as IDISPATCH PTR VBS

Sub Load_VBS() Constructor
    dhInitialize(TRUE)
    dhToggleExceptions(TRUE)
    dhCreateObject "MSScriptControl.ScriptControl",NULL,@VBS
    dhPutValue VBS,".Language %s","VBScript"
End Sub

Sub UnLoad_VBS() Destructor
    SAFE_RELEASE(VBS)
    dhUninitialize True
End Sub

Function Replace(S as string,F as string,R as string)as string
    Dim Ret as zstring ptr
    dhGetValue "%s",@Ret,VBS,".Eval %s","Replace("""+S+""","""+F+""","""+R+""")"
    Return *Ret
End Function

Dim as string S="Mississippi",F="i",R=""

?Replace(S,F,R)

Sleep

Last edited by xroot on Nov 23, 2010 16:27, edited 2 times in total.
vbmrupp
Posts: 26
Joined: Sep 29, 2010 3:39
Location: Columbia SC

Post by vbmrupp »

TJF wrote:You may be interessted in a shorter and faster version:

Code: Select all

SUB STRreplace(BYREF T AS STRING, BYREF I AS STRING, BYREF S AS STRING, BYVAL A AS INTEGER = 1)
  VAR p = INSTR(A, T, I), li = LEN(I), ls = LEN(S) : IF li = ls THEN li = 0
  WHILE p
    IF li THEN T = LEFT(T, p - 1) & S & MID(T, p + li) ELSE MID(T, p) = S
    p = INSTR(p + ls, T, I)
  WEND
END SUB
The result is passed back in the T variable to the calling code.

PS: I think this topic should be moved to Tips and Tricks.
Can you explain how this is faster? is a while loop faster than a do loop? I'm just curious.
Thanks
TJF
Posts: 3809
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Post by TJF »

vbmrupp wrote:Can you explain how this is faster? is a while loop faster than a do loop? I'm just curious.
Thanks
Just try it with long strings, like:

Code: Select all

SUB STRreplace(BYREF T AS STRING, BYREF I AS STRING, BYREF S AS STRING, BYVAL A AS INTEGER = 1)
  VAR p = INSTR(A, T, I), li = LEN(I), ls = LEN(S) : IF li = ls THEN li = 0
  WHILE p
    IF li THEN T = LEFT(T, p - 1) & S & MID(T, p + li) ELSE MID(T, p) = S
    p = INSTR(p + ls, T, I)
  WEND
END SUB


FUNCTION Replace(BYREF src AS STRING,BYREF find AS STRING,BYREF repl AS STRING,start AS INTEGER=1) AS STRING
   DIM source AS STRING,buf AS STRING
   source = src
   buf = find

    DIM indx AS INTEGER = INSTR(start,source,buf)
    IF indx=0 THEN RETURN ""
    IF indx = 1 THEN RETURN repl & MID(source,LEN(buf)+1)
    DIM n AS INTEGER = 0
    DIM tmp AS STRING
    DO
            n+=1
            IF n=indx THEN EXIT DO
            tmp += MID(source,n,1)
    LOOP
    RETURN tmp & repl & MID(source,indx + LEN(buf))
END FUNCTION

' generate a long string
VAR t = "0123456789ABCDEF"
FOR i AS INTEGER = 0 TO 17
  t &= t
NEXT

' test Replace
VAR ti = TIMER
VAR r = Replace(T, "123", "321")
VAR t1 = TIMER - ti

'test STRreplace
ti = TIMER
STRreplace(T, "321", "123")
VAR t2 = TIMER - ti

' output the result
?"   STR LEN: ";LEN(t)
?
?"   Replace: ";t1
?"STRreplace: ";t2
?
?"     ratio: ";t1 / t2

SLEEP
There is no speed difference between DO and WHILE loop.

One big difference: FUNCTION/RETURN is slower than SUB(BYREF.

But there is more optimization in the STRreplace code.
TJF
Posts: 3809
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Post by TJF »

I had a closer look at the Replace code: it does just one (the first) replacement :{

STRreplace does all matching replacements in the input string in one call.
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Post by MichaelW »

vbmrupp wrote: Can you explain how this is faster?
Your code has a shorter loop, but it loops more times.

Code: Select all

dim as string s = "my other brother darryl"
Replace( s, "darryl","Darryl" ) '' loop executes 18 times
STRreplace( s, "darryl","Darryl" ) '' loop executes 1 time
Even so, the difference is not large, 4700 clock cycles versus 3280 clock cycles running on a P3.
TJF
Posts: 3809
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Post by TJF »

@MichaelW:

The difference isn't big at short strings. Try longer one, like:

Code: Select all

' generate a long string
VAR s = "0123456789ABCDEF"
FOR i AS INTEGER = 0 TO 17
  s &= s
NEXT
s &= "my other brother darryl"

?Replace( s, "darryl","Darryl" )

STRreplace( s, "darryl","Darryl" )
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Post by dodicat »

TJF wrote:@MichaelW:

The difference isn't big at short strings. Try longer one, like:

Code: Select all

' generate a long string
VAR s = "0123456789ABCDEF"
FOR i AS INTEGER = 0 TO 17
  s &= s
NEXT
s &= "my other brother darryl"

?Replace( s, "darryl","Darryl" )

STRreplace( s, "darryl","Darryl" )
Hi JTF
I've been messing around with string replace myself over in the squares topic.
I used Function SAR (Search and replace), and I've modified it a bit for this thread, it really is similar to your own but a function.
My original SAR didn't take the shortcut for equal lengths out and in.
So thanks for that little shortcut.
As far as I can see, replace only replaces the first instance.

Ive done a couple of replacements with each procedure, but to slow both yours and mine, I've made the replacement a different length to that being replaced.

Code: Select all


FUNCTION Replace(BYREF src AS STRING,BYREF find AS STRING,BYREF repl AS STRING,start AS INTEGER=1) AS STRING
   DIM source AS STRING,buf AS STRING
   source = src
   buf = find

    DIM indx AS INTEGER = INSTR(start,source,buf)
    IF indx=0 THEN RETURN ""
    IF indx = 1 THEN RETURN repl & MID(source,LEN(buf)+1)
    DIM n AS INTEGER = 0
    DIM tmp AS STRING
    DO
            n+=1
            IF n=indx THEN EXIT DO
            
            tmp += MID(source,n,1)
    LOOP 
    RETURN tmp & repl & MID(source,indx + LEN(buf))
END FUNCTION

SUB STRreplace(BYREF T AS STRING, BYREF I AS STRING, BYREF S AS STRING, BYVAL A AS INTEGER = 1)
  VAR p = INSTR(A, T, I), li = LEN(I), ls = LEN(S) : IF li = ls THEN li = 0
  WHILE p
    IF li THEN T = LEFT(T, p - 1) & S & MID(T, p + li) ELSE MID(T, p) = S
    p = INSTR(p + ls, T, I)
  WEND
END SUB

Function SAR(s0 As String,s1 As String,s2 As String) As String
    var lens1=Len(s1),lens2=Len(s2)
    If lens1=lens2 Then lens1=0
   dim as string s=s0 
    Dim As Integer position=Instr(s,s1)
    While position>0
        If lens1 Then   
            s=Left(s,position-1) & s2 & Mid(s,position+Lens1)
        Else
            Mid(s,position) = S2
        End If
        position=Instr(position+Lens2,s,s1)
    Wend
    Function=s
End Function

' generate a long string
VAR s = "0123456789ABCDEF"
FOR i AS INTEGER = 0 TO 12'17
  s &= s
NEXT
dim brother as string="my other brother darryl darryl"
s &= brother

dim as string s2,s3
dim as double t1,t2,t3,t4,t5,t6
t1=timer
s2=Replace(s,"456","**")
s2=Replace( s,"darryl","Darryl" ) '' loop executes 18 times
t2=timer

t3=timer
s3=SAR(s,"456","**")
s3=SAR(s3,"darryl","Darryl" )
t4=timer

t5=timer
STRreplace( s,"456","**" )
STRreplace( s,"darryl","Darryl" ) '' loop executes 1 time
t6=timer

print "Replace    ";mid(s2,len(s2)-len(brother)-20)
print "SAR        "; mid(s3,len(s3)-len(brother)-20)
print "STRreplace ";mid(s,len(s)-len(brother)-20)

print "TIMES"
print "Replace    ";t2-t1
print "SAR        ";t4-t3
print "STRreplace ";t6-t5
print "done"
sleep

 

dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Autoit3 StringReplace

Post by dodicat »

xroot wrote:There is a command line entry to run one liners from Autoit3 ----
Hi xroot
Your stringreplace is extremely fast.
I have renamed the function to SAR (to save a lot of typing), and tried it on a numerical string compressor I was working on.
Thanks

Code: Select all


'COMPRESS A NUMBER 
#define UNICODE
#include Once "disphelper/disphelper.bi"
Dim Shared As String setkey(0 To 99)
Dim shared as IDISPATCH PTR VBS
declare Function SAR(S as string,F as string,R as string)as string
Declare Function encode(Byref num1 As String,key As Integer=27) As String
Declare Function decode(Byref num1 As String,key As Integer=27) As String
declare Function rr(first As Double, last As Double) As Double
declare Sub Load_VBS() Constructor
declare Sub UnLoad_VBS() Destructor
'________________________________________________________
Dim As String ENCODED,DECODED,NUMBER
Dim As Long count_number_chars,count_encode_chars 'counters
For z As Integer =1 To 100000
    NUMBER=NUMBER+Chr(rr(48,57))'random numerical characters.
Next z
count_number_chars=Len(NUMBER)  ' number of digits
Print "Please wait"
Dim As Double t1,t2

t1=Timer

ENCODED=encode(NUMBER)        'Compress 
count_encode_chars=Len(ENCODED)  'number of code digits
DECODED=decode(ENCODED)        'expand
t2=Timer
Print NUMBER
Print ENCODED
Print
Print "TOTAL","TOTAL"
Print "NUMBER","ENCODE"
Print "LENGTH","LENGTH"

Print count_number_chars,count_encode_chars
Print 
Print "Overall compression  = ";count_encode_chars/count_number_chars
Print
Print 
Print "Done",t2-t1;" seconds"

If NUMBER<>DECODED Then 
    Print "ERROR"
Else
    Print "No errors"
End If
Sleep
'___________________________________________________

Sub Load_VBS() Constructor
    dhInitialize(TRUE)
    dhToggleExceptions(TRUE)
    dhCreateObject "MSScriptControl.ScriptControl",NULL,@VBS
    dhPutValue VBS,".Language %s","VBScript"
End Sub

Sub UnLoad_VBS() Destructor
    SAFE_RELEASE(VBS)
    dhUninitialize True
End Sub

Function SAR(S as string,F as string,R as string)as string
    Dim Ret as zstring ptr
    dhGetValue "%s",@Ret,VBS,".Eval %s","Replace("""+S+""","""+F+""","""+R+""")"
    Return *Ret
End Function

Function rr(first As Double, last As Double) As Double
    Function = Rnd * (last - first) + first
End Function


'______________________________________________________

Function encode(Byref num1 As String,key As Integer=27) As String
    key=key+129
    If key<0 Then key=0
    If key>156 Then key=156
    Dim As String num2=num1
    For x As Integer=0 To 99:setkey(x)=Chr(x+key):Next
        
        Dim As Integer s1
        s1=99 
        Do 
            num2=SAR(num2,Str(s1),setkey(s1))
            s1=s1-1
        Loop Until s1=-1
        Return num2
    End Function
    Function decode(Byref num1 As String,key As Integer=27) As String 
        key=key+129
        If key<0 Then key=0
        If key>156 Then key=156
        For x As Integer=0 To 99:setkey(x)=Chr(x+key):Next
            Dim As String num2=num1
            Dim As Integer s1
            s1=99 
            Do 
                num2=SAR(num2,setkey(s1),Str(s1))
                s1=s1-1
            Loop Until s1=-1
            Return num2
        End Function
        
        
        
         
vbmrupp
Posts: 26
Joined: Sep 29, 2010 3:39
Location: Columbia SC

Post by vbmrupp »

Thanks for all the replies. This is the reason I like to come here; it is easy to get a discussion going and I learn much. As a follow-up question to TJF:
One big difference: FUNCTION/RETURN is slower than SUB(BYREF.
Aren't they both returning the results back onto the stack? How is returning the new value using Sub faster than Function?...I'm just asking

Also:
Could a Replace,Split,Join functions be added to the next FB version. It could be placed in the VBCompat.bi; where all VB6 functions that FB doesn't could be placed.

Thanks
TJF
Posts: 3809
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Post by TJF »

vbmrupp wrote:Aren't they both returning the results back onto the stack? How is returning the new value using Sub faster than Function?...I'm just asking
In my example I used a 4 MB string. The stack size is 1 MB by default. I guess only a PTR to the result is passed onto the stack.

In your replace code a copy of the result string is generated allways. In STRreplace a copy is only generated when the find and replace strings have different length (faster and less memory consumption).
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Post by MichaelW »

TJF wrote:The difference isn't big at short strings. Try longer one…
The absolute difference changes with the size of the string, the relative difference does not, or at least not significantly. On my system, for a 4x larger string the cycle counts were 5075 and 3520. 4700/3280=1.43, 5075/3520=1.44.

In terms of execution time the difference between a sub and a function is relatively small, with the function typically requiring only a small number of additional instructions (~~8).
marcov
Posts: 3455
Joined: Jun 16, 2005 9:45
Location: Netherlands
Contact:

Post by marcov »

MichaelW wrote: In terms of execution time the difference between a sub and a function is relatively small, with the function typically requiring only a small number of additional instructions (~~8).
... for registerable value types.
vbmrupp
Posts: 26
Joined: Sep 29, 2010 3:39
Location: Columbia SC

Post by vbmrupp »

TJF wrote:
vbmrupp wrote:Aren't they both returning the results back onto the stack? How is returning the new value using Sub faster than Function?...I'm just asking
In my example I used a 4 MB string. The stack size is 1 MB by default. I guess only a PTR to the result is passed onto the stack.

In your replace code a copy of the result string is generated allways. In STRreplace a copy is only generated when the find and replace strings have different length (faster and less memory consumption).
In your Sub the passed source string is changed, therefore you would have to have a copy in the callee before passing it. Unless you want the source string altered. So a copy is required somewhere on the stack.
Post Reply