lib/Bio/Matrix/IO/phylip.pm

   1 #
   2 # BioPerl module for Bio::Matrix::IO::phylip
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Jason Stajich <jason-at-bioperl-dot.org>
   7 #
   8 # Copyright Jason Stajich
   9 #
  10 # You may distribute this module under the same terms as perl itself
  11
  12 # POD documentation - main docs before the code
  13
  14 =head1 NAME
  15
  16 Bio::Matrix::IO::phylip - A parser for PHYLIP distance matricies
  17
  18 =head1 SYNOPSIS
  19
  20   use Bio::Matrix::IO;
  21   my $parser = Bio::Matrix::IO->new(-format   => 'phylip',
  22                                    -file     => 't/data/phylipdist.out');
  23   my $matrix = $parser->next_matrix;
  24
  25 =head1 DESCRIPTION
  26
  27 This is a parser for PHYLIP distance matrix output.
  28
  29 =head1 FEEDBACK
  30
  31 =head2 Mailing Lists
  32
  33 User feedback is an integral part of the evolution of this and other
  34 Bioperl modules. Send your comments and suggestions preferably to
  35 the Bioperl mailing list.  Your participation is much appreciated.
  36
  37   bioperl-l@bioperl.org                  - General discussion
  38   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  39
  40 =head2 Support
  41
  42 Please direct usage questions or support issues to the mailing list:
  43
  44 I<bioperl-l@bioperl.org>
  45
  46 rather than to the module maintainer directly. Many experienced and
  47 reponsive experts will be able look at the problem and quickly
  48 address it. Please include a thorough description of the problem
  49 with code and data examples if at all possible.
  50
  51 =head2 Reporting Bugs
  52
  53 Report bugs to the Bioperl bug tracking system to help us keep track
  54 of the bugs and their resolution. Bug reports can be submitted via
  55 the web:
  56
  57   https://github.com/bioperl/bioperl-live/issues
  58
  59 =head1 AUTHOR - Jason Stajich
  60
  61 Email jason-at-bioperl-dot.org
  62
  63 =head1 APPENDIX
  64
  65 The rest of the documentation details each of the object methods.
  66 Internal methods are usually preceded with a _
  67
  68 =cut
  69
  70
  71 # Let the code begin...
  72
  73
  74 package Bio::Matrix::IO::phylip;
  75
  76 use vars qw($DEFAULTPROGRAM);
  77 use strict;
  78
  79 $DEFAULTPROGRAM = 'phylipdist';
  80
  81 use Bio::Matrix::PhylipDist;
  82
  83 use base qw(Bio::Matrix::IO);
  84
  85 =head2 new
  86
  87  Title   : new
  88  Usage   : my $obj = Bio::Matrix::IO::phylip->new();
  89  Function: Builds a new Bio::Matrix::IO::phylip object
  90  Returns : an instance of Bio::Matrix::IO::phylip
  91  Args    :
  92
  93
  94 =cut
  95
  96 sub new {
  97   my($class,@args) = @_;
  98
  99   my $self = $class->SUPER::new(@args);
 100   my ($prog) = $self->_rearrange([qw(PROGRAM)], @args);
 101   $self->{'_program'} = $prog || $DEFAULTPROGRAM;
 102   return $self;
 103 }
 104
 105
 106 =head2 next_matrix
 107
 108  Title   : next_matrix
 109  Usage   : my $matrix = $parser->next_matrix
 110  Function: Get the next result set from parser data
 111  Returns : L<Bio::Matrix::PhylipDist>
 112  Args    : none
 113
 114
 115 =cut
 116
 117 sub next_matrix {
 118    my ($self) = @_;
 119    my @names;
 120    my @values;
 121    my $entry;
 122    my $size = 0;
 123    while ($entry=$self->_readline) {
 124        if($#names >=0 && $entry =~/^\s+\d+\n$/){
 125            $self->_pushback($entry);
 126            last;
 127        } elsif($entry=~/^\s+(\d+)\n$/){
 128            $size = $1;
 129            next;
 130        } elsif( $entry =~ s/^\s+(\-?\d+\.\d+)/$1/ ) {
 131            my (@line) = split( /\s+/,$entry);
 132            push @{$values[-1]}, @line;
 133            next;
 134        }
 135        my ($n,@line) = split( /\s+/,$entry);
 136
 137        push @names, $n;
 138        push @values, [@line];
 139    }
 140    if( scalar @names != $size ) {
 141        $self->warn("The number of entries ".(scalar @names).
 142                    " is not the same $size");
 143    }
 144    $#names>=0 || return;
 145    my %dist;
 146    my $i=0;
 147    foreach my $name(@names){
 148        my $j=0;
 149        foreach my $n(@names) {
 150            $dist{$name}{$n} = [$i,$j];
 151            $j++;
 152        }
 153        $i++;
 154    }
 155    my $matrix = Bio::Matrix::PhylipDist->new
 156        (-matrix_name => $self->{'_program'},
 157         -matrix      => \%dist,
 158         -names       => \@names,
 159         -values      => \@values);
 160     return $matrix;
 161 }
 162
 163 =head2 write_matrix
 164
 165  Title   : write_matrix
 166  Usage   : $matio->write_matrix($matrix)
 167  Function: Write out a matrix in the phylip distance format
 168  Returns : none
 169  Args    : L<Bio::Matrix::PhylipDist>
 170
 171
 172 =cut
 173
 174 sub write_matrix {
 175     my ($self,@matricies) = @_;
 176     foreach my $matrix ( @matricies ) {
 177         my @names = @{$matrix->names};
 178         my @values = @{$matrix->_values};
 179         my %matrix = %{$matrix->_matrix};
 180         my $str;
 181         $str.= (" "x 4). scalar(@names)."\n";
 182         foreach my $name (@names){
 183             my $newname = $name. (" " x (15-length($name)));
 184             if( length($name) >= 15 ) { $newname .= " " }
 185             $str.=$newname;
 186             my $count = 0;
 187             foreach my $n (@names){
 188                 my ($i,$j) = @{$matrix{$name}{$n}};
 189                 if($count < $#names){
 190                     $str.= $values[$i][$j]. "  ";
 191                 }
 192                 else {
 193                     $str.= $values[$i][$j];
 194                 }
 195                 $count++;
 196             }
 197             $str.="\n";
 198         }
 199         $self->_print($str);
 200     }
 201 }
 202
 203
 204 1;