argh! count number of full stops??

i have to count the number of full stops in my program thing. does anyone know how to do that? please??!

counting any individual characters really

You would eliminate the spaces, if that's what you mean.

VB Code:

MsgBox "Character count: " & Len(strBuff) - Len(Replace(strBuff, " ", "")) + 1

if you have any vbCRLF, you would also replace the two characters with one, or possibly none, depending if you want to count them or not.

VB Code:

MsgBox Len(strBuff) - Len(Replace(strBuff, vbCrLf, "x")) + 1

By full stops do you mean line breaks? If so then try this:

VB Code:

lCur = InStr(1, sMyStr, vbCrLf)
Do Until lCur = 0
    lCount = lCount + 1
    lCur = InStr(lCur , sMyStr, vbCrLf)
Loop

I didn't test it, but try that. There must be a better way though.

EDIT: ... And DG beat me to the punch with a better solution.

VB Code:

Public Function Sisic(sMain As String, sLookFor As String) As Long
 
   '[S]tring [I]n [S]tring [I}nstance [C]ount
   
    Dim nStart As Long
    Dim nResult As Long
 
    nStart = 1
    nResult = 0
    
    Do While InStr(nStart, sMain, sLookFor) > 0
        nStart = InStr(nStart, sMain, sLookFor) + 1
        Sisic = Sisic + 1
    Loop
    
End Function

There are more efficient ways to do this, but this is the most readable, and is virtually identical to the post above.

Try this:

VB Code:

Option Explicit
 
Private Sub Form_Load()
 
    Debug.Print Sisic("Now is the time for all good men to come to the aid of the party", "o")
    
End Sub
 
Public Function Sisic(Str As String, LookFor As String) As Long
 
    Dim lLookFor As Long
    Dim Tmp() As Byte
    Dim i As Long
    
    If LenB(Str) > 0 Then
    
        lLookFor = AscW(LookFor)
        Tmp = Str
        
        For i = 0 To LenB(Str) - 1 Step 2
            If Tmp(i) = lLookFor Then
                Sisic = Sisic + 1
            End If
        Next
        
    End If
    
End Function

VB Code:

Function InStrCount(ByRef pszString As String, ByRef pszFind As String) As Long
Dim sTemp As String
    sTemp = Replace$(pszString, pszFind, vbNullString)
    InStrCount = Len(pszString) - Len(sTemp)
End Function

VB Code:

Option Explicit
 
Private Declare Function GetTickCount Lib "kernel32" () As Long
 
 
Private Sub Command1_Click()
 
    Const TEST As String = "Now is the time for all good men to come to the aid of the party"
    
    Dim Start As Long
    Dim Finish As Long
    Dim i As Long
    
    Start = GetTickCount()
    For i = 0 To 1000000
        Sisic TEST, "o"
    Next
    Finish = GetTickCount()
    Text1.Text = Finish - Start
    
    Start = GetTickCount()
    For i = 0 To 1000000
        InStrCount TEST, "o"
    Next
    Finish = GetTickCount
    Text2.Text = Finish - Start
    
End Sub
 
 
Public Function Sisic(Str As String, LookFor As String) As Long
 
    Dim lLookFor As Long
    Dim Tmp() As Byte
    Dim i As Long
    
    If LenB(Str) > 0 Then
    
        lLookFor = AscW(LookFor)
        Tmp = Str
        
        For i = 0 To LenB(Str) - 1 Step 2
            If Tmp(i) = lLookFor Then
                Sisic = Sisic + 1
            End If
        Next
        
    End If
    
End Function
    
Function InStrCount(ByRef pszString As String, ByRef pszFind As String) As Long
Dim sTemp As String
    sTemp = Replace$(pszString, pszFind, vbNullString)
    InStrCount = Len(pszString) - Len(sTemp)
End Function

Gives:
IDE Sisic:8266, InStrCount:5828
Compiled Sisic:1344, InStrCount:5375

on P4 2.79Ghz,1Gb RAM

in VB6 "Strings are Evil"(TM)

I always find that the sooner you can treat them as numbers the better.

Don't be sad. :thumb:

