Results 1 to 20 of 20

Thread: [RESOLVED] Looking for possible optimization of code to count bits (1's).

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Aug 2006
    Location
    TeXaS
    Posts
    497

    Resolved [RESOLVED] Looking for possible optimization of code to count bits (1's).

    I was wondering if anyone could find a better solution to this code i wrote.
    The purpose of this function is to simply tell me how many bits are flagged in a long integer.
    I figured there may be some sort of magical equation (which i am not currently seeing) that could possibly cut down most of the looping.
    Thanks in advanced for any time you spend on this.

    Code:
    Public Function FindLetterCount(ByVal pValue As Long) As Byte
        
        Dim MyCnt As Byte
        Dim i As Long
    
        For i = 30 To 0 Step -1
            MyCnt = MyCnt + Abs(CBool(pValue And (2 ^ i)))
        Next i
        
        FindLetterCount = MyCnt
    
    End Function

  2. #2
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,060

    Re: Looking for possible optimization of code to count bits (1's).

    Code:
    Public Function CountLetters(ByVal Value As Long) As Byte
        Dim nTemp As Integer
    
                nTemp = Value And &H1&
        nTemp = nTemp - ((Value And &H2&) = &H2&)
        nTemp = nTemp - ((Value And &H4&) = &H4&)
        nTemp = nTemp - ((Value And &H8&) = &H8&)
        nTemp = nTemp - ((Value And &H10&) = &H10&)
        nTemp = nTemp - ((Value And &H20&) = &H20&)
        nTemp = nTemp - ((Value And &H40&) = &H40&)
        nTemp = nTemp - ((Value And &H80&) = &H80&)
        nTemp = nTemp - ((Value And &H100&) = &H100&)
        nTemp = nTemp - ((Value And &H200&) = &H200&)
        nTemp = nTemp - ((Value And &H400&) = &H400&)
        nTemp = nTemp - ((Value And &H800&) = &H800&)
        nTemp = nTemp - ((Value And &H1000&) = &H1000&)
        nTemp = nTemp - ((Value And &H2000&) = &H2000&)
        nTemp = nTemp - ((Value And &H4000&) = &H4000&)
        nTemp = nTemp - ((Value And &H8000&) = &H8000&)
        nTemp = nTemp - ((Value And &H10000) = &H10000)
        nTemp = nTemp - ((Value And &H20000) = &H20000)
        nTemp = nTemp - ((Value And &H40000) = &H40000)
        nTemp = nTemp - ((Value And &H80000) = &H80000)
        nTemp = nTemp - ((Value And &H100000) = &H100000)
        nTemp = nTemp - ((Value And &H200000) = &H200000)
        nTemp = nTemp - ((Value And &H400000) = &H400000)
        nTemp = nTemp - ((Value And &H800000) = &H800000)
        nTemp = nTemp - ((Value And &H1000000) = &H1000000)
        nTemp = nTemp - ((Value And &H2000000) = &H2000000)
        nTemp = nTemp - ((Value And &H4000000) = &H4000000)
        nTemp = nTemp - ((Value And &H8000000) = &H8000000)
        nTemp = nTemp - ((Value And &H10000000) = &H10000000)
        nTemp = nTemp - ((Value And &H20000000) = &H20000000)
        nTemp = nTemp - ((Value And &H40000000) = &H40000000)
        nTemp = nTemp - ((Value And &H80000000) = &H80000000)
    
        CountLetters = nTemp
    End Function
    Last edited by Bonnie West; Mar 30th, 2013 at 04:41 AM. Reason: Added MSB line
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

  3. #3
    PowerPoster
    Join Date
    Jul 2006
    Location
    Maldon, Essex. UK
    Posts
    6,334

    Re: Looking for possible optimization of code to count bits (1's).

    Could you 'fudge' the top bit by
    Code:
        If (Value And &H80000000) <> 0 Then nTemp = nTemp + 1
    ? (I bet there's a classier way)

  4. #4
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,060

    Re: Looking for possible optimization of code to count bits (1's).

    In the OP, the most significant bit was ignored for some reason. Since I couldn't figure out why, I just decided to leave it out as well.
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

  5. #5
    PowerPoster
    Join Date
    Jul 2006
    Location
    Maldon, Essex. UK
    Posts
    6,334

    Re: Looking for possible optimization of code to count bits (1's).

    @Bonnie: I'm guessing that OP was seeing an Overflow error using the original technique when 'looking' at bit 31. I suppose your code could be modified to just add it in
    Code:
    nTemp = nTemp - ((Value And &H80000000) = &H80000000)

  6. #6
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,060

    Re: Looking for possible optimization of code to count bits (1's).

    Ah yes, that must be it! The code you gave is, of course, the logical continuation of my code!
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

  7. #7
    Cumbrian Milk's Avatar
    Join Date
    Jan 2007
    Location
    0xDEADBEEF
    Posts
    2,448

    Re: Looking for possible optimization of code to count bits (1's).

    I don't have vb6 any more, but I think this will work.
    Code:
    Public Function CountBits(ByVal pValue As Long) As Long    
        Dim Ct As Long
        Do While pValue <> 0
          Ct = Ct + 1
          pValue = pValue And (pValue - 1) 'remove lsb
        Loop
        FindLetterCount = Ct
    End Function
    It should only loop for the number of bits in the number, i.e. it is slower when more bits are set.
    W o t . S i g

  8. #8
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,060

    Re: Looking for possible optimization of code to count bits (1's).

    That is very clever, Milk!

    But there is just one problem - when the MSB is set, it overflows!

    You also had a typo.

    Code:
    Public Function CountBits(ByVal Value As Long) As Long
        Const MSB = &H80000000, ONE = 1&
    
        CountBits = -((Value And MSB) = MSB)
        Value = Value And &H7FFFFFFF
    
        Do While Value
            CountBits = CountBits + ONE
            Value = Value And Value - ONE
        Loop
    End Function
    EDIT

    Combining Milk's and dilettante's codes resulted in the amended function above, which can now count the MSB as well.
    Last edited by Bonnie West; Apr 1st, 2013 at 12:22 AM. Reason: Fixed overflow bug
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

  9. #9
    Fanatic Member
    Join Date
    Jan 2013
    Posts
    894

    Re: Looking for possible optimization of code to count bits (1's).

    can be faster, just concatenate all those lines, and save a lot of memory writes


    Public Function CountLetters(ByVal Value As Long) As Byte

    CountLetters = (Value And &H1& ) - ((Value And &H2&) = &H2&) - ((Value And &H4&) = &H4&) - ((Value And &H8&) = &H8&) - ((Value And &H10&) = &H10&) - ((Value And &H20&) = &H20&) - ((Value And &H40&) = &H40&) - ((Value And &H80&) = &H80&) - ((Value And &H100&) = &H100&) - ((Value And &H200&) = &H200&) - ((Value And &H400&) = &H400&) - ((Value And &H800&) = &H800&) - ((Value And &H1000&) = &H1000&) - ((Value And &H2000&) = &H2000&) - ((Value And &H4000&) = &H4000&) - ((Value And &H8000&) = &H8000&) - ((Value And &H10000) = &H10000) - ((Value And &H20000) = &H20000) - ((Value And &H40000) = &H40000) - ((Value And &H80000) = &H80000) - ((Value And &H100000) = &H100000) - ((Value And &H200000) = &H200000) - ((Value And &H400000) = &H400000) - ((Value And &H800000) = &H800000) - ((Value And &H1000000) = &H1000000) - ((Value And &H2000000) = &H2000000) - ((Value And &H4000000) = &H4000000) - ((Value And &H8000000) = &H8000000) - ((Value And &H10000000) = &H10000000) - ((Value And &H20000000) = &H20000000) - ((Value And &H40000000) = &H40000000) - ((Value And &H80000000) = &H80000000)

    End Function

  10. #10
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,060

    Re: Looking for possible optimization of code to count bits (1's).

    Quote Originally Posted by flyguille View Post
    can be faster, just concatenate all those lines, and save a lot of memory writes
    Somebody disagrees with you:

    Quote Originally Posted by triggernum5
    I just thought I'd mention that I did testing on vb6 arithmetic, and found that there is often a drastic (Up to 40% in extreme case) performance increase to be had by splitting long equations over multiple lines.. A good rule of thumb when you need fast math is to replace avoid the brackets and take it to the next line instead
    Also, isn't it that VB still has to save to a temporary variable the results of each subexpression? While attempting to concatenate all of those lines, I ran into VB's limits on line length and continuation characters, so I had to place 2 subexpressions on each line.
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

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

    Re: Looking for possible optimization of code to count bits (1's).

    Quote Originally Posted by Bonnie West View Post
    Also, isn't it that VB still has to save to a temporary variable the results of each subexpression? While attempting to concatenate all of those lines, I ran into VB's limits on line length and continuation characters, so I had to place 2 subexpressions on each line.
    If you disasemble the compiled program you might be surprised at the level of optimization the compiler does even using the default optimization settings. Remember, VB6's second compiler pass uses the same code generator that VC 6.0 uses.

    How abut something like this:
    Code:
    Option Explicit
    
    Private Function BitCount(ByVal Value As Long) As Long
        Dim I As Long
        
        BitCount = (Value And &H80000000) <> 0
        Value = Value And &H7FFFFFFF
        For I = 0 To 30
            BitCount = BitCount + (Value And 1)
            Value = Value \ 2
        Next
    End Function
    
    Private Sub Command1_Click()
        MsgBox BitCount(&HF0F0F0F0)
    End Sub
    
    Private Sub Command2_Click()
        Dim V As Long
        Dim C As Long
        
        For V = 0 To 99999
            C = BitCount(V)
        Next
        MsgBox "Done"
    End Sub
    Name:  sshot1.png
Views: 203
Size:  6.1 KB

    Ooops, has a bug. See correction posted below.
    Last edited by dilettante; Mar 31st, 2013 at 10:14 AM.

  12. #12
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,060

    Re: Looking for possible optimization of code to count bits (1's).

    Here are the results of the attached simple benchmark module on my PC:

    Test Number = &HF& 1st 2nd 3rd
    CountLetters = 4 4.7462 secs. 4.8537 secs. 4.8538 secs.
    BitCount = 4 11.5658 secs. 11.5421 secs. 11.5421 secs.

    Test Number = &HFFFF& 1st 2nd 3rd
    CountLetters = 16 5.0503 secs. 4.9849 secs. 4.9847 secs.
    BitCount = 16 11.6078 secs. 11.6078 secs. 11.6078 secs.

    Test Number = &HFFFFFFFF 1st 2nd 3rd
    CountLetters = 32 4.7212 secs. 4.7212 secs. 4.7881 secs.
    BitCount = 30 11.5407 secs. 11.5406 secs. 11.6078 secs.

    Code was compiled to Native Code, optimized for Fast Code, all Advanced Optimizations were on and Process Priority was boosted to Realtime. There were 11 running processes while benchmarking. The loops ran for 100,000,000 iterations.
    Attached Files Attached Files
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

  13. #13

    Thread Starter
    Hyperactive Member
    Join Date
    Aug 2006
    Location
    TeXaS
    Posts
    497

    Re: Looking for possible optimization of code to count bits (1's).

    Thanks Milk!, your code runs much quicker.

  14. #14

    Thread Starter
    Hyperactive Member
    Join Date
    Aug 2006
    Location
    TeXaS
    Posts
    497

    Re: [RESOLVED] Looking for possible optimization of code to count bits (1's).

    Just to say, im actually using 182 bits instead of 31. ive just been looping the array of long integers for now for comparison until i find a better fix. my word search routine feels nearly instant already. i'm just working on making it faster. i appreciate everyones help.

  15. #15
    PowerPoster
    Join Date
    Jul 2006
    Location
    Maldon, Essex. UK
    Posts
    6,334

    Re: [RESOLVED] Looking for possible optimization of code to count bits (1's).

    I think I'd have chickened out and used a Byte Array rather than Longs. Avoids the 'messy' sign bit worries.

  16. #16
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,060

    Re: [RESOLVED] Looking for possible optimization of code to count bits (1's).

    Quote Originally Posted by Doogle View Post
    I think I'd have chickened out and used a Byte Array rather than Longs. Avoids the 'messy' sign bit worries.
    It's all fixed now! See post #8.
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

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

    Re: [RESOLVED] Looking for possible optimization of code to count bits (1's).

    Yeah, BitCount() above has a bug that causes the sign bit to start the count at -1 instead of 1.

    Fix:
    Code:
    Private Function BitCount(ByVal Value As Long) As Long
        Dim I As Long
        
        If Value And &H80000000 Then
            BitCount = 1
            Value = Value And &H7FFFFFFF
        End If
        For I = 0 To 30
            BitCount = BitCount + (Value And 1)
            Value = Value \ 2
        Next
    End Function

  18. #18
    PowerPoster
    Join Date
    Jan 2008
    Posts
    11,074

    Re: [RESOLVED] Looking for possible optimization of code to count bits (1's).

    Better than anything I came up with.

    I converted the long to binary and then summed up the digits

    BTW:

    What value has all 32 bits set?


    Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.

  19. #19
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,060

    Re: [RESOLVED] Looking for possible optimization of code to count bits (1's).

    Quote Originally Posted by jmsrickland View Post
    btw:

    What value has all 32 bits set?
    -1& = &o37777777777 = &hffffffff
    Last edited by Bonnie West; Apr 1st, 2013 at 12:21 AM.
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

  20. #20
    MS SQL Powerposter szlamany's Avatar
    Join Date
    Mar 2004
    Location
    Connecticut
    Posts
    18,263

    Re: [RESOLVED] Looking for possible optimization of code to count bits (1's).

    fwiw...

    I was trolling around looking for a method to find a high order bit in C++ today - and remember seeing this thread the other day...

    I went with this code in C++ to find high order bit.

    Seems you could use it for counting bits as well - by just making the return's be +1's to your return value.

    Wonder how it would time out with your other methods...

    Code:
    	int highOrderBit(__int64 bitPattern) {
    		if (bitPattern >> 63) {return 63;}
    		if (bitPattern >> 62) {return 62;}
    		if (bitPattern >> 61) {return 61;}
    		if (bitPattern >> 60) {return 60;}
    		if (bitPattern >> 59) {return 59;}
    		if (bitPattern >> 58) {return 58;}
    		if (bitPattern >> 57) {return 57;}
    		if (bitPattern >> 56) {return 56;}
    		if (bitPattern >> 55) {return 55;}
    		if (bitPattern >> 54) {return 54;}
    		if (bitPattern >> 53) {return 53;}
    		if (bitPattern >> 52) {return 52;}
    		if (bitPattern >> 51) {return 51;}
    		if (bitPattern >> 50) {return 50;}
    .
    .
    .
    		if (bitPattern >> 9) {return 9;}
    		if (bitPattern >> 8) {return 8;}
    		if (bitPattern >> 7) {return 7;}
    		if (bitPattern >> 6) {return 6;}
    		if (bitPattern >> 5) {return 5;}
    		if (bitPattern >> 4) {return 4;}
    		if (bitPattern >> 3) {return 3;}
    		if (bitPattern >> 2) {return 2;}
    		if (bitPattern >> 1) {return 1;}
    		if (bitPattern >> 0) {return 0;}
    		return -1;
    	}
    [edit] oops - you would have to mask each one in order for it to count bits - right? sorry - nvm [/edit]
    Last edited by szlamany; Apr 1st, 2013 at 09:39 AM.

    *** Read the sticky in the DB forum about how to get your question answered quickly!! ***

    Please remember to rate posts! Rate any post you find helpful - even in old threads! Use the link to the left - "Rate this Post".

    Some Informative Links:
    [ SQL Rules to Live By ] [ Reserved SQL keywords ] [ When to use INDEX HINTS! ] [ Passing Multi-item Parameters to STORED PROCEDURES ]
    [ Solution to non-domain Windows Authentication ] [ Crazy things we do to shrink log files ] [ SQL 2005 Features ] [ Loading Pictures from DB ]

    MS MVP 2006, 2007, 2008

Tags for this Thread

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