Bio/TreeIO/lintree.pm

   1 #
   2 # BioPerl module for Bio::TreeIO::lintree
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Jason Stajich <jason-at-bioperl-dot-org>
   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::TreeIO::lintree - Parser for lintree output trees
  17
  18 =head1 SYNOPSIS
  19
  20   # do not use directly, use through Bio::TreeIO
  21   use Bio::TreeIO;
  22   my $treeio = Bio::TreeIO->new(-format => 'lintree',
  23                                -file   => 't/data/crab.nj');
  24   my $tree = $treeio->next_tree;
  25
  26 =head1 DESCRIPTION
  27
  28 Parser for the lintree output which looks like this
  29
  30   13 sequences     1000 bootstraping
  31 1 A-salina
  32 2 C-vittat
  33 3 C-sp.
  34 4 L-aequit
  35 5 P-camtsc
  36 6 E-tenuim
  37 7 L-splend
  38 8 P-bernha
  39 9 P-acadia
  40 10 P-p(NE)
  41 11 P-p(GU)
  42 12 P-l(NE)
  43 13 P-l(GU)
  44  14 and   2        0.098857      1000
  45  14 and   3        0.127932      1000
  46  15 and   1        0.197471      1000
  47  15 and  14        0.029273       874
  48  16 and  10        0.011732      1000
  49  16 and  11        0.004529      1000
  50  17 and  12        0.002258      1000
  51  17 and  13        0.000428      1000
  52  18 and  16        0.017512      1000
  53  18 and  17        0.010824       998
  54  19 and   4        0.006534      1000
  55  19 and   5        0.006992      1000
  56  20 and  15        0.070461      1000
  57  20 and  18        0.030579       998
  58  21 and   8        0.003339      1000
  59  21 and   9        0.002042      1000
  60  22 and   6        0.011142      1000
  61  22 and  21        0.010693       983
  62  23 and  20        0.020714       996
  63  23 and  19        0.020350      1000
  64  24 and  23        0.008665       826
  65  24 and  22        0.013457       972
  66  24 and   7        0.025598      1000
  67
  68 See http://www.bio.psu.edu/People/Faculty/Nei/Lab/software.htm for access
  69 to the program and N Takezaki, A Rzhetsky, and M Nei, "Phylogenetic test
  70 of the molecular clock and linearized trees." Mol Biol Evol 12(5):823-33.
  71
  72 =head1 FEEDBACK
  73
  74 =head2 Mailing Lists
  75
  76 User feedback is an integral part of the evolution of this and other
  77 Bioperl modules. Send your comments and suggestions preferably to
  78 the Bioperl mailing list.  Your participation is much appreciated.
  79
  80   bioperl-l@bioperl.org                  - General discussion
  81   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  82
  83 =head2 Support
  84
  85 Please direct usage questions or support issues to the mailing list:
  86
  87 I<bioperl-l@bioperl.org>
  88
  89 rather than to the module maintainer directly. Many experienced and
  90 reponsive experts will be able look at the problem and quickly
  91 address it. Please include a thorough description of the problem
  92 with code and data examples if at all possible.
  93
  94 =head2 Reporting Bugs
  95
  96 Report bugs to the Bioperl bug tracking system to help us keep track
  97 of the bugs and their resolution. Bug reports can be submitted via the
  98 web:
  99
 100   https://github.com/bioperl/bioperl-live/issues
 101
 102 =head1 AUTHOR - Jason Stajich
 103
 104 Email jason-at-bioperl-dot-org
 105
 106 =head1 CONTRIBUTORS
 107
 108 Ideas and discussion from:
 109  Alan Christoffels
 110  Avril Coghlan
 111
 112 =head1 APPENDIX
 113
 114 The rest of the documentation details each of the object methods.
 115 Internal methods are usually preceded with a _
 116
 117 =cut
 118
 119
 120 # Let the code begin...
 121
 122
 123 package Bio::TreeIO::lintree;
 124 use vars qw(%Defaults);
 125 use strict;
 126
 127
 128 use base qw(Bio::TreeIO);
 129 $Defaults{'NodeType'} = "Bio::Tree::Node";
 130
 131 =head2 new
 132
 133  Title   : new
 134  Usage   : my $obj = Bio::TreeIO::lintree->new();
 135  Function: Builds a new Bio::TreeIO::lintree object
 136  Returns : an instance of Bio::TreeIO::lintree
 137  Args    : -nodetype => Node type to create [default Bio::Tree::Node]
 138
 139
 140 =cut
 141
 142 sub _initialize {
 143     my ($self,@args) = @_;
 144     $self->SUPER::_initialize(@args);
 145     my ($nodetype) = $self->_rearrange([qw(NODETYPE)],@args);
 146     $nodetype ||= $Defaults{'NodeType'};
 147     $self->nodetype($nodetype);
 148 }
 149
 150 =head2 next_tree
 151
 152  Title   : next_tree
 153  Usage   : my $tree = $treeio->next_tree
 154  Function: Gets the next tree in the stream
 155  Returns : Bio::Tree::TreeI
 156  Args    : none
 157
 158
 159 =cut
 160
 161 sub next_tree {
 162     my ($self) = @_;
 163     my $seentop = 0;
 164     my ($tipcount,%data,@nodes) = (0);
 165     my $nodetype = $self->nodetype;
 166
 167     while( defined( $_ = $self->_readline) ) {
 168         if( /^\s*(\d+)\s+sequences/ox ) {
 169             if( $seentop ) {
 170                 $self->_pushback($_);
 171                 last;
 172             }
 173             $tipcount = $1;
 174             $seentop = 1;
 175         } elsif( /^(\d+)\s+(\S+)\s*$/ox ) {
 176             # deal with setting an outgroup
 177             unless( defined $data{'outgroup'} ) {
 178                 $data{'outgroup'} = [$1,$2];
 179             }
 180             $nodes[$1 - 1] = { '-id' => $2 };
 181         } elsif( m/^\s*(\d+)\s+and\s+(\d+)\s+(\-?\d+\.\d+)(?:\s+(\d+))?/ox ) {
 182             my ($node,$descend,$blength,$bootstrap) = ( $1, $2, $3, $4 );
 183             # need to -- descend and node because
 184             # array is 0 based
 185             $node--;$descend--;
 186             $nodes[$descend]->{'-branch_length'} = $blength;
 187             $nodes[$descend]->{'-bootstrap'}     = $bootstrap; #? here
 188             $nodes[$node]->{'-id'} = $node+1;
 189             push @{$nodes[$node]->{'-d'}}, $descend;
 190
 191         } elsif( /\s+(\S+)\-distance was used\./ox ) {
 192             $data{'method'} = $1;
 193         } elsif( /\s*seed=(\d+)/ox ) {
 194             $data{'seed'} = $1;
 195         } elsif( m/^outgroup:\s+(\d+)\s+(\S+)/ox ) {
 196             $data{'outgroup'} = [$1,$2];
 197         }
 198     }
 199     if( @nodes ) {
 200         my @treenodes;
 201         foreach my $n ( @nodes ) {
 202             push @treenodes, $nodetype->new(%{$n});
 203         }
 204
 205         foreach my $tn ( @treenodes ) {
 206             my $n = shift @nodes;
 207             for my $ptr ( @{ $n->{'-d'} || [] } ) {
 208                 $tn->add_Descendent($treenodes[$ptr]);
 209             }
 210         }
 211         my $T = Bio::Tree::Tree->new(-root => (pop @treenodes) );
 212         if( $data{'outgroup'} ) {
 213             my ($outgroup) = $treenodes[$data{'outgroup'}->[0]];
 214             if( ! defined $outgroup) {
 215                 $self->warn("cannot find '". $data{'outgroup'}->[1]. "'\n");
 216             } else {
 217                 $T->reroot($outgroup->ancestor);
 218             }
 219         }
 220         return $T;
 221     }
 222     return; # if there are no more trees, return undef
 223
 224 }
 225
 226 =head2 nodetype
 227
 228  Title   : nodetype
 229  Usage   : $obj->nodetype($newval)
 230  Function:
 231  Example :
 232  Returns : value of nodetype (a scalar)
 233  Args    : on set, new value (a scalar or undef, optional)
 234
 235
 236 =cut
 237
 238 sub nodetype{
 239    my ($self,$value) = @_;
 240    if( defined $value) {
 241        eval "require $value";
 242        if( $@ ) { $self->throw("$@: Unrecognized Node type for ".ref($self).
 243                                "'$value'");}
 244
 245        my $a = bless {},$value;
 246        unless( $a->isa('Bio::Tree::NodeI')  ) {
 247            $self->throw("Must provide a valid Bio::Tree::NodeI or child class to SeqFactory Not $value");
 248        }
 249       $self->{'nodetype'} = $value;
 250     }
 251    return $self->{'nodetype'};
 252 }
 253
 254 1;