|
0
|
1 # Result.pm,v 1.3 2002/06/20 18:50:39 amackey Exp
|
|
|
2 #
|
|
|
3 # BioPerl module for Bio::Tools::Phylo::PAML::Result
|
|
|
4 #
|
|
|
5 # Cared for by Jason Stajich <jason@bioperl.org>
|
|
|
6 #
|
|
|
7 # Copyright Jason Stajich, Aaron Mackey
|
|
|
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::Phylo::PAML::Result - A PAML result set object
|
|
|
16
|
|
|
17 =head1 SYNOPSIS
|
|
|
18
|
|
|
19 Give standard usage here
|
|
|
20
|
|
|
21 =head1 DESCRIPTION
|
|
|
22
|
|
|
23 Describe the object here
|
|
|
24
|
|
|
25 =head1 FEEDBACK
|
|
|
26
|
|
|
27 =head2 Mailing Lists
|
|
|
28
|
|
|
29 User feedback is an integral part of the evolution of this and other
|
|
|
30 Bioperl modules. Send your comments and suggestions preferably to
|
|
|
31 the Bioperl mailing list. Your participation is much appreciated.
|
|
|
32
|
|
|
33 bioperl-l@bioperl.org - General discussion
|
|
|
34 http://bioperl.org/MailList.shtml - About the mailing lists
|
|
|
35
|
|
|
36 =head2 Reporting Bugs
|
|
|
37
|
|
|
38 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
39 of the bugs and their resolution. Bug reports can be submitted via
|
|
|
40 email or the web:
|
|
|
41
|
|
|
42 bioperl-bugs@bioperl.org
|
|
|
43 http://bugzilla.bioperl.org/
|
|
|
44
|
|
|
45 =head1 AUTHOR - Jason Stajich, Aaron Mackey
|
|
|
46
|
|
|
47 Email jason@bioperl.org
|
|
|
48 Email amackey@virginia.edu
|
|
|
49
|
|
|
50 Describe contact details here
|
|
|
51
|
|
|
52 =head1 CONTRIBUTORS
|
|
|
53
|
|
|
54 Additional contributors names and emails here
|
|
|
55
|
|
|
56 =head1 APPENDIX
|
|
|
57
|
|
|
58 The rest of the documentation details each of the object methods.
|
|
|
59 Internal methods are usually preceded with a _
|
|
|
60
|
|
|
61 =cut
|
|
|
62
|
|
|
63
|
|
|
64 # Let the code begin...
|
|
|
65
|
|
|
66
|
|
|
67 package Bio::Tools::Phylo::PAML::Result;
|
|
|
68 use vars qw(@ISA);
|
|
|
69 use strict;
|
|
|
70
|
|
|
71
|
|
|
72 use Bio::Root::Root;
|
|
|
73 use Bio::AnalysisResultI;
|
|
|
74 @ISA = qw(Bio::Root::Root Bio::AnalysisResultI);
|
|
|
75
|
|
|
76 =head2 new
|
|
|
77
|
|
|
78 Title : new
|
|
|
79 Usage : my $obj = new Bio::Tools::Phylo::PAML::Result(%data);
|
|
|
80 Function: Builds a new Bio::Tools::Phylo::PAML::Result object
|
|
|
81 Returns : Bio::Tools::Phylo::PAML::Result
|
|
|
82 Args : -trees => array reference of L<Bio::Tree::TreeI> objects
|
|
|
83 -MLmatrix => ML matrix
|
|
|
84 .... MORE ARGUMENTS LISTED HERE BY AARON AND JASON
|
|
|
85
|
|
|
86 =cut
|
|
|
87
|
|
|
88 sub new {
|
|
|
89 my($class,@args) = @_;
|
|
|
90
|
|
|
91 my $self = $class->SUPER::new(@args);
|
|
|
92
|
|
|
93 my ($trees,$mlmat,$seqs,$ngmatrix,
|
|
|
94 $codonpos,$codonfreq,$version) = $self->_rearrange([qw(TREES MLMATRIX
|
|
|
95 SEQS NGMATRIX
|
|
|
96 CODONPOS CODONFREQ
|
|
|
97 VERSION)], @args);
|
|
|
98 $self->reset_seqs;
|
|
|
99 if( $trees ) {
|
|
|
100 if(ref($trees) !~ /ARRAY/i ) {
|
|
|
101 $self->warn("Must have provided a valid array reference to initialize trees");
|
|
|
102 } else {
|
|
|
103 foreach my $t ( @$trees ) {
|
|
|
104 $self->add_tree($t);
|
|
|
105 }
|
|
|
106 }
|
|
|
107 }
|
|
|
108 $self->{'_treeiterator'} = 0;
|
|
|
109
|
|
|
110 if( $mlmat ) {
|
|
|
111 if( ref($mlmat) !~ /ARRAY/i ) {
|
|
|
112 $self->warn("Must have provided a valid array reference to initialize MLmatrix");
|
|
|
113 } else {
|
|
|
114 $self->set_MLmatrix($mlmat);
|
|
|
115 }
|
|
|
116 }
|
|
|
117 if( $seqs ) {
|
|
|
118 if( ref($seqs) !~ /ARRAY/i ) {
|
|
|
119 $self->warn("Must have provided a valid array reference to initialize seqs");
|
|
|
120 } else {
|
|
|
121 foreach my $s ( @$seqs ) {
|
|
|
122 $self->add_seq($s);
|
|
|
123 }
|
|
|
124 }
|
|
|
125 }
|
|
|
126 if( $ngmatrix ) {
|
|
|
127 if( ref($ngmatrix) !~ /ARRAY/i ) {
|
|
|
128 $self->warn("Must have provided a valid array reference to initialize NGmatrix");
|
|
|
129 } else {
|
|
|
130 $self->set_NGmatrix($ngmatrix);
|
|
|
131 }
|
|
|
132 }
|
|
|
133
|
|
|
134 if( $codonfreq ) {
|
|
|
135
|
|
|
136
|
|
|
137 }
|
|
|
138
|
|
|
139 if( $codonpos ) {
|
|
|
140 if( ref($codonpos) !~ /ARRAY/i ) {
|
|
|
141 $self->warn("Must have provided a valid array reference to initialize codonpos");
|
|
|
142 } else {
|
|
|
143 $self->set_codon_pos_basefreq(@$codonpos);
|
|
|
144 }
|
|
|
145 }
|
|
|
146
|
|
|
147 $self->version($version) if defined $version;
|
|
|
148
|
|
|
149 return $self;
|
|
|
150 }
|
|
|
151
|
|
|
152 =head2 next_tree
|
|
|
153
|
|
|
154 Title : next_tree
|
|
|
155 Usage : my $tree = $factory->next_tree;
|
|
|
156 Function: Get the next tree from the factory
|
|
|
157 Returns : L<Bio::Tree::TreeI>
|
|
|
158 Args : none
|
|
|
159
|
|
|
160 =cut
|
|
|
161
|
|
|
162 sub next_tree{
|
|
|
163 my ($self,@args) = @_;
|
|
|
164 return $self->{'_trees'}->[$self->{'_treeiterator'}++] || undef;
|
|
|
165 }
|
|
|
166
|
|
|
167 =head2 rewind_tree
|
|
|
168
|
|
|
169 Title : rewind_tree_iterator
|
|
|
170 Usage : $result->rewind_tree()
|
|
|
171 Function: Rewinds the tree iterator so that next_tree can be
|
|
|
172 called again from the beginning
|
|
|
173 Returns : none
|
|
|
174 Args : none
|
|
|
175
|
|
|
176 =cut
|
|
|
177
|
|
|
178 sub rewind_tree_iterator {
|
|
|
179 shift->{'_treeiterator'} = 0;
|
|
|
180 }
|
|
|
181
|
|
|
182 =head2 add_tree
|
|
|
183
|
|
|
184 Title : add_tree
|
|
|
185 Usage : $result->add_tree($tree);
|
|
|
186 Function: Adds a tree
|
|
|
187 Returns : integer which is the number of trees stored
|
|
|
188 Args : L<Bio::Tree::TreeI>
|
|
|
189
|
|
|
190 =cut
|
|
|
191
|
|
|
192 sub add_tree{
|
|
|
193 my ($self,$tree) = @_;
|
|
|
194 if( $tree && ref($tree) && $tree->isa('Bio::Tree::TreeI') ) {
|
|
|
195 push @{$self->{'_trees'}},$tree;
|
|
|
196 }
|
|
|
197 return scalar @{$self->{'_trees'}};
|
|
|
198 }
|
|
|
199
|
|
|
200
|
|
|
201 =head2 set_MLmatrix
|
|
|
202
|
|
|
203 Title : set_MLmatrix
|
|
|
204 Usage : $result->set_MLmatrix($mat)
|
|
|
205 Function: Set the ML Matrix
|
|
|
206 Returns : none
|
|
|
207 Args : Arrayref to MLmatrix (must be arrayref to 2D matrix whic is
|
|
|
208 lower triangle pairwise)
|
|
|
209
|
|
|
210
|
|
|
211 =cut
|
|
|
212
|
|
|
213 sub set_MLmatrix{
|
|
|
214 my ($self,$mat) = @_;
|
|
|
215 return unless ( defined $mat );
|
|
|
216 if( ref($mat) !~ /ARRAY/i ) {
|
|
|
217 $self->warn("Did not provide a valid 2D Array reference for set_MLmatrix");
|
|
|
218 return;
|
|
|
219 }
|
|
|
220 $self->{'_mlmatrix'} = $mat;
|
|
|
221 }
|
|
|
222
|
|
|
223 =head2 get_MLmatrix
|
|
|
224
|
|
|
225 Title : get_MLmatrix
|
|
|
226 Usage : my $mat = $result->get_MLmatrix()
|
|
|
227 Function: Get the ML matrix
|
|
|
228 Returns : 2D Array reference
|
|
|
229 Args : none
|
|
|
230
|
|
|
231
|
|
|
232 =cut
|
|
|
233
|
|
|
234 sub get_MLmatrix{
|
|
|
235 my ($self,@args) = @_;
|
|
|
236 return $self->{'_mlmatrix'};
|
|
|
237 }
|
|
|
238
|
|
|
239 =head2 set_NGmatrix
|
|
|
240
|
|
|
241 Title : set_NGmatrix
|
|
|
242 Usage : $result->set_NGmatrix($mat)
|
|
|
243 Function: Set the Nei & Gojobori Matrix
|
|
|
244 Returns : none
|
|
|
245 Args : Arrayref to NGmatrix (must be arrayref to 2D matrix whic is
|
|
|
246 lower triangle pairwise)
|
|
|
247
|
|
|
248
|
|
|
249 =cut
|
|
|
250
|
|
|
251 sub set_NGmatrix{
|
|
|
252 my ($self,$mat) = @_;
|
|
|
253 return unless ( defined $mat );
|
|
|
254 if( ref($mat) !~ /ARRAY/i ) {
|
|
|
255 $self->warn("Did not provide a valid 2D Array reference for set_NGmatrix");
|
|
|
256 return;
|
|
|
257 }
|
|
|
258 $self->{'_ngmatrix'} = $mat;
|
|
|
259 }
|
|
|
260
|
|
|
261 =head2 get_NGmatrix
|
|
|
262
|
|
|
263 Title : get_NGmatrix
|
|
|
264 Usage : my $mat = $result->get_NGmatrix()
|
|
|
265 Function: Get the Nei & Gojobori matrix
|
|
|
266 Returns : 2D Array reference
|
|
|
267 Args : none
|
|
|
268
|
|
|
269
|
|
|
270 =cut
|
|
|
271
|
|
|
272 sub get_NGmatrix{
|
|
|
273 my ($self,@args) = @_;
|
|
|
274 return $self->{'_ngmatrix'};
|
|
|
275 }
|
|
|
276
|
|
|
277
|
|
|
278 =head2 add_seq
|
|
|
279
|
|
|
280 Title : add_seq
|
|
|
281 Usage : $obj->add_seq($seq)
|
|
|
282 Function: Add a Bio::PrimarySeq to the Result
|
|
|
283 Returns : none
|
|
|
284 Args : Bio::PrimarySeqI
|
|
|
285 See also : L<Bio::PrimarySeqI>
|
|
|
286
|
|
|
287 =cut
|
|
|
288
|
|
|
289 sub add_seq{
|
|
|
290 my ($self,$seq) = @_;
|
|
|
291 if( $seq ) {
|
|
|
292 unless( $seq->isa("Bio::PrimarySeqI") ) {
|
|
|
293 $self->warn("Must provide a valid Bio::PrimarySeqI to add_seq");
|
|
|
294 return;
|
|
|
295 }
|
|
|
296 push @{$self->{'_seqs'}},$seq;
|
|
|
297 }
|
|
|
298
|
|
|
299 }
|
|
|
300
|
|
|
301 =head2 reset_seqs
|
|
|
302
|
|
|
303 Title : reset_seqs
|
|
|
304 Usage : $result->reset_seqs
|
|
|
305 Function: Reset the OTU seqs stored
|
|
|
306 Returns : none
|
|
|
307 Args : none
|
|
|
308
|
|
|
309
|
|
|
310 =cut
|
|
|
311
|
|
|
312 sub reset_seqs{
|
|
|
313 my ($self) = @_;
|
|
|
314 $self->{'_seqs'} = [];
|
|
|
315 }
|
|
|
316
|
|
|
317 =head2 get_seqs
|
|
|
318
|
|
|
319 Title : get_seqs
|
|
|
320 Usage : my @otus = $result->get_seqs
|
|
|
321 Function: Get the seqs Bio::PrimarySeq (OTU = Operational Taxonomic Unit)
|
|
|
322 Returns : Array of Bio::PrimarySeq
|
|
|
323 Args : None
|
|
|
324 See also : L<Bio::PrimarySeq>
|
|
|
325
|
|
|
326 =cut
|
|
|
327
|
|
|
328 sub get_seqs{
|
|
|
329 my ($self) = @_;
|
|
|
330 return @{$self->{'_seqs'}};
|
|
|
331 }
|
|
|
332
|
|
|
333 =head2 set_codon_pos_basefreq
|
|
|
334
|
|
|
335 Title : set_codon_pos_basefreq
|
|
|
336 Usage : $result->set_codon_pos_basefreq(@freqs)
|
|
|
337 Function: Set the codon position base frequencies
|
|
|
338 Returns : none
|
|
|
339 Args : Array of length 3 where each slot has a hashref
|
|
|
340 keyed on DNA base
|
|
|
341
|
|
|
342
|
|
|
343 =cut
|
|
|
344
|
|
|
345 sub set_codon_pos_basefreq {
|
|
|
346 my ($self,@codonpos) = @_;
|
|
|
347 if( scalar @codonpos != 3 ) {
|
|
|
348 $self->warn("invalid array to set_codon_pos_basefreq, must be an array of length 3");
|
|
|
349 return;
|
|
|
350 }
|
|
|
351 foreach my $pos ( @codonpos ) {
|
|
|
352 if( ref($pos) !~ /HASH/i ||
|
|
|
353 ! exists $pos->{'A'} ) {
|
|
|
354 $self->warn("invalid array to set_codon_pos_basefreq, must be an array with hashreferences keyed on DNA bases, C,A,G,T");
|
|
|
355 }
|
|
|
356 }
|
|
|
357 $self->{'_codonposbasefreq'} = [@codonpos];
|
|
|
358 }
|
|
|
359
|
|
|
360 =head2 get_codon_pos_basefreq
|
|
|
361
|
|
|
362 Title : get_codon_pos_basefreq
|
|
|
363 Usage : my @basepos = $result->get_codon_pos_basefreq;
|
|
|
364 Function: Get the codon position base frequencies
|
|
|
365 Returns : Array of length 3 (each codon position), each
|
|
|
366 slot is a hashref keyed on DNA bases, the values are
|
|
|
367 the frequency of the base at that position for all sequences
|
|
|
368 Args : none
|
|
|
369 Note : The array starts at 0 so position '1' is in position '0'
|
|
|
370 of the array
|
|
|
371
|
|
|
372 =cut
|
|
|
373
|
|
|
374 sub get_codon_pos_basefreq{
|
|
|
375 my ($self) = @_;
|
|
|
376 return @{$self->{'_codonposbasefreq'}};
|
|
|
377 }
|
|
|
378
|
|
|
379 =head2 version
|
|
|
380
|
|
|
381 Title : version
|
|
|
382 Usage : $obj->version($newval)
|
|
|
383 Function: Get/Set version
|
|
|
384 Returns : value of version
|
|
|
385 Args : newvalue (optional)
|
|
|
386
|
|
|
387
|
|
|
388 =cut
|
|
|
389
|
|
|
390 sub version{
|
|
|
391 my $self = shift;
|
|
|
392 $self->{'_version'} = shift if @_;
|
|
|
393 return $self->{'_version'};
|
|
|
394 }
|
|
|
395
|
|
|
396 1;
|
