Bio/Tools/Phylo/Phylip/ProtDist.pm

   1 # $Id$
   2 # BioPerl module for Bio::Tools::Phylo::Phylip::ProtDist
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Shawn Hoon <shawnh@fugu-sg.org>
   7 #
   8 # Copyright Shawn Hoon
   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::Tools::Phylo::Phylip::ProtDist - parser for ProtDist output
  17
  18 =head1 SYNOPSIS
  19
  20     use Bio::Tools::Phylo::Phylip::ProtDist;
  21     my $parser = Bio::Tools::Phylo::Phylip::ProtDist->new(-file => 'outfile');
  22     while( my $result = $parser->next_matrix) {
  23       # do something with it
  24     }
  25
  26 =head1 DESCRIPTION
  27
  28 A parser for ProtDist output into a L<Bio::Matrix::PhylipDist> object.
  29 See also L<Bio::Matrix::IO::phylip> this module may go away.
  30
  31 =head1 FEEDBACK
  32
  33 =head2 Mailing Lists
  34
  35 User feedback is an integral part of the evolution of this and other
  36 Bioperl modules. Send your comments and suggestions preferably to
  37 the Bioperl mailing list.  Your participation is much appreciated.
  38
  39   bioperl-l@bioperl.org                  - General discussion
  40   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  41
  42 =head2 Support
  43
  44 Please direct usage questions or support issues to the mailing list:
  45
  46 L<bioperl-l@bioperl.org>
  47
  48 rather than to the module maintainer directly. Many experienced and
  49 reponsive experts will be able look at the problem and quickly
  50 address it. Please include a thorough description of the problem
  51 with code and data examples if at all possible.
  52
  53 =head2 Reporting Bugs
  54
  55 Report bugs to the Bioperl bug tracking system to help us keep track
  56 of the bugs and their resolution. Bug reports can be submitted via the
  57 web:
  58
  59   http://bugzilla.open-bio.org/
  60
  61 =head1 AUTHOR - Shawn Hoon
  62
  63 Email shawnh@fugu-sg.org
  64
  65 =head1 APPENDIX
  66
  67 The rest of the documentation details each of the object methods.
  68 Internal methods are usually preceded with a _
  69
  70 =cut
  71
  72
  73 # Let the code begin...
  74
  75
  76 package Bio::Tools::Phylo::Phylip::ProtDist;
  77 use strict;
  78
  79 use Bio::Matrix::PhylipDist;
  80
  81
  82 use base qw(Bio::Root::Root Bio::Root::IO);
  83
  84 =head2 new
  85
  86  Title   : new
  87  Usage   : my $obj = Bio::Tools::Phylo::Phylip::ProtDist->new();
  88  Function: Builds a new Bio::Tools::Phylo::Phylip::ProtDist object
  89  Returns : Bio::Tools::ProtDist
  90  Args    : -fh/-file => $val, # for initing input, see Bio::Root::IO
  91            -program  => 'programname' # name of the program
  92
  93 =cut
  94
  95 sub new {
  96   my($class,@args) = @_;
  97
  98   my $self = $class->SUPER::new(@args);
  99   $self->_initialize_io(@args);
 100   my ($prog) = $self->_rearrange([qw(PROGRAM)], @args);
 101   $self->{'_program'} = $prog;
 102   return $self;
 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    for my $name (@names){
 147        my $j=0;
 148        for my $n (@names) {
 149            $dist{$name}{$n} = [$i,$j];
 150            $j++;
 151        }
 152        $i++;
 153    }
 154    return Bio::Matrix::PhylipDist->new(-program => $self->{'_program'},
 155                                              -matrix  => \%dist,
 156                                              -names   => \@names,
 157                                              -values  => \@values);
 158 }
 159
 160 1;