VBspeed / String / Replicate
VBspeed © 2000-10, updated: 29-Sep-2002
Replicate


The Definition
Function Replicate
Returns a pattern replicated in a string a specified number of times.
Comes down to an enhanced version of VB's native String$ function, that does not allow more than one character to be repeated.
Declaration:
Replicate(Number, Pattern)
Arguments:
NumberRequired. Number of replications desired.
PatternRequired. Character pattern to replicate.
Example:
Replicate(3, "abc") => "abcabcabc"
You may use this function (VB5/6-compatible) to verify the correctness of your code.


The Charts
Calls
 sRet = Replicate(Number, Pattern)
Call 1 Number = 10
Pattern = "abc"
Call 2 Number = 10000
Pattern = "abc"
Call 3 Number = 10
Pattern = Replicate(100, "abcdefhgij")   [=1000 chars]
Call 4 Number = 10000
Pattern = "a"   [you would normally do this job with String$, of course]

Note that the first versions of Replicate02/03/05 did not work correctly on this call under VB6 (only!). Below you find the revised versions.
 VB5
CodeAuthorDopingNotes
Replicate01 Donald  
Replicate02 Larry  
Replicate03 Larry  
Replicate04 GuidoTLB 
Replicate05 Donald  
Replicate06 DonaldTLB 
Replicate07 Peter  
Replicate08 NickAPI 
Replicate09 MikeAPI 
Replicate10 MarzoTLB 
Replicate11 DonaldAPI,TLB 
Replicate12 MarzoTLB 
Replicate13 PaulTLB 
Replicate14 MarzoTLB 
Call 1
122.250.670µs
111.840.548µs
91.780.529µs
81.700.505µs
41.290.384µs
51.350.401µs
71.390.413µs
61.370.406µs
1311.713.483µs
101.780.531µs
31.180.351µs
21.080.322µs
X1.010.300µs
11.000.297µs
Call 2
136.75540µs
123.69295µs
113.31265µs
102.63211µs
82.33187µs
92.43194µs
72.34187µs
41.2399µs
11.0080µs
51.29103µs
62.06165µs
31.2197µs
X0.5544µs
21.2197µs
Call 3
1012.3053.169µs
1213.6659.084µs
1313.7559.434µs
1113.0756.504µs
912.2953.148µs
711.8151.068µs
812.2853.092µs
51.737.484µs
62.9412.705µs
41.436.164µs
31.144.945µs
21.024.409µs
X1.054.542µs
11.004.324µs
Call 4
13123.15407.122µs
81.053.473µs
11.003.306µs
1117.3957.479µs
41.013.330µs
1218.1660.031µs
31.003.318µs
92.387.853µs
109.4231.150µs
71.023.370µs
51.003.322µs
61.023.364µs
X1.384.564µs
21.003.313µs
 VB6
CodeAuthorDopingNotes
Replicate01 Donald  
Replicate02 Larry  
Replicate03 Larry  
Replicate04 GuidoTLB 
Replicate05 Donald  
Replicate06 DonaldTLB 
Replicate07 Peter  
Replicate08 NickAPI 
Replicate09 MikeAPI 
Replicate10 MarzoTLB 
Replicate11 DonaldAPI,TLB 
Replicate12 MarzoTLB 
Replicate13 PaulTLB 
Replicate14 MarzoTLB 
Call 1
122.440.751µs
101.840.567µs
91.800.555µs
71.380.424µs
51.160.357µs
41.060.327µs
61.340.412µs
81.420.436µs
1311.433.524µs
111.850.571µs
21.030.316µs
31.030.319µs
X0.960.298µs
11.000.308µs
Call 2
1325.89657µs
129.00228µs
96.58167µs
11.0025µs
116.67169µs
64.25108µs
106.67169µs
41.4236µs
74.81122µs
51.4437µs
85.74146µs
31.1128µs
X3.5189µs
21.1128µs
Call 3
101.888.295µs
112.8412.548µs
122.8612.670µs
41.044.579µs
81.838.098µs
21.004.437µs
91.858.184µs
71.707.496µs
133.0513.476µs
61.597.036µs
51.114.908µs
11.004.422µs
X1.044.590µs
31.014.445µs
Call 4
13163.87545.473µs
81.063.534µs
21.003.324µs
91.545.120µs
11.003.329µs
1210.4934.916µs
31.013.346µs
102.387.920µs
119.4531.457µs
61.043.446µs
51.003.330µs
41.013.353µs
X1.374.576µs
71.023.382µs
Conclusions
  • A weird situation ... impossible to name an overall winner. Both the nature of the test call and the VB-version highly influence the results, and it's even hard to see a pattern in the distribution of the numbers. For example: Why is Replicate04 so extraordinarily good at Call 2 under VB6??? (under Win95 as well as XP!)
  • Note that, contrary to most other disciplines, VB6 looks very good here compared to VB5. Why??
Mail your code! How to read all those numbers


The Code
Replicate01
submitted 05-Dec-2000 by Donald Lessau  
Doping: none
Public Function Replicate01(ByVal Number&, Pattern$) As String
' by Donald, donald@xbeat.net, 20001205
  Dim lenPattern As Long
  Dim posTarget As Long
  
  If Number > 0 Then
    lenPattern = Len(Pattern)
    If lenPattern Then
      Replicate01 = Space$(Number * lenPattern)
      For posTarget = 1 To Number * lenPattern Step lenPattern
        Mid$(Replicate01, posTarget) = Pattern
      Next
    End If
  End If

End Function
Author's comments:
Donald's comments:

top | charts


Replicate02
submitted 05-Dec-2000 by Larry Serflaten  
Doping: none
Public Function Replicate02(ByVal Number&, Pattern$) As String
' by Larry Serflaten, serflaten@usinternet.com, 20001205, rev 002
  
  If Number > 0 Then
    If Len(Pattern) = 1 Then
      Replicate02 = String$(Number, Pattern)
    Else
      Replicate02 = Pattern & Space$((Number - 1) * Len(Pattern))
      If Len(Replicate02) > Len(Pattern) Then
        Mid$(Replicate02, Len(Pattern) + 1) = Replicate02
      End If
    End If
  End If
  
End Function
Author's comments:
Donald's comments: Highly interesting code! Watch it carefully and begin to wonder why this works (and it does work)...

top | charts


Replicate03
submitted 06-Dec-2000 by Larry Serflaten  
Doping: none
Public Function Replicate03(ByVal Number&, Pattern$) As String
' by Larry Serflaten, serflaten@usinternet.com, 20001206, rev 002

  ' Trying a variable for Len(Parameter) because it is used at least
  ' twice, possibly 3 times.
  Dim LP As Long
  
  If Number > 0 Then
    LP = Len(Pattern)
    If LP = 1 Then
      Replicate03 = String$(Number, Pattern)
    Else
      Replicate03 = Pattern & Space$((Number - 1) * LP)
      If Len(Replicate03) > LP Then
        Mid$(Replicate03, LP + 1) = Replicate03
      End If
    End If
  End If
  
End Function
Author's comments:
Donald's comments:

top | charts


Replicate04
submitted 06-Dec-2000 by Guido Beckmann  
Doping: needs reference to typelib BStrAPI.tlb (by G.Beckmann) - Download BStrAPI.tlb (2KB zipped, VB5-compatible).
Public Function Replicate04(ByVal Number&, Pattern$) As String
' by G.Beckmann, G.Beckmann@NikoCity.de, 20001206

    Dim c&, cChars&
    If Number > 0 Then
        c = Len(Pattern)
        If c Then
            cChars = c * Number
            Replicate04 = BStrAPI.SysAllocStringLen(vbNullString, cChars)
            Mid$(Replicate04, 1, c) = Pattern

            Do Until c >= cChars
                Mid$(Replicate04, c + 1, c) = Replicate04
                c = c + c
            Loop
        End If
    End If
End Function
Author's comments:
Donald's comments:

top | charts


Replicate05
submitted 06-Dec-2000 by Donald Lessau  
Doping: none
Public Function Replicate05(ByVal Number&, Pattern$) 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
Author's comments: Note, how getting rid of that one string concatenation in Replicate03 brings 50% speed gain!
Donald's comments:

top | charts


