annotate variant_effect_predictor/Bio/Tools/Genscan.pm @ 0:2bc9b66ada89 draft default tip

Uploaded
author mahtabm
date Thu, 11 Apr 2013 06:29:17 -0400
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
1 # $Id: Genscan.pm,v 1.22 2002/10/22 07:38:46 lapp Exp $
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
2 #
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
3 # BioPerl module for Bio::Tools::Genscan
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
4 #
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
5 # Cared for by Hilmar Lapp <hlapp@gmx.net>
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
6 #
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
7 # Copyright Hilmar Lapp
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
8 #
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
9 # You may distribute this module under the same terms as perl itself
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
10
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
11 # POD documentation - main docs before the code
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
12
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
13 =head1 NAME
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
14
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
15 Bio::Tools::Genscan - Results of one Genscan run
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
16
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
17 =head1 SYNOPSIS
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
18
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
19 $genscan = Bio::Tools::Genscan->new(-file => 'result.genscan');
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
20 # filehandle:
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
21 $genscan = Bio::Tools::Genscan->new( -fh => \*INPUT );
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
22
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
23 # parse the results
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
24 # note: this class is-a Bio::Tools::AnalysisResult which implements
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
25 # Bio::SeqAnalysisParserI, i.e., $genscan->next_feature() is the same
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
26 while($gene = $genscan->next_prediction()) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
27 # $gene is an instance of Bio::Tools::Prediction::Gene, which inherits
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
28 # off Bio::SeqFeature::Gene::Transcript.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
29 #
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
30 # $gene->exons() returns an array of
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
31 # Bio::Tools::Prediction::Exon objects
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
32 # all exons:
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
33 @exon_arr = $gene->exons();
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
34
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
35 # initial exons only
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
36 @init_exons = $gene->exons('Initial');
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
37 # internal exons only
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
38 @intrl_exons = $gene->exons('Internal');
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
39 # terminal exons only
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
40 @term_exons = $gene->exons('Terminal');
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
41 # singleton exons:
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
42 ($single_exon) = $gene->exons();
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
43 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
44
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
45 # essential if you gave a filename at initialization (otherwise the file
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
46 # will stay open)
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
47 $genscan->close();
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
48
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
49 =head1 DESCRIPTION
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
50
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
51 The Genscan module provides a parser for Genscan gene structure prediction
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
52 output. It parses one gene prediction into a Bio::SeqFeature::Gene::Transcript-
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
53 derived object.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
54
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
55 This module also implements the Bio::SeqAnalysisParserI interface, and thus
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
56 can be used wherever such an object fits. See L<Bio::SeqAnalysisParserI>.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
57
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
58 =head1 FEEDBACK
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
59
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
60 =head2 Mailing Lists
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
61
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
62 User feedback is an integral part of the evolution of this and other
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
63 Bioperl modules. Send your comments and suggestions preferably to one
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
64 of the Bioperl mailing lists. Your participation is much appreciated.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
65
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
66 bioperl-l@bioperl.org - General discussion
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
67 http://bio.perl.org/MailList.html - About the mailing lists
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
68
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
69 =head2 Reporting Bugs
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
70
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
71 Report bugs to the Bioperl bug tracking system to help us keep track
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
72 the bugs and their resolution. Bug reports can be submitted via email
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
73 or the web:
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
74
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
75 bioperl-bugs@bio.perl.org
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
76 http://bugzilla.bioperl.org/
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
77
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
78 =head1 AUTHOR - Hilmar Lapp
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
79
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
80 Email hlapp@gmx.net
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
81
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
82 Describe contact details here
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
83
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
84 =head1 APPENDIX
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
85
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
86 The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
87
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
88 =cut
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
89
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
90
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
91 # Let the code begin...
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
92
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
93
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
94 package Bio::Tools::Genscan;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
95 use vars qw(@ISA);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
96 use strict;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
97 use Symbol;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
98
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
99 use Bio::Root::Root;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
100 use Bio::Tools::AnalysisResult;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
101 use Bio::Tools::Prediction::Gene;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
102 use Bio::Tools::Prediction::Exon;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
103
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
104 @ISA = qw(Bio::Tools::AnalysisResult);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
105
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
106 sub _initialize_state {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
107 my ($self,@args) = @_;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
108
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
109 # first call the inherited method!
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
110 $self->SUPER::_initialize_state(@args);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
111
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
112 # our private state variables
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
113 $self->{'_preds_parsed'} = 0;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
114 $self->{'_has_cds'} = 0;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
115 # array of pre-parsed predictions
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
116 $self->{'_preds'} = [];
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
117 # seq stack
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
118 $self->{'_seqstack'} = [];
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
119 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
120
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
121 =head2 analysis_method
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
122
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
123 Usage : $genscan->analysis_method();
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
124 Purpose : Inherited method. Overridden to ensure that the name matches
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
125 /genscan/i.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
126 Returns : String
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
127 Argument : n/a
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
128
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
129 =cut
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
130
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
131 #-------------
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
132 sub analysis_method {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
133 #-------------
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
134 my ($self, $method) = @_;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
135 if($method && ($method !~ /genscan/i)) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
136 $self->throw("method $method not supported in " . ref($self));
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
137 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
138 return $self->SUPER::analysis_method($method);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
139 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
140
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
141 =head2 next_feature
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
142
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
143 Title : next_feature
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
144 Usage : while($gene = $genscan->next_feature()) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
145 # do something
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
146 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
147 Function: Returns the next gene structure prediction of the Genscan result
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
148 file. Call this method repeatedly until FALSE is returned.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
149
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
150 The returned object is actually a SeqFeatureI implementing object.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
151 This method is required for classes implementing the
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
152 SeqAnalysisParserI interface, and is merely an alias for
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
153 next_prediction() at present.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
154
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
155 Example :
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
156 Returns : A Bio::Tools::Prediction::Gene object.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
157 Args :
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
158
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
159 =cut
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
160
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
161 sub next_feature {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
162 my ($self,@args) = @_;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
163 # even though next_prediction doesn't expect any args (and this method
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
164 # does neither), we pass on args in order to be prepared if this changes
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
165 # ever
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
166 return $self->next_prediction(@args);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
167 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
168
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
169 =head2 next_prediction
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
170
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
171 Title : next_prediction
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
172 Usage : while($gene = $genscan->next_prediction()) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
173 # do something
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
174 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
175 Function: Returns the next gene structure prediction of the Genscan result
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
176 file. Call this method repeatedly until FALSE is returned.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
177
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
178 Example :
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
179 Returns : A Bio::Tools::Prediction::Gene object.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
180 Args :
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
181
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
182 =cut
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
183
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
184 sub next_prediction {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
185 my ($self) = @_;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
186 my $gene;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
187
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
188 # if the prediction section hasn't been parsed yet, we do this now
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
189 $self->_parse_predictions() unless $self->_predictions_parsed();
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
190
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
191 # get next gene structure
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
192 $gene = $self->_prediction();
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
193
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
194 if($gene) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
195 # fill in predicted protein, and if available the predicted CDS
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
196 #
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
197 my ($id, $seq);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
198 # use the seq stack if there's a seq on it
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
199 my $seqobj = pop(@{$self->{'_seqstack'}});
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
200 if(! $seqobj) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
201 # otherwise read from input stream
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
202 ($id, $seq) = $self->_read_fasta_seq();
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
203 # there may be no sequence at all, or none any more
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
204 if($id && $seq) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
205 $seqobj = Bio::PrimarySeq->new('-seq' => $seq,
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
206 '-display_id' => $id,
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
207 '-alphabet' => "protein");
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
208 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
209 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
210 if($seqobj) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
211 # check that prediction number matches the prediction number
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
212 # indicated in the sequence id (there may be incomplete gene
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
213 # predictions that contain only signals with no associated protein
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
214 # and CDS, like promoters, poly-A sites etc)
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
215 $gene->primary_tag() =~ /[^0-9]([0-9]+)$/;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
216 my $prednr = $1;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
217 if($seqobj->display_id() !~ /_predicted_\w+_$prednr\|/) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
218 # this is not our sequence, so push back for next prediction
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
219 push(@{$self->{'_seqstack'}}, $seqobj);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
220 } else {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
221 $gene->predicted_protein($seqobj);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
222 # CDS prediction, too?
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
223 if($self->_has_cds()) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
224 ($id, $seq) = $self->_read_fasta_seq();
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
225 $seqobj = Bio::PrimarySeq->new('-seq' => $seq,
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
226 '-display_id' => $id,
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
227 '-alphabet' => "dna");
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
228 $gene->predicted_cds($seqobj);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
229 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
230 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
231 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
232 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
233
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
234 return $gene;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
235 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
236
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
237 =head2 _parse_predictions
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
238
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
239 Title : _parse_predictions()
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
240 Usage : $obj->_parse_predictions()
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
241 Function: Parses the prediction section. Automatically called by
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
242 next_prediction() if not yet done.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
243 Example :
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
244 Returns :
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
245
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
246 =cut
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
247
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
248 sub _parse_predictions {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
249 my ($self) = @_;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
250 my %exontags = ('Init' => 'Initial',
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
251 'Intr' => 'Internal',
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
252 'Term' => 'Terminal',
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
253 'Sngl' => '');
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
254 my $gene;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
255 my $seqname;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
256
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
257 while(defined($_ = $self->_readline())) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
258 if(/^\s*(\d+)\.(\d+)/) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
259 # exon or signal
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
260 my $prednr = $1;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
261 my $signalnr = $2; # not used presently
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
262 if(! defined($gene)) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
263 $gene = Bio::Tools::Prediction::Gene->new(
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
264 '-primary' => "GenePrediction$prednr",
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
265 '-source' => 'Genscan');
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
266 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
267 # split into fields
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
268 chomp();
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
269 my @flds = split(' ', $_);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
270 # create the feature object depending on the type of signal
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
271 my $predobj;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
272 my $is_exon = grep {$_ eq $flds[1];} (keys(%exontags));
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
273 if($is_exon) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
274 $predobj = Bio::Tools::Prediction::Exon->new();
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
275 } else {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
276 # PolyA site, or Promoter
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
277 $predobj = Bio::SeqFeature::Generic->new();
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
278 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
279 # set common fields
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
280 $predobj->source_tag('Genscan');
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
281 $predobj->score($flds[$#flds]);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
282 $predobj->strand((($flds[2] eq '+') ? 1 : -1));
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
283 my ($start, $end) = @flds[(3,4)];
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
284 if($predobj->strand() == 1) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
285 $predobj->start($start);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
286 $predobj->end($end);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
287 } else {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
288 $predobj->end($start);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
289 $predobj->start($end);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
290 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
291 # add to gene structure (should be done only when start and end
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
292 # are set, in order to allow for proper expansion of the range)
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
293 if($is_exon) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
294 # first, set fields unique to exons
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
295 $predobj->start_signal_score($flds[8]);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
296 $predobj->end_signal_score($flds[9]);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
297 $predobj->coding_signal_score($flds[10]);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
298 $predobj->significance($flds[11]);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
299 $predobj->primary_tag($exontags{$flds[1]} . 'Exon');
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
300 $predobj->is_coding(1);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
301 # Figure out the frame of this exon. This is NOT the frame
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
302 # given by Genscan, which is the absolute frame of the base
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
303 # starting the first predicted complete codon. By comparing
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
304 # to the absolute frame of the first base we can compute the
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
305 # offset of the first complete codon to the first base of the
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
306 # exon, which determines the frame of the exon.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
307 my $cod_offset;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
308 if($predobj->strand() == 1) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
309 $cod_offset = $flds[6] - (($predobj->start()-1) % 3);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
310 # Possible values are -2, -1, 0, 1, 2. -1 and -2 correspond
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
311 # to offsets 2 and 1, resp. Offset 3 is the same as 0.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
312 $cod_offset += 3 if($cod_offset < 1);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
313 } else {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
314 # On the reverse strand the Genscan frame also refers to
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
315 # the first base of the first complete codon, but viewed
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
316 # from forward, which is the third base viewed from
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
317 # reverse.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
318 $cod_offset = $flds[6] - (($predobj->end()-3) % 3);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
319 # Possible values are -2, -1, 0, 1, 2. Due to the reverse
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
320 # situation, {2,-1} and {1,-2} correspond to offsets
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
321 # 1 and 2, resp. Offset 3 is the same as 0.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
322 $cod_offset -= 3 if($cod_offset >= 0);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
323 $cod_offset = -$cod_offset;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
324 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
325 # Offsets 2 and 1 correspond to frame 1 and 2 (frame of exon
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
326 # is the frame of the first base relative to the exon, or the
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
327 # number of bases the first codon is missing).
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
328 $predobj->frame(3 - $cod_offset);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
329 # then add to gene structure object
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
330 $gene->add_exon($predobj, $exontags{$flds[1]});
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
331 } elsif($flds[1] eq 'PlyA') {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
332 $predobj->primary_tag("PolyAsite");
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
333 $gene->poly_A_site($predobj);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
334 } elsif($flds[1] eq 'Prom') {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
335 $predobj->primary_tag("Promoter");
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
336 $gene->add_promoter($predobj);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
337 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
338 next;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
339 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
340 if(/^\s*$/ && defined($gene)) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
341 # current gene is completed
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
342 $gene->seq_id($seqname);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
343 $self->_add_prediction($gene);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
344 $gene = undef;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
345 next;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
346 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
347 if(/^(GENSCAN)\s+(\S+)/) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
348 $self->analysis_method($1);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
349 $self->analysis_method_version($2);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
350 next;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
351 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
352 if(/^Sequence\s+(\S+)\s*:/) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
353 $seqname = $1;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
354 next;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
355 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
356
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
357 if(/^Parameter matrix:\s+(\S+)/i) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
358 $self->analysis_subject($1);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
359 next;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
360 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
361
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
362 if(/^Predicted coding/) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
363 $self->_has_cds(1);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
364 next;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
365 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
366 /^>/ && do {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
367 # section of predicted sequences
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
368 $self->_pushback($_);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
369 last;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
370 };
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
371 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
372 $self->_predictions_parsed(1);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
373 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
374
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
375 =head2 _prediction
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
376
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
377 Title : _prediction()
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
378 Usage : $gene = $obj->_prediction()
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
379 Function: internal
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
380 Example :
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
381 Returns :
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
382
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
383 =cut
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
384
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
385 sub _prediction {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
386 my ($self) = @_;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
387
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
388 return undef unless(exists($self->{'_preds'}) && @{$self->{'_preds'}});
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
389 return shift(@{$self->{'_preds'}});
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
390 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
391
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
392 =head2 _add_prediction
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
393
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
394 Title : _add_prediction()
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
395 Usage : $obj->_add_prediction($gene)
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
396 Function: internal
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
397 Example :
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
398 Returns :
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
399
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
400 =cut
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
401
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
402 sub _add_prediction {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
403 my ($self, $gene) = @_;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
404
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
405 if(! exists($self->{'_preds'})) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
406 $self->{'_preds'} = [];
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
407 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
408 push(@{$self->{'_preds'}}, $gene);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
409 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
410
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
411 =head2 _predictions_parsed
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
412
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
413 Title : _predictions_parsed
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
414 Usage : $obj->_predictions_parsed
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
415 Function: internal
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
416 Example :
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
417 Returns : TRUE or FALSE
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
418
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
419 =cut
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
420
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
421 sub _predictions_parsed {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
422 my ($self, $val) = @_;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
423
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
424 $self->{'_preds_parsed'} = $val if $val;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
425 if(! exists($self->{'_preds_parsed'})) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
426 $self->{'_preds_parsed'} = 0;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
427 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
428 return $self->{'_preds_parsed'};
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
429 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
430
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
431 =head2 _has_cds
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
432
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
433 Title : _has_cds()
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
434 Usage : $obj->_has_cds()
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
435 Function: Whether or not the result contains the predicted CDSs, too.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
436 Example :
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
437 Returns : TRUE or FALSE
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
438
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
439 =cut
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
440
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
441 sub _has_cds {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
442 my ($self, $val) = @_;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
443
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
444 $self->{'_has_cds'} = $val if $val;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
445 if(! exists($self->{'_has_cds'})) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
446 $self->{'_has_cds'} = 0;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
447 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
448 return $self->{'_has_cds'};
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
449 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
450
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
451 =head2 _read_fasta_seq
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
452
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
453 Title : _read_fasta_seq()
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
454 Usage : ($id,$seqstr) = $obj->_read_fasta_seq();
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
455 Function: Simple but specialised FASTA format sequence reader. Uses
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
456 $self->_readline() to retrieve input, and is able to strip off
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
457 the traling description lines.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
458 Example :
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
459 Returns : An array of two elements.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
460
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
461 =cut
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
462
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
463 sub _read_fasta_seq {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
464 my ($self) = @_;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
465 my ($id, $seq);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
466 local $/ = ">";
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
467
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
468 my $entry = $self->_readline();
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
469 if($entry) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
470 $entry =~ s/^>//;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
471 # complete the entry if the first line came from a pushback buffer
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
472 while($entry !~ />$/) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
473 last unless $_ = $self->_readline();
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
474 $entry .= $_;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
475 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
476 # delete everything onwards from an intervening empty line (at the
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
477 # end there might be statistics stuff)
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
478 $entry =~ s/\n\n.*$//s;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
479 # id and sequence
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
480 if($entry =~ /^(\S+)\n([^>]+)/) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
481 $id = $1;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
482 $seq = $2;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
483 } else {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
484 $self->throw("Can't parse Genscan predicted sequence entry");
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
485 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
486 $seq =~ s/\s//g; # Remove whitespace
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
487 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
488 return ($id, $seq);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
489 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
490
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
491 1;