[Bio] / FigKernelScripts / svr_compare_feature_tables.pl Repository:
ViewVC logotype

Diff of /FigKernelScripts/svr_compare_feature_tables.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1, Wed Aug 18 20:35:45 2010 UTC revision 1.2, Sun Aug 29 19:51:57 2010 UTC
# Line 21  Line 21 
21  # http://www.theseed.org/LICENSE.TXT.  # http://www.theseed.org/LICENSE.TXT.
22  #  #
23    
24    #
25    # Input files:
26    #
27    # ID seed-format-location function
28    #
29    
30  # usage:  svr_compare_feature_tables  old_features.tab  new_fatures.tab  > comparison.tab  2> summary.txt  # usage:  svr_compare_feature_tables  old_features.tab  new_fatures.tab  > comparison.tab  2> summary.txt
31    
32  use strict;  use strict;
# Line 28  Line 34 
34    
35  use SeedUtils;  use SeedUtils;
36  use Data::Dumper;  use Data::Dumper;
37    use YAML::Any;
38  # use Carp;  # use Carp;
39    
40  $0 =~ m/([^\/]+)$/;  $0 =~ m/([^\/]+)$/;
41  my $self  = $1;  my $self  = $1;
42  my $usage = "$self  old_features.tab  new_fatures.tab  \> comparison.tab  2\> summary.txt";  my $usage = "$self  old_features.tab  new_fatures.tab [summary.yaml] \> comparison.tab  2\> summary.txt";
43    
44  my $old_3col_file;  my $old_3col_file;
45  (($old_3col_file = shift) && (-f $old_3col_file))  (($old_3col_file = shift) && (-f $old_3col_file))
# Line 42  Line 49 
49  (($new_3col_file = shift) && (-f $new_3col_file))  (($new_3col_file = shift) && (-f $new_3col_file))
50      || die "Could not find new_3col_file $new_3col_file\n\n\tusage: $usage\n\n";      || die "Could not find new_3col_file $new_3col_file\n\n\tusage: $usage\n\n";
51    
52    my $summary_yaml;
53    if (@ARGV)
54    {
55        $summary_yaml = shift;
56    }
57    
58  my ($old_tbl, $old_num_pegs) = &load_tbl($old_3col_file);  my ($old_tbl, $old_num_pegs) = &load_tbl($old_3col_file);
59  my ($new_tbl, $new_num_pegs) = &load_tbl($new_3col_file);  my ($new_tbl, $new_num_pegs) = &load_tbl($new_3col_file);
60    
# Line 72  Line 85 
85      $keys{$key} = 1;      $keys{$key} = 1;
86  }  }
87  @keys = sort { &by_key($a,$b) } (keys %keys);  @keys = sort { &by_key($a,$b) } (keys %keys);
 print STDERR (q(Num keys = ), (scalar @keys), qq(\n\n)) if $ENV{VERBOSE};  
88    
89    print STDERR (q(Num keys = ), (scalar @keys), qq(\n\n)) if $ENV{VERBOSE};
90    
91  print STDOUT (q(#), join(qq(\t), qw(Comparison Old_ID New_ID Old_Length New_Length Length_Diff Old_Loc New_Loc Old_Function New_Function)), qq(\n));  print STDOUT '#', join(qq(\t), qw(Comparison Old_ID New_ID Old_Length New_Length Length_Diff Old_Loc New_Loc Old_Function New_Function)), qq(\n);
92  foreach my $key (sort { &by_key($a,$b) } @keys) {  foreach my $key (sort { &by_key($a,$b) } @keys) {
93      my $case      = q();      my $case      = q();
94    
# Line 141  Line 154 
154      }      }
155      my $diff = $new_len - $old_len;      my $diff = $new_len - $old_len;
156    
157      print STDOUT (join(qq(\t), ($case, $old_fid, $new_fid, $old_len, $new_len, $diff, $old_loc, $new_loc, $old_func, $new_func)), qq(\n));      print STDOUT join(qq(\t), ($case, $old_fid, $new_fid, $old_len, $new_len, $diff, $old_loc, $new_loc, $old_func, $new_func)), qq(\n);
158  }  }
159    
160    
161    if (defined($summary_yaml))
162    {
163        if (open(my $fh, ">", $summary_yaml))
164        {
165            &write_summary_yaml($fh, $old_num_pegs, $new_num_pegs, $identical, $same_stop, $differ, $short, $long, $added, $lost);
166        }
167        else
168        {
169            die "Error opening $summary_yaml for writing: $!";
170        }
171    }
172    else
173    {
174  &write_summary($old_num_pegs, $new_num_pegs, $identical, $same_stop, $differ, $short, $long, $added, $lost);  &write_summary($old_num_pegs, $new_num_pegs, $identical, $same_stop, $differ, $short, $long, $added, $lost);
175    }
176    
177  exit(0);  exit(0);
178    
# Line 271  Line 299 
299    
300      return 1;      return 1;
301  }  }
302    sub write_summary_yaml {
303        my ($fh, $old_pegs, $new_pegs, $identical, $same_stop, $differ, $short, $long, $added, $lost) = @_;
304    
305        my $dat = {
306            old_num => $old_pegs,
307            new_num => $new_pegs,
308        };
309    
310        for my $what (qw(same_stop added lost identical differ short long))
311        {
312            my $val = eval "\$$what";
313            $dat->{$what} = $val;
314            $dat->{"${what}_pct_old"} = 100 * $val / $old_pegs;
315            $dat->{"${what}_pct_new"} = 100 * $val / $new_pegs;
316        }
317    
318        print $fh Dump($dat);
319        return 1;
320    }

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3