VB Code:

Option Explicit
 
Private Declare Function GetTickCount Lib "kernel32" () As Long
 
 
Private Sub Command1_Click()
 
    Const TEST As String = "Now is the time for all good men to come to the aid of the party "
    
    Dim Start As Long
    Dim Finish As Long
    Dim i As Long
    
    Start = GetTickCount()
    For i = 0 To 1000000
        Sisic TEST, "o"
    Next
    Finish = GetTickCount()
    Text1.Text = Finish - Start
    
    Start = GetTickCount()
    For i = 0 To 1000000
        InStrCount TEST, "o"
    Next
    Finish = GetTickCount
    Text2.Text = Finish - Start
 
    Start = GetTickCount()
    For i = 0 To 1000000
        Sisic2 TEST, "o"
    Next
    Finish = GetTickCount
    Text3.Text = Finish - Start
    
End Sub
 
Public Function Sisic2(sMain As String, sLookFor As String) As Long
 
   '[S]tring [I]n [S]tring [I}nstance [C]ount
       Dim nStart As Long
    Dim nResult As Long
 
    nStart = 1
    nResult = 0
    
    Do While InStr(nStart, sMain, sLookFor) > 0
        nStart = InStr(nStart, sMain, sLookFor) + 1
        Sisic2 = Sisic2 + 1
    Loop
    End Function
    
Public Function Sisic(Str As String, LookFor As String) As Long
 
    Dim lLookFor As Long
    Dim Tmp() As Byte
    Dim i As Long
    
    If LenB(Str) > 0 Then
    
        lLookFor = AscW(LookFor)
        Tmp = Str
        
        For i = 0 To LenB(Str) - 1 Step 2
            If Tmp(i) = lLookFor Then
                Sisic = Sisic + 1
            End If
        Next
        
    End If
    
End Function
    
Function InStrCount(ByRef pszString As String, ByRef pszFind As String) As Long
Dim sTemp As String
    sTemp = Replace$(pszString, pszFind, vbNullString)
    InStrCount = Len(pszString) - Len(sTemp)
End Function

Thought I'd try out the Instr method:

IDE Sisic:8235,InStrCount:5844,Sisic2:4296
Compiled Sisic:1250,InStrCount:5375,Sisic2:1890

I'm quite surprised how fast the Instr method executes.

I came up with this monstrocity :D

VB Code:

Private Function Woof(ByVal Text As String, ByVal SearchString As String) As Long
    Dim lngIndex As Long
    For lngIndex = 1 To Len(Text)
        If Mid$(Text, lngIndex, 1) <> SearchString Then
            Mid$(Text, lngIndex, 1) = " "
        End If
    Next lngIndex
    Text = Replace$(Text, " ", vbNullString)
    Woof = Len(Text)
End Function

Read it and weep...slower than all of your code :D

Woof

Quote:

---

Originally Posted by yrwyddfa

What you should be sad about is the performance of the Aussies in the Ashes . . . ;)

---

You'll pay for that :mad:

VB Code:

Function InStrCount2(ByRef pszString As String, ByRef pszFind As String) As Long
Dim chBuf()     As Byte
Dim chSearch()  As Byte
Dim lchSearch   As Long
Dim lSearchLen  As Long
Dim lChunkLen   As Long
Dim i           As Long
Dim j           As Long
 
    chBuf = pszString
 
    lChunkLen = LenB(pszFind)
    lSearchLen = LenB(pszString)
 
    If (lChunkLen < lSearchLen) Then
        If (lChunkLen = 2) Then
            lchSearch = AscW(pszFind)
            For i = 0 To lSearchLen - 1 Step 2
                If (chBuf(i) = lchSearch) Then _
                    InStrCount2 = InStrCount2 + 1
            Next i
          Else
            chSearch = pszFind
 
            For i = 0 To lSearchLen - 1 Step lChunkLen
                For j = 0 To lChunkLen Step 2
                    If (chBuf(i + j) <> chSearch(j)) Then
                        Exit For
                      Else
                        If (j = lChunkLen) Then _
                            InStrCount2 = InStrCount2 + 1
                    End If
                Next j
            Next i
        End If
      Else
        Err.Raise 1, , "You suck"
    End If
