[RESOLVED] Repeating first 2 characters?

[Zach_VB6]

I'm trying to find the fastest way to do this. I've written a function where you input a string of numbers and it takes the first 2 characters and repeats them until the new string has the same length of the input string.

So input = 56378, output = 56565. Input=89432, output=89898

This is what I have now:

Private Function Alternate(Num As String) As String
Dim first(0 To 1) As String, x As Long
    first(1) = Mid$(Num, 1, 1)
    first(0) = Mid$(Num, 2, 1)
    For x = 1 To Len(Num)
        Alternate = Alternate & first(x Mod 2)
    Next x
End Function

Can you guys think of anything faster?

[Golgo1]

very small point,
do not use len(num) as the loop condition. put it into a var, and use the var
also, outside the loop, set the first two chars, then your loop only needs to be for 3 to iLength..

and I suppose, if you want to nitpick speed and the length will be constant, then you can ditch the loop and code the entire new string in one line. But that wouldn't be very flexible.

And maybe some others know, would Left() be faster than a Mid()?

[LaVolpe]

Maybe this?

Private Function Alternate(Num As String) As String
    Dim sPrefix As String, lLen As Long, X As Long
    sPrefix = Left$(Num, 2)
    lLen = Len(Num)
    Alternate = Space$(lLen)
    For X = 1 To lLen - 1 Step 2
        Mid$(Alternate, X, 2) = sPrefix
    Next X
    If (lLen And 1) Then Mid$(Alternate, lLen, 1) = Left$(sPrefix, 1)
End Function

This method does not resize the string during/after the loop

[Merri]

Replicate:

Dim Test As String

Test = "AB" & Space$(8)
Mid$(Test, 3) = Test

MsgBox Test

I think this works the fastest when the start length has 8 characters or so, I haven't fully benchmarked it. But longer than that and it'll become slower.

[Zach_VB6]

very small point,
do not use len(num) as the loop condition. put it into a var, and use the var
also, outside the loop, set the first two chars, then your loop only needs to be for 3 to iLength..

and I suppose, if you want to nitpick speed and the length will be constant, then you can ditch the loop and code the entire new string in one line. But that wouldn't be very flexible.

And maybe some others know, would Left() be faster than a Mid()?

The len as a loop condition is only executed once, as seen in this snippet:

Private Sub TestLoop()
Dim x As Long
    For x = 1 To GetLoop
        DoEvents
    Next x
End Sub

Private Function GetLoop() As Long
    Debug.Print "GetLoop called!"
    GetLoop = 5
End Function

Call TestLoop and you'll see that GetLoop (the loop condition) is called once.

Maybe this?

Private Function Alternate(Num As String) As String
    Dim sPrefix As String, lLen As Long, X As Long
    sPrefix = Left$(Num, 2)
    lLen = Len(Num)
    Alternate = Space$(lLen)
    For X = 1 To lLen - 1 Step 2
        Mid$(Alternate, X, 2) = sPrefix
    Next X
    If (lLen And 1) Then Mid$(Alternate, lLen, 1) = Left$(sPrefix, 1)
End Function

This method does not resize the string during/after the loop

LaVolpe you are a genius in every way. I'm gonna see if others have different responses just for kicks

[Golgo1]

actually... thinking about it more, you can take the Mod out entirely

Private Function Alternate(Num As String) As String
dim strPair as string,  x As Long, L as long

strPair = Mid$(Num, 1, 1) & Mid$(Num, 2, 1)  'combine chars
L = Len(Num) /2

For x = 1 To L
        Alternate = Alternate & strPair
Next x

'if orginal Num was an ODD numbered length, trim last digit
if len(Alternate) > len(Num) then  Alternate = left(Alternate,len(Alternate)-1)

End Function

Of course, this doest take into account spaces or empty strings (use Trim() )

[Zach_VB6]

And yes, Left is a little faster than Mid:

[Zach_VB6]

actually... thinking about it more, you can take the Mod out entirely

...

Of course, this doest take into account spaces or empty strings (use Trim() )

I rewrote it for ya

Private Function Alternate(Num As String) As String
dim strPair as string,  x As Long

strPair = Left$(Num,2)  'combine chars

