Binary image compression challenge - Lars's entry

Lars H, 2008-07-27: Some four years after the binary image compression challenge was issued, I was implementing the HashLife algorithm, which has been described as doing "compression in both space and time". So I though I'd check how good it was at compressing images that are not Life patterns. In the case of the cat.gif image, it turned out to be the best so far (not counting entries that used gzip for post-processing)!

The idea is to first encode the image as a quadtree, then serialise that quadtree in a bit-compact manner. The first part is a minor variation on code in HashLife; I even used the exact same find procedure:

proc find {nw ne sw se} {
    variable hash
    set key [list $nw $ne $sw $se]
    if {![info exists hash($key)]} then {
        variable heap
        set hash($key) [llength $heap]
        switch -- [lindex $heap $nw 0] "cell" {
            lappend heap [list 2node $nw $ne $sw $se]
        } "2node" {
            lappend heap [list 4node $nw $ne $sw $se $hash($key)]
        } default {
            lappend heap [list bignode $nw $ne $sw $se $hash($key)]
        }
    }
    return $hash($key)
}
proc encode_photo {name {side -1} {w 0} {h 0} {x 0} {y 0}} {
    if {$side<1} then {
        set w [image width $name]
        set h [image height $name]
        set side 1
        while {$side<$w || $side<$h} {incr side $side}
    }
    if {$side > 1} then {
        set half [expr {$side/2}]
        return [find [encode_photo $name $half $w $h $x $y]\
          [encode_photo $name $half $w $h [expr {$x+$half}] $y]\
          [encode_photo $name $half $w $h $x [expr {$y+$half}]]\
          [encode_photo $name $half $w $h [expr {$x+$half}] [expr {$y+$half}]] ]
    }
    if {$x>=$w || $y>=$h} then {return 0}
    if {[lindex [$name get $x $y] 0]} then {return 0} else {return 1}
}

The resulting quadtree, whose root is returned by this encode_photo, has the following properties:

• Node 0 is always the white bit and node 1 is always the black bit.
• All other nodes are completely identified by its four component nodes, which have numbers lower than that of the node itself.
• The last node is the image as a whole (padded with white to a square whose side is a power of 2).

Hence the tree can be encoded as follows:

• Start with node 2, and do the nodes in sequence.
• In order to encode node n, where 2**(k–1) < n ≤ 2**k, one needs to encode four numbers <2**k, so encode it as a sequence of 4k bits. Just butt all the bits together.

Bit-fiddling is generally awkward, so I only coded two procedures to compute how many are needed.

proc estimate_bits {root} {
    set sum 4
    set last 2
    set bpn 8
    while {2*$last<$root} {
        set sum [expr {$sum + $bpn*$last}]
        incr bpn 4
        incr last $last
    }
    expr {$sum + $bpn*($root-$last)}
}
proc bytelength {image} {
    set ::heap {{cell 0} {cell 1}}
    array unset ::hash
    set root [encode_photo $image]
    format {Last node %d; %d bytes} $root [expr {([estimate_bits $root]+7)/8}]
}

For an actual image encoding format, this would have to be equipped with some way of determining the non-padded dimensions of the image, but that is negligible.

Some approaches for further improving the compression are:

• Use separate address spaces for nodes of different sizes. For the cat image, with 2191 nodes to encode, there are 1074 nodes with side 8, but only 141 nodes with side 4, so in principle you could get by with 4*8=32 bits for each 8-node, making a total of 4296 bytes (38.7% of current file size) for 49% of the nodes. As it currently stands, 929 8-nodes are encoded using more than 32 bits, and the average for all 8-nodes is 39.996 bits per 8-node.
• Use some other arithmetic coding for the numbers.

But I've got other stuff to do…