Bio/Matrix/IO/phylip.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::Matrix::IO::phylip
   4 #
   5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   6 #
   7 # Cared for by Jason Stajich <jason-at-bioperl-dot.org>
   8 #
   9 # Copyright Jason Stajich
  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::IO::phylip - A parser for PHYLIP distance matricies
  18
  19 =head1 SYNOPSIS
  20
  21   use Bio::Matrix::IO;
  22   my $parser = Bio::Matrix::IO->new(-format   => 'phylip'
  23                                    -file     => 't/data/phylipdist.out');
  24   my $matrix = $parser->next_matrix;
  25
  26 =head1 DESCRIPTION
  27
  28 This is a parser for PHYLIP distance matrix output.
  29
  30 =head1 FEEDBACK
  31
  32 =head2 Mailing Lists
  33
  34 User feedback is an integral part of the evolution of this and other
  35 Bioperl modules. Send your comments and suggestions preferably to
  36 the Bioperl mailing list.  Your participation is much appreciated.
  37
  38   bioperl-l@bioperl.org                  - General discussion
  39   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  40
  41 =head2 Support
  42
  43 Please direct usage questions or support issues to the mailing list:
  44
  45 L<bioperl-l@bioperl.org>
  46
  47 rather than to the module maintainer directly. Many experienced and
  48 reponsive experts will be able look at the problem and quickly
  49 address it. Please include a thorough description of the problem
  50 with code and data examples if at all possible.
  51
  52 =head2 Reporting Bugs
  53
  54 Report bugs to the Bioperl bug tracking system to help us keep track
  55 of the bugs and their resolution. Bug reports can be submitted via
  56 the web:
  57
  58   http://bugzilla.open-bio.org/
  59
  60 =head1 AUTHOR - Jason Stajich
  61
  62 Email jason-at-bioperl-dot.org
  63
  64 =head1 APPENDIX
  65
  66 The rest of the documentation details each of the object methods.
  67 Internal methods are usually preceded with a _
  68
  69 =cut
  70
  71
  72 # Let the code begin...
  73
  74
  75 package Bio::Matrix::IO::phylip;
  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;