For x = 1 To LenB(Num) \ 4
        Alternate = Alternate & strPair
Next x

'if orginal Num was an ODD numbered length, trim last digit
if lenb(Alternate) > lenb(Num) then  Alternate = left$(Alternate,len(Alternate)-1)

End Function

[Merri]

My earlier suggestion as a function:

Option Explicit

Public Function Alternate(Expression As String, Optional ByVal Length As Long = 2) As String
    Select Case Length
    Case Is < 1
    Case 1
        If Len(Expression) Then Alternate = String$(Len(Expression), Left$(Expression, 1))
    Case Else
        Alternate = Expression
        If Length < Len(Expression) Then Mid$(Alternate, 1 + Length) = Alternate
    End Select
End Function

Private Sub Form_Load()
    Debug.Print Alternate("1234567890", 3)
End Sub

[LaVolpe]

Very nice Merri. I didn't even know Mid$ did an "auto-fill" like that!

[Golgo1]

ah I see LV posted while I was typing

pretty much the same idea though, make a prefix and do half the loops

And yes, you are right, with a FOR loop, the condition values are set once. My bad, I got it mixed up with a WHILE loop.

That is a pretty handy little graph, I had no idea Str$ was THAT much slower. (slower yes, but that's alot)

[Golgo1]

holy hell, I agree! using Mid like that is sweet. I never knew it did that either!
And the Select Case takes care of most of the validation. Slightly longer code, but gauranteed to be faster.
Nice

[Merri]

A slight update to account for errors. Should be bullet proof, no error with any possible input parameters.

Public Function Alternate(Expression As String, Optional ByVal Length As Byte = 2) As String
    If Len(Expression) = 0 Then Exit Function
    Select Case Length
    Case 1
        Alternate = String$(Len(Expression), Left$(Expression, 1))
    Case Else
        Alternate = Expression
        If Length < Len(Expression) Then Mid$(Alternate, 1 + Length) = Alternate
    End Select
End Function

Len(Expression) check makes sure we do not get an error with Length = 1 situation when Left$ is called.

Length is now a Byte instead of Long, thus throwing negative value out of the picture -> no need to check for it!

Length must be shorter than Len(Expression) for the Mid$ to run. This avoids an error.

Behavior change: if Length = 0 the code returns the input string instead of a null string.


But notice that in many cases it would be better to use Mid$ inline instead of calling this function...

[Zach_VB6]

One speed change:

    If LenB(Expression) = 0 Then Exit Function

That saves me 8 nanoseconds

[Merri]

Can't use LenB, because afaik it would give an error on Left$ if Expression's byte length is 1... so shorter to use Len instead & having better error validation at the same time.

A better speed optimization would be to use an extra variable to hold the result of Len.

[anhn]

Shorter:

Function Alternate(ByVal sNum As String, ByVal iLen As Byte) As String
    If Len(sNum) > iLen Then Mid$(sNum, iLen + 1) = sNum
    Alternate = sNum
End Function

[Zach_VB6]

Merri & anhn, you know never fail to amaze.

[anhn]

In case you want to repeat more than 255 characters:

Function RepeatLeft(sText As String, ByVal iLen As Long) As String
    RepeatLeft = sText
    If (iLen > 0) And (Len(sText) > iLen) Then Mid$(RepeatLeft, iLen + 1) = RepeatLeft
End Function

[Merri]

anhn: Mid$ is unable to repeat one character. You need two characters minimum. So iLen > 1 to avoid an extra call to Mid$ or you need to go back to Select Case or If Then structure, which is already used in post #9.

[anhn]

I have this:

?RepeatLeft("abcd",1)
aaaa

[Merri]

Does not work for me:

? RepeatLeft("abcdefghijkl", 1)
aabbddffhhjj

I have Visual Basic 6.0 (SP6) version 6.0.9782


This works:

Function RepeatLeft(sText As String, ByVal iLen As Long) As String
    RepeatLeft = sText
    If Len(sText) > iLen Then
        If iLen = 1 Then Mid$(RepeatLeft, 2, 1) = RepeatLeft: iLen = 2
        If iLen > 1 Then Mid$(RepeatLeft, iLen + 1) = RepeatLeft
    End If
End Function