Binary image compression challenge - mig's Entry

MS Note: This is similar to Jeff's non-compressing encoding at Binary image compression challenge. It does not compress, the size of the encoded file for an image having X pixels is (12+X/8) bytes.

My compressing entry is at Binary image compression challenge - MS's Entry


The differences are:

  • faster encoding - access the [$img data] in one go, instead of repeating [$img get] calls. Note that it does this twice (once hidden in the photo'colors call).
  • it encodes changes in color, instead of encoding the color.

The second difference is expected to produce more zeros, and hence (maybe?) a file that compresses better even though it has the same length as Jeff's.


Results

  • courier12.dif: 2163b (courier12.dif.gz: 660b) courier12.gif: 1923b
  • times12i.dif: 1611b (times12i.dif.gz: 683b) times12i.gif: 1947b
  • castle.dif: 15763b (castle.dif.gz: 10234b) castle.gif: 11598b

castle.dif has 80% nonzero bits, versus 69% in castle.jeff.

 #
 # Given an image, it returns an encoded binary string.
 #

 proc analyse img {
     set h [image height $img]
     set w [image width  $img]
     set raw [$img data]
     set clr0 [lindex [lindex $raw 0] 0]
     set clr $clr0
     set str {}
 
     catch {
         foreach line $raw {
             foreach pix $line {
                 if {$pix ne $clr} {
                     set clr1 $pix
                     return; #double break
                 }
             }
         }
         set clr1 $clr0
     }
 
     foreach line $raw {
         foreach pix $line {
             append str [expr {$pix ne $clr}]
             set clr $pix
         }
     }
     set clr0 [expr {[string replace $clr0 0 0 0x]}]
     set clr1 [expr {[string replace $clr1 0 0 0x]}]
     return [binary format ssiib* $w $h $clr0 $clr1 $str]
 }

 #
 # Given an encoded binary string, it returns an image.
 #
 
 proc synth {data} {
     binary scan $data ssiib* w h clr0 clr1 str
     set img [image create photo -width $w -height $h]
 
     set clr0 \#[format %06x $clr0]
     set clr1 \#[format %06x $clr1]
 
     set empty [list]
     set data $empty
     set line $empty
 
     set clrs [list $clr0 $clr1]
     set clr $clr0
     set nclr 0
     set i 0
     foreach bit [split $str {}] {
         if {$bit} {
             set nclr [expr {!$nclr}]
             set clr [lindex $clrs $nclr]
         }
         lappend line $clr
         if {[incr i] == $w} {
             lappend data $line
             set line $empty
             set i 0
         }
     }
 
     $img put $data -to 0 0
     return $img
 }

PS I've tried your version in my compression code (my second attempt). The results are interesting indeed, both castle and courier12 compress less than with the JH variant. Howerver, times12i compresses somewhat better - Here are the numbers:

  • courier12: Was 671, grows to 721, gaining 50 bytes
  • times12i: Was 718, shrinks to 684, 34 bytes less
  • castle: Was 11442, grows to 12417, gaining 975 bytes.