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

Thread: argh! count number of full stops??

  1. #1

    Thread Starter
    Junior Member
    Join Date
    Aug 2005
    Location
    perth
    Posts
    30

    Arrow 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

  2. #2
    Banned dglienna's Avatar
    Join Date
    Jun 2004
    Location
    Center of it all
    Posts
    17,901

    Re: argh! count number of full stops??

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


    VB Code:
    1. 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:
    1. MsgBox Len(strBuff) - Len(Replace(strBuff, vbCrLf, "x")) + 1

  3. #3
    No place like 127.0.0.1 eyeRmonkey's Avatar
    Join Date
    Jul 2005
    Location
    Blissful Oblivion
    Posts
    2,306

    Re: argh! count number of full stops??

    By full stops do you mean line breaks? If so then try this:
    VB Code:
    1. lCur = InStr(1, sMyStr, vbCrLf)
    2. Do Until lCur = 0
    3.     lCount = lCount + 1
    4.     lCur = InStr(lCur , sMyStr, vbCrLf)
    5. 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.
    Visual Studio 2005 Professional Edition (.NET Framework 2.0)
    ~ VB .NET Links: Visual Basic 6 to .NET Function Equivalents (Thread) | Refactor! (White Paper) | Easy Control for Wizard Forms | Making A Proper UI For WinForms | Graphics & GDI+ Tutorial | Websites For Free Icons
    ~ QUOTE: Programming today is a race between software engineers striving to build bigger and better idiot-proof programs, and the Universe trying to produce bigger and better idiots. So far, the Universe is winning. -Rich Cook

    ~ eyeRmonkey.com

  4. #4
    Frenzied Member yrwyddfa's Avatar
    Join Date
    Aug 2001
    Location
    England
    Posts
    1,253

    Re: argh! count number of full stops??

    VB Code:
    1. Public Function Sisic(sMain As String, sLookFor As String) As Long
    2.  
    3.    '[S]tring [I]n [S]tring [I}nstance [C]ount
    4.    
    5.     Dim nStart As Long
    6.     Dim nResult As Long
    7.  
    8.     nStart = 1
    9.     nResult = 0
    10.    
    11.     Do While InStr(nStart, sMain, sLookFor) > 0
    12.         nStart = InStr(nStart, sMain, sLookFor) + 1
    13.         Sisic = Sisic + 1
    14.     Loop
    15.    
    16. End Function

    There are more efficient ways to do this, but this is the most readable, and is virtually identical to the post above.
    "As far as the laws of mathematics refer to reality, they are not certain; and as far as they are certain, they do not refer to reality." - Albert Einstein

    It's turtles! And it's all the way down

  5. #5
    Frenzied Member yrwyddfa's Avatar
    Join Date
    Aug 2001
    Location
    England
    Posts
    1,253

    Re: argh! count number of full stops??

    Try this:

    VB Code:
    1. Option Explicit
    2.  
    3. Private Sub Form_Load()
    4.  
    5.     Debug.Print Sisic("Now is the time for all good men to come to the aid of the party", "o")
    6.    
    7. End Sub
    8.  
    9. Public Function Sisic(Str As String, LookFor As String) As Long
    10.  
    11.     Dim lLookFor As Long
    12.     Dim Tmp() As Byte
    13.     Dim i As Long
    14.    
    15.     If LenB(Str) > 0 Then
    16.    
    17.         lLookFor = AscW(LookFor)
    18.         Tmp = Str
    19.        
    20.         For i = 0 To LenB(Str) - 1 Step 2
    21.             If Tmp(i) = lLookFor Then
    22.                 Sisic = Sisic + 1
    23.             End If
    24.         Next
    25.        
    26.     End If
    27.    
    28. End Function
    "As far as the laws of mathematics refer to reality, they are not certain; and as far as they are certain, they do not refer to reality." - Albert Einstein

    It's turtles! And it's all the way down

  6. #6
    I'm about to be a PowerPoster!
    Join Date
    Jan 2005
    Location
    Everywhere
    Posts
    13,647

    Re: argh! count number of full stops??

    VB Code:
    1. Function InStrCount(ByRef pszString As String, ByRef pszFind As String) As Long
    2. Dim sTemp As String
    3.     sTemp = Replace$(pszString, pszFind, vbNullString)
    4.     InStrCount = Len(pszString) - Len(sTemp)
    5. End Function

  7. #7
    Frenzied Member yrwyddfa's Avatar
    Join Date
    Aug 2001
    Location
    England
    Posts
    1,253

    Re: argh! count number of full stops??

    VB Code:
    1. Option Explicit
    2.  
    3. Private Declare Function GetTickCount Lib "kernel32" () As Long
    4.  
    5.  
    6. Private Sub Command1_Click()
    7.  
    8.     Const TEST As String = "Now is the time for all good men to come to the aid of the party"
    9.    
    10.     Dim Start As Long
    11.     Dim Finish As Long
    12.     Dim i As Long
    13.    
    14.     Start = GetTickCount()
    15.     For i = 0 To 1000000
    16.         Sisic TEST, "o"
    17.     Next
    18.     Finish = GetTickCount()
    19.     Text1.Text = Finish - Start
    20.    
    21.     Start = GetTickCount()
    22.     For i = 0 To 1000000
    23.         InStrCount TEST, "o"
    24.     Next
    25.     Finish = GetTickCount
    26.     Text2.Text = Finish - Start
    27.    
    28. End Sub
    29.  
    30.  
    31. Public Function Sisic(Str As String, LookFor As String) As Long
    32.  
    33.     Dim lLookFor As Long
    34.     Dim Tmp() As Byte
    35.     Dim i As Long
    36.    
    37.     If LenB(Str) > 0 Then
    38.    
    39.         lLookFor = AscW(LookFor)
    40.         Tmp = Str
    41.        
    42.         For i = 0 To LenB(Str) - 1 Step 2
    43.             If Tmp(i) = lLookFor Then
    44.                 Sisic = Sisic + 1
    45.             End If
    46.         Next
    47.        
    48.     End If
    49.    
    50. End Function
    51.    
    52. Function InStrCount(ByRef pszString As String, ByRef pszFind As String) As Long
    53. Dim sTemp As String
    54.     sTemp = Replace$(pszString, pszFind, vbNullString)
    55.     InStrCount = Len(pszString) - Len(sTemp)
    56. End Function

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

    on P4 2.79Ghz,1Gb RAM
    "As far as the laws of mathematics refer to reality, they are not certain; and as far as they are certain, they do not refer to reality." - Albert Einstein

    It's turtles! And it's all the way down

  8. #8
    Frenzied Member yrwyddfa's Avatar
    Join Date
    Aug 2001
    Location
    England
    Posts
    1,253

    Re: argh! count number of full stops??

    in VB6 "Strings are Evil"(TM)

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

    Don't be sad.
    "As far as the laws of mathematics refer to reality, they are not certain; and as far as they are certain, they do not refer to reality." - Albert Einstein

    It's turtles! And it's all the way down

  9. #9
    Frenzied Member yrwyddfa's Avatar
    Join Date
    Aug 2001
    Location
    England
    Posts
    1,253

    Re: argh! count number of full stops??

    VB Code:
    1. Option Explicit
    2.  
    3. Private Declare Function GetTickCount Lib "kernel32" () As Long
    4.  
    5.  
    6. Private Sub Command1_Click()
    7.  
    8.     Const TEST As String = "Now is the time for all good men to come to the aid of the party "
    9.    
    10.     Dim Start As Long
    11.     Dim Finish As Long
    12.     Dim i As Long
    13.    
    14.     Start = GetTickCount()
    15.     For i = 0 To 1000000
    16.         Sisic TEST, "o"
    17.     Next
    18.     Finish = GetTickCount()
    19.     Text1.Text = Finish - Start
    20.    
    21.     Start = GetTickCount()
    22.     For i = 0 To 1000000
    23.         InStrCount TEST, "o"
    24.     Next
    25.     Finish = GetTickCount
    26.     Text2.Text = Finish - Start
    27.  
    28.     Start = GetTickCount()
    29.     For i = 0 To 1000000
    30.         Sisic2 TEST, "o"
    31.     Next
    32.     Finish = GetTickCount
    33.     Text3.Text = Finish - Start
    34.    
    35. End Sub
    36.  
    37. Public Function Sisic2(sMain As String, sLookFor As String) As Long
    38.  
    39.    '[S]tring [I]n [S]tring [I}nstance [C]ount
    40.        Dim nStart As Long
    41.     Dim nResult As Long
    42.  
    43.     nStart = 1
    44.     nResult = 0
    45.    
    46.     Do While InStr(nStart, sMain, sLookFor) > 0
    47.         nStart = InStr(nStart, sMain, sLookFor) + 1
    48.         Sisic2 = Sisic2 + 1
    49.     Loop
    50.     End Function
    51.    
    52. Public Function Sisic(Str As String, LookFor As String) As Long
    53.  
    54.     Dim lLookFor As Long
    55.     Dim Tmp() As Byte
    56.     Dim i As Long
    57.    
    58.     If LenB(Str) > 0 Then
    59.    
    60.         lLookFor = AscW(LookFor)
    61.         Tmp = Str
    62.        
    63.         For i = 0 To LenB(Str) - 1 Step 2
    64.             If Tmp(i) = lLookFor Then
    65.                 Sisic = Sisic + 1
    66.             End If
    67.         Next
    68.        
    69.     End If
    70.    
    71. End Function
    72.    
    73. Function InStrCount(ByRef pszString As String, ByRef pszFind As String) As Long
    74. Dim sTemp As String
    75.     sTemp = Replace$(pszString, pszFind, vbNullString)
    76.     InStrCount = Len(pszString) - Len(sTemp)
    77. 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.
    "As far as the laws of mathematics refer to reality, they are not certain; and as far as they are certain, they do not refer to reality." - Albert Einstein

    It's turtles! And it's all the way down

  10. #10
    Super Moderator Wokawidget's Avatar
    Join Date
    Nov 2001
    Location
    Headingly Occupation: Classified
    Posts
    9,632

    Re: argh! count number of full stops??

    I came up with this monstrocity
    VB Code:
    1. Private Function Woof(ByVal Text As String, ByVal SearchString As String) As Long
    2.     Dim lngIndex As Long
    3.     For lngIndex = 1 To Len(Text)
    4.         If Mid$(Text, lngIndex, 1) <> SearchString Then
    5.             Mid$(Text, lngIndex, 1) = " "
    6.         End If
    7.     Next lngIndex
    8.     Text = Replace$(Text, " ", vbNullString)
    9.     Woof = Len(Text)
    10. End Function
    Read it and weep...slower than all of your code

    Woof

  11. #11
    I'm about to be a PowerPoster!
    Join Date
    Jan 2005
    Location
    Everywhere
    Posts
    13,647

    Re: argh! count number of full stops??

    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

    VB Code:
    1. Function InStrCount2(ByRef pszString As String, ByRef pszFind As String) As Long
    2. Dim chBuf()     As Byte
    3. Dim chSearch()  As Byte
    4. Dim lchSearch   As Long
    5. Dim lSearchLen  As Long
    6. Dim lChunkLen   As Long
    7. Dim i           As Long
    8. Dim j           As Long
    9.  
    10.     chBuf = pszString
    11.  
    12.     lChunkLen = LenB(pszFind)
    13.     lSearchLen = LenB(pszString)
    14.  
    15.     If (lChunkLen < lSearchLen) Then
    16.         If (lChunkLen = 2) Then
    17.             lchSearch = AscW(pszFind)
    18.             For i = 0 To lSearchLen - 1 Step 2
    19.                 If (chBuf(i) = lchSearch) Then _
    20.                     InStrCount2 = InStrCount2 + 1
    21.             Next i
    22.           Else
    23.             chSearch = pszFind
    24.  
    25.             For i = 0 To lSearchLen - 1 Step lChunkLen
    26.                 For j = 0 To lChunkLen Step 2
    27.                     If (chBuf(i + j) <> chSearch(j)) Then
    28.                         Exit For
    29.                       Else
    30.                         If (j = lChunkLen) Then _
    31.                             InStrCount2 = InStrCount2 + 1
    32.                     End If
    33.                 Next j
    34.             Next i
    35.         End If
    36.       Else
    37.         Err.Raise 1, , "You suck"
    38.     End If
    39. End Function

    Results (compiled and run at realtime priority):

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

    Specs: Athlon XP 2600+, 512 RAM.

  12. #12
    Frenzied Member yrwyddfa's Avatar
    Join Date
    Aug 2001
    Location
    England
    Posts
    1,253

    Re: argh! count number of full stops??

    This code certainly squeezes the rep point from me. Nice one
    "As far as the laws of mathematics refer to reality, they are not certain; and as far as they are certain, they do not refer to reality." - Albert Einstein

    It's turtles! And it's all the way down

  13. #13
    I'm about to be a PowerPoster!
    Join Date
    Jan 2005
    Location
    Everywhere
    Posts
    13,647

    Re: argh! count number of full stops??

    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.

  14. #14
    Frenzied Member yrwyddfa's Avatar
    Join Date
    Aug 2001
    Location
    England
    Posts
    1,253

    Re: argh! count number of full stops??

    VB Code:
    1. Option Explicit
    2.  
    3. Private Declare Function GetTickCount Lib "kernel32" () As Long
    4. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    5.  
    6. Private BufStr(511) As Byte
    7. Private BufFind(511) As Byte
    8.  
    9. Private Sub Command1_Click()
    10.  
    11.     Const TEST As String = "Now is the time for all good men to come to the aid of the party "
    12.    
    13.     Dim Start As Long
    14.     Dim Finish As Long
    15.     Dim i As Long
    16.    
    17.     Start = GetTickCount()
    18.     For i = 0 To 1000000
    19.         Sisic3 TEST, "o"
    20.     Next
    21.     Finish = GetTickCount
    22.     Text3.Text = Finish - Start
    23.    
    24. End Sub
    25.  
    26. Public Function Sisic3(Str As String, Find As String) As Long
    27.  
    28.     Dim i As Long
    29.     Dim j As Long
    30.     Dim lenStr As Long
    31.     Dim lenFind As Long
    32.     Dim Flag As Long
    33.    
    34.     CopyMemory BufStr(0), ByVal StrPtr(Str), LenB(Str)
    35.     CopyMemory BufFind(0), ByVal StrPtr(Find), LenB(Str)
    36.    
    37.     lenStr = LenB(Str)
    38.     lenFind = LenB(Find)
    39.    
    40.     For i = (lenStr - 1) To lenFind Step -2
    41.         Flag = 0
    42.         For j = (lenFind - 1) To 0 Step -2
    43.             If Not (BufStr(i - (lenFind - j)) = BufFind(j - 1)) Then
    44.                 Flag = -1
    45.                 Exit For
    46.             End If
    47.         Next
    48.         If Flag = 0 Then
    49.             Sisic3 = Sisic3 + 1
    50.         End If
    51.     Next
    52.    
    53. End Function

    Gives a compiled speed of 890.
    "As far as the laws of mathematics refer to reality, they are not certain; and as far as they are certain, they do not refer to reality." - Albert Einstein

    It's turtles! And it's all the way down

  15. #15
    Frenzied Member yrwyddfa's Avatar
    Join Date
    Aug 2001
    Location
    England
    Posts
    1,253

    Re: argh! count number of full stops??

    VB Code:
    1. Public Function Sisic3(Str As String, Find As String) As Long
    2.  
    3.     Dim i As Long
    4.     Dim j As Long
    5.     Dim lenStr As Long
    6.     Dim lenFind As Long
    7.     Dim Flag As Long
    8.    
    9.     lenStr = LenB(Str)
    10.     lenFind = LenB(Find)
    11.    
    12.     CopyMemory BufStr(0), ByVal StrPtr(Str), lenStr
    13.     CopyMemory BufFind(0), ByVal StrPtr(Find), lenFind
    14.    
    15.     For i = (lenStr - 1) To lenFind Step -2
    16.         Flag = 0
    17.         For j = (lenFind - 1) To 0 Step -2
    18.             If Not (BufStr(i - (lenFind - j)) = BufFind(j - 1)) Then
    19.                 Flag = -1
    20.                 Exit For
    21.             End If
    22.         Next
    23.         If Flag = 0 Then
    24.             Sisic3 = Sisic3 + 1
    25.         End If
    26.     Next
    27.    
    28. End Function

    gives a compiled speed of 811
    "As far as the laws of mathematics refer to reality, they are not certain; and as far as they are certain, they do not refer to reality." - Albert Einstein

    It's turtles! And it's all the way down

  16. #16
    Frenzied Member yrwyddfa's Avatar
    Join Date
    Aug 2001
    Location
    England
    Posts
    1,253

    Re: argh! count number of full stops??

    VB Code:
    1. Option Explicit
    2.  
    3. Private Declare Function GetTickCount Lib "kernel32" () As Long
    4. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    5.  
    6. Private BufStr(511) As Byte
    7. Private BufFind(511) As Byte
    8.  
    9. Private Sub Command1_Click()
    10.  
    11.     Const TEST As String = "Now is the time for all good men to come to the aid of the party "
    12.    
    13.     Dim Start As Long
    14.     Dim Finish As Long
    15.     Dim i As Long
    16.     Dim Str As String
    17.    
    18.     Str = "o"
    19.    
    20.     Start = GetTickCount()
    21.     For i = 0 To 1000000
    22.        Sisic3 StrPtr(TEST), StrPtr("is"), LenB(TEST), LenB(Str)
    23.     Next
    24.     Finish = GetTickCount
    25.     Text3.Text = Finish - Start
    26.    
    27. End Sub
    28.  
    29. Public Function Sisic3(ByVal pStr As Long, ByVal pFind As Long, ByVal lenStr As Long, ByVal lenFind As Long) As Long
    30.  
    31.     Dim i As Long
    32.     Dim j As Long
    33.     Dim Flag As Long
    34.    
    35.     CopyMemory BufStr(0), ByVal pStr, lenStr
    36.     CopyMemory BufFind(0), ByVal pFind, lenFind
    37.    
    38.     For i = (lenStr - 1) To lenFind Step -2
    39.         Flag = 0
    40.         For j = (lenFind - 1) To 0 Step -2
    41.             If Not (BufStr(i - (lenFind - j)) = BufFind(j - 1)) Then
    42.                 Flag = -1
    43.                 Exit For
    44.             End If
    45.         Next
    46.         If Flag = 0 Then
    47.             Sisic3 = Sisic3 + 1
    48.         End If
    49.     Next
    50.    
    51. End Function

    Compiled execution time of 515
    "As far as the laws of mathematics refer to reality, they are not certain; and as far as they are certain, they do not refer to reality." - Albert Einstein

    It's turtles! And it's all the way down

  17. #17
    I'm about to be a PowerPoster!
    Join Date
    Jan 2005
    Location
    Everywhere
    Posts
    13,647

    Re: argh! count number of full stops??

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

  18. #18
    I'm about to be a PowerPoster!
    Join Date
    Jan 2005
    Location
    Everywhere
    Posts
    13,647

    Re: argh! count number of full stops??

    w00000t!

    VB Code:
    1. Function InStrCount3(ByVal pszString As Long, ByVal pszFind As Long) As Long
    2. Static chBuf(1024)  As Byte
    3. Static chFind(1024) As Byte
    4. Dim chSearchChar    As Byte
    5. Dim lStringLen      As Long
    6. Dim lFindLen        As Long
    7. Dim i               As Long
    8. Dim j               As Long
    9.  
    10.     RtlMoveMemory lStringLen, ByVal (pszString - 4), 4&
    11.     RtlMoveMemory chBuf(0), ByVal pszString, lStringLen
    12.  
    13.     RtlMoveMemory lFindLen, ByVal (pszFind - 4), 4&
    14.  
    15.     If (lFindLen = 2) Then
    16.         RtlMoveMemory chSearchChar, ByVal pszFind, 1
    17.         For i = 0 To lStringLen Step 2
    18.             If (chBuf(i) = chSearchChar) Then _
    19.                 InStrCount3 = InStrCount3 + 1
    20.         Next i
    21.       Else
    22.         RtlMoveMemory chFind(0), ByVal pszFind, lFindLen
    23.         For i = 0 To lStringLen Step lFindLen
    24.             For j = 0 To lFindLen Step 2
    25.                 If (chBuf(i + j) <> chFind(j)) Then
    26.                     Exit For
    27.                   Else
    28.                     If (j = lFindLen) Then _
    29.                         InStrCount3 = InStrCount3 + 1
    30.                 End If
    31.             Next j
    32.         Next i
    33.     End If
    34. End Function

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

  19. #19

  20. #20
    I'm about to be a PowerPoster!
    Join Date
    Jan 2005
    Location
    Everywhere
    Posts
    13,647

    Re: argh! count number of full stops??

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

    VB Code:
    1. Declare Sub RtlMoveMemory Lib "ntdll.dll" ( _
    2.     ByRef lpvDest As Any, _
    3.     ByRef lpvSrc As Any, _
    4.     ByVal cbLen As Long _
    5. )

  21. #21
    Frenzied Member yrwyddfa's Avatar
    Join Date
    Aug 2001
    Location
    England
    Posts
    1,253

    Re: argh! count number of full stops??

    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.
    "As far as the laws of mathematics refer to reality, they are not certain; and as far as they are certain, they do not refer to reality." - Albert Einstein

    It's turtles! And it's all the way down

  22. #22
    I'm about to be a PowerPoster!
    Join Date
    Jan 2005
    Location
    Everywhere
    Posts
    13,647

    Re: argh! count number of full stops??

    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.

  23. #23
    Frenzied Member yrwyddfa's Avatar
    Join Date
    Aug 2001
    Location
    England
    Posts
    1,253

    Re: argh! count number of full stops??

    VB Code:
    1. Option Explicit
    2.  
    3. Private Declare Function GetTickCount Lib "kernel32" () As Long
    4. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    5.  
    6. Private BufStr(511) As Byte
    7. Private BufFind(511) As Byte
    8.  
    9. Private Sub Command1_Click()
    10.  
    11.     Const TEST As String = "Now is the time for all good men to come to the aid of the party "
    12.    
    13.     Dim Start As Long
    14.     Dim Finish As Long
    15.     Dim i As Long
    16.     Dim Str As String
    17.    
    18.     Str = "o"
    19.    
    20.     Start = GetTickCount()
    21.     For i = 0 To 1000000
    22.        Sisic3 StrPtr(TEST), StrPtr(Str), LenB(TEST), LenB(Str)
    23.     Next
    24.     Finish = GetTickCount
    25.     Text3.Text = Finish - Start
    26.    
    27. End Sub
    28.  
    29. Public Function Sisic3(pStr As Long, pFind As Long, lenStr As Long, lenFind As Long) As Long
    30.  
    31.     Dim i As Long
    32.     Dim j As Long
    33.     Dim Flag As Long
    34.    
    35.     CopyMemory BufStr(0), ByVal pStr, lenStr
    36.     CopyMemory BufFind(0), ByVal pFind, lenFind
    37.    
    38.     If lenFind = 2 Then
    39.         For i = (lenStr - 1) To lenFind Step -2
    40.             If BufStr(i) = BufFind(0) Then
    41.                 Sisic3 = Sisic3 + 1
    42.             End If
    43.         Next
    44.     Else
    45.         For i = (lenStr - 1) To lenFind Step -2
    46.             Flag = 0
    47.             For j = (lenFind - 1) To 0 Step -2
    48.                 If Not (BufStr(i - (lenFind - j)) = BufFind(j - 1)) Then
    49.                     Flag = -1
    50.                     Exit For
    51.                 End If
    52.             Next
    53.             If Flag = 0 Then
    54.                 Sisic3 = Sisic3 + 1
    55.             End If
    56.         Next
    57.     End If
    58.    
    59. End Function

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

    I've added it to this routine and it comes in at 271
    Last edited by yrwyddfa; Aug 26th, 2005 at 08:40 AM.
    "As far as the laws of mathematics refer to reality, they are not certain; and as far as they are certain, they do not refer to reality." - Albert Einstein

    It's turtles! And it's all the way down

  24. #24
    I'm about to be a PowerPoster!
    Join Date
    Jan 2005
    Location
    Everywhere
    Posts
    13,647

    Re: argh! count number of full stops??

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

  25. #25
    Frenzied Member yrwyddfa's Avatar
    Join Date
    Aug 2001
    Location
    England
    Posts
    1,253

    Re: argh! count number of full stops??

    VB Code:
    1. Public Function Sisic3(pStr As Long, pFind As Long, lenStr As Long, lenFind As Long) As Long
    2.  
    3.     Dim i As Long
    4.     Dim j As Long
    5.     Dim Flag As Long
    6.    
    7.     CopyMemory BufStr(0), ByVal pStr, lenStr
    8.     CopyMemory BufFind(0), ByVal pFind, lenFind
    9.    
    10.     If lenFind = 2 Then
    11.         For i = (lenStr - 1) To lenFind Step -2
    12.             If BufStr(i - 1) = BufFind(0) Then
    13.                 Sisic3 = Sisic3 + 1
    14.             End If
    15.         Next
    16.     Else
    17.         For i = (lenStr - 1) To lenFind Step -2
    18.             Flag = 0
    19.             For j = (lenFind - 1) To 0 Step -2
    20.                 If Not (BufStr(i - (lenFind - j)) = BufFind(j - 1)) Then
    21.                     Flag = -1
    22.                     Exit For
    23.                 End If
    24.             Next
    25.             If Flag = 0 Then
    26.                 Sisic3 = Sisic3 + 1
    27.             End If
    28.         Next
    29.     End If
    30.    
    31. End Function
    Yup! Whoops

    It works now but is a measly 453. What does it run at on your machine?
    "As far as the laws of mathematics refer to reality, they are not certain; and as far as they are certain, they do not refer to reality." - Albert Einstein

    It's turtles! And it's all the way down

  26. #26
    Frenzied Member yrwyddfa's Avatar
    Join Date
    Aug 2001
    Location
    England
    Posts
    1,253

    Re: argh! count number of full stops??

    VB Code:
    1. Option Explicit
    2.  
    3. Private Declare Function GetTickCount Lib "kernel32" () As Long
    4. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    5.  
    6. Private BufStr(511) As Byte
    7. Private BufFind(511) As Byte
    8.  
    9.  
    10. Private Sub Command1_Click()
    11.  
    12.     Const TEST As String = "Now is the time for all good men to come to the aid of the party "
    13.    
    14.         Dim Start As Long
    15.     Dim Finish As Long
    16.     Dim i As Long
    17.    
    18.     Dim str As String
    19.    
    20.     str = "o"
    21.    
    22.         Start = GetTickCount()
    23.     For i = 0 To 1000000
    24.         Sisic TEST, "o"
    25.     Next
    26.     Finish = GetTickCount()
    27.     Text1.Text = Finish - Start
    28.    
    29.     Start = GetTickCount()
    30.     For i = 0 To 1000000
    31.         InStrCount3 StrPtr(TEST), StrPtr(str)
    32.     Next
    33.     Finish = GetTickCount
    34.     Text2.Text = Finish - Start
    35.  
    36.     Start = GetTickCount()
    37.     For i = 0 To 1000000
    38.         Sisic2 TEST, "o"
    39.     Next
    40.     Finish = GetTickCount
    41.     Text3.Text = Finish - Start
    42.    
    43.         Start = GetTickCount()
    44.     For i = 0 To 1000000
    45.         Sisic3 StrPtr(TEST), StrPtr(str), LenB(TEST), LenB(str)
    46.     Next
    47.     Finish = GetTickCount
    48.     Text4.Text = Finish - Start
    49.    
    50. End Sub
    51.  
    52.     Public Function Sisic(str As String, LookFor As String) As Long
    53.  
    54.     Dim lLookFor As Long
    55.     Dim Tmp() As Byte
    56.     Dim i As Long
    57.         If LenB(str) > 0 Then
    58.             lLookFor = AscW(LookFor)
    59.         Tmp = str
    60.                 For i = 0 To LenB(str) - 1 Step 2
    61.             If Tmp(i) = lLookFor Then
    62.                 Sisic = Sisic + 1
    63.             End If
    64.         Next
    65.             End If
    66.     End Function
    67.    
    68. Public Function Sisic2(sMain As String, sLookFor As String) As Long
    69.  
    70.    '[S]tring [I]n [S]tring [I}nstance [C]ount
    71.        Dim nStart As Long
    72.     Dim nResult As Long
    73.  
    74.     nStart = 1
    75.     nResult = 0
    76.    
    77.     Do While InStr(nStart, sMain, sLookFor) > 0
    78.         nStart = InStr(nStart, sMain, sLookFor) + 1
    79.         Sisic2 = Sisic2 + 1
    80.     Loop
    81.     End Function
    82.    
    83.  
    84.  
    85. Public Function Sisic3(pStr As Long, pFind As Long, lenStr As Long, lenFind As Long) As Long
    86.  
    87.     Dim i As Long
    88.     Dim j As Long
    89.     Dim Flag As Long
    90.    
    91.     CopyMemory BufStr(0), ByVal pStr, lenStr
    92.     CopyMemory BufFind(0), ByVal pFind, lenFind
    93.    
    94.     If lenFind = 2 Then
    95.         For i = (lenStr - 1) To lenFind Step -2
    96.             If BufStr(i - 1) = BufFind(0) Then
    97.                 Sisic3 = Sisic3 + 1
    98.             End If
    99.         Next
    100.     Else
    101.         For i = (lenStr - 1) To lenFind Step -2
    102.             Flag = 0
    103.             For j = (lenFind - 1) To 0 Step -2
    104.                 If Not (BufStr(i - (lenFind - j)) = BufFind(j - 1)) Then
    105.                     Flag = -1
    106.                     Exit For
    107.                 End If
    108.             Next
    109.             If Flag = 0 Then
    110.                 Sisic3 = Sisic3 + 1
    111.             End If
    112.         Next
    113.     End If
    114.    
    115. End Function
    116.  
    117. Function InStrCount3(ByVal pszString As Long, ByVal pszFind As Long) As Long
    118. Static chBuf(1024)  As Byte
    119. Static chFind(1024) As Byte
    120. Dim chSearchChar    As Byte
    121. Dim lStringLen      As Long
    122. Dim lFindLen        As Long
    123. Dim i               As Long
    124. Dim j               As Long
    125.  
    126.     CopyMemory lStringLen, ByVal (pszString - 4), 4&
    127.     CopyMemory chBuf(0), ByVal pszString, lStringLen
    128.  
    129.     CopyMemory lFindLen, ByVal (pszFind - 4), 4&
    130.  
    131.     If (lFindLen = 2) Then
    132.         CopyMemory chSearchChar, ByVal pszFind, 1
    133.         For i = 0 To lStringLen Step 2
    134.             If (chBuf(i) = chSearchChar) Then _
    135.                 InStrCount3 = InStrCount3 + 1
    136.         Next i
    137.       Else
    138.         CopyMemory chFind(0), ByVal pszFind, lFindLen
    139.         For i = 0 To lStringLen Step lFindLen
    140.             For j = 0 To lFindLen Step 2
    141.                 If (chBuf(i + j) <> chFind(j)) Then
    142.                     Exit For
    143.                   Else
    144.                     If (j = lFindLen) Then _
    145.                         InStrCount3 = InStrCount3 + 1
    146.                 End If
    147.             Next j
    148.         Next i
    149.     End If
    150. End Function

    My results are:

    Sisic1: 1281
    Sisic2: 1875
    Sisic3: 469
    InstrCount3: 516
    "As far as the laws of mathematics refer to reality, they are not certain; and as far as they are certain, they do not refer to reality." - Albert Einstein

    It's turtles! And it's all the way down

  27. #27
    I'm about to be a PowerPoster!
    Join Date
    Jan 2005
    Location
    Everywhere
    Posts
    13,647

    Re: argh! count number of full stops??

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

  28. #28
    Frenzied Member yrwyddfa's Avatar
    Join Date
    Aug 2001
    Location
    England
    Posts
    1,253

    Re: argh! count number of full stops??

    When run at realtime not much siginificant difference:

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

    How fast does it run on your system?
    "As far as the laws of mathematics refer to reality, they are not certain; and as far as they are certain, they do not refer to reality." - Albert Einstein

    It's turtles! And it's all the way down

  29. #29
    Frenzied Member yrwyddfa's Avatar
    Join Date
    Aug 2001
    Location
    England
    Posts
    1,253

    Re: argh! count number of full stops??

    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.
    "As far as the laws of mathematics refer to reality, they are not certain; and as far as they are certain, they do not refer to reality." - Albert Einstein

    It's turtles! And it's all the way down

  30. #30
    Frenzied Member yrwyddfa's Avatar
    Join Date
    Aug 2001
    Location
    England
    Posts
    1,253

    Re: argh! count number of full stops??

    Still both are examples of extremely fast VB code.

    I hope the author of the thread appreciates this lot
    "As far as the laws of mathematics refer to reality, they are not certain; and as far as they are certain, they do not refer to reality." - Albert Einstein

    It's turtles! And it's all the way down

  31. #31
    Frenzied Member yrwyddfa's Avatar
    Join Date
    Aug 2001
    Location
    England
    Posts
    1,253

    Re: argh! count number of full stops??

    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 . . .
    "As far as the laws of mathematics refer to reality, they are not certain; and as far as they are certain, they do not refer to reality." - Albert Einstein

    It's turtles! And it's all the way down

  32. #32
    G&G Moderator chemicalNova's Avatar
    Join Date
    Jun 2002
    Location
    Victoria, Australia
    Posts
    4,246

    Re: argh! count number of full stops??

    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

    Visual Studio 6, Visual Studio.NET 2005, MASM

  33. #33
    Frenzied Member yrwyddfa's Avatar
    Join Date
    Aug 2001
    Location
    England
    Posts
    1,253

    Re: argh! count number of full stops??

    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.
    "As far as the laws of mathematics refer to reality, they are not certain; and as far as they are certain, they do not refer to reality." - Albert Einstein

    It's turtles! And it's all the way down

  34. #34
    I'm about to be a PowerPoster!
    Join Date
    Jan 2005
    Location
    Everywhere
    Posts
    13,647

    Re: argh! count number of full stops??

    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.

  35. #35
    Frenzied Member yrwyddfa's Avatar
    Join Date
    Aug 2001
    Location
    England
    Posts
    1,253

    Re: argh! count number of full stops??

    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.
    "As far as the laws of mathematics refer to reality, they are not certain; and as far as they are certain, they do not refer to reality." - Albert Einstein

    It's turtles! And it's all the way down

  36. #36
    I'm about to be a PowerPoster!
    Join Date
    Jan 2005
    Location
    Everywhere
    Posts
    13,647

    Re: argh! count number of full stops??

    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.

  37. #37
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    33,431

    Re: argh! count number of full stops??

    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?

  38. #38
    Frenzied Member yrwyddfa's Avatar
    Join Date
    Aug 2001
    Location
    England
    Posts
    1,253

    Re: argh! count number of full stops??

    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 . . .
    "As far as the laws of mathematics refer to reality, they are not certain; and as far as they are certain, they do not refer to reality." - Albert Einstein

    It's turtles! And it's all the way down

  39. #39
    I'm about to be a PowerPoster!
    Join Date
    Jan 2005
    Location
    Everywhere
    Posts
    13,647

    Re: argh! count number of full stops??

    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").

  40. #40
    Frenzied Member yrwyddfa's Avatar
    Join Date
    Aug 2001
    Location
    England
    Posts
    1,253

    Re: argh! count number of full stops??

    Non-pointer variables (simple types) are - as you say - stack allocated. I'm pretty sure that SafeArray's are heap allocated.
    "As far as the laws of mathematics refer to reality, they are not certain; and as far as they are certain, they do not refer to reality." - Albert Einstein

    It's turtles! And it's all the way down

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