-
May 25th, 2021, 07:19 AM
#1
Thread Starter
Frenzied Member
[RESOLVED] The fastest StringRepeat algorithm
I'd like to find a fastest StringRepeat algorithm.
Here is a StringRepeat function written in JavaScript:
Code:
function stringRepeat(str, num) {
var result = '';
for (num |= 0; num > 0; num >>>= 1, str += str) {
if (num & 1) {
result += str;
}
}
return result;
}
-
May 25th, 2021, 07:29 AM
#2
Re: The fastest StringRepeat algorithm
What you have you tried? :-)
This would be my simple approach:
Code:
Option Explicit
Private Sub Form_Load()
Dim a As String
Debug.Print StringRepeat("SearchingDataOnly", 7)
End Sub
Public Function StringRepeat(sStr As String, lNum As Long) As String
Dim i As Long
Dim lLen As Long, lPos As Long
lLen = Len(sStr)
StringRepeat = Space$(lLen * lNum)
lPos = 1
For i = 0 To lNum - 1
Mid$(StringRepeat, lPos, lLen) = sStr
lPos = lPos + lLen
Next i
End Function
-
May 25th, 2021, 07:33 AM
#3
Re: The fastest StringRepeat algorithm
In VB6 you don't want to concatenate to a string to build a string if at all possible as that can be quite slow.
So, as a minimum, you would create the string to be the correct size, and then fill it.
There are likely faster methods, but off the top of my head, without testing (so I could have a syntax error)...
Code:
Function stringRepeat(str As String, num As Long)
Dim strLength as Long
strLength = len(str)
Dim ptr as Long
Dim tmpString as String
tmpString = Space$(strLength * num)
Dim i As Long
ptr = 1
For i = 1 to num
Mid$(tmpString, ptr, strLength) = str
ptr = ptr + strLength
Next
stringRepeat = tmpString
End Function
p.s. Looks like Arnoutdv and I agree completely, on the basic, non-researched approach. It should be pretty quick, and many times faster than concatenation as the value of num grows.
Last edited by passel; May 25th, 2021 at 07:36 AM.
"Anyone can do any amount of work, provided it isn't the work he is supposed to be doing at that moment" Robert Benchley, 1930
-
May 25th, 2021, 07:36 AM
#4
Re: The fastest StringRepeat algorithm
Or use the light-weight-Shell-API's
https://docs.microsoft.com/en-us/win...i-strcatchainw
EDIT:
Done Excel/vba, that's why there is a "PtrSafe and a LongPtr, change to suit
No idea about speed
Code:
Private Declare PtrSafe Function StrCatChainW Lib "shlwapi" (ByVal Dest As LongPtr, ByVal DestSize As Long, ByVal offset As Long, ByVal Source As LongPtr) As Long
Public Function StripNull(ByVal InString As String) As String
'Input: String containing null terminator (Chr(0))
'Returns: all character before the null terminator
Dim iNull As Long
If Len(InString) > 0 Then
iNull = InStr(InString, vbNullChar)
Select Case iNull
Case 0
StripNull = InString
Case 1
StripNull = ""
Case Else
StripNull = Left$(InString, iNull - 1)
End Select
End If
End Function
Sub main()
Dim src As String
Dim dst As String
Dim i As Long
Dim j As Long
i = 5
src = "Hello World!"
dst = String(i * Len(src) + 1, " ")
j = 0
Do
j = StrCatChainW(StrPtr(dst), Len(dst), j, StrPtr(src))
Loop Until j = Len(dst) - 1
Debug.Print StripNull(dst)
End Sub
Last edited by Zvoni; May 25th, 2021 at 08:01 AM.
Last edited by Zvoni; Tomorrow at 31:69 PM.
----------------------------------------------------------------------------------------
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------------------
People call me crazy because i'm jumping out of perfectly fine airplanes.
---------------------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad
-
May 25th, 2021, 08:32 AM
#5
Thread Starter
Frenzied Member
Re: The fastest StringRepeat algorithm
Thank you Arnoutdv, passel and Zvoni, I'll test the algorithms of the three of you tomorrow and post the test results.
-
May 25th, 2021, 08:37 AM
#6
Re: The fastest StringRepeat algorithm
Originally Posted by SearchingDataOnly
Thank you Arnoutdv, passel and Zvoni, I'll test the algorithms of the three of you tomorrow and post the test results.
That would be comparing apples to oranges as JS algorithm is superior -- it's implementing string repeat with *minimum* concatenations looping on the *bits* of the num variable and appending current doubling-chunk when the bit is set which is totally faster than VB6 impl presented.
Here is another inefficient but still minimal one-liner:
Code:
Public Function StringRepeat(sStr As String, lNum As Long) As String
StringRepeat = Replace(Space$(lNum), " ", sStr)
End Function
cheers,
</wqw>
-
May 25th, 2021, 08:40 AM
#7
Thread Starter
Frenzied Member
Re: The fastest StringRepeat algorithm
Originally Posted by wqweto
That would be comparing apples to oranges as JS algorithm is superior -- it's implementing string repeat with *minimum* concatenations looping on the *bits* of the num variable and appending current doubling-chunk when the bit is set which is totally faster than VB6 impl presented.
cheers,
</wqw>
Yes, I did see the wonders of the JS algorithm, so I'm curious whether VB6 can provide a faster algorithm than JS.
-
May 25th, 2021, 08:43 AM
#8
Re: The fastest StringRepeat algorithm
In the sample provided, by Passel and by me, there is no concatenation.
Only filling of single reserved memory block.
In the JS sample there are multiple concatenations.
Both of str and of the result variable.
-
May 25th, 2021, 08:52 AM
#9
Re: The fastest StringRepeat algorithm
Arnout, my sample also doesn't "concatenate" (in the classical sense).
At least that's the way i understood the documentation of that API
I think the "bottleneck" is in (re-)allocating memory for the "resulting" string (and its intermediaries).
Basically, in a 1:1 port of the JS-sample (with concats) the memory-manager would be playing ping-pong with the memory-allocations, while in your, passel's and my sample, the destination-memory gets allocated once.
Last edited by Zvoni; Tomorrow at 31:69 PM.
----------------------------------------------------------------------------------------
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------------------
People call me crazy because i'm jumping out of perfectly fine airplanes.
---------------------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad
-
May 25th, 2021, 08:55 AM
#10
Re: The fastest StringRepeat algorithm
Originally Posted by SearchingDataOnly
. . . so I'm curious whether VB6 can provide a faster algorithm than JS.
No, VB6 can barely hold its pants on so it cannot provide any better algorithm out of the box for sure.
And then you know, the better algorithms have been invented by the academics long time ago -- just have to read those textbooks.
cheers,
</wqw>
Last edited by wqweto; May 25th, 2021 at 09:09 AM.
-
May 25th, 2021, 09:08 AM
#11
Re: The fastest StringRepeat algorithm
Simple test results, compiled (Fast code only):
Code:
---------------------------
Project1
---------------------------
StringRepeat Arnout+Passel: 469
StringRepeat zvoni: 625
StringRepeat wqweto: 4563
StringRepeat basic &: 1156
---------------------------
OK
---------------------------
Code:
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function StrCatChainW Lib "shlwapi" (ByVal Dest As Long, ByVal DestSize As Long, ByVal offset As Long, ByVal Source As Long) As Long
Private Sub Form_Load()
Dim a As String, s As String
Dim i As Long, n As Long, t As Long
Dim m As String
n = 25
s = "SearchingDataOnly"
t = GetTickCount
For i = 1 To 1000000
a = StringRepeat(s, n)
Next i
t = GetTickCount - t
m = "StringRepeat Arnout+Passel: " & CStr(t)
t = GetTickCount
For i = 1 To 1000000
a = StringRepeatAPI(s, n)
Next i
t = GetTickCount - t
m = m & vbLf & "StringRepeat zvoni: " & CStr(t)
t = GetTickCount
For i = 1 To 1000000
a = StringRepeat2(s, n)
Next i
t = GetTickCount - t
m = m & vbLf & "StringRepeat wqweto: " & CStr(t)
t = GetTickCount
For i = 1 To 1000000
a = StringRepeat3(s, n)
Next i
t = GetTickCount - t
m = m & vbLf & "StringRepeat basic &: " & CStr(t)
MsgBox m
End Sub
Public Function StringRepeat(sStr As String, lNum As Long) As String
Dim i As Long
Dim lLen As Long, lPos As Long
lLen = Len(sStr)
StringRepeat = Space$(lLen * lNum)
lPos = 1
For i = 0 To lNum - 1
Mid$(StringRepeat, lPos, lLen) = sStr
lPos = lPos + lLen
Next i
End Function
Public Function StringRepeat2(sStr As String, lNum As Long) As String
StringRepeat2 = Replace(Space$(lNum), " ", sStr)
End Function
Public Function StringRepeat3(sStr As String, lNum As Long) As String
Dim i As Long
For i = 0 To lNum - 1
StringRepeat3 = StringRepeat3 & sStr
Next i
End Function
Private Function StripNull(ByVal InString As String) As String
'Input: String containing null terminator (Chr(0))
'Returns: all character before the null terminator
Dim iNull As Long
If Len(InString) > 0 Then
iNull = InStrRev(InString, vbNullChar)
Select Case iNull
Case 0: StripNull = InString
Case 1: StripNull = ""
Case Else: StripNull = Left$(InString, iNull - 1)
End Select
End If
End Function
Public Function StringRepeatAPI(sStr As String, lNum As Long) As String
Dim j As Long
Dim s As String
s = Space$(lNum * Len(sStr) + 1)
j = 0
Do
j = StrCatChainW(StrPtr(s), Len(s), j, StrPtr(sStr))
Loop Until j = Len(s) - 1
StringRepeatAPI = StripNull(s)
End Function
-
May 25th, 2021, 09:17 AM
#12
Re: The fastest StringRepeat algorithm
Another one (i'm bored)
Also in Excel/VBA
Code:
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Function RepeatString(ByRef InString, ByVal NumTimes As Long) As String
Dim src() As Byte
Dim srclen As Long
Dim dst() As Byte
Dim i As Long
src = InString
srclen = UBound(src) + 1
ReDim dst(NumTimes * srclen - 1)
For i = 0 To NumTimes - 1
CopyMemory dst(i * srclen), src(0), srclen
Next
RepeatString = dst
End Function
Sub main()
Debug.Print RepeatString("Hello World!", 5)
End Sub
Last edited by Zvoni; Tomorrow at 31:69 PM.
----------------------------------------------------------------------------------------
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------------------
People call me crazy because i'm jumping out of perfectly fine airplanes.
---------------------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad
-
May 25th, 2021, 09:21 AM
#13
Re: The fastest StringRepeat algorithm
Originally Posted by Arnoutdv
Simple test results, compiled (Fast code only):
My one-liner is *not* the JS algorithm.
Here is the JS translated
Code:
Public Function StringRepeatFast(sStr As String, ByVal lNum As Long) As String
Dim sChunk As String
Dim lPos As Long
StringRepeatFast = String(Len(sStr) * lNum, 0)
sChunk = sStr
Do While lNum > 0
If (lNum And 1) <> 0 Then
Mid(StringRepeatFast, lPos + 1, Len(sChunk)) = sChunk
lPos = lPos + Len(sChunk)
End If
sChunk = sChunk & sChunk
lNum = lNum / 2
Loop
End Function
Again not very fast unfortunately.
@Arnoutdv: You can test all functions like this
Code:
For i = 10000 To 20000
a = StringRepeatFast(s, i)
Next i
. . . with variable i as repeat number parameter, not a constant n = 25.
cheers,
</wqw>
-
May 25th, 2021, 09:26 AM
#14
Re: The fastest StringRepeat algorithm
Originally Posted by wqweto
My one-liner is *not* the JS algorithm.
Hahaha, that's not what I was thinking
But the translation of JS algo is also doing multiple concats on sStr, so this must be slower due to allocation then filling the buffer with lNum steps.
I assume the JS engine has the same problem.
-
May 25th, 2021, 09:33 AM
#15
Re: The fastest StringRepeat algorithm
I gave it a shot. My first attempt was similar to Arnoutdv/Passel's, but then I tried doubling the size of data to copy on each pass and pulling the data from the destination buffer on each loop and the time improved significantly (more than twice as fast in my tests). Code is lightly tested and may have bugs, so use at your own risk!
Code:
Option Explicit
Private Declare Function StrCatChainW Lib "shlwapi" (ByVal Dest As Long, ByVal DestSize As Long, ByVal offset As Long, ByVal Source As Long) As Long
Public Function StripNull(ByVal InString As String) As String
'Input: String containing null terminator (Chr(0))
'Returns: all character before the null terminator
Dim iNull As Long
If Len(InString) > 0 Then
iNull = InStr(InString, vbNullChar)
Select Case iNull
Case 0
StripNull = InString
Case 1
StripNull = ""
Case Else
StripNull = Left$(InString, iNull - 1)
End Select
End If
End Function
Function StringRepeatZvoni(Str As String, Num As Long) As String
Dim j As Long
StringRepeatZvoni = String(Num * Len(Str) + 1, " ")
Do
j = StrCatChainW(StrPtr(StringRepeatZvoni), Len(StringRepeatZvoni), j, StrPtr(Str))
Loop Until j = Len(StringRepeatZvoni) - 1
StringRepeatZvoni = StripNull(StringRepeatZvoni)
End Function
Public Function StringRepeatJpbro2(ByVal p_String As String, ByVal p_RepeatCount As Long) As String
Dim ll As Long
Dim jj As Long
If p_RepeatCount > 0 Then
ll = Len(p_String)
If ll Then
StringRepeatJpbro2 = Space$(ll * p_RepeatCount)
Mid$(StringRepeatJpbro2, 1, ll) = p_String
jj = ll + 1
Do While ll < Len(StringRepeatJpbro2)
Mid$(StringRepeatJpbro2, jj) = Mid$(StringRepeatJpbro2, 1, ll)
ll = ll + ll
jj = ll + 1
Loop
End If
End If
End Function
Public Function StringRepeatJpbro1(ByVal p_String As String, ByVal p_RepeatCount As Long) As String
Dim ll As Long
Dim ii As Long
If p_RepeatCount > 0 Then
ll = Len(p_String)
If ll Then
StringRepeatJpbro1 = Space$(ll * p_RepeatCount)
For ii = 1 To Len(StringRepeatJpbro1) Step ll
Mid$(StringRepeatJpbro1, ii, ll) = p_String
Next ii
End If
End If
End Function
Function stringRepeatPassel(Str As String, Num As Long) As String
Dim strLength As Long
strLength = Len(Str)
Dim ptr As Long
Dim tmpString As String
tmpString = Space$(strLength * Num)
Dim i As Long
ptr = 1
For i = 1 To Num
Mid$(tmpString, ptr, strLength) = Str
ptr = ptr + strLength
Next
stringRepeatPassel = tmpString
End Function
Function StringRepeatWqweto(Str As String, Num As Long) As String
StringRepeatWqweto = Replace$(Space$(Num), " ", Str)
End Function
Public Function StringRepeatArnoutdv(sStr As String, lNum As Long) As String
Dim i As Long
Dim lLen As Long, lPos As Long
lLen = Len(sStr)
StringRepeatArnoutdv = Space$(lLen * lNum)
lPos = 1
For i = 0 To lNum - 1
Mid$(StringRepeatArnoutdv, lPos, lLen) = sStr
lPos = lPos + lLen
Next i
End Function
Sample timings (100,000 loops):
-
May 25th, 2021, 09:47 AM
#16
Re: The fastest StringRepeat algorithm
String operations in JS are optimized for extreme speeds. V8 team made miracles to make JS very fast. It is even recommend not to use JSON natively (yes, it is JavaScript) but parse JSON strings as it is the faster way to load such data:
Also comparing 20+ years old VB6 generated instructions to current latest CPU JIT generated code is ... not comparable.
-
May 25th, 2021, 09:57 AM
#17
Re: The fastest StringRepeat algorithm
I test all methods.
For Num=10000 To 20000 Step 5
Code:
---------------------------
Project1
---------------------------
StringRepeat StringBuffer Arnout+Passel: 609ms
StringRepeat StrCat (zvoni): 922ms
StringRepeat one-liner (wqweto): 4.797ms
StringRepeat JS (wqweto): 906ms
StringRepeat CopyMem (zvoni): 1.156ms
StringRepeat Jpbro2: 282ms
---------------------------
OK
---------------------------
Clever combination of methods jpbro!
-
May 25th, 2021, 10:18 AM
#18
Re: The fastest StringRepeat algorithm
Originally Posted by Arnoutdv
Clever combination of methods jpbro!
Thanks! The original Javascript code is still king when run in a browser. 100,000 JS loops takes about 20ms vs. 70ms for my VB6 attempt (compiled with all optimizations turned on).
-
May 25th, 2021, 11:03 AM
#19
Re: The fastest StringRepeat algorithm
StringRepeatJpbro2 above is a masterpiece -- the honey-badger of Mid$ operator.
It's faster even then rep movsb as on each iteration it always copies from "hot" CPU cache (the source location remains the same).
The overhead compared to JS comes from the final BSTR allocation, not from the concatenations.
cheers,
</wqw>
-
May 25th, 2021, 12:34 PM
#20
Re: The fastest StringRepeat algorithm
Not sure I see the controversy here.
This is the most obvious course after naïve concatenation. It's concise and should be fast enough for most purposes:
Code:
Private Function StrRepeat(ByRef Repeated As String, ByVal Count As Long) As String
Dim Length As Long
Dim I As Long
If Count > 0 Then
Length = Len(Repeated)
StrRepeat = Space$(Length * Count)
For I = 1 To Length * (Count - 1) + 1 Step Length
Mid$(StrRepeat, I) = Repeated
Next
End If
End Function
Yes, I realize it just parrots answers given above.
-
May 25th, 2021, 12:53 PM
#21
Re: The fastest StringRepeat algorithm
Originally Posted by wqweto
StringRepeatJpbro2 above is a masterpiece -- the honey-badger of Mid$ operator.
Wow! Thank you for the high praise
I took one more stab at it and I was able to speed things up a bit more by taking a slightly different approach. I still double the chunk size on each loop, but instead of using Mid$, I tried overlaying safearrays on the source & buffer strings and then use RtlMoveMemory to copy the source array into the buffer array. I get about a 30% improvement with this approach over my previous attempt. It's still just under half the speed of JS, but it might be the best I can do.
Code:
Option Explicit
' SafeArray code courtesy of Bonnie West at https://www.vbforums.com/showthread.php?729385-VB6-clsStrToIntArray-cls-Cast-String-To-Integer-Array
Public Const FADF_AUTO As Integer = &H1 'An array that is allocated on the stack.
Public Const FADF_FIXEDSIZE As Integer = &H10 'An array that may not be resized or reallocated.
Public Type SAFEARRAY1D 'Represents a safe array. (One Dimensional)
cDims As Integer 'The count of dimensions.
fFeatures As Integer 'Flags used by the SafeArray.
cbElements As Long 'The size of an array element.
cLocks As Long 'The number of times the array has been locked without a corresponding unlock.
pvData As Long 'Pointer to the data.
cElements As Long 'The number of elements in the dimension.
lLbound As Long 'The lower bound of the dimension.
End Type 'https://msdn.microsoft.com/en-us/library/ms221482(v=vs.85).aspx
Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef ArrayVar() As Any) As Long
Public Declare Sub PutMem4 Lib "msvbvm60.dll" (ByVal addr As Long, ByVal NewVal As Long)
Private Declare Sub CopyMemoryLong Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Function StringRepeatJpbro3(ByVal p_String As String, ByVal p_RepeatCount As Long) As String
Dim lt_Buff As SAFEARRAY1D
Dim lt_Src As SAFEARRAY1D
Dim la_Buff() As Integer
Dim la_Src() As Integer
Dim l_LenSrc As Long
Dim l_LenBuff As Long
Dim ii As Long
If p_RepeatCount < 0 Then Err.Raise 5, , "Repeat count must be >0"
If p_RepeatCount = 0 Then Exit Function ' Nothing to repeat, short-circuit
l_LenSrc = Len(p_String)
If l_LenSrc = 0 Then Exit Function ' Nothing to repeat, short-circuit
' Prepare the output buffer
l_LenBuff = l_LenSrc * p_RepeatCount
StringRepeatJpbro3 = Space$(l_LenBuff)
' Overlay safearrays on source and buffer strings
With lt_Buff
.cDims = 1
.fFeatures = FADF_AUTO Or FADF_FIXEDSIZE
.cbElements = 2&
.cLocks = 1&
.lLbound = 1&
.pvData = StrPtr(StringRepeatJpbro3)
.cElements = l_LenBuff
End With
PutMem4 VarPtrArray(la_Buff), VarPtr(lt_Buff)
With lt_Src
.cDims = 1
.fFeatures = FADF_AUTO Or FADF_FIXEDSIZE
.cbElements = 2&
.cLocks = 1&
.lLbound = 1&
.pvData = StrPtr(p_String)
.cElements = l_LenSrc
End With
PutMem4 VarPtrArray(la_Src), VarPtr(lt_Src)
' Copy the first chunk to the beginning of the buffer
CopyMemoryLong VarPtr(la_Buff(1)), VarPtr(la_Src(1)), l_LenSrc * 2
' Copy remaining chunks to the buffer, doubling the size on each loop and pulling from our existing buffer
For ii = l_LenSrc + 1 To l_LenBuff
CopyMemoryLong VarPtr(la_Buff(ii)), VarPtr(la_Buff(1)), l_LenSrc * 2 ' Copy next chunk from start of buffer to the buffer insert point
ii = ii + l_LenSrc - 1 'Set the next buffer insert point
l_LenSrc = l_LenSrc * 2 ' Double the chunk size
If l_LenSrc > l_LenBuff - ii Then l_LenSrc = l_LenBuff - ii ' We can't copy too much data! So make sure we won't overrun our buffer
Next ii
' Cleanup
PutMem4 VarPtrArray(la_Buff), 0&
PutMem4 VarPtrArray(la_Src), 0&
End Function
-
May 25th, 2021, 12:58 PM
#22
Re: The fastest StringRepeat algorithm
And here are the latest timings including Dilettante's & my latest attempts. 100,000 runs compiled to native code with all the usual optimizations enabled:
-
May 25th, 2021, 01:53 PM
#23
Re: The fastest StringRepeat algorithm
Last edited by Zvoni; Tomorrow at 31:69 PM.
----------------------------------------------------------------------------------------
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------------------
People call me crazy because i'm jumping out of perfectly fine airplanes.
---------------------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad
-
May 25th, 2021, 03:28 PM
#24
Re: The fastest StringRepeat algorithm
I was a little bored so I added a parameter that I thought might be useful for this method. This latest version includes an optional "Delimiter" parameter where you can define a string that will be inserted between every repeated string (except for the last). This is useful for things like generating SQL command queries, e.g.:
Code:
ArrayOfFieldNames = Split("[Field1] [Field2] [Field3] [Field4]", " ")
l_Sql = "INSERT INTO mytable (" & Join$(ArrayOfFieldNames, ", ") & ") VALUES (" & StringRepeat("?", UBound(ArrayOfFieldNames)-LBound(ArrayOfFieldNames) + 1, ", ") & ")"
This will generate the following string
Code:
INSERT INTO mytable ([Field1], [Field2], [Field3], [Field4]) VALUES (?, ?, ?, ?)
Even with this addition, the performance is about the same. Hope somebody finds it useful!
Code:
Option Explicit
Public Const FADF_AUTO As Integer = &H1 'An array that is allocated on the stack.
Public Const FADF_FIXEDSIZE As Integer = &H10 'An array that may not be resized or reallocated.
Public Type SAFEARRAY1D 'Represents a safe array. (One Dimensional)
cDims As Integer 'The count of dimensions.
fFeatures As Integer 'Flags used by the SafeArray.
cbElements As Long 'The size of an array element.
cLocks As Long 'The number of times the array has been locked without a corresponding unlock.
pvData As Long 'Pointer to the data.
cElements As Long 'The number of elements in the dimension.
lLbound As Long 'The lower bound of the dimension.
End Type 'https://msdn.microsoft.com/en-us/library/ms221482(v=vs.85).aspx
Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef ArrayVar() As Any) As Long
Public Declare Sub PutMem4 Lib "msvbvm60.dll" (ByVal addr As Long, ByVal NewVal As Long)
Private Declare Sub CopyMemoryLong Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Public Function StringRepeat(ByVal p_String As String, ByVal p_RepeatCount As Long, Optional ByVal p_Delimiter As String = "") As String
Dim lt_Buff As SAFEARRAY1D
Dim la_Buff() As Integer
Dim l_LenSrc As Long
Dim l_LenBuff As Long
Dim l_LenDelim As Long
Dim ii As Long
If p_RepeatCount < 0 Then Err.Raise 5, , "Repeat count must be >0"
If p_RepeatCount = 0 Then Exit Function ' Nothing to repeat, short-circuit
l_LenSrc = Len(p_String)
If l_LenSrc = 0 Then Exit Function ' Nothing to repeat, short-circuit
l_LenDelim = Len(p_Delimiter)
' Prepare the output buffer
l_LenBuff = l_LenSrc * p_RepeatCount + l_LenDelim * (p_RepeatCount - 1)
StringRepeat = Space$(l_LenBuff)
' Overlay safearrays on source and buffer strings
With lt_Buff
.cDims = 1
.fFeatures = FADF_AUTO Or FADF_FIXEDSIZE
.cbElements = 2&
.cLocks = 1&
.lLbound = 1&
.pvData = StrPtr(StringRepeat)
.cElements = l_LenBuff
End With
PutMem4 VarPtrArray(la_Buff), VarPtr(lt_Buff)
' Copy the first chunk to the beginning of the buffer
CopyMemoryLong VarPtr(la_Buff(1)), StrPtr(p_String), l_LenSrc * 2
' Handle delimiter if defined
If l_LenDelim Then
If l_LenSrc < l_LenBuff Then
' Copy the delimiter into the buffer and make the source len include the delimiter len
CopyMemoryLong VarPtr(la_Buff(l_LenSrc + 1)), StrPtr(p_Delimiter), l_LenDelim * 2 ' Copy next chunk from start of buffer to the buffer insert point
l_LenSrc = l_LenSrc + l_LenDelim
End If
End If
' Copy remaining chunks to the buffer, doubling the size on each loop and pulling from our existing buffer
For ii = l_LenSrc + 1 To l_LenBuff
CopyMemoryLong VarPtr(la_Buff(ii)), VarPtr(la_Buff(1)), l_LenSrc * 2 ' Copy next chunk from start of buffer to the buffer insert point
ii = ii + l_LenSrc - 1 'Set the next buffer insert point
l_LenSrc = l_LenSrc + l_LenSrc ' Double the chunk size
' We can't copy too much data! So make sure we won't overrun our buffer
If ii < l_LenBuff Then If l_LenSrc > l_LenBuff - ii Then l_LenSrc = l_LenBuff - ii
Next ii
' Cleanup
PutMem4 VarPtrArray(la_Buff), 0&
End Function
-
May 25th, 2021, 09:50 PM
#25
Re: The fastest StringRepeat algorithm
@Eduardo - your attachment isn't working, but did you try the timing with a compiled native code EXE with all optimizations selected except "Assume no aliasing"?
EDIT: Eduardo - your entire post disappeared?
-
May 25th, 2021, 10:12 PM
#26
Re: The fastest StringRepeat algorithm
Originally Posted by jpbro
did you try the timing with a compiled native code EXE with all optimizations selected except "Assume no aliasing"?
I tried with all optimizations, including "Assume no aliasing".
But I discovered the reason, it is that you are testing with 25 repeat count, and I was testing with 5.
It seems that the one from Arnoutdv is faster for small counts (dilettante's one is close), but yours go to the head for counts > 20
-
May 25th, 2021, 11:15 PM
#27
Re: The fastest StringRepeat algorithm
Thanks for the clarifications Eduardo. I've tried smaller repeat counts here and I can reproduce your results. I think it might be best to "tune" the method by picking the appropriate algorithm for lower/higher repeat values. I'll give it a shot and post back here.
-
May 26th, 2021, 12:58 AM
#28
Addicted Member
Re: The fastest StringRepeat algorithm
-
May 26th, 2021, 01:47 AM
#29
Re: The fastest StringRepeat algorithm
Wow, I added Replicate05 from vbspeed.
And something unexpected is in here.
The 2nd single Mid$ statement replicates the complete sequence in one go! The help doesn't help me out to explain.
For Num=10000 To 20000 Step 5
The results:
Code:
---------------------------
Project1
---------------------------
StringRepeat StringBuffer Arnout+Passel: 610ms
StringRepeat StrCat (zvoni): 1.187ms
StringRepeat one-liner (wqweto): 4.672ms
StringRepeat JS (wqweto): 781ms
StringRepeat CopyMem (zvoni): 1.078ms
StringRepeat Jpbro2: 282ms
StringRepeat Replicate05: 250ms
---------------------------
OK
---------------------------
Code:
Public Function Replicate05(Pattern$, ByVal Number&) As String
' by Donald, donald@xbeat.net, 20001206, rev 002
' based on Replicate03 by Larry Serflaten, serflaten@usinternet.com, 20001206
Dim LP As Long
If Number > 0 Then
LP = Len(Pattern)
Select Case LP
Case Is > 1
Replicate05 = Space$(Number * LP)
Mid$(Replicate05, 1, LP) = Pattern
If Number > 1 Then
Mid$(Replicate05, LP + 1) = Replicate05
End If
Case 1
Replicate05 = String$(Number, Pattern)
End Select
End If
End Function
-
May 26th, 2021, 02:14 AM
#30
Re: The fastest StringRepeat algorithm
jpbro,
i noticed something peculiar with the StrCatChainAPI.
could you replace my function with this one and test?
Code:
Function StringRepeatZvoni(Str As String, Num As Long) As String
Dim j As Long
If Num > 0 Then
StringRepeatZvoni = String(Num * Len(Str) + 1, " ")
j = StrCatChainW(StrPtr(StringRepeatZvoni), Len(StringRepeatZvoni), j, StrPtr(Str))
j = StrCatChainW(StrPtr(StringRepeatZvoni), Len(StringRepeatZvoni), j, StrPtr(StringRepeatZvoni))
StringRepeatZvoni = StripNull(StringRepeatZvoni)
End If
End Function
Last edited by Zvoni; Tomorrow at 31:69 PM.
----------------------------------------------------------------------------------------
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------------------
People call me crazy because i'm jumping out of perfectly fine airplanes.
---------------------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad
-
May 26th, 2021, 02:17 AM
#31
Re: The fastest StringRepeat algorithm
This Mid$(Replicate05, LP + 1) = Replicate05 translates roughly to memcpy with overlapping source and destination.
I previously did some tests with memcpy from msvcrt.dll but because in C/C++ memcpy with overlapping buffers is undefined behavior the MSVC runtime decided to implement memcpy with memmove semantics so it was not working.
Then I tried _memccpy and it does use rep movsb with overlapping buffers but the cdecl incurred error handling overhead (stack corrupted) so the performance was lacking compared to jpbro2.
Using Mid$ operator with overlapping buffers is news to me -- nice hack!
Edit: Actually this implementation is so compact it can be inlined with 2 lines of code like this
Code:
Option Explicit
Private Sub Form_Load()
Dim lCount As Long
Dim sPattern As String
Dim sReplicate As String
'--- have these available
lCount = 100
sPattern = "test"
'--- inline replicate in 2 lines
sReplicate = sPattern & Space$((lCount - 1) * Len(sPattern))
Mid$(sReplicate, Len(sPattern) + 1) = sReplicate
'--- checkout result
Debug.Print sReplicate
End Sub
cheers,
</wqw>
Last edited by wqweto; May 26th, 2021 at 02:30 AM.
-
May 26th, 2021, 02:25 AM
#32
Re: The fastest StringRepeat algorithm
Originally Posted by Zvoni
jpbro,
i noticed something peculiar with the StrCatChainAPI.
could you replace my function with this one and test?
Code:
Function StringRepeatZvoni(Str As String, Num As Long) As String
Dim j As Long
If Num > 0 Then
StringRepeatZvoni = String(Num * Len(Str) + 1, " ")
j = StrCatChainW(StrPtr(StringRepeatZvoni), Len(StringRepeatZvoni), j, StrPtr(Str))
j = StrCatChainW(StrPtr(StringRepeatZvoni), Len(StringRepeatZvoni), j, StrPtr(StringRepeatZvoni))
StringRepeatZvoni = StripNull(StringRepeatZvoni)
End If
End Function
I think because of the StripNull you have a lot of overhead, another string copy
Code:
Private Function StripNull(ByVal InString As String) As String
'Input: String containing null terminator (Chr(0))
'Returns: all character before the null terminator
Dim iNull As Long
If Len(InString) > 0 Then
iNull = InStrRev(InString, vbNullChar)
Select Case iNull
Case 0: StripNull = InString
Case 1: StripNull = ""
Case Else: StripNull = Left$(InString, iNull - 1)
End Select
End If
End Function
---------------------------
Project1
---------------------------
StringRepeat StringBuffer Arnout+Passel: 593ms
StringRepeat StrCat (zvoni): 860ms
StringRepeat one-liner (wqweto): 4.922ms
StringRepeat JS (wqweto): 797ms
StringRepeat CopyMem (zvoni): 1.156ms
StringRepeat Jpbro2: 265ms
StringRepeat Replicate05: 250ms
StringRepeat StringRepeatZvoni: 547ms
---------------------------
OK
---------------------------
-
May 26th, 2021, 02:29 AM
#33
Re: The fastest StringRepeat algorithm
Arnout,
thx.
An improvement at least... :-)
If i'm reading this right, i get the bronze medal
I think because of the StripNull you have a lot of overhead, another string copy
I think so, too, but it was the only way to get rid of the trailing Null-Char i could find in the short time.
Last edited by Zvoni; Tomorrow at 31:69 PM.
----------------------------------------------------------------------------------------
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------------------
People call me crazy because i'm jumping out of perfectly fine airplanes.
---------------------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad
-
May 26th, 2021, 02:32 AM
#34
Re: The fastest StringRepeat algorithm
I added the vbNullChar removement to the StringRepeatZvoni function and the speed increased a little, but still you have the additional assignment / copy
Code:
Function StringRepeatZvoni(Str As String, Num As Long) As String
Dim j As Long
If Num > 0 Then
StringRepeatZvoni = String(Num * Len(Str) + 1, " ")
j = StrCatChainW(StrPtr(StringRepeatZvoni), Len(StringRepeatZvoni), j, StrPtr(Str))
j = StrCatChainW(StrPtr(StringRepeatZvoni), Len(StringRepeatZvoni), j, StrPtr(StringRepeatZvoni))
j = InStrRev(StringRepeatZvoni, vbNullChar)
If j > 0 Then
StringRepeatZvoni = Left$(StringRepeatZvoni, j - 1)
End If
End If
End Function
---------------------------
Project1
---------------------------
StringRepeat StringBuffer Arnout+Passel: 593ms
StringRepeat StrCat (zvoni): 1.172ms
StringRepeat one-liner (wqweto): 4.781ms
StringRepeat JS (wqweto): 860ms
StringRepeat CopyMem (zvoni): 1.094ms
StringRepeat Jpbro2: 265ms
StringRepeat Replicate05: 266ms
StringRepeat StringRepeatZvoni: 469ms
---------------------------
OK
---------------------------
-
May 26th, 2021, 02:37 AM
#35
Re: The fastest StringRepeat algorithm
Originally Posted by Zvoni
If i'm reading this right, i get the bronze medal
Wait. . .
:-)),
</wqw>
-
May 26th, 2021, 05:57 AM
#36
Re: The fastest StringRepeat algorithm
Code:
Public Function StrRepeatChrisE1(ByRef Text As String, ByVal Count As Long) As String
Dim lLength As Long
If Count > 0 Then
lLength = Len(Text)
If lLength > 1 Then
If Count > 1 Then
StrRepeatChrisE1 = Space$(lLength * Count)
Mid$(StrRepeatChrisE1, 1) = Text
Mid$(StrRepeatChrisE1, lLength + 1) = StrRepeatChrisE1
ElseIf Count = 1 Then
StrRepeatChrisE1 = Text
End If
ElseIf lLength = 1 Then
StrRepeatChrisE1 = String$(Count, Text)
End If
End If
End Function
Public Function StrRepeatChrisE2(ByRef Text As String, ByVal Count As Long) As String
If Count = 0 Then Exit Function
If LenB(Text) = 0 Then Exit Function
If LenB(Text) > 2 Then
StrRepeatChrisE2 = Space$(Len(Text) * Count)
Mid$(StrRepeatChrisE2, 1) = Text
If Count > 1 Then
Mid$(StrRepeatChrisE2, Len(Text) + 1) = StrRepeatChrisE2
End If
Else
StrRepeatChrisE2 = String$(Count, Text)
End If
End Function
to hunt a species to extinction is not logical !
since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.
-
May 26th, 2021, 10:17 AM
#37
Thread Starter
Frenzied Member
-
May 26th, 2021, 10:18 AM
#38
Thread Starter
Frenzied Member
Re: The fastest StringRepeat algorithm
Last edited by SearchingDataOnly; May 26th, 2021 at 10:34 AM.
-
May 26th, 2021, 06:08 PM
#39
Re: The fastest StringRepeat algorithm
Of course if you don't validate for correctness you may be giving credit to bogus "solutions."
-
May 26th, 2021, 07:58 PM
#40
Thread Starter
Frenzied Member
Re: The fastest StringRepeat algorithm
Originally Posted by dilettante
Of course if you don't validate for correctness you may be giving credit to bogus "solutions."
In fact, I mainly want to know how big the gap between VB6 and JavaScript is in the processing of strings, so I did not study the details of the above code carefully. Jpbro has also surprised me many times before.
When I saw the JavaScript code in post#1, I guessed intuitively that its performance might be very high. So, I want to know whether VB6 can provide a comparable solution.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|