End Function

Results (compiled and run at realtime priority):

Sisic() - 1265 ms
InStrCount() - 4329 ms
InStrCount2() - 1218 ms

Specs: Athlon XP 2600+, 512 RAM.

This code certainly squeezes the rep point from me. Nice one :thumb:

I had a hunch this would work and it did. Change lchSearch from Long to Byte and the results are as follows:

Sisic() - 1265 ms
InStrCount() - 4313 ms
InStrCount2() - 1172 ms

To me that suggests a Byte/Long comparison is a two step operation (pad the byte out to a Long and then compare) whereas a Byte/Byte comparison can be done in one hit.

VB Code:

Option Explicit
 
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 
Private BufStr(511) As Byte
Private BufFind(511) As Byte
 
Private Sub Command1_Click()
 
    Const TEST As String = "Now is the time for all good men to come to the aid of the party "
    
    Dim Start As Long
    Dim Finish As Long
    Dim i As Long
    
    Start = GetTickCount()
    For i = 0 To 1000000
        Sisic3 TEST, "o"
    Next
    Finish = GetTickCount
    Text3.Text = Finish - Start
    
End Sub
 
Public Function Sisic3(Str As String, Find As String) As Long
 
    Dim i As Long
    Dim j As Long
    Dim lenStr As Long
    Dim lenFind As Long
    Dim Flag As Long
    
    CopyMemory BufStr(0), ByVal StrPtr(Str), LenB(Str)
    CopyMemory BufFind(0), ByVal StrPtr(Find), LenB(Str)
    
    lenStr = LenB(Str)
    lenFind = LenB(Find)
    
    For i = (lenStr - 1) To lenFind Step -2
        Flag = 0
        For j = (lenFind - 1) To 0 Step -2
            If Not (BufStr(i - (lenFind - j)) = BufFind(j - 1)) Then
                Flag = -1
                Exit For
            End If
        Next
        If Flag = 0 Then
            Sisic3 = Sisic3 + 1
        End If
    Next
    
End Function

Gives a compiled speed of 890.

VB Code:

Public Function Sisic3(Str As String, Find As String) As Long
 
    Dim i As Long
    Dim j As Long
    Dim lenStr As Long
    Dim lenFind As Long
    Dim Flag As Long
    
    lenStr = LenB(Str)
    lenFind = LenB(Find)
    
    CopyMemory BufStr(0), ByVal StrPtr(Str), lenStr
    CopyMemory BufFind(0), ByVal StrPtr(Find), lenFind
    
    For i = (lenStr - 1) To lenFind Step -2
        Flag = 0
        For j = (lenFind - 1) To 0 Step -2
            If Not (BufStr(i - (lenFind - j)) = BufFind(j - 1)) Then
                Flag = -1
                Exit For
            End If
        Next
        If Flag = 0 Then
            Sisic3 = Sisic3 + 1
        End If
    Next
    
End Function

gives a compiled speed of 811

VB Code:

Option Explicit
 
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 
Private BufStr(511) As Byte
Private BufFind(511) As Byte
 
Private Sub Command1_Click()
 
    Const TEST As String = "Now is the time for all good men to come to the aid of the party "
    
    Dim Start As Long
    Dim Finish As Long
    Dim i As Long
    Dim Str As String
    
    Str = "o"
    
    Start = GetTickCount()
    For i = 0 To 1000000
       Sisic3 StrPtr(TEST), StrPtr("is"), LenB(TEST), LenB(Str)
    Next
    Finish = GetTickCount
    Text3.Text = Finish - Start
    
End Sub
 
Public Function Sisic3(ByVal pStr As Long, ByVal pFind As Long, ByVal lenStr As Long, ByVal lenFind As Long) As Long
 
    Dim i As Long
    Dim j As Long
    Dim Flag As Long
    
    CopyMemory BufStr(0), ByVal pStr, lenStr
    CopyMemory BufFind(0), ByVal pFind, lenFind
    
    For i = (lenStr - 1) To lenFind Step -2
        Flag = 0
        For j = (lenFind - 1) To 0 Step -2
            If Not (BufStr(i - (lenFind - j)) = BufFind(j - 1)) Then
                Flag = -1
                Exit For
            End If
        Next
        If Flag = 0 Then
            Sisic3 = Sisic3 + 1
        End If
    Next
    
