[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

---

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

---

Could you 'fudge' the top bit by

Code:

---

    If (Value And &H80000000) <> 0 Then nTemp = nTemp + 1

---

? (I bet there's a classier way) :)

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

@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)

---

Ah yes, that must be it! The code you gave is, of course, the logical continuation of my code!

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.

That is very clever, Milk! :thumb:

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

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.

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

Quote:

---

Originally Posted by flyguille

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.

Quote:

---

Originally Posted by Bonnie West

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

---

Attachment 98275

Ooops, has a bug. See correction posted below.

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.

Thanks Milk!, your code runs much quicker. :)

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.

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

Quote:

---

Originally Posted by Doogle

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.

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

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

---

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?

Quote:

---

Originally Posted by jmsrickland

btw:

What value has all 32 bits set?

---

-1& = &o37777777777 = &hffffffff

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]:blush: