← Back to branch summary

~ubuntu-branches/ubuntu/raring/bioperl/raring

« back to all changes in this revision

Viewing changes to Bio/TreeIO/lintree.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2008-03-18 14:44:57 UTC
  • mfrom: (4 hardy)
  • mto: This revision was merged to the branch mainline in revision 6.
  • Revision ID: james.westby@ubuntu.com-20080318144457-1jjoztrvqwf0gruk
http://bugs.debian.org/448890
* debian/control:
  - Removed MIA Matt Hope (dopey) from the Uploaders field.
    Thank you for your work, Matt. I hope you are doing well.
  - Downgraded some recommended package to the 'Suggests' priority,
    according to the following discussion on Upstream's mail list.
    http://bioperl.org/pipermail/bioperl-l/2008-March/027379.html
    (Closes: #448890)
* debian/copyright converted to machine-readable format.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/TreeIO/lintree.pm
1
 
# $Id: lintree.pm,v 1.1 2003/12/11 22:51:09 jason Exp $
 
1
# $Id: lintree.pm,v 1.8.4.1 2006/10/02 23:10:37 sendu Exp $
2
2
#
3
3
# BioPerl module for Bio::TreeIO::lintree
4
4
#
64
64
 24 and  22        0.013457       972
65
65
 24 and   7        0.025598      1000
66
66
 
67
 
See http://shanghai.bio.psu.edu/lintree.html for access to the program
68
 
and N Takezaki, A Rzhetsky, and M Nei, "Phylogenetic test of the
69
 
molecular clock and linearized trees." Mol Biol Evol 12(5):823-33.
 
67
See http://www.bio.psu.edu/People/Faculty/Nei/Lab/software.htm for access
 
68
to the program and N Takezaki, A Rzhetsky, and M Nei, "Phylogenetic test
 
69
of the molecular clock and linearized trees." Mol Biol Evol 12(5):823-33.
70
70
 
71
71
=head1 FEEDBACK
72
72
 
76
76
Bioperl modules. Send your comments and suggestions preferably to
77
77
the Bioperl mailing list.  Your participation is much appreciated.
78
78
 
79
 
  bioperl-l@bioperl.org              - General discussion
80
 
  http://bioperl.org/MailList.shtml  - About the mailing lists
 
79
  bioperl-l@bioperl.org                  - General discussion
 
80
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
81
81
 
82
82
=head2 Reporting Bugs
83
83
 
84
84
Report bugs to the Bioperl bug tracking system to help us keep track
85
 
of the bugs and their resolution. Bug reports can be submitted via
86
 
email or the web:
 
85
of the bugs and their resolution. Bug reports can be submitted via the
 
86
web:
87
87
 
88
 
  bioperl-bugs@bioperl.org
89
 
  http://bioperl.org/bioperl-bugs/
 
88
  http://bugzilla.open-bio.org/
90
89
 
91
90
=head1 AUTHOR - Jason Stajich
92
91
 
110
109
 
111
110
 
112
111
package Bio::TreeIO::lintree;
113
 
use vars qw(@ISA %Defaults);
 
112
use vars qw(%Defaults);
114
113
use strict;
115
114
 
116
 
use Bio::TreeIO;
117
115
 
118
 
@ISA = qw(Bio::TreeIO);
 
116
use base qw(Bio::TreeIO);
119
117
$Defaults{'NodeType'} = "Bio::Tree::Node";
120
118
 
121
119
=head2 new
155
153
    my $nodetype = $self->nodetype;   
156
154
 
157
155
    while( defined( $_ = $self->_readline) ) {
158
 
        if( /^\s*(\d+)\s+sequences/ ) {
 
156
        if( /^\s*(\d+)\s+sequences/ox ) {
159
157
            if( $seentop ) { 
160
158
                $self->_pushback($_);
161
159
                last;
162
160
            }
163
161
            $tipcount = $1;
164
162
            $seentop = 1;
165
 
        } elsif( /^(\d+)\s+(\S+)/ ) {
 
163
        } elsif( /^(\d+)\s+(\S+)\s*$/ox ) {
166
164
            # deal with setting an outgroup
167
165
            unless( defined $data{'outgroup'} ) {
168
166
                $data{'outgroup'} = [$1,$2];
169
167
            }
170
168
            $nodes[$1 - 1] = { '-id' => $2 }; 
171
 
        } elsif( m/^\s+(\d+)\s+and\s+(\d+)\s+(\d+\.\d+)(?:\s+(\d+))?/ox ) {
 
169
        } elsif( m/^\s*(\d+)\s+and\s+(\d+)\s+(\-?\d+\.\d+)(?:\s+(\d+))?/ox ) {
172
170
            my ($node,$descend,$blength,$bootstrap) = ( $1, $2, $3, $4 );
173
171
            # need to -- descend and node because
174
172
            # array is 0 based
178
176
            $nodes[$node]->{'-id'} = $node+1;
179
177
            push @{$nodes[$node]->{'-d'}}, $descend;
180
178
            
181
 
        } elsif( /\s+(\S+)\-distance was used\./ ) {
 
179
        } elsif( /\s+(\S+)\-distance was used\./ox ) {
182
180
            $data{'method'} = $1;
183
 
        } elsif( /\s*seed=(\d+)/ ) {
 
181
        } elsif( /\s*seed=(\d+)/ox ) {
184
182
            $data{'seed'} = $1;
185
183
        } elsif( m/^outgroup:\s+(\d+)\s+(\S+)/ox ) {
186
184
            $data{'outgroup'} = [$1,$2];
187
185
        }
188
186
    }
189
 
    my @treenodes;
190
 
    foreach my $n ( @nodes ) {  
191
 
        push @treenodes, $nodetype->new(%{$n});
192
 
    }
193
 
    
194
 
    foreach my $tn ( @treenodes ) {
195
 
        my $n = shift @nodes;
196
 
        for my $ptr ( @{ $n->{'-d'} || [] } ) {
197
 
            $tn->add_Descendent($treenodes[$ptr]);
198
 
        }
199
 
    }
200
 
    my $T = Bio::Tree::Tree->new(-root => (pop @treenodes) );
201
 
    if( $data{'outgroup'} ) {
202
 
        my ($outgroup) = $treenodes[$data{'outgroup'}->[0]];
203
 
        if( ! defined $outgroup) {
204
 
            $self->warn("cannot find '". $data{'outgroup'}->[1]. "'\n");
205
 
        } else { 
206
 
            $T->reroot($outgroup->ancestor);
207
 
        }
208
 
    }
209
 
    return $T;
 
187
    if( @nodes ) {
 
188
        my @treenodes;
 
189
        foreach my $n ( @nodes ) {      
 
190
            push @treenodes, $nodetype->new(%{$n});
 
191
        }
 
192
        
 
193
        foreach my $tn ( @treenodes ) {
 
194
            my $n = shift @nodes;
 
195
            for my $ptr ( @{ $n->{'-d'} || [] } ) {
 
196
                $tn->add_Descendent($treenodes[$ptr]);
 
197
            }
 
198
        }
 
199
        my $T = Bio::Tree::Tree->new(-root => (pop @treenodes) );
 
200
        if( $data{'outgroup'} ) {
 
201
            my ($outgroup) = $treenodes[$data{'outgroup'}->[0]];
 
202
            if( ! defined $outgroup) {
 
203
                $self->warn("cannot find '". $data{'outgroup'}->[1]. "'\n");
 
204
            } else { 
 
205
                $T->reroot($outgroup->ancestor);
 
206
            }
 
207
        }
 
208
        return $T;
 
209
    }
 
210
    return; # if there are no more trees, return undef
 
211
        
210
212
}
211
213
 
212
214
=head2 nodetype