by David Qualls (2 Submissions)
Category: Math/Dates
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Wed 21st June 2006
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Simple bit vectors: minor changes from before. getbit(), setbit(), togglebit(), etc. Comes thru e-mail just awful. Use zipped version.
VBcoders
' bitvect: A simple bitvector library.
' David Qualls, Choctaw, Oklahoma
' [email protected]
'
' This file includes a number of constants, a global array, and functions for
' dealing with bits in integers, or arrays of integers (Longs actually). It
' also includes a test function to test the other functions for errors.
'
' The following functions are defined within this file:
'
' getbit (bitvect() As Long, posn As Long) As Long
' setbit (bitvect() As Long, posn As Long)
' clearbit (bitvect() As Long, posn As Long)
' togglebit(bitvect() As Long, posn As Long)
' toggleThen_getbit(bitvect() As Long, posn As Long) As Long
' highestbit(bitvect() As Long) As Long
' lowestbit(bitvect() As Long) As Long
' comparebitv(bv1() As Long, bv2() As Long) As Long
' bits2string(bitvect() As Long) As String
' string2bits(bitvect() As Long, bstr As String) As Long()
'
' A support function: binarySearch_Long() is defined here to prevent
' dependencies on another file. It really belongs in a separate file
'
' Prior to using any of these functions, the initialization function
' initializeBITSarray() should (or must, depending on the function)
' be called one time.
'
' Bit vectors begin with BIT0, not BIT1. All bits OFF is the constant
' NOBITS. Higher order bits (BIT1 is higher order than BIT0, etc.)
' are numerically more significant (BIT1 > BIT0, etc.)
'
' There are two requirements of the array of longs passed to any of these
' functions as the first argument (bitvect), and two requirements of the
' second argument (posn):
' 1: bitvect must not be zero length. Thus, it must be Dimensioned (or
' ReDimensioned) before being passed to the function.
' 2: bitvect must be zero based (the first element must be at index zero).
' 3: posn must not be negative (zero is fine however).
' 4: If bitvect is a static array, posn must never exceed 32*length(bitvect)
' (although getbit() will succeede even if posn is too large.)
'
' That's all the requirements I know of. The functions grow the
' array (if dynamic) as required to accomodate ON bits in higher positions.
' For simplicity, these functions do not attempt to shrink bitvect. However,
' the highestbit() function can be used to obtain the required length of the
' array (reqlen=highestbit() \ 32 + 1) if you wish to shrink it yourself.
' If KeepBitVectorsShort = True Then
' ReDim Preserve bitvect(0 To (highestbit(bitvect) \ 32))
' End If
Public Const NOBITS As Long = 0
Public Const BIT0 As Long = 1
Public Const BIT1 As Long = BIT0 * 2
Public Const BIT2 As Long = BIT1 * 2
Public Const BIT3 As Long = BIT2 * 2
Public Const BIT4 As Long = BIT3 * 2
Public Const BIT5 As Long = BIT4 * 2
Public Const BIT6 As Long = BIT5 * 2
Public Const BIT7 As Long = BIT6 * 2
Public Const BIT8 As Long = BIT7 * 2
Public Const BIT9 As Long = BIT8 * 2
Public Const BIT10 As Long = BIT9 * 2
Public Const BIT11 As Long = BIT10 * 2
Public Const BIT12 As Long = BIT11 * 2
Public Const BIT13 As Long = BIT12 * 2
Public Const BIT14 As Long = BIT13 * 2
Public Const BIT15 As Long = BIT14 * 2
Public Const BIT16 As Long = BIT15 * 2
Public Const BIT17 As Long = BIT16 * 2
Public Const BIT18 As Long = BIT17 * 2
Public Const BIT19 As Long = BIT18 * 2
Public Const BIT20 As Long = BIT19 * 2
Public Const BIT21 As Long = BIT20 * 2
Public Const BIT22 As Long = BIT21 * 2
Public Const BIT23 As Long = BIT22 * 2
Public Const BIT24 As Long = BIT23 * 2
Public Const BIT25 As Long = BIT24 * 2
Public Const BIT26 As Long = BIT25 * 2
Public Const BIT27 As Long = BIT26 * 2
Public Const BIT28 As Long = BIT27 * 2
Public Const BIT29 As Long = BIT28 * 2
Public Const BIT30 As Long = BIT29 * 2
Public Const BIT31 As Long = (Not 0) And (Not _
(BIT0 Or BIT1 Or BIT2 Or BIT3 Or BIT4 Or BIT5 Or BIT6 Or BIT7 Or _
BIT8 Or BIT9 Or BIT10 Or BIT11 Or BIT12 Or BIT13 Or BIT14 Or BIT15 Or _
BIT16 Or BIT17 Or BIT18 Or BIT19 Or BIT20 Or BIT21 Or BIT22 Or BIT23 Or _
BIT24 Or BIT25 Or BIT26 Or BIT27 Or BIT28 Or BIT29 Or BIT30))
Private Const BITS0thru4 As Long = BIT0 Or BIT1 Or BIT2 Or BIT3 Or BIT4
Private Const BITS0thru7 As Long = BIT0 Or BIT1 Or BIT2 Or BIT3 Or BIT4 Or BIT5 Or BIT6 Or BIT7
Private Const BITS8thru15 As Long = BIT8 Or BIT9 Or BIT10 Or BIT11 Or BIT12 Or BIT13 Or BIT14 Or BIT15
Private Const BITS16thru23 As Long = BIT16 Or BIT17 Or BIT18 Or BIT19 Or BIT20 Or BIT21 Or BIT22 Or BIT23
Private Const BITS24thru31 As Long = BIT24 Or BIT25 Or BIT26 Or BIT27 Or BIT28 Or BIT29 Or BIT30 Or BIT31
Public Const BYTE0 As Long = BITS0thru7
Public Const BYTE1 As Long = BITS8thru15
Public Const BYTE2 As Long = BITS16thru23
Public Const BYTE3 As Long = BITS24thru31
Public BITS() As Long
Private testbitvect() As Long
Private testbitvect2() As Long
Sub initializeBITSarray()
ReDim BITS(31)
BITS(0) = BIT0
BITS(1) = BIT1
BITS(2) = BIT2
BITS(3) = BIT3
BITS(4) = BIT4
BITS(5) = BIT5
BITS(6) = BIT6
BITS(7) = BIT7
BITS(8) = BIT8
BITS(9) = BIT9
BITS(10) = BIT10
BITS(11) = BIT11
BITS(12) = BIT12
BITS(13) = BIT13
BITS(14) = BIT14
BITS(15) = BIT15
BITS(16) = BIT16
BITS(17) = BIT17
BITS(18) = BIT18
BITS(19) = BIT19
BITS(20) = BIT20
BITS(21) = BIT21
BITS(22) = BIT22
BITS(23) = BIT23
BITS(24) = BIT24
BITS(25) = BIT25
BITS(26) = BIT26
BITS(27) = BIT27
BITS(28) = BIT28
BITS(29) = BIT29
BITS(30) = BIT30
BITS(31) = BIT31
End Sub
Function getbit(bitvect() As Long, ByVal posn As Long) As Long
'{ Returns zero if the indicated bit is off, NON-ZERO if on.
Dim indx As Long
Dim ofst As Long
indx = posn \ 32 ' Hopefully, basic is smart enough to convert this to posn >> 5
' ofst = posn MOD 32
ofst = posn And BITS0thru4
If indx <= UBound(bitvect) Then
getbit = bitvect(indx) And BITS(ofst)
Else
getbit = 0
End If
'}
End Function
Function setbit(bitvect() As Long, ByVal posn As Long)
'{ Sets indicated bit to one, or ON.
Dim indx As Long
Dim ofst As Long
indx = posn \ 32 ' Hopefully, basic is smart enough to convert this to posn >> 5
' ofst = posn MOD 32
ofst = posn And BITS0thru4
If indx > UBound(bitvect) Then
ReDim Preserve bitvect(0 To indx)
End If
bitvect(indx) = bitvect(indx) Or BITS(ofst)
'}
End Function
Function clearbit(bitvect() As Long, ByVal posn As Long)
'{ Sets indicated bit to zero, or OFF.
Dim indx As Long
Dim ofst As Long
indx = posn \ 32 ' Hopefully, basic is smart enough to convert this to posn >> 5
' ofst = posn MOD 32
ofst = posn And BITS0thru4
If indx <= UBound(bitvect) Then
bitvect(indx) = bitvect(indx) And (Not BITS(ofst))
' Else, do nothing. Bit is assumed off if not within bitvect array.
End If
'}
End Function
Function togglebit(bitvect() As Long, ByVal posn As Long)
'{ Toggles the indicated bit. OFF goes to ON, ON goes to OFF.
Dim indx As Long
Dim ofst As Long
indx = posn \ 32 ' Hopefully, basic is smart enough to convert this to posn >> 5
' ofst = posn MOD 32
ofst = posn And BITS0thru4
If indx > UBound(bitvect) Then ' bit is assumed off, need to set it.
ReDim Preserve bitvect(0 To indx)
End If
bitvect(indx) = bitvect(indx) Xor BITS(ofst)
'}
End Function
Function toggleThen_getbit(bitvect() As Long, ByVal posn As Long) As Long
'{ Toggles the indicated bit, and returns the NEW bit value (well,
' actually, returns zero if new bit is off, NON-ZERO if on.
Dim indx As Long
Dim ofst As Long
indx = posn \ 32 ' Hopefully, basic is smart enough to convert this to posn >> 5
' ofst = posn MOD 32
ofst = posn And BITS0thru4
If indx > UBound(bitvect) Then ' bit is assumed off, need to set it.
ReDim Preserve bitvect(0 To indx)
End If
bitvect(indx) = bitvect(indx) Xor BITS(ofst) ' toggle the bit
toggleThen_getbit = bitvect(indx) And BITS(ofst) ' same as getbit
'}
End Function
Function highestbit(bitvect() As Long) As Long
'{ This function returns the most-significant on-bit of bitvect.
' A value of -1 indicates no bits are on.
Dim indx As Long
Dim ofst As Long
' Linearly search for the last (highest order) element in bitvect array
' with a non-zero value (at least one bit ON).
indx = UBound(bitvect) + 1
Do While indx <> 0
indx = indx - 1
If bitvect(indx) <> 0 Then Exit Do
Loop
If bitvect(indx) = 0 Then 'exited naturally from the for-loop above.
highestbit = -1 'No bits are on.
Exit Function
ElseIf bitvect(indx) And BIT31 Then 'the sign bit is on. Would hose the bsearch algorithm!
ofst = 31
Else ' a linear search will require 15.5 comparisons (on average).
' a binary search will require about 3.91 comparisons (on average).
' This difference probably justifies the function call and
' additional overhead of a binary search.
ofst = binarySearch_Long(bitvect(indx), BITS, 31)
If BITS(ofst) <> bitvect(indx) Then ofst = ofst - 1
End If
highestbit = indx * 32 + ofst
'}
End Function
Function lowestbit(bitvect() As Long) As Long
'{ This function returns the least-significant on-bit of bitvect.
' A value of -1 indicates no bits are on.
Dim indx As Long
Dim ofst As Long
Dim lval As Long
Dim bmask As Long
' Linearly search for the first (lowest order) element in bitvect array
' with a non-zero value (at least one bit ON).
indx = -1
Do While indx < UBound(bitvect)
indx = indx + 1
If bitvect(indx) <> 0 Then Exit Do
Loop
lval = bitvect(indx)
If lval = 0 Then 'exited naturally from the Do-loop above.
lowestbit = -1 'No bits are on.
Exit Function
End If
' do a linear search for lowest order bit.
bmask = BIT0
ofst = 0
Do While ofst <= 29 'loop at most 30 times, and retain ofst.
' If lval And BITS(ofst) Then Goto GOT_OFST ' TOO SLOW. multiplication is faster than array-lookup.
If lval And bmask Then GoTo GOT_OFST 'skip the after-loop section.
bmask = bmask * 2 'would run-time error the 31'st time thru
ofst = ofst + 1
Loop
' after-loop section. Now bmask == BIT30
If lval And bmask Then '31'st attempt. bmask is already in a register. Use it!
ofst = 30
ElseIf lval And BIT31 Then '32'nd attempt
ofst = 31
End If
GOT_OFST:
lowestbit = indx * 32 + ofst
'}
End Function
Function comparebitv(bv1() As Long, bv2() As Long) As Long
'{ Returns -1 is bv1 is numerically less than bv2,
' 0 if bv1 is equal to bv2,
' +1 if bv1 is numerically greater than bv2,
'
Dim indx1 As Long
Dim indx2 As Long
indx1 = UBound(bv1)
indx2 = UBound(bv2)
Do While indx1 > indx2
If bv1(indx1) <> NOBITS Then 'bv1 > bv2
comparebitv = 1
Exit Function
End If
indx1 = indx1 - 1
Loop
Do While indx2 > indx1
If bv2(indx2) <> NOBITS Then 'bv2 > bv1
comparebitv = -1
Exit Function
End If
indx2 = indx2 - 1
Loop
' Now the two indices are equal. Arbitrarily pick indx1 to use.
' Look for the highest order elements that are not equal.
Do
If bv1(indx1) <> bv2(indx1) Then GoTo COMPARE_LONGS
indx1 = indx1 - 1
Loop While indx1 >= 0
' Normal exit: looped thru the entire array, and every element compared equal.
comparebitv = 0
Exit Function
COMPARE_LONGS:
If (bv1(indx1) And BIT31) Xor (bv2(indx1) And BIT31) Then 'they differ in BIT31
If bv2(indx1) And BIT31 Then 'BIT31 of bv1 must have been OFF.
comparebitv = -1 'bv2 is greater.
Else 'BIT31 of bv2 is OFF.
comparebitv = 1 'bv1 is greater.
End If
Exit Function
End If
' Now that the sign bit is handled, the rest is duck-soup since both
' values should be positive. Granted this does ASSUME that 00000 - 01111
' (but with 32 bits, not 5) does not overflow. Works fine in 2's complement.
' If unsure, just get rid of the diff var, and use bv1(indx1) < bv2(indx1),
' bv1(indx1) > bv2(indx1) instead. Unless VB is a smarter optimizer than
' I think it is, the diff construct will run a little faster.
Dim diff As Long
diff = bv1(indx1) - bv2(indx1)
' If bv1(indx1) < bv2(indx1) Then
If diff < 0 Then ' bv1(indx1) < bv2(indx1)
comparebitv = -1
' ElseIf bv1(indx1) > bv2(indx1) Then
ElseIf diff > 0 Then ' bv1(indx1) > bv2(indx1)
comparebitv = 1
Else ' bv1(indx1) = bv2(indx1)
comparebitv = 0
End If
'}
End Function
Private Function intbits2string(intbit As Long) As String
'{
Dim i As Long
Dim bmask As Long
intbits2string = "00000000000000000000000000000000"
bmask = BIT0
For i = 32 To 3 Step -1
If intbit And bmask Then Mid(intbits2string, i, 1) = "1"
bmask = bmask * 2 'this would throw an exception the 31'st time.
'multiplication is faster than retreiving values from BITS array.
Next i
If intbit And bmask Then Mid(intbits2string, 2, 1) = "1"
If intbit And BIT31 Then Mid(intbits2string, 1, 1) = "1"
'}
End Function
Function bits2string(bitvect() As Long) As String
'{
Dim i As Long
For i = UBound(bitvect) To 0 Step -1
bits2string = bits2string & intbits2string(bitvect(i))
Next i
'}
End Function
Function string2bits(bitvect() As Long, bstr As String) As Long()
'{ Converts a string of "1"s and "0"s (actually, any non-1's are treated as
' zeros) into a bit vector and stores it in bitvect. Most significant bits
' appear leftmost within bstr. bitvect must be dynamic (available for ReDim)
' unless bstr will fit within the available length of bitvect.
'
' Returns bitvect().
Dim indx As Long 'within bitvect
Dim ofst As Long 'within each Long in bitvect
Dim posn As Long 'within the input string bstr
Dim lval As Long 'a long valued utility
' Dim digit As String
posn = Len(bstr) - 1
indx = posn \ 32
ofst = (posn And BITS0thru4) + 1
' If bitvect not big enough to hold bit-string,
If indx > UBound(bitvect) Then
ReDim bitvect(0 To indx)
End If
' If bitvect has extra integers in it, make sure they're set to NOBITS.
For lval = UBound(bitvect) To indx + 1 Step -1
bitvect(lval) = NOBITS
Next lval
posn = 1
Do While indx >= 0
lval = NOBITS
Do While ofst > 0
ofst = ofst - 1
'digit = Mid(bstr, posn, 1)
If 0 = StrComp("1", Mid(bstr, posn, 1)) Then lval = lval Or BITS(ofst)
posn = posn + 1
Loop
bitvect(indx) = lval
ofst = 32
indx = indx - 1
Loop
' comment out the following two lines if this is working correctly.
' If posn - 1 <> Len(bstr) Then Debug.Print "ERROR 20"
' Debug.Print bits2string(bitvect)
' Exit Function bitvect() 'The Microsoft book says THIS is how to do it!
string2bits = bitvect() 'This is how it compiles correctly.
'}
End Function
Function testbitvector()
ReDim testbitvect(0)
ReDim testbitvect2(0)
Dim bitstr As String
Dim bitstr2 As String
Dim cntr As Long
Call initializeBITSarray
Call string2bits(testbitvect, "")
If comparebitv(testbitvect2, testbitvect) <> 0 Then Debug.Print "ERROR 21"
If testbitvect(0) <> NOBITS Then Debug.Print "ERROR 21a"
Call string2bits(testbitvect, "1")
' Debug.Print bits2string(testbitvect)
If testbitvect(0) <> BIT0 Then Debug.Print "ERROR 23"
Call clearbit(testbitvect, 0)
Call string2bits(testbitvect, "10000000000000000000000000000000")
If testbitvect(0) <> BIT31 Then Debug.Print "ERROR 24"
' Debug.Print bits2string(testbitvect)
Call clearbit(testbitvect, 31)
Call string2bits(testbitvect, "100000000000000000000000000000000")
If testbitvect(1) <> BIT0 Then Debug.Print "ERROR 24"
' Debug.Print bits2string(testbitvect)
Call clearbit(testbitvect, 32)
If getbit(testbitvect, 5) Then Debug.Print "ERROR 1"
If getbit(testbitvect, 50) Then Debug.Print "ERROR 1a"
Call setbit(testbitvect, 50)
If toggleThen_getbit(testbitvect, 50) Then Debug.Print "ERROR 2"
Call togglebit(testbitvect, 31)
' Debug.Print "Bit 31: " & bits2string(testbitvect)
Call clearbit(testbitvect, 31)
If getbit(testbitvect, 31) Then Debug.Print "ERROR 3"
Debug.Print "Bit cnt " & "9 | 8 | 7 | 6 | 5 | 4 | 3 | 2 | 1 | 0"
Debug.Print "Bit cnt " & "543210987654321098765432109876543210987654321098765432109876543210987654321098765432109876543210"
Call setbit(testbitvect, 64)
Debug.Print "Bit 64: " & bits2string(testbitvect)
Call setbit(testbitvect, 95)
Debug.Print "+Bit 95:" & bits2string(testbitvect)
Call setbit(testbitvect, 0)
Debug.Print "+Bit 0 :" & bits2string(testbitvect)
bitstr = bits2string(testbitvect)
Call string2bits(testbitvect2, bitstr)
Debug.Print "ditto :" & bits2string(testbitvect2)
If comparebitv(testbitvect2, testbitvect) <> 0 Then Debug.Print "ERROR 22"
Call string2bits(testbitvect2, "1")
If testbitvect2(2) <> NOBITS Or testbitvect2(1) <> NOBITS _
Or testbitvect2(0) <> BIT0 Then Debug.Print "ERROR 25"
ReDim testbitvect2(0)
If lowestbit(testbitvect) <> 0 Then Debug.Print "ERROR 4"
If highestbit(testbitvect) <> 95 Then Debug.Print "ERROR 5"
Call clearbit(testbitvect, 95)
Call clearbit(testbitvect, 0)
Call setbit(testbitvect, 31)
Call setbit(testbitvect, 51)
If lowestbit(testbitvect) <> 31 Then Debug.Print "ERROR 6"
If highestbit(testbitvect) <> 64 Then Debug.Print "ERROR 7"
Call clearbit(testbitvect, 64)
Call clearbit(testbitvect, 31)
Call clearbit(testbitvect, 51)
If lowestbit(testbitvect) <> -1 Then Debug.Print "ERROR 8"
If highestbit(testbitvect) <> -1 Then Debug.Print "ERROR 9"
Call setbit(testbitvect, 31)
Call setbit(testbitvect2, 32)
If comparebitv(testbitvect, testbitvect2) <> -1 Then Debug.Print "ERROR 10"
If comparebitv(testbitvect2, testbitvect) <> 1 Then Debug.Print "ERROR 11"
Call clearbit(testbitvect2, 32)
Call setbit(testbitvect2, 31)
Call setbit(testbitvect2, 30)
If comparebitv(testbitvect, testbitvect2) <> -1 Then Debug.Print "ERROR 12"
If comparebitv(testbitvect2, testbitvect) <> 1 Then Debug.Print "ERROR 13"
Call clearbit(testbitvect2, 31)
If comparebitv(testbitvect, testbitvect2) <> 1 Then Debug.Print "ERROR 14"
If comparebitv(testbitvect2, testbitvect) <> -1 Then Debug.Print "ERROR 15"
Call clearbit(testbitvect2, 30) 'now testbitvect2 is all OFF.
If comparebitv(testbitvect, testbitvect2) <> 1 Then Debug.Print "ERROR 16"
If comparebitv(testbitvect2, testbitvect) <> -1 Then Debug.Print "ERROR 17"
ReDim testbitvect(0)
If comparebitv(testbitvect, testbitvect2) <> 0 Then Debug.Print "ERROR 18"
If comparebitv(testbitvect2, testbitvect) <> 0 Then Debug.Print "ERROR 19"
ReDim testbitvect2(0)
ReDim testbitvect(0)
For cntr = 0 To 99
Call setbit(testbitvect2, cntr)
If highestbit(testbitvect2) <> cntr Then Debug.Print "ERROR 40"
bitstr = bits2string(testbitvect2)
If comparebitv(string2bits(testbitvect, bitstr), testbitvect2) <> 0 Then Debug.Print "ERROR 41 at cntr=" & cntr
Next cntr
ReDim testbitvect2(0)
ReDim testbitvect(0)
For cntr = 99 To 0 Step -1
Call setbit(testbitvect2, cntr)
If lowestbit(testbitvect2) <> cntr Then Debug.Print "ERROR 42"
bitstr = bits2string(testbitvect2)
If comparebitv(string2bits(testbitvect, bitstr), testbitvect2) <> 0 Then Debug.Print "ERROR 43 at cntr=" & cntr
Next cntr
Debug.Print "End of tests for bitvector."
End Function
Private Function binarySearch_Long(ByVal key As Long, realarray() As Long, ByVal nelem As Long) As Long
'{ I believe this algorithm may have the theoretic minimum number of iterations.
' It has less than any other bsearch I've examined.
Dim lft As Long, rht As Long
Dim elm As Long ' array element value
Dim diff As Long
binarySearch_Long = 0 ' in case nelem=0
lft = 0
rht = nelem ' off the end of the array: by design!
Do While lft < rht ' automatically checks for zero len array.
'{ ' must exit loop when lft == rht.
' NOTE: The following will overflow if nelem > ~1 billion!
binarySearch_Long = (rht + lft) \ 2
' binarySearch_Long = lft + (rht - lft) \ 2 'good up to about 2 billion.
' See line 368 for a discussion about diff. Since all values in
' this context are positive, it should work and not overflow. Don't
' use this approach in general; instead use the commented out approach.
diff = key - realarray(binarySearch_Long)
' elm = realarray(binarySearch_Long)
' If key < elm Then
If diff < 0 Then
rht = binarySearch_Long ' rht always in 'already compared' state.
' ElseIf key > elm Then
ElseIf diff > 0 Then
lft = binarySearch_Long + 1 ' lft always in 'not yet compared' state.
Else ' Found it!
Exit Function
End If
'}
Loop
binarySearch_Long = rht ' or lft; doesn't matter.
'}
End Function
No comments have been posted about Simple bit vectors: minor changes from before. getbit(), setbit(), togglebit(), etc. Comes thru e-m. Why not be the first to post a comment about Simple bit vectors: minor changes from before. getbit(), setbit(), togglebit(), etc. Comes thru e-m.
