branch-1-6/Bio/Matrix/PhylipDist.pm

   1 # BioPerl module for Bio::Matrix::PhylipDist
   2 #
   3 # $Id$
   4 #
   5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   6 #
   7 # Cared for by Shawn Hoon <shawnh@fugu-sg.org>
   8 #
   9 # Copyright Shawn Hoon
  10 #
  11 # You may distribute this module under the same terms as perl itself
  12
  13 # POD documentation - main docs before the code
  14
  15 =head1 NAME
  16
  17 Bio::Matrix::PhylipDist - A Phylip Distance Matrix object
  18
  19 =head1 SYNOPSIS
  20
  21   use Bio::Tools::Phylo::Phylip::ProtDist;
  22   my $dist = Bio::Tools::Phylo::Phylip::ProtDist->new(
  23     -file=>"protdist.out",
  24     -program=>"ProtDist");
  25   #or
  26    my $dist = Bio::Tools::Phylo::Phylip::ProtDist->new(
  27     -fh=>"protdist.out",
  28     -program=>"ProtDist");
  29
  30
  31   #get specific entries
  32   my $distance_value = $dist->get_entry('ALPHA','BETA');
  33   my @columns        = $dist->get_column('ALPHA');
  34   my @rows           = $dist->get_row('BETA');
  35   my @diagonal       = $dist->get_diagonal();
  36
  37   #print the matrix in phylip numerical format
  38   print $dist->print_matrix;
  39
  40 =head1 DESCRIPTION
  41
  42 Simple object for holding Distance Matrices generated by the following Phylip programs:
  43
  44 1) dnadist
  45 2) protdist
  46 3) restdist
  47
  48 It currently handles parsing of the matrix without the data output option.
  49
  50     5
  51 Alpha          0.00000  4.23419  3.63330  6.20865  3.45431
  52 Beta           4.23419  0.00000  3.49289  3.36540  4.29179
  53 Gamma          3.63330  3.49289  0.00000  3.68733  5.84929
  54 Delta          6.20865  3.36540  3.68733  0.00000  4.43345
  55 Epsilon        3.45431  4.29179  5.84929  4.43345  0.00000
  56
  57 =head1 FEEDBACK
  58
  59
  60 =head2 Mailing Lists
  61
  62 User feedback is an integral part of the evolution of this and other
  63 Bioperl modules. Send your comments and suggestions preferably to one
  64 of the Bioperl mailing lists. Your participation is much appreciated.
  65
  66   bioperl-l@bioperl.org                  - General discussion
  67   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  68
  69 =head2 Support
  70
  71 Please direct usage questions or support issues to the mailing list:
  72
  73 I<bioperl-l@bioperl.org>
  74
  75 rather than to the module maintainer directly. Many experienced and
  76 reponsive experts will be able look at the problem and quickly
  77 address it. Please include a thorough description of the problem
  78 with code and data examples if at all possible.
  79
  80 =head2 Reporting Bugs
  81
  82 Report bugs to the Bioperl bug tracking system to help us keep track
  83 the bugs and their resolution.  Bug reports can be submitted via the
  84 web:
  85
  86   http://bugzilla.open-bio.org/
  87
  88 =head1 AUTHOR - Shawn Hoon
  89
  90 Email shawnh@fugu-sg.org
  91
  92 =head1 CONTRIBUTORS
  93
  94 Jason Stajich, jason-at-bioperl-dot-org
  95
  96 =head1 APPENDIX
  97
  98
  99 The rest of the documentation details each of the object
 100 methods. Internal methods are usually preceded with a "_".
 101
 102 =cut
 103
 104 # Let the code begin...
 105
 106 package Bio::Matrix::PhylipDist;
 107 use strict;
 108
 109
 110 use base qw(Bio::Root::Root Bio::Matrix::MatrixI);
 111
 112 =head2 new
 113
 114  Title   : new
 115  Usage   : my $family = Bio::Matrix::PhylipDist->new(-file=>"protdist.out",
 116                                                      -program=>"protdist");
 117  Function: Constructor for PhylipDist Object
 118  Returns : L<Bio::Matrix::PhylipDist>
 119
 120 =cut
 121
 122 sub new {
 123     my ($class,@args) = @_;
 124     my $self = $class->SUPER::new(@args);
 125     my ($matrix,$values, $names,
 126         $program,$matname,
 127         $matid) = $self->_rearrange([qw(MATRIX
 128                                         VALUES
 129                                         NAMES
 130                                         PROGRAM
 131                                         MATRIX_NAME
 132                                         MATRIX_ID
 133                                         )],@args);
 134
 135     ($matrix && $values && $names) ||
 136         $self->throw("Need matrix, values, and names fields all provided!");
 137
 138     $program && $self->matrix_name($program) if defined $program;
 139
 140     $self->_matrix($matrix) if ref($matrix) =~ /HASH/i;
 141     $self->_values($values) if ref($values) =~ /ARRAY/i;
 142     $self->names($names) if ref($names) =~ /ARRAY/i;
 143
 144     $self->matrix_name($matname) if defined $matname;
 145     $self->matrix_id  ($matid)   if defined $matid;
 146
 147     return $self;
 148 }
 149
 150 =head2 get_entry
 151
 152  Title   : get_entry
 153  Usage   : $matrix->get_entry();
 154  Function: returns a particular entry
 155  Returns : a float
 156  Arguments:  string id1, string id2
 157
 158 =cut
 159
 160 sub get_entry {
 161   my ($self,$row,$column) = @_;
 162   $row && $column || $self->throw("Need at least 2 ids");
 163   my %matrix = %{$self->_matrix};
 164   my @values = @{$self->_values};
 165   if(ref $matrix{$row}{$column}){
 166       my ($i,$j) = @{$matrix{$row}{$column}};
 167       return $values[$i][$j];
 168   }
 169   return;
 170
 171 }
 172
 173 =head2 get_row
 174
 175  Title   : get_row
 176  Usage   : $matrix->get_row('ALPHA');
 177  Function: returns a particular row
 178  Returns : an array of float
 179  Arguments:  string id1
 180
 181 =cut
 182
 183 sub get_row {
 184     my ($self,$row) = @_;
 185     $row || $self->throw("Need at least a row id");
 186
 187     my %matrix = %{$self->_matrix};
 188     my @values = @{$self->_values};
 189     my @names = @{$self->names};
 190     $matrix{$row} || return;
 191     my ($val) = values %{$matrix{$row}};
 192     my $row_pointer = $val->[0];
 193     my $index = scalar(@names)-1;
 194     return @{$values[$row_pointer]}[0..$index];
 195 }
 196
 197 =head2 get_column
 198
 199  Title   : get_column
 200  Usage   : $matrix->get_column('ALPHA');
 201  Function: returns a particular column
 202  Returns : an array of floats
 203  Arguments:  string id1
 204
 205 =cut
 206
 207 sub get_column {
 208     my ($self,$column) = @_;
 209     $column || $self->throw("Need at least a column id");
 210
 211     my %matrix = %{$self->_matrix};
 212     my @values = @{$self->_values};
 213     my @names = @{$self->names};
 214     $matrix{$column} || return ();
 215     my ($val) = values %{$matrix{$column}};
 216     my $row_pointer = $val->[0];
 217     my @ret;
 218     for(my $i=0; $i < scalar(@names); $i++) {
 219         push @ret, $values[$i][$row_pointer];
 220     }
 221     return @ret;
 222 }
 223
 224 =head2 get_diagonal
 225
 226  Title   : get_diagonal
 227  Usage   : $matrix->get_diagonal();
 228  Function: returns the diagonal of the matrix
 229  Returns : an array of float
 230  Arguments:  string id1
 231
 232 =cut
 233
 234 sub get_diagonal {
 235   my ($self) = @_;
 236   my %matrix = %{$self->_matrix};
 237   my @values = @{$self->_values};
 238   my @return;
 239   foreach my $name (@{$self->names}){
 240     my ($i,$j) = @{$matrix{$name}{$name}};
 241     push @return,$values[$i][$j];
 242   }
 243   return @return;
 244 }
 245
 246 =head2 print_matrix
 247
 248  Title   : print_matrix
 249  Usage   : $matrix->print_matrix();
 250  Function: returns a string of the matrix in phylip format
 251  Returns : a string
 252  Arguments:
 253
 254 =cut
 255
 256 sub print_matrix {
 257   my ($self) = @_;
 258   my @names = @{$self->names};
 259   my @values = @{$self->_values};
 260   my %matrix = %{$self->_matrix};
 261   my $str;
 262   $str.= (" "x 4). scalar(@names)."\n";
 263   foreach my $name (@names){
 264     my $newname = $name. (" " x (15-length($name)));
 265     if( length($name) >= 15 ) { $newname .= " " }
 266     $str.=$newname;
 267     my $count = 0;
 268     foreach my $n (@names) {
 269       my ($i,$j) = @{$matrix{$name}{$n}};
 270       if($count < $#names){
 271         $str .= $values[$i][$j]. "  ";
 272       }
 273       else {
 274           if( ! defined $values[$i][$j] ) {
 275               $self->debug("no value for $i,$j cell\n");
 276           } else {
 277               $str .= $values[$i][$j];
 278           }
 279       }
 280       $count++;
 281     }
 282     $str.="\n";
 283   }
 284   return $str;
 285 }
 286
 287 =head2 _matrix
 288
 289  Title   : _matrix
 290  Usage   : $matrix->_matrix();
 291  Function: get/set for hash reference of the pointers
 292            to the value matrix
 293  Returns : hash reference
 294  Arguments: hash reference
 295
 296 =cut
 297
 298 sub _matrix {
 299   my ($self,$val) = @_;
 300   if($val){
 301     $self->{'_matrix'} = $val;
 302   }
 303   return $self->{'_matrix'};
 304 }
 305
 306
 307 =head2 names
 308
 309  Title   : names
 310  Usage   : $matrix->names();
 311  Function: get/set for array ref of names of sequences
 312  Returns : an array reference
 313  Arguments: an array reference
 314
 315 =cut
 316
 317 sub names {
 318   my ($self,$val) = @_;
 319   if($val){
 320     $self->{'_names'} = $val;
 321   }
 322   return $self->{'_names'};
 323 }
 324
 325 =head2 program
 326
 327  Title   : program
 328  Usage   : $matrix->program();
 329  Function: get/set for the program name generating this
 330            matrix
 331  Returns : string
 332  Arguments: string
 333
 334 =cut
 335
 336 sub program {
 337   my ($self) = shift;
 338   return $self->matrix_name(@_);
 339 }
 340
 341 =head2 _values
 342
 343  Title   : _values
 344  Usage   : $matrix->_values();
 345  Function: get/set for array ref of the matrix containing
 346            distance values
 347  Returns : an array reference
 348  Arguments: an array reference
 349
 350 =cut
 351
 352 sub _values {
 353   my ($self,$val) = @_;
 354   if($val){
 355     $self->{'_values'} = $val;
 356   }
 357   return $self->{'_values'};
 358 }
 359
 360
 361 =head1 L<Bio::Matrix::MatrixI> implementation
 362
 363
 364 =head2 matrix_id
 365
 366  Title   : matrix_id
 367  Usage   : my $id = $matrix->matrix_id
 368  Function: Get/Set the matrix ID
 369  Returns : scalar value
 370  Args    : [optional] new id value to store
 371
 372
 373 =cut
 374
 375 sub matrix_id{
 376    my $self = shift;
 377    return $self->{'_matid'} = shift if @_;
 378    return $self->{'_matid'};
 379
 380
 381 }
 382
 383 =head2 matrix_name
 384
 385  Title   : matrix_name
 386  Usage   : my $name = $matrix->matrix_name();
 387  Function: Get/Set the matrix name
 388  Returns : scalar value
 389  Args    : [optional] new matrix name value
 390
 391
 392 =cut
 393
 394 sub matrix_name{
 395    my $self = shift;
 396    return $self->{'_matname'} = shift if @_;
 397    return $self->{'_matname'};
 398 }
 399
 400 =head2 column_header
 401
 402  Title   : column_header
 403  Usage   : my $name = $matrix->column_header(0)
 404  Function: Gets the column header for a particular column number
 405  Returns : string
 406  Args    : integer
 407
 408
 409 =cut
 410
 411 sub column_header{
 412     my ($self,$num) = @_;
 413     my @coln = $self->column_names;
 414     return $coln[$num];
 415 }
 416
 417
 418 =head2 row_header
 419
 420  Title   : row_header
 421  Usage   : my $name = $matrix->row_header(0)
 422  Function: Gets the row header for a particular row number
 423  Returns : string
 424  Args    : integer
 425
 426
 427 =cut
 428
 429 sub row_header{
 430     my ($self,$num) = @_;
 431     my @rown = $self->row_names;
 432    return $rown[$num];
 433 }
 434 =head2 column_num_for_name
 435
 436  Title   : column_num_for_name
 437  Usage   : my $num = $matrix->column_num_for_name($name)
 438  Function: Gets the column number for a particular column name
 439  Returns : integer
 440  Args    : string
 441
 442
 443 =cut
 444
 445 sub column_num_for_name{
 446    my ($self,$name) = @_;
 447    my $ct = 0;
 448    foreach my $n ( $self->column_names ) {
 449        return $ct if $n eq $name;
 450        $ct++;
 451    }
 452    return;
 453 }
 454
 455 =head2 row_num_for_name
 456
 457  Title   : row_num_for_name
 458  Usage   : my $num = $matrix->row_num_for_name($name)
 459  Function: Gets the row number for a particular row name
 460  Returns : integer
 461  Args    : string
 462
 463
 464 =cut
 465
 466 sub row_num_for_name{
 467    my ($self,$name) = @_;
 468    my $ct = 0;
 469    foreach my $n ( $self->row_names ) {
 470        return $ct if $n eq $name;
 471        $ct++;
 472    }
 473 }
 474
 475 =head2 num_rows
 476
 477  Title   : num_rows
 478  Usage   : my $rowcount = $matrix->num_rows;
 479  Function: Get the number of rows
 480  Returns : integer
 481  Args    : none
 482
 483
 484 =cut
 485
 486 sub num_rows{ return scalar @{shift->names} }
 487
 488 =head2 num_columns
 489
 490  Title   : num_columns
 491  Usage   : my $colcount = $matrix->num_columns
 492  Function: Get the number of columns
 493  Returns : integer
 494  Args    : none
 495
 496
 497 =cut
 498
 499 sub num_columns{
 500    return scalar @{shift->names};
 501 }
 502
 503 =head2 row_names
 504
 505  Title   : row_names
 506  Usage   : my @rows = $matrix->row_names
 507  Function: The names of all the rows
 508  Returns : array in array context, arrayref in scalar context
 509  Args    : none
 510
 511
 512 =cut
 513
 514 sub row_names{ return @{shift->names} }
 515
 516 =head2 column_names
 517
 518  Title   : column_names
 519  Usage   : my @columns = $matrix->column_names
 520  Function: The names of all the columns
 521  Returns : array in array context, arrayref in scalar context
 522  Args    : none
 523
 524
 525 =cut
 526
 527 sub column_names{ return @{shift->names} }
 528 1;