End Function

Compiled execution time of 515

Cheat... you took the byte array out of the procedure ;)

w00000t! :D

VB Code:

Function InStrCount3(ByVal pszString As Long, ByVal pszFind As Long) As Long
Static chBuf(1024)  As Byte
Static chFind(1024) As Byte
Dim chSearchChar    As Byte
Dim lStringLen      As Long
Dim lFindLen        As Long
Dim i               As Long
Dim j               As Long
 
    RtlMoveMemory lStringLen, ByVal (pszString - 4), 4&
    RtlMoveMemory chBuf(0), ByVal pszString, lStringLen
 
    RtlMoveMemory lFindLen, ByVal (pszFind - 4), 4&
 
    If (lFindLen = 2) Then
        RtlMoveMemory chSearchChar, ByVal pszFind, 1
        For i = 0 To lStringLen Step 2
            If (chBuf(i) = chSearchChar) Then _
                InStrCount3 = InStrCount3 + 1
        Next i
      Else
        RtlMoveMemory chFind(0), ByVal pszFind, lFindLen
        For i = 0 To lStringLen Step lFindLen
            For j = 0 To lFindLen Step 2
                If (chBuf(i + j) <> chFind(j)) Then
                    Exit For
                  Else
                    If (j = lFindLen) Then _
                        InStrCount3 = InStrCount3 + 1
                End If
            Next j
        Next i
    End If
End Function

Sisic3() - 391 ms
InStrCount3() - 343 ms

u forgot to include the API declarations.

Woof :D

Come on Woka... I can write them off the top of my head :p

VB Code:

Declare Sub RtlMoveMemory Lib "ntdll.dll" ( _
    ByRef lpvDest As Any, _
    ByRef lpvSrc As Any, _
    ByVal cbLen As Long _
)

Nice code.

I would think, though, that the difference of 50 is negligable. What's the average over many process runs?

I suspect that any performance increase is due to the fact you determine whether it's a single character, or a phrase to look for.

I'd be interested to see the performance for phrases.

Yeah, yours enters two loops while mine enters only one for a single character.

I ran it at realtime priority and it was always the same time every time. At normal priority it would obviously vary more but it wouldn't be such an accurate reflection of the code's efficiency.

VB Code:

Option Explicit
 
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 
Private BufStr(511) As Byte
Private BufFind(511) As Byte
 
Private Sub Command1_Click()
 
    Const TEST As String = "Now is the time for all good men to come to the aid of the party "
    
    Dim Start As Long
    Dim Finish As Long
    Dim i As Long
    Dim Str As String
    
    Str = "o"
    
    Start = GetTickCount()
    For i = 0 To 1000000
       Sisic3 StrPtr(TEST), StrPtr(Str), LenB(TEST), LenB(Str)
    Next
    Finish = GetTickCount
    Text3.Text = Finish - Start
    
End Sub
 
Public Function Sisic3(pStr As Long, pFind As Long, lenStr As Long, lenFind As Long) As Long
 
    Dim i As Long
    Dim j As Long
    Dim Flag As Long
    
    CopyMemory BufStr(0), ByVal pStr, lenStr
    CopyMemory BufFind(0), ByVal pFind, lenFind
    
    If lenFind = 2 Then
        For i = (lenStr - 1) To lenFind Step -2
            If BufStr(i) = BufFind(0) Then
                Sisic3 = Sisic3 + 1
            End If
        Next
    Else
        For i = (lenStr - 1) To lenFind Step -2
            Flag = 0
            For j = (lenFind - 1) To 0 Step -2
                If Not (BufStr(i - (lenFind - j)) = BufFind(j - 1)) Then
                    Flag = -1
                    Exit For
                End If
            Next
            If Flag = 0 Then
                Sisic3 = Sisic3 + 1
            End If
        Next
    End If
    
