Add L-encoding bias parameter to MasterCoder

darcs-hash:20080829200550-4d648-5deb2bdf78e87d5692d3fbf42fc8f955bcc4b6ca.gz

diff --git a/MasterCoder.pm b/MasterCoder.pm
index 00644af722ed412b4f4e9479a6fd5baca00f15c5..a4695f3649893f3bb97491c51ca40e230b38e6ca 100644 (file)
--- a/MasterCoder.pm
+++ b/MasterCoder.pm
@@ -33,6 +33,10 @@ sub new ($$$$) {
     # Treat as private; you shouldn't use this; use
     # ->tencode and ->tdecode instead.
    '_tencoder' => $tencoder,
+
+    # Treat as private, though you may set this
+    # once at construction if you really feel like it.
+   '_lbias' => 1,
   }, $class;
 
   $$self{'msg_prefix'} = $self->tencode($msgprefix);
@@ -67,7 +71,7 @@ sub _lenc_body_len($$) {
     my $ccc = $$self{'code_chars_count'};
 
     return 0 if $in == 0;
-    return POSIX::floor( log(($ccc-1)*$in + 1) / log($ccc) );
+    return POSIX::floor( log(($ccc-1)*$in + 1) / log($ccc) ) - $$self{'_lbias'};
 }
 
 sub _lenc_correction($) {
@@ -79,18 +83,23 @@ sub _lenc_correction($) {
 
 sub lencode ($$) {
     my $self = shift @_;
-    my $in = shift @_;
+    my $in = (shift @_);
+    $in += $self->_lenc_correction($$self{'_lbias'});
     my $enclen = $self->_lenc_body_len($in);
 
     my $ccc = $$self{'code_chars_count'};
 
     warn "Can't encode numbers that big!" if $enclen >= $ccc - 1;
     return undef if $enclen >= $ccc - 1;
-    return $self->tencode($enclen) if $in == 0;
 
-    $in -= $self->_lenc_correction($enclen);
+    $in -= $self->_lenc_correction($enclen+$$self{'_lbias'});
+
+    return $self->tencode($enclen) if $in == 0
+                                  and $enclen == 0
+                                  and $$self{'_lbias'} == 0;
 
-    return $self->tencode($enclen) . $self->tencode_padded($in, $enclen);
+    return $self->tencode($enclen)
+         . $self->tencode_padded($in, $enclen+$$self{'_lbias'});
 }
 
 sub ldecode($$) {
@@ -103,17 +112,28 @@ sub ldecode($$) {
     my $ccc = $$self{'code_chars_count'};
 
     warn "Can't decode numbers that big!" if $reallen >= $ccc - 1;
-
     return (undef, undef) if length $in < $reallen or $reallen >= $ccc - 1;
 
+    $reallen += $$self{'_lbias'};
+
     my $encval = substr($in, 1, $reallen);
 
     my $realval = $self->tdecode($encval);
     $realval += $self->_lenc_correction($reallen);
+    $realval -= $self->_lenc_correction($$self{'_lbias'});
 
     return ( $realval, $reallen+1 )
 }
 
+sub llargest($) {
+    my $self = shift @_;
+
+    my $ccc = $$self{'code_chars_count'};
+    return $self->_lenc_correction($ccc + $$self{'_lbias'} - 1)
+         - $self->_lenc_correction($$self{'_lbias'})
+         - 1;
+}
+
 #################################################################
 
     # Takes an already encoded message (encoded somehow by the

diff --git a/MasterCoder_test.pl b/MasterCoder_test.pl
index 827a7aa8fabb29a54d5324e13d8b4f3ca044b183..f0c0429b032bdc03ff0a574a35c71da82cdd33d0 100644 (file)
--- a/MasterCoder_test.pl
+++ b/MasterCoder_test.pl
@@ -11,7 +11,7 @@ die unless $coder->tencode_padded($MESSAGE_START,2) eq "OO";
 
 print "Checking T encoding machinery... \n";
 
-foreach my $i (0 .. 35) {
+foreach my $i (0 .. 24) {
     my $enc = $coder->tencode_padded($i,2);
     my $dec = $coder->tdecode($enc);
 
@@ -21,19 +21,32 @@ foreach my $i (0 .. 35) {
     die if $dec != $i;
 }
 
-print "Checking L encoding machinery... \n";
+print "Checking L encoding machinery for a variety of biases... \n";
+print "Some warnings are normal!  We have to test that llargest()\n";
+print "returns the right things.\n";
 
-foreach my $i (0 .. 1554) {
-    my $enc = $coder->lencode($i);
-    my ($deci, $decsize) = $coder->ldecode($enc);
+foreach my $bias ( 0 .. 2 ) {
 
-    print $i, " ", $enc, " (", length $enc, 
-               ") ==> ", $deci, " (", $decsize, ")\n"
-               if $i % 100 == 0;
+    $$coder{'_lbias'} = $bias;
+    my $limit = $coder->llargest();
+    print "BIAS ",$bias," LIMIT ",$limit,"\n";
 
-    die if $deci != $i;
-    die if $decsize != length $enc;
+    foreach my $i (0 .. $limit) {
+        my $enc = $coder->lencode($i);
+        my ($deci, $decsize) = $coder->ldecode($enc . "_____");
 
-}
+        die if not defined $enc;
+
+        print "  ", $i, " ", $enc, " (", length $enc, 
+                   ") ==> ", $deci, " (", $decsize, ")\n"
+                   if $i % 100 == 0;
 
+        die if $deci != $i;
+        die if $decsize != length $enc;
+    }
+
+    my $enc_undef = $coder->lencode($limit+1);
+    die if defined $enc_undef;
+}
 
+print "Successfully completed.\n";