t/AlignIO/AlignIO.t: fix number of tests in plan (fixup c523e6bed866)
[bioperl-live.git] / Bio / Matrix / PhylipDist.pm
blobb676eab66c1612ff87ab3a7ae2b3cb1ead6caf4a
1 # BioPerl module for Bio::Matrix::PhylipDist
4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
6 # Cared for by Shawn Hoon <shawnh@fugu-sg.org>
8 # Copyright Shawn Hoon
10 # You may distribute this module under the same terms as perl itself
12 # POD documentation - main docs before the code
14 =head1 NAME
16 Bio::Matrix::PhylipDist - A Phylip Distance Matrix object
18 =head1 SYNOPSIS
20 use Bio::Tools::Phylo::Phylip::ProtDist;
21 my $dist = Bio::Tools::Phylo::Phylip::ProtDist->new(
22 -file=>"protdist.out",
23 -program=>"ProtDist");
24 #or
25 my $dist = Bio::Tools::Phylo::Phylip::ProtDist->new(
26 -fh=>"protdist.out",
27 -program=>"ProtDist");
30 #get specific entries
31 my $distance_value = $dist->get_entry('ALPHA','BETA');
32 my @columns = $dist->get_column('ALPHA');
33 my @rows = $dist->get_row('BETA');
34 my @diagonal = $dist->get_diagonal();
36 #print the matrix in phylip numerical format
37 print $dist->print_matrix;
39 =head1 DESCRIPTION
41 Simple object for holding Distance Matrices generated by the following Phylip programs:
43 1) dnadist
44 2) protdist
45 3) restdist
47 It currently handles parsing of the matrix without the data output option.
50 Alpha 0.00000 4.23419 3.63330 6.20865 3.45431
51 Beta 4.23419 0.00000 3.49289 3.36540 4.29179
52 Gamma 3.63330 3.49289 0.00000 3.68733 5.84929
53 Delta 6.20865 3.36540 3.68733 0.00000 4.43345
54 Epsilon 3.45431 4.29179 5.84929 4.43345 0.00000
56 =head1 FEEDBACK
59 =head2 Mailing Lists
61 User feedback is an integral part of the evolution of this and other
62 Bioperl modules. Send your comments and suggestions preferably to one
63 of the Bioperl mailing lists. Your participation is much appreciated.
65 bioperl-l@bioperl.org - General discussion
66 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
68 =head2 Support
70 Please direct usage questions or support issues to the mailing list:
72 I<bioperl-l@bioperl.org>
74 rather than to the module maintainer directly. Many experienced and
75 reponsive experts will be able look at the problem and quickly
76 address it. Please include a thorough description of the problem
77 with code and data examples if at all possible.
79 =head2 Reporting Bugs
81 Report bugs to the Bioperl bug tracking system to help us keep track
82 the bugs and their resolution. Bug reports can be submitted via the
83 web:
85 https://github.com/bioperl/bioperl-live/issues
87 =head1 AUTHOR - Shawn Hoon
89 Email shawnh@fugu-sg.org
91 =head1 CONTRIBUTORS
93 Jason Stajich, jason-at-bioperl-dot-org
95 =head1 APPENDIX
98 The rest of the documentation details each of the object
99 methods. Internal methods are usually preceded with a "_".
101 =cut
103 # Let the code begin...
105 package Bio::Matrix::PhylipDist;
106 use strict;
109 use base qw(Bio::Root::Root Bio::Matrix::MatrixI);
111 =head2 new
113 Title : new
114 Usage : my $family = Bio::Matrix::PhylipDist->new(-file=>"protdist.out",
115 -program=>"protdist");
116 Function: Constructor for PhylipDist Object
117 Returns : L<Bio::Matrix::PhylipDist>
119 =cut
121 sub new {
122 my ($class,@args) = @_;
123 my $self = $class->SUPER::new(@args);
124 my ($matrix,$values, $names,
125 $program,$matname,
126 $matid) = $self->_rearrange([qw(MATRIX
127 VALUES
128 NAMES
129 PROGRAM
130 MATRIX_NAME
131 MATRIX_ID
132 )],@args);
134 ($matrix && $values && $names) ||
135 $self->throw("Need matrix, values, and names fields all provided!");
137 $program && $self->matrix_name($program) if defined $program;
139 $self->_matrix($matrix) if ref($matrix) =~ /HASH/i;
140 $self->_values($values) if ref($values) =~ /ARRAY/i;
141 $self->names($names) if ref($names) =~ /ARRAY/i;
143 $self->matrix_name($matname) if defined $matname;
144 $self->matrix_id ($matid) if defined $matid;
146 return $self;
149 =head2 get_entry
151 Title : get_entry
152 Usage : $matrix->get_entry();
153 Function: returns a particular entry
154 Returns : a float
155 Arguments: string id1, string id2
157 =cut
159 sub get_entry {
160 my ($self,$row,$column) = @_;
161 $row && $column || $self->throw("Need at least 2 ids");
162 my %matrix = %{$self->_matrix};
163 my @values = @{$self->_values};
164 if(ref $matrix{$row}{$column}){
165 my ($i,$j) = @{$matrix{$row}{$column}};
166 return $values[$i][$j];
168 return;
172 =head2 get_row
174 Title : get_row
175 Usage : $matrix->get_row('ALPHA');
176 Function: returns a particular row
177 Returns : an array of float
178 Arguments: string id1
180 =cut
182 sub get_row {
183 my ($self,$row) = @_;
184 $row || $self->throw("Need at least a row id");
186 my %matrix = %{$self->_matrix};
187 my @values = @{$self->_values};
188 my @names = @{$self->names};
189 $matrix{$row} || return;
190 my ($val) = values %{$matrix{$row}};
191 my $row_pointer = $val->[0];
192 my $index = scalar(@names)-1;
193 return @{$values[$row_pointer]}[0..$index];
196 =head2 get_column
198 Title : get_column
199 Usage : $matrix->get_column('ALPHA');
200 Function: returns a particular column
201 Returns : an array of floats
202 Arguments: string id1
204 =cut
206 sub get_column {
207 my ($self,$column) = @_;
208 $column || $self->throw("Need at least a column id");
210 my %matrix = %{$self->_matrix};
211 my @values = @{$self->_values};
212 my @names = @{$self->names};
213 $matrix{$column} || return ();
214 my ($val) = values %{$matrix{$column}};
215 my $row_pointer = $val->[0];
216 my @ret;
217 for(my $i=0; $i < scalar(@names); $i++) {
218 push @ret, $values[$i][$row_pointer];
220 return @ret;
223 =head2 get_diagonal
225 Title : get_diagonal
226 Usage : $matrix->get_diagonal();
227 Function: returns the diagonal of the matrix
228 Returns : an array of float
229 Arguments: string id1
231 =cut
233 sub get_diagonal {
234 my ($self) = @_;
235 my %matrix = %{$self->_matrix};
236 my @values = @{$self->_values};
237 my @return;
238 foreach my $name (@{$self->names}){
239 my ($i,$j) = @{$matrix{$name}{$name}};
240 push @return,$values[$i][$j];
242 return @return;
245 =head2 print_matrix
247 Title : print_matrix
248 Usage : $matrix->print_matrix();
249 Function: returns a string of the matrix in phylip format
250 Returns : a string
251 Arguments:
253 =cut
255 sub print_matrix {
256 my ($self) = @_;
257 my @names = @{$self->names};
258 my @values = @{$self->_values};
259 my %matrix = %{$self->_matrix};
260 my $str;
261 $str.= (" "x 4). scalar(@names)."\n";
262 foreach my $name (@names){
263 my $newname = $name. (" " x (15-length($name)));
264 if( length($name) >= 15 ) { $newname .= " " }
265 $str.=$newname;
266 my $count = 0;
267 foreach my $n (@names) {
268 my ($i,$j) = @{$matrix{$name}{$n}};
269 if($count < $#names){
270 $str .= $values[$i][$j]. " ";
272 else {
273 if( ! defined $values[$i][$j] ) {
274 $self->debug("no value for $i,$j cell\n");
275 } else {
276 $str .= $values[$i][$j];
279 $count++;
281 $str.="\n";
283 return $str;
286 =head2 _matrix
288 Title : _matrix
289 Usage : $matrix->_matrix();
290 Function: get/set for hash reference of the pointers
291 to the value matrix
292 Returns : hash reference
293 Arguments: hash reference
295 =cut
297 sub _matrix {
298 my ($self,$val) = @_;
299 if($val){
300 $self->{'_matrix'} = $val;
302 return $self->{'_matrix'};
306 =head2 names
308 Title : names
309 Usage : $matrix->names();
310 Function: get/set for array ref of names of sequences
311 Returns : an array reference
312 Arguments: an array reference
314 =cut
316 sub names {
317 my ($self,$val) = @_;
318 if($val){
319 $self->{'_names'} = $val;
321 return $self->{'_names'};
324 =head2 program
326 Title : program
327 Usage : $matrix->program();
328 Function: get/set for the program name generating this
329 matrix
330 Returns : string
331 Arguments: string
333 =cut
335 sub program {
336 my ($self) = shift;
337 return $self->matrix_name(@_);
340 =head2 _values
342 Title : _values
343 Usage : $matrix->_values();
344 Function: get/set for array ref of the matrix containing
345 distance values
346 Returns : an array reference
347 Arguments: an array reference
349 =cut
351 sub _values {
352 my ($self,$val) = @_;
353 if($val){
354 $self->{'_values'} = $val;
356 return $self->{'_values'};
360 =head1 L<Bio::Matrix::MatrixI> implementation
363 =head2 matrix_id
365 Title : matrix_id
366 Usage : my $id = $matrix->matrix_id
367 Function: Get/Set the matrix ID
368 Returns : scalar value
369 Args : [optional] new id value to store
372 =cut
374 sub matrix_id{
375 my $self = shift;
376 return $self->{'_matid'} = shift if @_;
377 return $self->{'_matid'};
382 =head2 matrix_name
384 Title : matrix_name
385 Usage : my $name = $matrix->matrix_name();
386 Function: Get/Set the matrix name
387 Returns : scalar value
388 Args : [optional] new matrix name value
391 =cut
393 sub matrix_name{
394 my $self = shift;
395 return $self->{'_matname'} = shift if @_;
396 return $self->{'_matname'};
399 =head2 column_header
401 Title : column_header
402 Usage : my $name = $matrix->column_header(0)
403 Function: Gets the column header for a particular column number
404 Returns : string
405 Args : integer
408 =cut
410 sub column_header{
411 my ($self,$num) = @_;
412 my @coln = $self->column_names;
413 return $coln[$num];
417 =head2 row_header
419 Title : row_header
420 Usage : my $name = $matrix->row_header(0)
421 Function: Gets the row header for a particular row number
422 Returns : string
423 Args : integer
426 =cut
428 sub row_header{
429 my ($self,$num) = @_;
430 my @rown = $self->row_names;
431 return $rown[$num];
433 =head2 column_num_for_name
435 Title : column_num_for_name
436 Usage : my $num = $matrix->column_num_for_name($name)
437 Function: Gets the column number for a particular column name
438 Returns : integer
439 Args : string
442 =cut
444 sub column_num_for_name{
445 my ($self,$name) = @_;
446 my $ct = 0;
447 foreach my $n ( $self->column_names ) {
448 return $ct if $n eq $name;
449 $ct++;
451 return;
454 =head2 row_num_for_name
456 Title : row_num_for_name
457 Usage : my $num = $matrix->row_num_for_name($name)
458 Function: Gets the row number for a particular row name
459 Returns : integer
460 Args : string
463 =cut
465 sub row_num_for_name{
466 my ($self,$name) = @_;
467 my $ct = 0;
468 foreach my $n ( $self->row_names ) {
469 return $ct if $n eq $name;
470 $ct++;
474 =head2 num_rows
476 Title : num_rows
477 Usage : my $rowcount = $matrix->num_rows;
478 Function: Get the number of rows
479 Returns : integer
480 Args : none
483 =cut
485 sub num_rows{ return scalar @{shift->names} }
487 =head2 num_columns
489 Title : num_columns
490 Usage : my $colcount = $matrix->num_columns
491 Function: Get the number of columns
492 Returns : integer
493 Args : none
496 =cut
498 sub num_columns{
499 return scalar @{shift->names};
502 =head2 row_names
504 Title : row_names
505 Usage : my @rows = $matrix->row_names
506 Function: The names of all the rows
507 Returns : array in array context, arrayref in scalar context
508 Args : none
511 =cut
513 sub row_names{ return @{shift->names} }
515 =head2 column_names
517 Title : column_names
518 Usage : my @columns = $matrix->column_names
519 Function: The names of all the columns
520 Returns : array in array context, arrayref in scalar context
521 Args : none
524 =cut
526 sub column_names{ return @{shift->names} }