Replicate06
submitted 06-Dec-2000 by Donald Lessau  
Doping: needs reference to typelib BStrAPI.tlb (by G.Beckmann) - Download BStrAPI.tlb (2KB zipped, VB5-compatible).
Public Function Replicate06(ByVal Number&, Pattern$) As String
' by Donald, donald@xbeat.net, 20001206
' based on Replicate03 by Larry Serflaten, serflaten@usinternet.com, 20001206
'          Replicate04 by G.Beckmann, G.Beckmann@NikoCity.de, 20001206

  Dim LP As Long
  
  If Number > 0 Then
    LP = Len(Pattern)
    If LP Then
      Replicate06 = BStrAPI.SysAllocStringLen(vbNullString, Number * LP)
      Mid$(Replicate06, 1, LP) = Pattern
      If Number > 1 Then
        Mid$(Replicate06, LP + 1) = Replicate06
      End If
    End If
  End If
  
End Function
Author's comments:
Donald's comments:

top | charts


Replicate07
submitted 06-Dec-2000 by Peter Weighill  
Doping: none
Public Function Replicate07(ByVal Number&, Pattern$) As String
' by Peter Weighill, pweighill@btinternet.com, 20001206
' based on Replicate03 by Larry Serflaten, serflaten@usinternet.com, 20001206
'      and Replicate05 by Donald, donald@xbeat.net, 20001206

  Dim LP As Long

  If Number > 0 Then
    LP = Len(Pattern)
    If LP Then
      Replicate07 = String$(Number * LP, Pattern$)
      If LP > 1 Then
        Mid$(Replicate07, 1, LP) = Pattern
        If Number > 1 Then
          Mid$(Replicate07, LP + 1) = Replicate07
        End If
      End If
    End If
  End If

End Function
Author's comments:
Donald's comments: Geared up for the LP=1 occasion.

top | charts


Replicate08
submitted 06-Dec-2000 by Nick Paldino  
Doping: API
Private Declare Sub CopyMemLng Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
        ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)

Public Function Replicate08(ByVal Number As Long, ByRef Pattern As String) As String ' by Nick Paldino, nicholas.paldino@exisconsulting.com, 20001206, rev 001 20011123 ' Only Replicate if there is a desire to Replicate ' (the number of times is greater than zero). If (Number > 0) Then ' Get the length of the string (in bytes). Dim plngPatternLength As Long plngPatternLength = LenB(Pattern) ' Allocate the length of the string. Replicate08 = Space$(Number * Len(Pattern)) ''was: Replicate08 = Space(Number * Len(Pattern)) ' Store the bytes copied, as well as the bytes left. The current number of bytes left ' is the length of the string in bytes. Dim plngBytesCopied As Long, plngBytesLeft As Long plngBytesLeft = LenB(Replicate08) ' The pointer to the beginning of the source string, and the destination string. ' Also store a pointer to the beginning of the replicated string. This is where the ' already replicated string lies. Dim plngSourcePointer As Long, plngDestPointer As Long, plngOriginalDestPointer As Long plngSourcePointer = StrPtr(Pattern) plngOriginalDestPointer = StrPtr(Replicate08) plngDestPointer = plngOriginalDestPointer ' Copy the first section. CopyMemLng plngDestPointer, plngSourcePointer, plngPatternLength ' Increment and decrement for the first copy. plngBytesLeft = plngBytesLeft - plngPatternLength plngBytesCopied = plngPatternLength plngDestPointer = plngDestPointer + plngPatternLength ' Loop Do While (plngBytesCopied < plngBytesLeft) ' Copy the number of characters copied into the buffer at the next available space. CopyMemLng plngDestPointer, plngOriginalDestPointer, plngBytesCopied ' Reduce the characters left. plngBytesLeft = plngBytesLeft - plngBytesCopied ' Increment the destination pointer. plngDestPointer = plngDestPointer + plngBytesCopied ' Double the bytes copied. plngBytesCopied = plngBytesCopied * 2 Loop ' Copy for the last time. CopyMemLng plngDestPointer, plngOriginalDestPointer, plngBytesLeft End If ' That's all folks. End Function
Author's comments:
Donald's comments: A large step for a programmer, a small step for the CPU ...

top | charts