End Function

Nope. Your routine to check for the two byte length is very significant :thumb:

I've added it to this routine and it comes in at 271

Bah. Your last function doesn't work. No wonder it's so much faster :)

VB Code:

Public Function Sisic3(pStr As Long, pFind As Long, lenStr As Long, lenFind As Long) As Long
 
    Dim i As Long
    Dim j As Long
    Dim Flag As Long
    
    CopyMemory BufStr(0), ByVal pStr, lenStr
    CopyMemory BufFind(0), ByVal pFind, lenFind
    
    If lenFind = 2 Then
        For i = (lenStr - 1) To lenFind Step -2
            If BufStr(i - 1) = BufFind(0) Then
                Sisic3 = Sisic3 + 1
            End If
        Next
    Else
        For i = (lenStr - 1) To lenFind Step -2
            Flag = 0
            For j = (lenFind - 1) To 0 Step -2
                If Not (BufStr(i - (lenFind - j)) = BufFind(j - 1)) Then
                    Flag = -1
                    Exit For
                End If
            Next
            If Flag = 0 Then
                Sisic3 = Sisic3 + 1
            End If
        Next
    End If
    
End Function

Yup! Whoops :blush:

It works now but is a measly 453. What does it run at on your machine?

VB Code:

Option Explicit
 
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 
Private BufStr(511) As Byte
Private BufFind(511) As Byte
 
 
Private Sub Command1_Click()
 
    Const TEST As String = "Now is the time for all good men to come to the aid of the party "
    
        Dim Start As Long
    Dim Finish As Long
    Dim i As Long
    
    Dim str As String
    
    str = "o"
    
        Start = GetTickCount()
    For i = 0 To 1000000
        Sisic TEST, "o"
    Next
    Finish = GetTickCount()
    Text1.Text = Finish - Start
    
    Start = GetTickCount()
    For i = 0 To 1000000
        InStrCount3 StrPtr(TEST), StrPtr(str)
    Next
    Finish = GetTickCount
    Text2.Text = Finish - Start
 
    Start = GetTickCount()
    For i = 0 To 1000000
        Sisic2 TEST, "o"
    Next
    Finish = GetTickCount
    Text3.Text = Finish - Start
    
        Start = GetTickCount()
    For i = 0 To 1000000
        Sisic3 StrPtr(TEST), StrPtr(str), LenB(TEST), LenB(str)
    Next
    Finish = GetTickCount
    Text4.Text = Finish - Start
    
End Sub
 
    Public Function Sisic(str As String, LookFor As String) As Long
 
    Dim lLookFor As Long
    Dim Tmp() As Byte
    Dim i As Long
        If LenB(str) > 0 Then
            lLookFor = AscW(LookFor)
        Tmp = str
                For i = 0 To LenB(str) - 1 Step 2
            If Tmp(i) = lLookFor Then
                Sisic = Sisic + 1
            End If
        Next
            End If
    End Function
    
Public Function Sisic2(sMain As String, sLookFor As String) As Long
 
   '[S]tring [I]n [S]tring [I}nstance [C]ount
       Dim nStart As Long
    Dim nResult As Long
 
    nStart = 1
    nResult = 0
    
    Do While InStr(nStart, sMain, sLookFor) > 0
        nStart = InStr(nStart, sMain, sLookFor) + 1
        Sisic2 = Sisic2 + 1
    Loop
    End Function
    
 
 
Public Function Sisic3(pStr As Long, pFind As Long, lenStr As Long, lenFind As Long) As Long
 
    Dim i As Long
    Dim j As Long
    Dim Flag As Long
    
    CopyMemory BufStr(0), ByVal pStr, lenStr
    CopyMemory BufFind(0), ByVal pFind, lenFind
    
    If lenFind = 2 Then
        For i = (lenStr - 1) To lenFind Step -2
            If BufStr(i - 1) = BufFind(0) Then
                Sisic3 = Sisic3 + 1
            End If
        Next
    Else
        For i = (lenStr - 1) To lenFind Step -2
            Flag = 0
            For j = (lenFind - 1) To 0 Step -2
                If Not (BufStr(i - (lenFind - j)) = BufFind(j - 1)) Then
                    Flag = -1
                    Exit For
                End If
            Next
            If Flag = 0 Then
                Sisic3 = Sisic3 + 1
            End If
        Next
    End If
    
