← Back to branch summary

~ubuntu-branches/ubuntu/gutsy/bioperl/gutsy

« back to all changes in this revision

Viewing changes to Bio/TreeIO/nexus.pm

  • Committer: Bazaar Package Importer
  • Author(s): Matt Hope
  • Date: 2004-04-18 14:24:11 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040418142411-gr92uexquw4w8liq
Tags: 1.4-1
* New upstream release
* Examples and working code are installed by default to usr/bin,
  this has been moved to usr/share/doc/bioperl/bin

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/TreeIO/nexus.pm
 
1
# $Id: nexus.pm,v 1.2 2003/12/06 18:10:26 jason Exp $
 
2
#
 
3
# BioPerl module for Bio::TreeIO::nexus
 
4
#
 
5
# Cared for by Jason Stajich <jason-at-open-bio-dot-org>
 
6
#
 
7
# Copyright Jason Stajich
 
8
#
 
9
# You may distribute this module under the same terms as perl itself
 
10
 
 
11
# POD documentation - main docs before the code
 
12
 
 
13
=head1 NAME
 
14
 
 
15
Bio::TreeIO::nexus - A TreeIO driver module for parsing Nexus tree output from PAUP
 
16
 
 
17
=head1 SYNOPSIS
 
18
 
 
19
  use Bio::TreeIO;
 
20
  my $in = new Bio::TreeIO(-file => 't/data/cat_tre.tre');
 
21
  while( my $tree = $in->next_tree ) {
 
22
  }
 
23
 
 
24
=head1 DESCRIPTION
 
25
 
 
26
This is a driver module for parsing PAUP Nexus tree format which
 
27
basically is just a remapping of trees.
 
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/MailList.shtml  - About the mailing lists
 
39
 
 
40
=head2 Reporting Bugs
 
41
 
 
42
Report bugs to the Bioperl bug tracking system to help us keep track
 
43
of the bugs and their resolution. Bug reports can be submitted via
 
44
the web:
 
45
 
 
46
  http://bugzilla.bioperl.org/
 
47
 
 
48
=head1 AUTHOR - Jason Stajich
 
49
 
 
50
Email jason-at-open-bio-dot-org
 
51
 
 
52
Describe contact details here
 
53
 
 
54
=head1 CONTRIBUTORS
 
55
 
 
56
Additional contributors names and emails here
 
57
 
 
58
=head1 APPENDIX
 
59
 
 
60
The rest of the documentation details each of the object methods.
 
61
Internal methods are usually preceded with a _
 
62
 
 
63
=cut
 
64
 
 
65
 
 
66
# Let the code begin...
 
67
 
 
68
 
 
69
package Bio::TreeIO::nexus;
 
70
use vars qw(@ISA);
 
71
use strict;
 
72
 
 
73
use Bio::TreeIO;
 
74
use Bio::Event::EventGeneratorI;
 
75
use IO::String;
 
76
 
 
77
@ISA = qw(Bio::TreeIO );
 
78
 
 
79
 
 
80
=head2 next_tree
 
81
 
 
82
 Title   : next_tree
 
83
 Usage   : my $tree = $treeio->next_tree
 
84
 Function: Gets the next tree in the stream
 
85
 Returns : Bio::Tree::TreeI
 
86
 Args    : none
 
87
 
 
88
 
 
89
=cut
 
90
 
 
91
sub next_tree {
 
92
    my ($self) = @_;
 
93
    unless ( $self->{'_parsed'} ) { 
 
94
        $self->_parse;
 
95
    }
 
96
    return $self->{'_trees'}->[$self->{'_treeiter'}++];
 
97
}
 
98
 
 
99
sub rewind { 
 
100
    shift->{'_treeiter'} = 0;
 
101
}
 
102
 
 
103
sub _parse {
 
104
   my ($self) = @_;
 
105
 
 
106
   $self->{'_parsed'} = 1;
 
107
   $self->{'_treeiter'} = 0;
 
108
 
 
109
   while( defined ( $_ = $self->_readline ) ) {
 
110
       next if /^\s+$/;
 
111
       last;
 
112
   }
 
113
   return unless( defined $_ );
 
114
   
 
115
   unless( /^\#NEXUS/i ) {
 
116
       $self->warn("File does not start with #NEXUS"); #'
 
117
           return;
 
118
   }
 
119
   my $state = 0;
 
120
   my %translate;
 
121
   while( defined ( $_ = $self->_readline ) ) {
 
122
       if( $state > 0 ) {          
 
123
           if( /^\[/ ) {
 
124
               $state++;
 
125
           } elsif( /^\]/ ) {
 
126
               $state--;
 
127
           } elsif( /^\s*Translate/ ) { 
 
128
               $state = 3;
 
129
           } elsif( $state == 3) {
 
130
               if( /^\s+(\S+)\s+(\S+)\,\s*$/ ) {
 
131
                   $translate{$1} = $2;
 
132
               } elsif( /^\s+;/) {
 
133
                   $state = 1;
 
134
               }
 
135
           } elsif( /^tree\s+(\S+)\s+\=\s+(?:\[\S+\])?\s+(.+\;)\s*$/ ) {
 
136
               my $buf = new IO::String($2);
 
137
               my $treeio = new Bio::TreeIO(-format => 'newick',
 
138
                                            -fh     => $buf);
 
139
               my $tree = $treeio->next_tree;
 
140
               foreach my $node ( grep { $_->is_Leaf } $tree->get_nodes ) {
 
141
                   my $id = $node->id;
 
142
                   my $lookup = $translate{$id};
 
143
                   $node->id($lookup || $id);
 
144
               }
 
145
               push @{$self->{'_trees'}},$tree;
 
146
           }
 
147
       } elsif( /^\s*Begin\s+trees;/i ) {
 
148
           $state = 1;
 
149
       } elsif( /^\s*End(\s+trees);/i ) {
 
150
           $state = 0;
 
151
           return;
 
152
       }
 
153
   }
 
154
}
 
155
 
 
156
 
 
157
=head2 write_tree
 
158
 
 
159
 Title   : write_tree
 
160
 Usage   : $treeio->write_tree($tree);
 
161
 Function: Writes a tree onto the stream
 
162
 Returns : none
 
163
 Args    : Bio::Tree::TreeI
 
164
 
 
165
 
 
166
=cut
 
167
 
 
168
sub write_tree{
 
169
   my ($self,$tree) = @_;
 
170
   $self->throw("Cannot call method write_tree on Bio::TreeIO object must use a subclass");
 
171
}
 
172
 
 
173
 
 
174
1;