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 use vars qw($DEFAULTPROGRAM);
  76 use strict;
  77
  78 $DEFAULTPROGRAM = 'phylipdist';
  79
  80 use Bio::Matrix::PhylipDist;
  81
  82 use base qw(Bio::Matrix::IO);
  83
  84 =head2 new
  85
  86  Title   : new
  87  Usage   : my $obj = Bio::Matrix::IO::phylip->new();
  88  Function: Builds a new Bio::Matrix::IO::phylip object
  89  Returns : an instance of Bio::Matrix::IO::phylip
  90  Args    :
  91
  92
  93 =cut
  94
  95 sub new {
  96   my($class,@args) = @_;
  97
  98   my $self = $class->SUPER::new(@args);
  99   my ($prog) = $self->_rearrange([qw(PROGRAM)], @args);
 100   $self->{'_program'} = $prog || $DEFAULTPROGRAM;
 101   return $self;
 102 }
 103
 104
 105 =head2 next_matrix
 106
 107  Title   : next_matrix
 108  Usage   : my $matrix = $parser->next_matrix
 109  Function: Get the next result set from parser data
 110  Returns : L<Bio::Matrix::PhylipDist>
 111  Args    : none
 112
 113
 114 =cut
 115
 116 sub next_matrix {
 117    my ($self) = @_;
 118    my @names;
 119    my @values;
 120    my $entry;
 121    my $size = 0;
 122    while ($entry=$self->_readline) {
 123        if($#names >=0 && $entry =~/^\s+\d+\n$/){
 124            $self->_pushback($entry);
 125            last;
 126        } elsif($entry=~/^\s+(\d+)\n$/){
 127            $size = $1;
 128            next;
 129        } elsif( $entry =~ s/^\s+(\-?\d+\.\d+)/$1/ ) {
 130            my (@line) = split( /\s+/,$entry);
 131            push @{$values[-1]}, @line;
 132            next;
 133        }
 134        my ($n,@line) = split( /\s+/,$entry);
 135
 136        push @names, $n;
 137        push @values, [@line];
 138    }
 139    if( scalar @names != $size ) {
 140        $self->warn("The number of entries ".(scalar @names).
 141                    " is not the same $size");
 142    }
 143    $#names>=0 || return;
 144    my %dist;
 145    my $i=0;
 146    foreach my $name(@names){
 147        my $j=0;
 148        foreach my $n(@names) {
 149            $dist{$name}{$n} = [$i,$j];
 150            $j++;
 151        }
 152        $i++;
 153    }
 154    my $matrix = Bio::Matrix::PhylipDist->new
 155        (-matrix_name => $self->{'_program'},
 156         -matrix      => \%dist,
 157         -names       => \@names,
 158         -values      => \@values);
 159     return $matrix;
 160 }
 161
 162 =head2 write_matrix
 163
 164  Title   : write_matrix
 165  Usage   : $matio->write_matrix($matrix)
 166  Function: Write out a matrix in the phylip distance format
 167  Returns : none
 168  Args    : L<Bio::Matrix::PhylipDist>
 169
 170
 171 =cut
 172
 173 sub write_matrix {
 174     my ($self,@matricies) = @_;
 175     foreach my $matrix ( @matricies ) {
 176         my @names = @{$matrix->names};
 177         my @values = @{$matrix->_values};
 178         my %matrix = %{$matrix->_matrix};
 179         my $str;
 180         $str.= (" "x 4). scalar(@names)."\n";
 181         foreach my $name (@names){
 182             my $newname = $name. (" " x (15-length($name)));
 183             if( length($name) >= 15 ) { $newname .= " " }
 184             $str.=$newname;
 185             my $count = 0;
 186             foreach my $n (@names){
 187                 my ($i,$j) = @{$matrix{$name}{$n}};
 188                 if($count < $#names){
 189                     $str.= $values[$i][$j]. "  ";
 190                 }
 191                 else {
 192                     $str.= $values[$i][$j];
 193                 }
 194                 $count++;
 195             }
 196             $str.="\n";
 197         }
 198         $self->_print($str);
 199     }
 200 }
 201
 202
 203 1;