Count Bits Extensions-VBForums
Results 1 to 1 of 1

Thread: Count Bits Extensions

  1. #1

    Thread Starter
    Powered By Medtronic dbasnett's Avatar
    Join Date
    Dec 2007
    Location
    Pointless Forest 38.517,-92.023
    Posts
    8,911

    Count Bits Extensions

    The following extensions count the number of bits set (1) in one of the integer data types (8 bits - 64 bits). A reference to the bit hack is in the module.

    Code:
    Imports System.Runtime.CompilerServices
    Module bitcount
        ''' <summary>
        ''' function used by the extension methods
        ''' </summary>
        ''' <param name="num">count bits in this</param>
        ''' <param name="sign">for signed data types the presence of sign</param>
        ''' <returns>bit count as integer</returns>
        ''' <remarks></remarks>
        Private Function CountBits(num As ULong, Optional sign As Boolean = False) As Integer
            ' based on http://graphics.stanford.edu/~seander/bithacks.html#CountBitsSetParallel
            ' m1  = 0x5555555555555555; //binary: 0101...
            ' m2  = 0x3333333333333333; //binary: 00110011..
            ' m4  = 0x0f0f0f0f0f0f0f0f; //binary:  4 zeros,  4 ones ...
    
            Dim i As ULong = num
            i -= ((i >> 1) And &H5555555555555555UL) 'm1 ops = 3
            i = (i And &H3333333333333333UL) + ((i >> 2) And &H3333333333333333UL) 'm2 ops = 4
            i = (i + (i >> 4)) And &HF0F0F0F0F0F0F0FUL 'm4 ops = 3
            i += i >> 8 'ops = 2
            i += i >> 16 'ops = 2
            i += i >> 32 'ops = 2
            i = i And &H7FUL 'ops = 1
            If sign Then i += 1UL 'ops = 1
            Return CInt(i) 'total ops = 18
        End Function
    
        'in the following methods the private function is called to do the work
        'the presence of the 'sign' argument ensures that the private function
        'is used.
    
        'unsigned
        <Extension()>
        Public Function CountBits(num As Byte) As Integer
            Return CountBits(CULng(num), False)
        End Function
    
        <Extension()>
        Public Function CountBits(num As UShort) As Integer
            Return CountBits(CULng(num), False)
        End Function
    
        <Extension()>
        Public Function CountBits(num As UInteger) As Integer
            Return CountBits(CULng(num), False)
        End Function
    
        <Extension()>
        Public Function CountBits(num As ULong) As Integer
            Return CountBits(CULng(num), False)
        End Function
    
        'Note how the 'sign' argument is determined, and how overflows
        'are inhibited by the use of a mask.
        'signed versions
        <Extension()>
        Public Function CountBits(num As SByte) As Integer
            Return CountBits(CULng(num And &H7F), num < 0)
        End Function
    
        <Extension()>
        Public Function CountBits(num As Short) As Integer
            Return CountBits(CULng(num And &H7FFF), num < 0)
        End Function
    
        <Extension()>
        Public Function CountBits(num As Integer) As Integer
            Return CountBits(CULng(num And &H7FFFFFFF), num < 0)
        End Function
    
        <Extension()>
        Public Function CountBits(num As Long) As Integer
            Return CountBits(CULng(num And &H7FFFFFFFFFFFFFFF), num < 0)
        End Function
    
        ''' <summary>
        ''' counts one bits in an array of bytes
        ''' </summary>
        ''' <param name="byteArray">array of bytes</param>
        ''' <returns>count</returns>
        ''' <remarks></remarks>
        <Extension()>
        Public Function CountBits(byteArray As Byte()) As Long
            Dim rv As Long = 0L
            For x As Integer = 0 To byteArray.Length - 1
                Dim b As Byte = byteArray(x)
                Dim count As Integer = b
                count = ((count >> 1) And &H55) + (count And &H55)
                count = ((count >> 2) And &H33) + (count And &H33)
                count = ((count >> 4) And &HF) + (count And &HF)
                rv += count
            Next
            Return rv
        End Function
    
    End Module
    Last edited by dbasnett; Aug 12th, 2014 at 06:02 AM.
    My First Computer -- Documentation Link (RT?M) -- Using the Debugger -- Prime Number Sieve
    Counting Bits -- Subnet Calculator -- UI Guidelines -- SerialPort Answer

    "Those who use Application.DoEvents have no idea what it does and those who know what it does never use it." John Wein
    "They who can give up essential liberty to obtain a little temporary safety, deserve neither liberty nor safety." Benjamin Franklin
    "It is not all that I know that is the problem, it is all I think I do that is."

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width

Survey posted by VBForums.