Version 15 of Binary image compression challenge
Updated 2004-09-04 01:49:06Richard Suchenwirth 2004-09-02 - Discussion in the Tcl chatroom brought me to propose this challenge for a Tcl contest:
- Given a set of moderate-sized black&white GIF images,
- write a pair of encoder/decoder between photo image and a binary string
- so that the decoding of the encoded image is equal to the original (lossless)
- and the average length of the encoded strings is minimal
I prefer GIF here because it is lossless in itself, and can be read in by plain Tk. Bitmap images cannot be processed pixel-by-pixel, so they're excluded, although they're binary.
Test images (feel free to add more. The GIF file size is the initial target to beat):
courier12.gif - 1923 bytes:
times12i.gif - 1947 bytes:
castle.gif - 11598 bytes
Links to solutions to this challenge:
- PS My you can find my attempt on Binary image compression challenge - Pascal's Entry. It compresses courier12.gif to 720 bytes and times12.gif to 834 bytes. Castle.gif is actually a compressed gif file! Mine 'compressed' to 13672...
Little helpers to compare and tally photo images:
proc photo'eq {im1 im2} {
#-- returns 1 if both images are exactly equal, else 0
set h [image height $im1]
if {[image height $im2] != $h} {return 0}
set w [image width $im1]
if {[image width $im2] != $w} {return 0}
for {set y 0} {$y<$h} {incr y} {
for {set x 0} {$x<$w} {incr x} {
if {[$im1 get $x $y] ne [$im2 get $x $y]} {return 0}
}
}
return 1
}
proc photo'colors img {
#-- return a list of {{r g b} n} tallies of pixel colors,
#-- sorted decreasing by n (number of pixels of that color)
set h [image height $img]
set w [image width $img]
for {set y 0} {$y<$h} {incr y} {
for {set x 0} {$x<$w} {incr x} {
set color [$img get $x $y]
if {![info exists a($color)]} {set a($color) 0}
incr a($color)
}
}
foreach {color n} [array get a] {lappend tally [list $color $n]}
lsort -decreasing -index 1 -integer $tally
}JH: Here is my solution, which doesn't compression at all (doesn't beat the GIF format, but is close, the 1923b becomes 2163b). It just represents the data in a small, raw form, but not compressed. It will hopefully provide someone with a starting point to apply compression. MS: castle.gif is 'compressed' to 15764b by this; gzip reduces that file to 10305b.
proc binimg'encode img {
set clrs [photo'colors $img]
if {[llength $clrs] != 2} { return -code error "not a 2 color image" }
set clr0 [lindex $clrs 0 0]
set clr1 [lindex $clrs 1 0]
set h [image height $img]
set w [image width $img]
set str ""
for {set y 0} {$y<$h} {incr y} {
for {set x 0} {$x<$w} {incr x} {
set color [$img get $x $y]
append str [string equal $color $clr1]
}
}
foreach {r g b} $clr0 { set color0 [expr {$r<<16 | $g <<8 | $b}]; break }
foreach {r g b} $clr1 { set color1 [expr {$r<<16 | $g <<8 | $b}]; break }
# store image as <w><h><clr0><clr1><binimgdata> where w and h are shorts
set binstr [binary format ssiib* $w $h $color0 $color1 $str]
return $binstr
}
proc binimg'decode data {
binary scan $data ssiib* w h color0 color1 clrs
set img [image create photo -width $w -height $h]
set clr(0) \#[format %.6x $color0]
set clr(1) \#[format %.6x $color1]
set i 0
set data ""
set line ""
foreach c [split $clrs {}] {
lappend line $clr($c)
if {[incr i] eq $w} {
set i 0
lappend data $line
set line ""
}
}
$img put $data -to 0 0
return $img
}See Binary image compression challenge - mig's Entry for a slight variant of this, which should compress better in general.
DKF: The simplest cheat way is to use gzip to compress the GIF files themselves! Both images compress to somewhere in the region of 1600-1650 bytes. Can you do better?
MS: Yes; gzip'ing Jeff's coded files reduces the thing to 640-654 bytes.
kroc: My attempt, based on RLE is here: Binary image compression challenge - Kroc's Entry and my results are:
- 923 bytes for courier12.gif
- 904 bytes for times12i.gif
- 15421 bytes for castle.gif (this one is very hard to beat).