- courier12.fibo 985b
- times12i.fibo 948b
- castle.fibo 11542b
- ouster.fibo 1775b
The image is
- analyzed as in Binary image compression challenge - mig's Entry - get bytes of transition encoding
- the bits are grouped in bytes (last one completed with 0s to length 8)
- the bytes are ranked by decreasing frequency, and numbered accordingly
- the byte-number stream is converted to a bitstream by Fibonacci coding
Encoding:
2 width
2 height
4 clr0
4 clr1
2 table length
256 table (may be shorter)
? data (fibo encoded)Requires the code at Fibonacci coding. Usage:
set w [encode $img] set img [decode $w]The code:
proc analyze 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
# Find the second color (assumes just two!)
catch {
foreach line $raw {
foreach pix $line {
if {$pix ne $clr} {
set clr1 $pix
return; #double break
}
}
}
set clr1 $clr0
}
# Compute a sequence of bytes encoding the color
# transitions (bit 1 marks a transition)
set mask 128
set byte 0
set bytes [list]
foreach line $raw {
foreach pix $line {
if {$pix ne $clr} {
incr byte $mask
set clr $pix
}
if {$mask != 1} {
set mask [expr {$mask >> 1}]
} else {
lappend bytes $byte
set byte 0
set mask 128
}
}
}
if {$mask!=128} {
lappend bytes $byte
}
return [list $w $h $clr0 $clr1 $bytes]
}
proc stats nums {
foreach num $nums {
if {[info exists a($num)]} {
incr a($num)
} else {
set a($num) 1
}
}
set tally [list]
foreach {num ct} [array get a] {
lappend tally [list $num $ct]
}
lsort -decreasing -index 1 -integer $tally
}
proc encode img {
foreach {w h clr0 clr1 bytes} [analyze $img] break
set data [list $w $h]
lappend data [expr {[string replace $clr0 0 0 0x]}]
lappend data [expr {[string replace $clr1 0 0 0x]}]
set tally [stats $bytes]
set len [llength $tally]
lappend data $len
# Compute the map: the most frequent byte is encoded
# as 1, the secondmost frequent as 2, ...
set i 0
foreach item $tally {
set byte [lindex $item 0]
set rmap($byte) [incr i]
lappend data $byte
}
# Fibonacci-encode the byte sequence
set toEnc [list]
foreach byte $bytes {
lappend toEnc $rmap($byte)
}
lappend data [fiboEncodeList $toEnc]
# Convert the data stream to binary
set clen [string repeat c $len]
set cmd [linsert $data 0 binary format ssiii${clen}B*]
return [eval $cmd]
}
proc decode bin {
set empty [list]
# Read the map and fibo sequence together, separate
# them and convert the map to 0/1 strings.
# Note that the map will be read with 1-based indices,
# hence add a dummy 0-th value
binary scan $bin ssiiiB* w h clr0 clr1 len fib
set map [list *]
set lim [expr {$len*8-1}]
set bmap [string range $fib 0 $lim]
set fib [string range $fib [incr lim] end]
for {set i 0} {$i < $len} {incr i} {
lappend map [string range $bmap 0 7]
set bmap [string range $bmap 8 end]
}
# Decode the Fibonacci-encoded bits
set fibData [fiboDecodeString $fib]
set bits {}
foreach num $fibData {
append bits [lindex $map $num]
}
set bits [string range $bits 0 [expr {$w*$h-1}]]
set fibdata {}
# Regenerate the img data
set clrs [list \#[format %06x $clr0] \#[format %06x $clr1]]
set nclr 0
set clr [lindex $clrs 0]
set i 0
set data $empty
set line $empty
foreach bit [split $bits {}] {
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
}
}
# Create the image
set img [image create photo -width $w -height $h]
$img put $data -to 0 0
return $img
}