canon: unbreak qtydiff

[ypp-sc-tools.main.git] / yarrg / canon

diff --git a/yarrg/canon b/yarrg/canon
index f1a8c9af13639f271e909e18097faf3e59622a08..590ffa86c0cbd1b203cbeb6c37acb7f6e1a903ca 100755 (executable)
--- a/yarrg/canon
+++ b/yarrg/canon
@@ -1,10 +1,14 @@
 #!/usr/bin/perl -w
 use strict qw(refs vars);
 our %s;
+my $bs= $ARGV[2];
 foreach my $ab (qw(0 1)) {
     open F, "zcat $ARGV[$ab] |" or die $!;
     while (<F>) {
-        my @l= split /\t/, $_;
+        chomp;
+        my @l= split /\t/, $_, -1;
+        @l == 6 or die "$#l";
+        if ($bs) { @l= ($l[0],$l[1],$l[4],$l[5]); }
         next unless length $l[2];
         $l[3]='1001' if $l[3] eq '>1000';
         my $k= sprintf "%-31s\t%-23s", $l[1], $l[0];
@@ -13,22 +17,69 @@ foreach my $ab (qw(0 1)) {
     }
     close F or die $!;
 }
-print "total rows: ", (scalar keys %s), "\n";
-my $lastk0='';
-my $changek0;
+
+my $nextcommod=0;
+my %commodmap;
+
+sub alencodenum ($) {
+    my ($val) = @_;
+    my $res= '';
+    while ($val || !length($res)) {
+        # allowing empty strings, reusing "0" for 62, doing base63,
+        # saves 0.5%
+        my $dig= $val % 62;
+        $val= ($val-$dig) / 62;
+        $res = chr($dig + ($dig<10 ? 48 :
+                           $dig<36 ? 97-10 :
+                           $dig<62 ? 65-36 : die $dig)) . $res;
+    }
+    return $res;
+}
+
+sub findcommod ($) {
+    my ($cname) = @_;
+    my $me= $commodmap{$cname};  return $me if defined $me;
+    my $val= $nextcommod++;
+    $commodmap{$cname}= $val;
+#    printf "%s:%s\n", $res,$cname;
+    return $val;
+}
+
+my $laststall='';
+
 foreach my $k (sort keys %s) {
     my @r= @{ $s{$k} };
-    my $whynot=
-        !defined($r[0]) ? 'ADD' :
-        !defined($r[2]) ? 'DEL' :
-        $r[0] != $r[2] ? 'pri' :
-        $r[1] != $r[3] ? (sprintf "qt %4d",($r[3]-$r[1])) :
-        undef;
-    next unless $whynot;
     $k =~ m/\t/;
-    if ($` ne $lastk0) { $lastk0=$`; $changek0++; }
-    print $whynot,"\t",$k;
-    print "\t", defined($_) ? $_ : "-" foreach @r;
-    print "\n";
+    my ($stall,$commod) = ($`,$');
+
+    my $eol= '';
+    my $prep= sub {
+        return if $eol;
+        $eol="\n";
+        if ($stall ne $laststall) {
+            printf "\"%s\n", $stall;
+            $laststall= $stall;
+        }
+        print alencodenum(findcommod($commod));
+    };
+
+    if (!defined($r[2])) {
+        $prep->();
+        printf "\n"; # no "-" here saves 3.5%
+        next;
+    }
+    # base62-encoding all these numbers saves about 8%
+    my $qtydiff= $r[3] - ($r[1] || 0);
+    if (!defined($r[0]) || $r[0] != $r[2]) {
+        $prep->();
+        printf "\@%s",alencodenum($r[2]);
+    }
+    if ($qtydiff>0) {
+        $prep->();
+        printf "+%s",alencodenum($qtydiff);
+    } elsif ($qtydiff<0) {
+        $prep->();
+        printf "-%s",alencodenum(-$qtydiff);
+    }
+    print $eol;
 }
-print "changes of k0: $changek0\n";