MS While rereading Data Compression [L1 ], I stumbled on Fibonacci universal codes (see Section 3.3 [L2 ]).
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 1The 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
}