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

Annotation of /FigKernelScripts/build_initial_objects_for_start_predictions.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download) (as text)

1 : overbeek 1.1 use FIG_Config;
2 :    
3 :     use FIG;
4 :     my $fig = new FIG;
5 :    
6 :     $usage = "usage: build_initial_objects_for_start_predictions < pegs_in_cluster > initial_objects";
7 :    
8 :     @pegs = <STDIN>;
9 :     chomp @pegs;
10 :     # print "NPEGS=", scalar(@pegs), "\n";
11 :     for ($i=0; $i < @pegs; $i++) # strip off all but peg ids at front
12 :     {
13 :     if ($pegs[$i] =~ /(\S+)\t.*/)
14 :     {
15 :     $pegs[$i] = $1;
16 :     }
17 :     }
18 :    
19 :     foreach $peg (@pegs)
20 :     {
21 :     $genome = $fig->genome_of($peg);
22 :     $loc = $fig->feature_location($peg);
23 :     # print "$len{$peg}\t$peg\t$loc\n";
24 :     if ($loc =~ /,/)
25 :     {
26 :     print STDERR "skipping $peg - do not handle complex locs\n";
27 :     next;
28 :     }
29 :    
30 :     ($contig,$begin,$end) = $fig->boundaries_of($loc);
31 :     if ($begin < $end)
32 :     {
33 :     $l = sprintf("%s_%d_%d",$contig,1,$begin-1);
34 :     $end += 3;
35 :     }
36 :     else
37 :     {
38 :     $l = sprintf("%s_%d_%d",$contig,$begin+1,$fig->contig_ln($genome,$contig));
39 :     $end -= 3;
40 :     }
41 :    
42 :     $loc = join("_",($contig,$begin,$end));
43 :     $seq = uc $fig->dna_seq($genome,$loc);
44 :     # The following hack handles uncertainty about whether SEED gives back the STOP or not
45 :     if (substr($seq,-6,3) =~ /TAA|TAG|TGA/i)
46 :     {
47 : overbeek 1.2 $end = ($begin < $end) ? $end-3 : $end+3;
48 : overbeek 1.1 $seq = substr($seq,0,length($seq) - 3);
49 :     }
50 :     elsif (substr($seq,-3,3) !~ /TAA|TAG|TGA/i)
51 :     {
52 :     die "BAD STOP: $genome $loc $seq\n";
53 :     }
54 :    
55 : overbeek 1.2 $loc = join("_",($contig,$begin,$end));
56 : overbeek 1.1
57 :    
58 :     # BACK INTO THE STOP FROM START OF PEG
59 :     $pre_peg = uc $fig->dna_seq($genome,$l);
60 :     $found = 0;
61 :     $len_pre_peg = length($pre_peg);
62 :    
63 :     for ($i=$len_pre_peg-3; $i > 0 && ! $found; $i-=3)
64 :     {
65 :     $stop = substr($pre_peg,$i,3);
66 :     if ($stop eq "TAG" || $stop eq "TAA" || $stop eq "TGA")
67 :     {
68 :     # print "FOUND $stop for $l\n";
69 :     $orf = substr($pre_peg,$i+3) . $seq;
70 :     if (($i-27) > 0)
71 :     {
72 :     $pre_orf = substr($pre_peg,$i-27,30);
73 :     my $gs = $fig->org_of($peg);
74 :     my @aliases = grep { $_ =~ /^([NXYZA]P_[0-9\.]+)|(uni\|)|(sp\|)/ } $fig->feature_aliases($peg);
75 :     print "ID=$peg\n";
76 :     print "GENOME=$gs\n";
77 :     if (@aliases > 0)
78 :     {
79 :     print "ALIASES=",join(",",@aliases),"\n";
80 :     }
81 :     print "CONTIG=$contig\n";
82 :     #####print "BEGIN=$begin\n";
83 :     if ($begin < $end)
84 :     {
85 :     print "BEGIN=", $begin-($len_pre_peg-$i-3), "\n";
86 :     }
87 :     else
88 :     {
89 :     print "BEGIN=", $begin+($len_pre_peg-$i-3), "\n";
90 :     }
91 :     print "END=$end\n";
92 :     print "SEQ=$orf\n";
93 :     print "PREFIX=$pre_orf\n";
94 :     print "OLD_START_POS=", $len_pre_peg-$i-2, "\n";
95 :     print "///\n";
96 :     $found = 1;
97 :     }
98 :     else
99 :     {
100 :     print STDERR "skipping $peg - not enough prefix before orf\n";
101 :     }
102 :     last;
103 :     }
104 :     }
105 :     if ( ! $found)
106 :     {
107 :     print STDERR "DID NOT FIND STOP BEFORE $peg $contig $begin $end $l\n";
108 :     }
109 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3