Mercurial > repos > mahtabm > ensembl
comparison variant_effect_predictor/Bio/Tools/Grail.pm @ 0:1f6dce3d34e0
Uploaded
author | mahtabm |
---|---|
date | Thu, 11 Apr 2013 02:01:53 -0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:1f6dce3d34e0 |
---|---|
1 # $Id: Grail.pm,v 1.6 2002/12/01 00:05:21 jason Exp $ | |
2 # | |
3 # BioPerl module for Bio::Tools::Grail | |
4 # | |
5 # Cared for by Jason Stajich <jason@bioperl.org> | |
6 # | |
7 # Copyright Jason Stajich | |
8 # | |
9 # You may distribute this module under the same terms as perl itself | |
10 | |
11 # POD documentation - main docs before the code | |
12 | |
13 =head1 NAME | |
14 | |
15 Bio::Tools::Grail - Results of one Grail run | |
16 | |
17 =head1 SYNOPSIS | |
18 | |
19 $grail = Bio::Tools::Grail->new(-file => 'result.grail'); | |
20 # filehandle: | |
21 $grail = Bio::Tools::Grail->new( -fh => \*INPUT ); | |
22 | |
23 # parse the results | |
24 while($gene = $grail->next_prediction()) { | |
25 # $gene is an instance of Bio::Tools::Prediction::Gene | |
26 | |
27 # $gene->exons() returns an array of | |
28 # Bio::Tools::Prediction::Exon objects | |
29 # all exons: | |
30 @exon_arr = $gene->exons(); | |
31 | |
32 # initial exons only | |
33 @init_exons = $gene->exons('Initial'); | |
34 # internal exons only | |
35 @intrl_exons = $gene->exons('Internal'); | |
36 # terminal exons only | |
37 @term_exons = $gene->exons('Terminal'); | |
38 # singleton exons only -- should be same as $gene->exons() because | |
39 # there are no other exons supposed to exist in this structure | |
40 @single_exons = $gene->exons('Single'); | |
41 } | |
42 | |
43 # essential if you gave a filename at initialization (otherwise the file | |
44 # will stay open) | |
45 $genscan->close(); | |
46 | |
47 =head1 DESCRIPTION | |
48 | |
49 The Grail module provides a parser for Grail gene structure prediction | |
50 output. | |
51 | |
52 | |
53 =head1 FEEDBACK | |
54 | |
55 =head2 Mailing Lists | |
56 | |
57 User feedback is an integral part of the evolution of this and other | |
58 Bioperl modules. Send your comments and suggestions preferably to one | |
59 of the Bioperl mailing lists. Your participation is much appreciated. | |
60 | |
61 bioperl-l@bioperl.org - General discussion | |
62 http://bio.perl.org/MailList.html - About the mailing lists | |
63 | |
64 =head2 Reporting Bugs | |
65 | |
66 Report bugs to the Bioperl bug tracking system to help us keep track | |
67 the bugs and their resolution. Bug reports can be submitted via email | |
68 or the web: | |
69 | |
70 bioperl-bugs@bio.perl.org | |
71 http://bugzilla.bioperl.org/ | |
72 | |
73 =head1 AUTHOR - Jason Stajich | |
74 | |
75 Email jason@bioperl.org | |
76 | |
77 Describe contact details here | |
78 | |
79 =head1 APPENDIX | |
80 | |
81 The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _ | |
82 | |
83 =cut | |
84 | |
85 # Let the code begin... | |
86 | |
87 package Bio::Tools::Grail; | |
88 use vars qw(@ISA); | |
89 use strict; | |
90 | |
91 use Bio::Root::Root; | |
92 use Bio::Root::IO; | |
93 use Bio::Tools::Prediction::Gene; | |
94 use Bio::Tools::Prediction::Exon; | |
95 use Symbol; | |
96 | |
97 @ISA = qw(Bio::Root::IO Bio::Root::Root); | |
98 | |
99 sub new { | |
100 my($class,@args) = @_; | |
101 | |
102 my $self = $class->SUPER::new(@args); | |
103 $self->_initialize_io(@args); | |
104 | |
105 return $self; | |
106 } | |
107 | |
108 =head2 next_prediction | |
109 | |
110 Title : next_prediction | |
111 Usage : while($gene = $grail->next_prediction()) { | |
112 # do something | |
113 } | |
114 Function: Returns the next gene structure prediction of the Grail result | |
115 file. Call this method repeatedly until FALSE is returned. | |
116 | |
117 Example : | |
118 Returns : A Bio::Tools::Prediction::Gene object. | |
119 Args : | |
120 | |
121 =cut | |
122 | |
123 sub next_prediction { | |
124 my ($self) = @_; | |
125 | |
126 # get next gene structure | |
127 my $gene = $self->_prediction(); | |
128 | |
129 if($gene) { | |
130 # fill in predicted protein, and if available the predicted CDS | |
131 # | |
132 my ($id, $seq); | |
133 # use the seq stack if there's a seq on it | |
134 my $seqobj = pop(@{$self->{'_seqstack'}}); | |
135 if(! $seqobj) { | |
136 # otherwise read from input stream | |
137 ($id, $seq) = $self->_read_fasta_seq(); | |
138 $seqobj = Bio::PrimarySeq->new('-seq' => $seq, | |
139 '-display_id' => $id, | |
140 '-alphabet' => "protein"); | |
141 } | |
142 # check that prediction number matches the prediction number | |
143 # indicated in the sequence id (there may be incomplete gene | |
144 # predictions that contain only signals with no associated protein | |
145 # and CDS, like promoters, poly-A sites etc) | |
146 $gene->primary_tag() =~ /[^0-9]([0-9]+)$/; | |
147 my $prednr = $1; | |
148 if($seqobj->display_id() !~ /_predicted_\w+_$prednr\|/) { | |
149 # this is not our sequence, so push back for the next prediction | |
150 push(@{$self->{'_seqstack'}}, $seqobj); | |
151 } else { | |
152 $gene->predicted_protein($seqobj); | |
153 # CDS prediction, too? | |
154 if($self->_has_cds()) { | |
155 ($id, $seq) = $self->_read_fasta_seq(); | |
156 $seqobj = Bio::PrimarySeq->new('-seq' => $seq, | |
157 '-display_id' => $id, | |
158 '-alphabet' => "dna"); | |
159 $gene->predicted_cds($seqobj); | |
160 } | |
161 } | |
162 } | |
163 return $gene; | |
164 } | |
165 | |
166 =head2 _parse_predictions | |
167 | |
168 Title : _parse_predictions() | |
169 Usage : $obj->_parse_predictions() | |
170 Function: Parses the prediction section. Automatically called by | |
171 next_prediction() if not yet done. | |
172 Example : | |
173 Returns : | |
174 | |
175 =cut | |
176 | |
177 sub _parse_predictions { | |
178 my ($self) = @_; | |
179 | |
180 # code needs to go here | |
181 | |
182 $self->_predictions_parsed(1); | |
183 } | |
184 | |
185 =head2 _prediction | |
186 | |
187 Title : _prediction() | |
188 Usage : $gene = $obj->_prediction() | |
189 Function: internal | |
190 Example : | |
191 Returns : | |
192 | |
193 =cut | |
194 | |
195 sub _prediction { | |
196 my ($self) = @_; | |
197 | |
198 return undef unless(exists($self->{'_preds'}) && @{$self->{'_preds'}}); | |
199 return shift(@{$self->{'_preds'}}); | |
200 } | |
201 | |
202 =head2 _add_prediction | |
203 | |
204 Title : _add_prediction() | |
205 Usage : $obj->_add_prediction($gene) | |
206 Function: internal | |
207 Example : | |
208 Returns : | |
209 | |
210 =cut | |
211 | |
212 sub _add_prediction { | |
213 my ($self, $gene) = @_; | |
214 | |
215 if(! exists($self->{'_preds'})) { | |
216 $self->{'_preds'} = []; | |
217 } | |
218 push(@{$self->{'_preds'}}, $gene); | |
219 } | |
220 | |
221 =head2 _predictions_parsed | |
222 | |
223 Title : _predictions_parsed | |
224 Usage : $obj->_predictions_parsed | |
225 Function: internal | |
226 Example : | |
227 Returns : TRUE or FALSE | |
228 | |
229 =cut | |
230 | |
231 sub _predictions_parsed { | |
232 my ($self, $val) = @_; | |
233 | |
234 $self->{'_preds_parsed'} = $val if $val; | |
235 if(! exists($self->{'_preds_parsed'})) { | |
236 $self->{'_preds_parsed'} = 0; | |
237 } | |
238 return $self->{'_preds_parsed'}; | |
239 } | |
240 | |
241 =head2 _has_cds | |
242 | |
243 Title : _has_cds() | |
244 Usage : $obj->_has_cds() | |
245 Function: Whether or not the result contains the predicted CDSs, too. | |
246 Example : | |
247 Returns : TRUE or FALSE | |
248 | |
249 =cut | |
250 | |
251 sub _has_cds { | |
252 my ($self, $val) = @_; | |
253 | |
254 $self->{'_has_cds'} = $val if $val; | |
255 if(! exists($self->{'_has_cds'})) { | |
256 $self->{'_has_cds'} = 0; | |
257 } | |
258 return $self->{'_has_cds'}; | |
259 } | |
260 | |
261 1; |