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

Diff of /FigKernelScripts/changed_starts.pl

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

revision 1.1, Sat Jul 23 16:04:32 2005 UTC revision 1.7, Mon Dec 5 18:56:37 2005 UTC
# Line 1  Line 1 
1    # -*- perl -*-
2    #
3    # Copyright (c) 2003-2006 University of Chicago and Fellowship
4    # for Interpretations of Genomes. All Rights Reserved.
5    #
6    # This file is part of the SEED Toolkit.
7    #
8    # The SEED Toolkit is free software. You can redistribute
9    # it and/or modify it under the terms of the SEED Toolkit
10    # Public License.
11    #
12    # You should have received a copy of the SEED Toolkit Public License
13    # along with this program; if not write to the University of Chicago
14    # at info@ci.uchicago.edu or the Fellowship for Interpretation of
15    # Genomes at veronika@thefig.info or download a copy from
16    # http://www.theseed.org/LICENSE.TXT.
17    #
18    
19    
20  use FIG;  use FIG;
21    my $fig = new FIG;
22    
23  $usage = "usage: changed_starts Proposed Annotations >> modified.starts";  $usage = "usage: changed_starts Proposed Annotations >> modified.starts";
24    
25  (  (
26   ($proposed    = shift @ARGV) && open(PROPOSED,"<$proposed") &&   ($proposed    = shift @ARGV) && open(PROPOSED,"<$proposed") &&
27   ($annotations = shift @ARGV) && open(ANN,">>$annotations")   ($annotations = shift @ARGV) && open(ANN,">$annotations")
28  )  )
29      || die $usage;      || die $usage;
30    
# Line 13  Line 32 
32    
33  while (defined($entry = <PROPOSED>))  while (defined($entry = <PROPOSED>))
34  {  {
35      if ($entry =~ /ID=(fig\|\d+\.\d+\.peg\.\d+).*\nOLD_START_POS=(\d+)\nNEW_START_POS=(\d+).*?CONF_GAP=(\S+).*?NEW_START_LOC=(\S+)_(\d+)_(\d+)\n/s)      if ($entry =~ /ID=(\S+).*\nOLD_START_POS=(\d+)\nNEW_START_POS=(\d+).*?CONF_GAP=(\S+).*?NEW_START_LOC=(\S+)_(\d+)_(\d+)\n/s)
36      {      {
37          ($peg,$old_pos,$new_pos,$conf_gap,$contig,$beg,$end) = ($1,$2,$3,$4,$5,$6,$7);          ($peg,$old_pos,$new_pos,$conf_gap,$contig,$beg,$end) = ($1,$2,$3,$4,$5,$6,$7);
38    
39          $old_beg = ($beg < $end) ? $beg - ($new_pos-$old_pos) : $beg + ($new_pos-$old_pos);          $old_beg = ($beg < $end) ? $beg - ($new_pos-$old_pos) : $beg + ($new_pos-$old_pos);
40          $old_start = join("_",($contig,$old_beg,$end));          $old_loc = join("_",($contig,$old_beg,$end));
41          $new_start = join("_",($contig,$beg,$end));          $new_loc = join("_",($contig,$beg,$end));
42          push(@changes,[$peg,$old_start,$new_start,$conf_gap]);          push(@changes,[$peg,$old_loc,$new_loc,$conf_gap]);
         print ANN "$peg\tChanged start from $old_start to $new_start\n";  
43      }      }
44  }  }
45    
46  foreach $_ (sort { $b->[3] <=> $a->[3] } @changes)  foreach $_ (sort { $b->[3] <=> $a->[3] } @changes)
47  {  {
48      print join("\t",@$_),"\n";      ($peg,$old_loc,$new_loc,$conf_gap) = @$_;
49        $peg =~ /\|(\d+\.\d+)/;
50        $genome = $1;
51        $dna    = $fig->dna_seq($genome,$new_loc);
52        $trans  = $fig->translate($dna,undef,'start');
53        if ((substr($trans,-1) ne "*") && (($peg =~ /^new/) || (! $fig->possibly_truncated($peg))))
54        {
55            print STDERR "missing STOP on $peg\n";
56        }
57        else
58        {
59            $trans =~ s/\*$//;
60        }
61        print join("\t",($peg,$old_loc,$new_loc,$conf_gap,$trans)),"\n";
62        print ANN "$peg\tChanged start from $old_loc to $new_loc\n";
63  }  }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3