Replicate09
submitted 10-Sep-2001 by Mike Peterson  
Doping: API
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Public Function Replicate09(ByVal lNumber&, sPattern$) As String ' by Mike Peterson, mpeterson1200@yahoo.com, 20010910 '****************************************************************************** 'Replication Function By: Mike Peterson 'Approach: Use CopyMemory API in exponential increments, using recursion to handle (lNumber <> 2^n) 'Note: This function is fastest when lNumber is a power of 2. '****************************************************************************** If lNumber > 0 Then Dim i&, lPointer&, LP& 'Allocate String Buffer LP = Len(sPattern) Replicate09 = Space$(LP * lNumber) 'Do first CopyMem CopyMemory ByVal StrPtr(Replicate09), ByVal StrPtr(sPattern), LP * 2 '** Unicode=2 bytes lPointer = LP * 2: i = 1 'Count how many times we 've CopyMem'd 'Here comes my new approach......... 'CopyMem to buffer exponentially!!! While (2 ^ i) <= lNumber CopyMemory ByVal StrPtr(Replicate09) + lPointer, ByVal StrPtr(Replicate09), lPointer lPointer = lPointer + lPointer: i = i + 1 Wend i = i - 1 'If lNumber was not a power of 2, we'll have to recursively catch the rest. If (2 ^ i) <> lNumber Then Dim s$ s = Replicate09(lNumber - (2 ^ i), sPattern) 'Recursion... 'Last CopyMem CopyMemory ByVal StrPtr(Replicate09) + lPointer, ByVal StrPtr(s), LenB(s) End If End If End Function
Author's comments:
Donald's comments:

top | charts


Replicate10
submitted 27-May-2002 by Marzo Junior  
Doping: TLB (cf. Dope'n'Declarations)
The code is rather long, have a look here.
Author's comments :
Donald's comments :

top | charts


Replicate11
submitted 27-May-2002 by Donald Lessau  
Doping: API, TLB (cf. Dope'n'Declarations)
Public Function Replicate11(ByVal Number As Long, ByRef Pattern As String) As String
' by Donald, donald@xbeat.net, 20020527
' flexible strategy approach
' partly based on Replicate08 by Nick Paldino
  Dim lenPattern As Long
  Dim ptrSrc As Long
  Dim ptrDst As Long

  If Number > 0 Then
    lenPattern = Len(Pattern)
    Select Case lenPattern
    Case 0
    Case 1
      ' good call 4: Replicate(10000, "a")
      Replicate11 = String$(Number, Pattern)
    Case Is < 256 '256 is just an arbitrary limit
      ' good call 1: Replicate(10, "abc")
      ' bad  call 2: Replicate(10000, "abc")
      Replicate11 = FastString.SysAllocStringLen(ByVal 0&, Number * lenPattern)
      Mid$(Replicate11, 1, lenPattern) = Pattern
      If Number > 1 Then
        Mid$(Replicate11, lenPattern + 1) = Replicate11
      End If
    Case Else
      ' good call 3: Replicate(10, "abcdefhgijabcdefhgij...abcdefhgijabcdefhgij" (1000))
      Replicate11 = FastString.SysAllocStringLen(ByVal 0&, Number * lenPattern)
      ptrSrc = StrPtr(Pattern)
      ptrDst = StrPtr(Replicate11)
      lenPattern = lenPattern * 2
      For ptrDst = ptrDst To ptrDst + (Number - 1) * lenPattern Step lenPattern
        CopyMemLng ptrDst, ptrSrc, lenPattern
      Next
    End Select
  End If
End Function
Author's comments:
Donald's comments:

top | charts


Replicate12
submitted 27-May-2002 by Marzo Junior  
Doping: TLB (cf. Dope'n'Declarations)
Class-wrapped. The code is rather long, have a look here.
Author's comments :
Donald's comments :

top | charts


Replicate13
submitted 10-Jun-2002 by Paul  
Doping: TLB (cf. Dope'n'Declarations)
  [29-Sep-2002] Note that the function fails with patterns containing upper unicode characters, for example Replicate13(1, ChrW$(8364)) will raise run-time error '9'.
Class-wrapped. The code is rather long, have a look here.
Author's comments :
Donald's comments :

top | charts


Replicate14
submitted 29-Sep-2002 by Marzo Junior  
Doping: TLB (cf. Dope'n'Declarations)
The code fills a rather large module (a single function with 337 lines, including comments, 25KB), have a look here.
Author's comments :
Donald's comments :

top | charts




VBspeed © 2000-10 by Donald Lessau