yarrg/canon

   1 #!/usr/bin/perl -w
   2 use strict qw(refs vars);
   3 our %s;
   4 my $bs= $ARGV[2];
   5 foreach my $ab (qw(0 1)) {
   6     open F, "zcat $ARGV[$ab] |" or die $!;
   7     while (<F>) {
   8         chomp;
   9         my @l= split /\t/, $_, -1;
  10         @l == 6 or die "$#l";
  11         if ($bs) { @l= ($l[0],$l[1],$l[4],$l[5]); }
  12         next unless length $l[2];
  13         $l[3]='1001' if $l[3] eq '>1000';
  14         my $k= sprintf "%-31s\t%-23s", $l[1], $l[0];
  15         $s{$k}[$ab*2]= $l[2];
  16         $s{$k}[$ab*2+1]= $l[3];
  17     }
  18     close F or die $!;
  19 }
  20 print "total rows: ", (scalar keys %s), "\n";
  21 my $lastk0='';
  22 my $changek0=0;
  23 foreach my $k (sort keys %s) {
  24     my @r= @{ $s{$k} };
  25     my $whynot=
  26         !defined($r[0]) ? 'ADD' :
  27         !defined($r[2]) ? 'DEL' :
  28         $r[0] != $r[2] ? 'pri' :
  29         $r[1] != $r[3] ? (sprintf "qt %4d",($r[3]-$r[1])) :
  30         undef;
  31     next unless $whynot;
  32     $k =~ m/\t/;
  33     if ($` ne $lastk0) { $lastk0=$`; $changek0++; }
  34     print $whynot,"\t",$k;
  35     print "\t", defined($_) ? $_ : "-" foreach @r;
  36     print "\n";
  37 }
  38 print "changes of k0: $changek0\n";