File Coverage

Bio/Matrix/IO/phylip.pm
Criterion Covered Total %
statement 40 72 55.5
branch 6 14 42.8
condition 3 6 50.0
subroutine 6 7 85.7
pod 3 3 100.0
total 58 102 56.8


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::Matrix::IO::phylip
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Jason Stajich
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
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 1     1   5 use vars qw($DEFAULTPROGRAM);
  1         2  
  1         48  
76 1     1   5 use strict;
  1         2  
  1         28  
77              
78             $DEFAULTPROGRAM = 'phylipdist';
79              
80 1     1   289 use Bio::Matrix::PhylipDist;
  1         2  
  1         23  
81              
82 1     1   6 use base qw(Bio::Matrix::IO);
  1         1  
  1         535  
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 1     1 1 4 my($class,@args) = @_;
97              
98 1         5 my $self = $class->SUPER::new(@args);
99 1         3 my ($prog) = $self->_rearrange([qw(PROGRAM)], @args);
100 1   33     4 $self->{'_program'} = $prog || $DEFAULTPROGRAM;
101 1         6 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
111             Args : none
112              
113              
114             =cut
115              
116             sub next_matrix {
117 1     1 1 5 my ($self) = @_;
118 1         2 my @names;
119             my @values;
120 1         0 my $entry;
121 1         2 my $size = 0;
122 1         6 while ($entry=$self->_readline) {
123 6 50 66     32 if($#names >=0 && $entry =~/^\s+\d+\n$/){
    100          
    50          
124 0         0 $self->_pushback($entry);
125 0         0 last;
126             } elsif($entry=~/^\s+(\d+)\n$/){
127 1         14 $size = $1;
128 1         3 next;
129             } elsif( $entry =~ s/^\s+(\-?\d+\.\d+)/$1/ ) {
130 0         0 my (@line) = split( /\s+/,$entry);
131 0         0 push @{$values[-1]}, @line;
  0         0  
132 0         0 next;
133             }
134 5         23 my ($n,@line) = split( /\s+/,$entry);
135            
136 5         10 push @names, $n;
137 5         12 push @values, [@line];
138             }
139 1 50       3 if( scalar @names != $size ) {
140 0         0 $self->warn("The number of entries ".(scalar @names).
141             " is not the same $size");
142             }
143 1 50       2 $#names>=0 || return;
144 1         1 my %dist;
145 1         2 my $i=0;
146 1         2 foreach my $name(@names){
147 5         5 my $j=0;
148 5         4 foreach my $n(@names) {
149 25         37 $dist{$name}{$n} = [$i,$j];
150 25         17 $j++;
151             }
152 5         6 $i++;
153             }
154             my $matrix = Bio::Matrix::PhylipDist->new
155 1         7 (-matrix_name => $self->{'_program'},
156             -matrix => \%dist,
157             -names => \@names,
158             -values => \@values);
159 1         3 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
169              
170              
171             =cut
172              
173             sub write_matrix {
174 0     0 1   my ($self,@matricies) = @_;
175 0           foreach my $matrix ( @matricies ) {
176 0           my @names = @{$matrix->names};
  0            
177 0           my @values = @{$matrix->_values};
  0            
178 0           my %matrix = %{$matrix->_matrix};
  0            
179 0           my $str;
180 0           $str.= (" "x 4). scalar(@names)."\n";
181 0           foreach my $name (@names){
182 0           my $newname = $name. (" " x (15-length($name)));
183 0 0         if( length($name) >= 15 ) { $newname .= " " }
  0            
184 0           $str.=$newname;
185 0           my $count = 0;
186 0           foreach my $n (@names){
187 0           my ($i,$j) = @{$matrix{$name}{$n}};
  0            
188 0 0         if($count < $#names){
189 0           $str.= $values[$i][$j]. " ";
190             }
191             else {
192 0           $str.= $values[$i][$j];
193             }
194 0           $count++;
195             }
196 0           $str.="\n";
197             }
198 0           $self->_print($str);
199             }
200             }
201              
202              
203             1;