if 0 { <
> [Richard Suchenwirth] 2004-05-31 - Here is code for compactly
storing a 2-dimensional matrix of bits, and getting and setting individual bits. A
maximum of 32 bits is packed into an integer. Together with some admin
data, the whole thing is a [transparent] value in [TOOT] format, though
the code below does not require TOOT. In any case, we get some type safety,
and helpful error messages on misuse, from this tagged representation. As usual with
[transparent] values, you'll have to reassign them to a variable if you
want changes to persist:
set arr [bitarray'set $arr $x $y $bit]
SYNOPSIS:
bitarray $width $height - returns a bitarray of given size, all 0s
bitarray $width $height $ones - same, plus sets all bits specified in $ones
bitarray'set $ba $x $y - returns the bit at row y, column x
bitarray'set $ba $x $y $b - returns a copy of $ba with the bit at row
y, column x set to !!$b
bitarray'ones $ba - returns a 'x y x y ...' list of set bits
The "copy constructor" ''bitarray $w $h $ones'' allows reassigning a
bitarray to another of different size, provided the set bits in $ones,
as might have been returned from the alternative serializer
''bitarray'ones'',
don't exceed the new dimensions. If the bitarray is sparsely populated,
the $ones representation may be more efficient, and convenient for
iteration over set bits.
----
}
proc bitarray {width height {ones ""}} {
set n [expr {($width+31)/32 * $height}]
set 0 [expr 1-1] ;# hope to share the "0" Tcl_Obj
set ints {}
for {set i 0} {$i<$n} {incr i} {
lappend ints $0
}
set ba [list bitarray | [list $width $height $ints]]
foreach {x y} $ones {
set ba [bitarray'set $ba $x $y 1]
}
set ba
}
proc bitarray'set {ba x y {bit ""}} {
if {[lrange $ba 0 1] ne "bitarray |"} {error "expected bitarray but got $ba"}
foreach {w h ints} [lindex $ba 2] break
if {$x<0 || $x>=$w || $y<0 || $y>=$h} {
error "indices $x $y out of bound for $w $h bitarray"
}
set index [expr {($w+31)/32 * $y + $x/32}]
set int [lindex $ints $index]
if {$bit eq ""} {
return [expr {!!($int & (1 << $x%32))}]
} else {
if {$bit != 0} {
lset ints $index [expr {$int | (1 << $x%32)}]
} else {
lset ints $index [expr {$int & ~(1 << $x%32)}]
}
list bitarray | [list $w $h $ints]
}
}
if 0 {The following implementation of bitarray'ones was straightforward
but very slow - 2.7 sec for a 100x100 bitarray on my 200MHz box.}
proc #bitarray'ones ba {
if {[lrange $ba 0 1] ne "bitarray |"} {error "expected bitarray but got $ba"}
foreach {w h ints} [lindex $ba 2] break
set res {}
for {set i 0} {$i<$h} {incr i} {
for {set j 0} {$j<$w} {incr j} {
if [bitarray'set $ba $j $i] {lappend res $j $i}
}
}
set res
}
if 0 {So I whipped up this alternative which is 2 LOC longer, but does
its job in 115 msec - a 20x speedup is well worth a redesign :^}
proc bitarray'ones ba {
if {[lrange $ba 0 1] ne "bitarray |"} {error "expected bitarray but got $ba"}
foreach {w h ints} [lindex $ba 2] break
set res {}
set x 0; set y 0
foreach int $ints {
for {set i 0} {$i<32} {incr i} {
if {$int & (1<<$i)} {lappend res [expr {$x+$i}] $y}
}
if {[incr x 32]>=$w} {set x 0; incr y}
}
set res
}
#--- Test suite:
proc ? {cmd expected} {
set t0 [clock clicks -milli]
catch {uplevel 1 $cmd} res
puts [list $cmd [expr {[clock clicks -milli]-$t0}] msec]
if {$res ne $expected} {puts "$cmd->$res, expected $expected"}
}
? {set a [bitarray 5 5]} {bitarray | {5 5 {0 0 0 0 0}}}
? {bitarray'set $a 1 2} 0
#-- Set a bit, and then another (nonzero counts as 1):
? {set a [bitarray'set $a 1 2 1]} {bitarray | {5 5 {0 0 2 0 0}}}
? {bitarray'ones $a} {1 2}
? {set a [bitarray'set $a 0 0 42]} {bitarray | {5 5 {1 0 2 0 0}}}
? {bitarray'ones $a} {0 0 1 2}
#-- Unset a bit:
? {set a [bitarray'set $a 1 2 0]} {bitarray | {5 5 {1 0 0 0 0}}}
? {bitarray'ones $a} {0 0}
#-- Testing copy constructor:
? {set b [bitarray 5 5 [bitarray'ones $a]]} {bitarray | {5 5 {1 0 0 0 0}}}
#-- But just reassignment makes a good copy, too :)
? {set c $b} {bitarray | {5 5 {1 0 0 0 0}}}
? {bitarray'ones $c} {0 0}
#-- Testing a bigger bitarray - "list" avoids lengthy output:
? {set d [bitarray 100 100 {99 99 0 0 47 11}]; list} {}
? {bitarray'ones $d} {0 0 47 11 99 99}
? {bitarray'set $d 99 99} 1
? {bitarray'set $d 98 76} 0
if 0 { <
>
See also [Bit vectors]
----
!!!!!!
%| [Category Data Structure] |%
[Arts and crafts of Tcl-Tk programming]
!!!!!!
}