End Function
 
Function InStrCount3(ByVal pszString As Long, ByVal pszFind As Long) As Long
Static chBuf(1024)  As Byte
Static chFind(1024) As Byte
Dim chSearchChar    As Byte
Dim lStringLen      As Long
Dim lFindLen        As Long
Dim i               As Long
Dim j               As Long
 
    CopyMemory lStringLen, ByVal (pszString - 4), 4&
    CopyMemory chBuf(0), ByVal pszString, lStringLen
 
    CopyMemory lFindLen, ByVal (pszFind - 4), 4&
 
    If (lFindLen = 2) Then
        CopyMemory chSearchChar, ByVal pszFind, 1
        For i = 0 To lStringLen Step 2
            If (chBuf(i) = chSearchChar) Then _
                InStrCount3 = InStrCount3 + 1
        Next i
      Else
        CopyMemory chFind(0), ByVal pszFind, lFindLen
        For i = 0 To lStringLen Step lFindLen
            For j = 0 To lFindLen Step 2
                If (chBuf(i + j) <> chFind(j)) Then
                    Exit For
                  Else
                    If (j = lFindLen) Then _
                        InStrCount3 = InStrCount3 + 1
                End If
            Next j
        Next i
    End If
End Function

My results are:

Sisic1: 1281
Sisic2: 1875
Sisic3: 469
InstrCount3: 516

They are, alternatingly, both 344 ms, and every second run yours is about 10-20 ms faster.

I also found that my phrase checking doesn't work, umm, so will fix that...

When run at realtime not much siginificant difference:

Sisic1: 1250
Sisic2: 1843
Sisic3: 455
InstrCount3: 516

How fast does it run on your system?

Quote:

---

Originally Posted by penagate

They are, alternatingly, both 344 ms, and every second run yours is about 10-20 ms faster.

I also found that my phrase checking doesn't work, umm, so will fix that...

---

I think that perhaps we should call a draw? Before long we'll be by passing every VB call (for instance SafeArrayCreateVectorEx will half the amount of heap allocations) for weird and wonderful API calls. :)

Still both are examples of extremely fast VB code.

I hope the author of the thread appreciates this lot :)

It's tricky to directly do stack allocations using VB. You'll need a machine code snippet that pushes and pops stuff at the right place at the right time.

Do you think I'm gonna tell ya how? Never ;)

There is a way of using heap allocations, and tricking VB to copy the local heap onto the stack, though . . .

Quote:

---

Originally Posted by yrwyddfa

It's tricky to directly do stack allocations using VB. You'll need a machine code snippet that pushes and pops stuff at the right place at the right time.

Do you think I'm gonna tell ya how? Never ;)

There is a way of using heap allocations, and tricking VB to copy the local heap onto the stack, though . . .

---

QBASIC could do these in 1 statement couldn't it? :)

chem

Cricket is the best sport ever invented. It isn't even a sport. It's about drinking and smoking and occasionally throwing/hitting/catching a ball.

The times listed are for 1million goes at the function. I suspect the Sudoku people will be using either mine, or Penegate's code when they find it.

I can't easily (ie without stepping up in a magnitude of ability) see how either piece of code can be directly improved.

I know how to do inline ASM but not how to call it without using an API and I think that would negate any advantage the stack allocation would have.

In this instance I would load an array with the ASM the final JMP instruction pointing to a module level Sub.

Using subclassing you can get Windows to vector to the array, the array should then vector to your local sub where you can clean up.

I haven't tried it (on this thing) but the setup code is bound to be expensive.

I tried a variety of things and all made it slower, so I'm willing to call it a draw here. I think we can safely say we have got fairly close to the fastest it can be done in pure VB.

BTW, why do you go backwards in your loop? I tried it and it makes no difference.

