Richard Suchenwirth 2004-09-02 - Discussion in the Tcl chatroom brought me to propose this challenge for a Tcl contest:
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:
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 }
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: