|
0
|
1 # BioPerl module for Bio::Tools::Phylo::Phylip::ProtDist
|
|
|
2 #
|
|
|
3 # Cared for by Shawn Hoon <shawnh@fugu-sg.org>
|
|
|
4 #
|
|
|
5 # Copyright Shawn Hoon
|
|
|
6 #
|
|
|
7 # You may distribute this module under the same terms as perl itself
|
|
|
8
|
|
|
9 # POD documentation - main docs before the code
|
|
|
10
|
|
|
11 =head1 NAME
|
|
|
12
|
|
|
13 Bio::Tools::Phylo::Phylip::ProtDist - DESCRIPTION of Object
|
|
|
14
|
|
|
15 =head1 SYNOPSIS
|
|
|
16
|
|
|
17 use Bio::Tools::Phylo::Phylip::ProtDist;
|
|
|
18 my $parser = new Bio::Tools::Phylo::Phylip::ProtDist(-file => 'outfile');
|
|
|
19 while( my $result = $parser->next_matrix) {
|
|
|
20
|
|
|
21 }
|
|
|
22
|
|
|
23 =head1 DESCRIPTION
|
|
|
24
|
|
|
25 A parser for ProtDist output into a Bio::Matrix::PhylipDist object
|
|
|
26
|
|
|
27 =head1 FEEDBACK
|
|
|
28
|
|
|
29 =head2 Mailing Lists
|
|
|
30
|
|
|
31 User feedback is an integral part of the evolution of this and other
|
|
|
32 Bioperl modules. Send your comments and suggestions preferably to
|
|
|
33 the Bioperl mailing list. Your participation is much appreciated.
|
|
|
34
|
|
|
35 bioperl-l@bioperl.org - General discussion
|
|
|
36 http://bioperl.org/MailList.shtml - About the mailing lists
|
|
|
37
|
|
|
38 =head2 Reporting Bugs
|
|
|
39
|
|
|
40 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
41 of the bugs and their resolution. Bug reports can be submitted via
|
|
|
42 email or the web:
|
|
|
43
|
|
|
44 bioperl-bugs@bioperl.org
|
|
|
45 http://bugzilla.bioperl.org/
|
|
|
46
|
|
|
47 =head1 AUTHOR - Shawn Hoon
|
|
|
48
|
|
|
49 Email shawnh@fugu-sg.org
|
|
|
50
|
|
|
51 Describe contact details here
|
|
|
52
|
|
|
53 =head1 CONTRIBUTORS
|
|
|
54
|
|
|
55 Additional contributors names and emails here
|
|
|
56
|
|
|
57 =head1 APPENDIX
|
|
|
58
|
|
|
59 The rest of the documentation details each of the object methods.
|
|
|
60 Internal methods are usually preceded with a _
|
|
|
61
|
|
|
62 =cut
|
|
|
63
|
|
|
64
|
|
|
65 # Let the code begin...
|
|
|
66
|
|
|
67
|
|
|
68 package Bio::Tools::Phylo::Phylip::ProtDist;
|
|
|
69 use vars qw(@ISA);
|
|
|
70 use strict;
|
|
|
71
|
|
|
72 use Bio::Root::Root;
|
|
|
73 use Bio::Matrix::PhylipDist;
|
|
|
74
|
|
|
75 use Bio::Root::IO;
|
|
|
76
|
|
|
77 @ISA = qw(Bio::Root::Root Bio::Root::IO );
|
|
|
78
|
|
|
79 =head2 new
|
|
|
80
|
|
|
81 Title : new
|
|
|
82 Usage : my $obj = new Bio::Tools::Phylo::Phylip::ProtDist();
|
|
|
83 Function: Builds a new Bio::Tools::Phylo::Phylip::ProtDist object
|
|
|
84 Returns : Bio::Tools::ProtDist
|
|
|
85 Args : -fh/-file => $val, # for initing input, see Bio::Root::IO
|
|
|
86
|
|
|
87
|
|
|
88 =cut
|
|
|
89
|
|
|
90 sub new {
|
|
|
91 my($class,@args) = @_;
|
|
|
92
|
|
|
93 my $self = $class->SUPER::new(@args);
|
|
|
94 $self->_initialize_io(@args);
|
|
|
95
|
|
|
96 return $self;
|
|
|
97 }
|
|
|
98
|
|
|
99 =head2 next_result
|
|
|
100
|
|
|
101 Title : next_result
|
|
|
102 Usage : my $matrix = $parser->next_result
|
|
|
103 Function: Get the next result set from parser data
|
|
|
104 Returns : L<Bio::Matrix::PhylipDist>
|
|
|
105 Args : none
|
|
|
106
|
|
|
107
|
|
|
108 =cut
|
|
|
109
|
|
|
110 sub next_matrix{
|
|
|
111 my ($self) = @_;
|
|
|
112 my @names;
|
|
|
113 my @values;
|
|
|
114 my $entry;
|
|
|
115 while ($entry=$self->_readline) {
|
|
|
116 if($#names >=0 && $entry =~/^\s+\d+$/){
|
|
|
117 last;
|
|
|
118 }
|
|
|
119 elsif($entry=~/^\s+\d+\n$/){
|
|
|
120 next;
|
|
|
121 }
|
|
|
122 my ($n,@line) = split( /\s+/,$entry);
|
|
|
123 push @names, $n;
|
|
|
124 push @values, [@line];
|
|
|
125 }
|
|
|
126 $#names>=0 || return;
|
|
|
127 my %dist;
|
|
|
128 my $i=0;
|
|
|
129 foreach my $name(@names){
|
|
|
130 my $j=0;
|
|
|
131 foreach my $n(@names) {
|
|
|
132 $dist{$name}{$n} = [$i,$j];
|
|
|
133 $j++;
|
|
|
134 }
|
|
|
135 $i++;
|
|
|
136 }
|
|
|
137 my $matrix = Bio::Matrix::PhylipDist->new(-matrix=>\%dist,
|
|
|
138 -names =>\@names,
|
|
|
139 -values=>\@values);
|
|
|
140 return $matrix;
|
|
|
141 }
|
|
|
142
|
|
|
143 1;
|
