Page 1 of 2 12 LastLast
Results 1 to 40 of 55

Thread: [RESOLVED] The fastest StringRepeat algorithm

  1. #1

    Thread Starter
    Frenzied Member
    Join Date
    Aug 2020
    Posts
    1,421

    Resolved [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;
    }

  2. #2
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,871

    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

  3. #3
    Sinecure devotee
    Join Date
    Aug 2013
    Location
    Southern Tier NY
    Posts
    6,582

    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

  4. #4
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    4,415

    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

  5. #5

    Thread Starter
    Frenzied Member
    Join Date
    Aug 2020
    Posts
    1,421

    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.

  6. #6
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: The fastest StringRepeat algorithm

    Quote Originally Posted by SearchingDataOnly View Post
    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>

  7. #7

    Thread Starter
    Frenzied Member
    Join Date
    Aug 2020
    Posts
    1,421

    Re: The fastest StringRepeat algorithm

    Quote Originally Posted by wqweto View Post
    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.

  8. #8
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,871

    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.

  9. #9
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    4,415

    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

  10. #10
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: The fastest StringRepeat algorithm

    Quote Originally Posted by SearchingDataOnly View Post
    . . . 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>

  11. #11
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,871

    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

  12. #12
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    4,415

    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

  13. #13
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: The fastest StringRepeat algorithm

    Quote Originally Posted by Arnoutdv View Post
    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>

  14. #14
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,871

    Re: The fastest StringRepeat algorithm

    Quote Originally Posted by wqweto View Post
    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.

  15. #15
    PowerPoster
    Join Date
    Aug 2010
    Location
    Canada
    Posts
    2,412

    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):

    Name:  StringRepeatTimings.jpg
Views: 387
Size:  11.0 KB

  16. #16
    Fanatic Member
    Join Date
    Jun 2019
    Posts
    557

    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.

  17. #17
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,871

    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!

  18. #18
    PowerPoster
    Join Date
    Aug 2010
    Location
    Canada
    Posts
    2,412

    Re: The fastest StringRepeat algorithm

    Quote Originally Posted by Arnoutdv View Post
    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).

  19. #19
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    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>

  20. #20
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    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.

  21. #21
    PowerPoster
    Join Date
    Aug 2010
    Location
    Canada
    Posts
    2,412

    Re: The fastest StringRepeat algorithm

    Quote Originally Posted by wqweto View Post
    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

  22. #22
    PowerPoster
    Join Date
    Aug 2010
    Location
    Canada
    Posts
    2,412

    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:

    Name:  StringRepeatTimings2.jpg
Views: 302
Size:  16.1 KB

  23. #23
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    4,415

    Re: The fastest StringRepeat algorithm

    Very nice
    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

  24. #24
    PowerPoster
    Join Date
    Aug 2010
    Location
    Canada
    Posts
    2,412

    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

  25. #25
    PowerPoster
    Join Date
    Aug 2010
    Location
    Canada
    Posts
    2,412

    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?

  26. #26
    PowerPoster
    Join Date
    Feb 2017
    Posts
    4,995

    Re: The fastest StringRepeat algorithm

    Quote Originally Posted by jpbro View Post
    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

  27. #27
    PowerPoster
    Join Date
    Aug 2010
    Location
    Canada
    Posts
    2,412

    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.

  28. #28
    Addicted Member gilman's Avatar
    Join Date
    Jan 2017
    Location
    Bilbao
    Posts
    176

    Re: The fastest StringRepeat algorithm


  29. #29
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,871

    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

  30. #30
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    4,415

    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

  31. #31
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    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>

  32. #32
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,871

    Re: The fastest StringRepeat algorithm

    Quote Originally Posted by Zvoni View Post
    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
    ---------------------------

  33. #33
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    4,415

    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

  34. #34
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,871

    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
    ---------------------------

  35. #35

  36. #36
    PowerPoster ChrisE's Avatar
    Join Date
    Jun 2017
    Location
    Frankfurt
    Posts
    3,040

    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.

  37. #37

    Thread Starter
    Frenzied Member
    Join Date
    Aug 2020
    Posts
    1,421

    Re: The fastest StringRepeat algorithm

    Below are my test results: (RC6 seems to have nothing to do with string processing. It would be great if RC6 could add some efficient string processing functions)
    Attached Images Attached Images  
    Attached Files Attached Files

  38. #38

    Thread Starter
    Frenzied Member
    Join Date
    Aug 2020
    Posts
    1,421

    Re: The fastest StringRepeat algorithm

    Hi jpbro,
    You are the champion.

    Quote Originally Posted by Zvoni View Post
    If i'm reading this right, i get the bronze medal
    The bronze medal was snatched by ChrisE.

    In addition, we have to be amazed by JavaScript.
    Last edited by SearchingDataOnly; May 26th, 2021 at 10:34 AM.

  39. #39
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: The fastest StringRepeat algorithm

    Of course if you don't validate for correctness you may be giving credit to bogus "solutions."

  40. #40

    Thread Starter
    Frenzied Member
    Join Date
    Aug 2020
    Posts
    1,421

    Re: The fastest StringRepeat algorithm

    Quote Originally Posted by dilettante View Post
    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.

Page 1 of 2 12 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width