lib/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
 125 use vars qw(%Defaults);
 126 use strict;
 127
 128
 129 use base qw(Bio::TreeIO);
 130 $Defaults{'NodeType'} = "Bio::Tree::Node";
 131
 132 =head2 new
 133
 134  Title   : new
 135  Usage   : my $obj = Bio::TreeIO::lintree->new();
 136  Function: Builds a new Bio::TreeIO::lintree object
 137  Returns : an instance of Bio::TreeIO::lintree
 138  Args    : -nodetype => Node type to create [default Bio::Tree::Node]
 139
 140
 141 =cut
 142
 143 sub _initialize {
 144     my ($self,@args) = @_;
 145     $self->SUPER::_initialize(@args);
 146     my ($nodetype) = $self->_rearrange([qw(NODETYPE)],@args);
 147     $nodetype ||= $Defaults{'NodeType'};
 148     $self->nodetype($nodetype);
 149 }
 150
 151 =head2 next_tree
 152
 153  Title   : next_tree
 154  Usage   : my $tree = $treeio->next_tree
 155  Function: Gets the next tree in the stream
 156  Returns : Bio::Tree::TreeI
 157  Args    : none
 158
 159
 160 =cut
 161
 162 sub next_tree {
 163     my ($self) = @_;
 164     my $seentop = 0;
 165     my ($tipcount,%data,@nodes) = (0);
 166     my $nodetype = $self->nodetype;
 167
 168     while( defined( $_ = $self->_readline) ) {
 169         if( /^\s*(\d+)\s+sequences/ox ) {
 170             if( $seentop ) {
 171                 $self->_pushback($_);
 172                 last;
 173             }
 174             $tipcount = $1;
 175             $seentop = 1;
 176         } elsif( /^(\d+)\s+(\S+)\s*$/ox ) {
 177             # deal with setting an outgroup
 178             unless( defined $data{'outgroup'} ) {
 179                 $data{'outgroup'} = [$1,$2];
 180             }
 181             $nodes[$1 - 1] = { '-id' => $2 };
 182         } elsif( m/^\s*(\d+)\s+and\s+(\d+)\s+(\-?\d+\.\d+)(?:\s+(\d+))?/ox ) {
 183             my ($node,$descend,$blength,$bootstrap) = ( $1, $2, $3, $4 );
 184             # need to -- descend and node because
 185             # array is 0 based
 186             $node--;$descend--;
 187             $nodes[$descend]->{'-branch_length'} = $blength;
 188             $nodes[$descend]->{'-bootstrap'}     = $bootstrap; #? here
 189             $nodes[$node]->{'-id'} = $node+1;
 190             push @{$nodes[$node]->{'-d'}}, $descend;
 191
 192         } elsif( /\s+(\S+)\-distance was used\./ox ) {
 193             $data{'method'} = $1;
 194         } elsif( /\s*seed=(\d+)/ox ) {
 195             $data{'seed'} = $1;
 196         } elsif( m/^outgroup:\s+(\d+)\s+(\S+)/ox ) {
 197             $data{'outgroup'} = [$1,$2];
 198         }
 199     }
 200     if( @nodes ) {
 201         my @treenodes;
 202         foreach my $n ( @nodes ) {
 203             push @treenodes, $nodetype->new(%{$n});
 204         }
 205
 206         foreach my $tn ( @treenodes ) {
 207             my $n = shift @nodes;
 208             for my $ptr ( @{ $n->{'-d'} || [] } ) {
 209                 $tn->add_Descendent($treenodes[$ptr]);
 210             }
 211         }
 212         my $T = Bio::Tree::Tree->new(-root => (pop @treenodes) );
 213         if( $data{'outgroup'} ) {
 214             my ($outgroup) = $treenodes[$data{'outgroup'}->[0]];
 215             if( ! defined $outgroup) {
 216                 $self->warn("cannot find '". $data{'outgroup'}->[1]. "'\n");
 217             } else {
 218                 $T->reroot($outgroup->ancestor);
 219             }
 220         }
 221         return $T;
 222     }
 223     return; # if there are no more trees, return undef
 224
 225 }
 226
 227 =head2 nodetype
 228
 229  Title   : nodetype
 230  Usage   : $obj->nodetype($newval)
 231  Function:
 232  Example :
 233  Returns : value of nodetype (a scalar)
 234  Args    : on set, new value (a scalar or undef, optional)
 235
 236
 237 =cut
 238
 239 sub nodetype{
 240    my ($self,$value) = @_;
 241    if( defined $value) {
 242        eval "require $value";
 243        if( $@ ) { $self->throw("$@: Unrecognized Node type for ".ref($self).
 244                                "'$value'");}
 245
 246        my $a = bless {},$value;
 247        unless( $a->isa('Bio::Tree::NodeI')  ) {
 248            $self->throw("Must provide a valid Bio::Tree::NodeI or child class to SeqFactory Not $value");
 249        }
 250       $self->{'nodetype'} = $value;
 251     }
 252    return $self->{'nodetype'};
 253 }
 254
 255 1;