[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
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
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
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)
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
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.
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
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
Re: Looking for possible optimization of code to count bits (1's).
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
Ooops, has a bug. See correction posted below.
Last edited by dilettante; Mar 31st, 2013 at 10:14 AM.
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.
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
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.
Re: [RESOLVED] Looking for possible optimization of code to count bits (1's).
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.
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
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
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.
Re: [RESOLVED] Looking for possible optimization of code to count bits (1's).
Originally Posted by jmsrickland
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