I just deleted a half-dozen chit chat posts from this thread and on a day when the server is slow, that doesn't make me happy so please let's stick to VB. Also there are 30+ replies here and we are not even sure what the original poster wants. Shouldn't we wait to find out?

Marty: We know what the poster wants, it's in the first post. He wants an algorithm to count the number of radixes in a string. OK we hijacked the post a little . . .

Penagate: the reason why I reversed the loops is because in assembly, and on the x86 architecture loops always ran faster backwards because there was one less counter allocation. I have no empirical evidence that this works with compiled VB one way or the other, but it certainly worked with TASM on my old 386 . . .

In assembly you would loop using %ecx. Here we're looping using i and j which you tell me is heap-allocated (I always thought locals were stack allocated but eh). So a loop is always gonna be faster in ASM.

As for backwards I see that you can use the "loop" instruction and it decreases the counter register. However that only decreases it by one and we are using Step. So I don't think either way is going to have any difference on the compiled output (probably just difference between an "add" and "sub").

Non-pointer variables (simple types) are - as you say - stack allocated. I'm pretty sure that SafeArray's are heap allocated.

VB Code:

Public Function Sisic4(pStr As Long, pFind As Long, lenStr As Long, lenFind As Long) As Long
 
    Dim i As Long
    Dim j As Long
    Dim Flag As Long
    
    CopyMemory BufStr(0), ByVal pStr, lenStr
    CopyMemory BufFind(0), ByVal pFind, lenFind
    
    i = lenStr - 1
    
    If lenFind = 2 Then
        Do Until i < lenFind
            If BufStr(i - 1) = BufFind(0) Then
                Sisic4 = Sisic4 + 1
            End If
            i = i - 2
        Loop
    Else
        Do Until i < lenFind
            Flag = 0
            j = lenFind - 1
            Do Until j < 0
                If Not (BufStr(i - (lenFind - j)) = BufFind(j - 1)) Then
                    Flag = -1
                    Exit Do
                End If
                j = j - 2
            Loop
            If Flag = 0 Then
                Sisic4 = Sisic4 + 1
            End If
            i = i - 2
        Loop
    End If
    
End Function

Removing the for/loops makes it go faster!!
Sisic3=469, Sisic4=438

It's more efficient to pass Long values ByVal instead of ByRef because ByRef results in an indirection whereas ByVal doesn't. Seeing as a pointer is the same size as a Long anyway, you lose instead of gaining. I deleted the benchmarking code so see if that gives any increase in times.

No! It makes it slower

Sisic3=475
Sisic4=544

Did you put the code in the form. I just realised it has to do a vtable lookup every time it calls the function, so I put it in a module and it is much faster... in fact your Sisic3 function is faster than Sisic4 that you posted in #41.

ByVal is faster... told you :D

InStrCount3: 375 ms
Sisic3: 344 ms
Sisic4 with ByRef: 343 ms
Sisic4 with ByVal: 313 ms

Yeah I put the function in the form :blush:

I managed to get mine to the same speed as yours, they are now basically exactly the same code :D

It is indeed faster to pass the string length as a parameter, and to use module-level buffers instead of statics.

So far I can't really think of any other optimisations to do.

I was surprised by the minor increase in speed from dumping the for/loops.

Quote:

---

Originally Posted by penagate

I managed to get mine to the same speed as yours, they are now basically exactly the same code :D

It is indeed faster to pass the string length as a parameter, and to use module-level buffers instead of statics.

So far I can't really think of any other optimisations to do.

---

I quite often allocate myself 2k of heap at app startup, and then just use that as a workspace. The main problem is, of course, dereferencing. CopyMemory is fine, but for dereferencing it's pretty slow .. .

I toyed with the idea of using HeapAlloc, but then the thought of calling CopyMemory on every loop iteration through the string just put me right off.

I tried it and it was slower.

Any ideas why for/loops are slower than do/loops. I have been under the impression that for/loops were faster.

Can't remember where I got that idea, from!

Neither can I, but I dunno why yours got faster. I tried it too and it over several runs it made no (noticable) difference either way.

BTW, I take that back about not thinking of any other optimisations to do :D

VB Code:

Function InStrCount4( _
    ByVal pszString As Long, _
    ByVal pszFind As Long, _
    ByVal pchSearchChar As Byte, _
    ByVal lStringLen As Long, _
    ByVal lFindLen As Long _
) As Long
Dim i               As Long
Dim j               As Long
 
    CopyMemory mchBuf(0), ByVal pszString, lStringLen
 
    If (lFindLen = 2) Then
        If (pchSearchChar = 0) Then _
            CopyMemory pchSearchChar, ByVal pszFind, 1
        Do
            If (mchBuf(i) = pchSearchChar) Then _
                InStrCount4 = InStrCount4 + 1
            i = i + 2
        Loop Until i = lStringLen
 
      Else
        CopyMemory mchFind(0), ByVal pszFind, lFindLen
        Do
            Do
                If (mchBuf(i + j) <> mchFind(j)) Then
                    Exit Do
                  Else
                    If (j = lFindLen) Then _
                        InStrCount4 = InStrCount4 + 1
                End If
                j = j + 2
            Loop Until j = lFindLen
            i = i + lFindLen
        Loop Until i = lStringLen
    End If
End Function

Results:
Sisic3: 328 ms
Sisc4 (ByVal): 312 ms
InStrCount4: 282 ms

:D :D

Yeah that's pretty fast. Haven't had time to look at it properly (and probably won't) What have you done? (I haven't got your intermediate code!)

Got rid of Statics, passed string lengths as parameters, that made it as fast as yours.

Added a choice between passing a pointer to find string buffer, and passing a byte character directly, that made it faster than yours.

Oh yeah. That's pretty cool.

If the CopyMemory is typelib defined - then that will make it faster, too (I believe - I haven't tried it yet - but might do some point this week)

according to MSDN Help using ordinal numbers is supposed to be faster than function names. However, I tried, and it made no difference whatsoever. You'd think it would be handled the same way by the linker anyway, so I fail to see the logic behind that one.

VB Code:

[
    uuid(842b47f0-0b27-11da-8cd6-0800200c9a66),
    version(0.1),
    helpstring("Win32 API Kernel32.DLL")
]
library Win32Stuff
{
    importlib("stdole2.tlb");
 
    [dllname("kernel32")]
 
    module kernel32
    {
        [
            entry("RtlMoveMemory")
        ]
        VOID CopyMemory ([in,out] LONG* lpDestination, [in,out] LONG* lpSource, [in] LONG Length);
    }
}

Compile this using MkTypLib (you may need to set a few path environment variables) remove 'CopyMemory' from your declare list and reference the compiled type library.

I get around 18% performance boost.

VB Code:

Public Function Sisic4(ByVal pStr As Long, ByVal pFind As Long, ByVal lenStr As Long, ByVal lenFind As Long) As Long
 
    Dim i As Long
    Dim j As Long
    Dim Flag As Long
    
    CopyMemory VarPtr(BufStr(0)), ByVal pStr, ByVal lenStr
    CopyMemory VarPtr(BufFind(0)), ByVal pFind, ByVal lenFind
    
    i = lenStr - 1
    
    If lenFind = 2 Then
        Do Until i < lenFind
            If BufStr(i - 1) = BufFind(0) Then
                Sisic4 = Sisic4 + 1
            End If
            i = i - 2
        Loop
    Else
        Do Until i < lenFind
            Flag = 0
            j = lenFind - 1
            Do Until j < 0
                If Not (BufStr(i - (lenFind - j)) = BufFind(j - 1)) Then
                    Flag = -1
                    Exit Do
                End If
                j = j - 2
            Loop
            If Flag = 0 Then
                Sisic4 = Sisic4 + 1
            End If
            i = i - 2
        Loop
    End If
    
End Function

.. note the varptr function is used to get the ptr to the first array entry.

Compiled the tlb, but I get a Type Mismatch on the VarPtr parameter?

Weird!

Have you commented out the existing CopyMemory declare?

Yup.

It likes it when I remove all the ByVal keywords, but then when I run my function, it bombs out with a subscript out of range error. Further inspection showed that my i variable had been overwritten with gibberish :sick: