Version 2 of Fibonacci coding

Updated 2004-09-04 14:16:45

MS While rereading Data Compression [2 ], I stumbled on Fibonacci universal codes (see Section 3.3 [1 ]).

Usage:

 % fiboEncodeList { 1 2 3 4 5 6 7 8 9 8 7 6 5 4 3 2 1}
 11110110011011100011001110101100001100011100001101011001110001101110011011
 % fiboDecodeStr 11110110011011100011001110101100001100011100001101011001110001101110011011
 1 2 3 4 5 6 7 8 9 8 7 6 5 4 3 2 1

The code:

 #
 # A memoizing generator for the Fibonacci numbers.  
 #

 variable fiboList [list 1 1]
 proc fibo n {
     variable fiboList
     set len [llength $fiboList]
     if {$len > $n} {
         return [lindex $fiboList $n]
     } 
     set res [expr {[fibo [expr {$n-2}]] + [fibo [expr {$n-1}]]}]
     lappend fiboList $res
     return $res
 }

 #
 # Computing the Fibonacci encoding of a number - see 
 # http://www.ics.uci.edu/~dan/pubs/DC-Sec3.html#Sec_3
 # (memoizing)
 #
 # Slight changes with respect to the reference in order 
 # to improve performance:
 #   - the codes are reversed, in order to be able to use
 #     appends instead of prepends
 #     Thus enc(5)=11000 instead of 00011
 #   - the initial 11 is replaced by an initial 1, so that
 #     split and join are easier to use to encode/decode
 #     streams.
 #

 variable fiboEncs
 proc fiboEncodeNum n {
     if {$n < 1} {
         error "fiboEncode works on positive numbers"
     }
     variable fiboEncs
     if {[info exists fiboEncs($n)]} {
         return $fiboEncs($n)
     }
     upvar 0 fiboEncs($n) res
     set res {}

     # Find the first fibonacci number $f > $n
     set f 1
     for {set k 1} {$f <= $n} {} {
         set f [fibo [incr k]]
     }

     while {[incr k -1]} {
         set f [fibo $k]
         if {$f <= $n} {
             append res 1
             incr n -$f
         } else {
             append res 0
         }
     }
     return $res
 }

 proc fiboDecodeNum str {
     set coeffs [split $str {}]
     if {[lindex $coeffs 0] != 1} {
         error "Number badly encoded"
     }
     set n 0
     set k [llength $coeffs]
     foreach c $coeffs {
         if {$c} {
             incr n [fibo $k]
         }
         incr k -1
     }
     set n
 }

 proc fiboEncodeList lst {
     set res {}
     foreach num $lst {
         append res 1[fiboEncodeNum $num]
     }
     return $res
 }

 proc fiboDecodeString str {
     set str [string map {11 " 1"} [string map {110 " 10"} $str]]
     set res [list]
     foreach s $str {
         lappend res [fiboDecodeNum $s]
     }
     return $res
 }