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 bitsThe "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]
}
}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
}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} 0See also: