diff variant_effect_predictor/Bio/TreeIO/newick.pm @ 0:1f6dce3d34e0

Uploaded

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/variant_effect_predictor/Bio/TreeIO/newick.pm	Thu Apr 11 02:01:53 2013 -0400
@@ -0,0 +1,256 @@
+# $Id: newick.pm,v 1.13.2.4 2003/09/14 19:00:35 jason Exp $
+#
+# BioPerl module for Bio::TreeIO::newick
+#
+# Cared for by Jason Stajich <[e-mail]>
+#
+# Copyright Jason Stajich
+#
+# You may distribute this module under the same terms as perl itself
+
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+Bio::TreeIO::newick - TreeIO implementation for parsing 
+  Newick/New Hampshire/PHYLIP format.
+
+=head1 SYNOPSIS
+
+  # do not use this module directly
+  use Bio::TreeIO;
+  my $treeio = new Bio::TreeIO(-format => 'newick', 
+                               -file => 't/data/LOAD_Ccd1.dnd');
+  my $tree = $treeio->next_tree;
+
+=head1 DESCRIPTION
+
+This module handles parsing and writing of Newick/PHYLIP/New Hampshire format.
+
+=head1 FEEDBACK
+
+=head2 Mailing Lists
+
+User feedback is an integral part of the evolution of this and other
+Bioperl modules. Send your comments and suggestions preferably to the
+Bioperl mailing list.  Your participation is much appreciated.
+
+  [e-mail]              - General discussion
+  http://bioperl.org/MailList.shtml  - About the mailing lists
+
+=head2 Reporting Bugs
+
+Report bugs to the Bioperl bug tracking system to help us keep track
+of the bugs and their resolution. Bug reports can be submitted via
+email or the web:
+
+  [e-mail]
+  http://bugzilla.bioperl.org/
+
+=head1 AUTHOR - Jason Stajich
+
+Email [e-mail]
+
+Describe contact details here
+
+=head1 CONTRIBUTORS
+
+Additional contributors names and emails here
+
+=head1 APPENDIX
+
+The rest of the documentation details each of the object methods.
+Internal methods are usually preceded with a _
+
+=cut
+
+
+# Let the code begin...
+
+
+package Bio::TreeIO::newick;
+use vars qw(@ISA);
+use strict;
+
+# Object preamble - inherits from Bio::Root::Root
+
+use Bio::TreeIO;
+use Bio::Event::EventGeneratorI;
+#use XML::Handler::Subs;
+
+
+@ISA = qw(Bio::TreeIO );
+
+=head2 next_tree
+
+ Title   : next_tree
+ Usage   : my $tree = $treeio->next_tree
+ Function: Gets the next tree in the stream
+ Returns : Bio::Tree::TreeI
+ Args    : none
+
+
+=cut
+
+sub next_tree{
+   my ($self) = @_;
+   local $/ = ";\n";
+   return unless $_ = $self->_readline;
+#   s/\s+//g;
+   my $despace = sub {my $dirty = shift; $dirty =~ s/\s+//gs; return $dirty};
+   my $dequote = sub {my $dirty = shift; $dirty =~ s/^"?\s*(.+?)\s*"?$/$1/; return $dirty};
+   s/([^"]*)(".+?")([^"]*)/$despace->($1) . $dequote->($2) . $despace->($3)/egsx;
+   $self->debug("entry is $_\n");
+#   my $empty = chr(20);
+ 
+   # replace empty labels with a tag
+#   s/\(,/\($empty,/ig;
+#   s/,,/,$empty,/ig;
+#   s/,,/,/ig;
+#   s/,\)/,$empty\)/ig;
+#   s/\"/\'/ig;
+
+   my $chars = '';
+   $self->_eventHandler->start_document;
+   my ($prev_event,$lastevent,$id) = ('','','');
+   foreach my $ch ( split(//,$_) ) {
+       if( $ch eq ';' ) { 	   
+	   return $self->_eventHandler->end_document;
+       } elsif( $ch eq '(' ) {
+	   $chars = '';
+	   $self->_eventHandler->start_element( {'Name' => 'tree'} );
+       } elsif($ch eq ')' ) {
+	   if( length $chars ) {
+	       if( $lastevent eq ':' ) {
+		   $self->_eventHandler->start_element( { 'Name' => 'branch_length'});
+		   $self->_eventHandler->characters($chars);
+		   $self->_eventHandler->end_element( {'Name' => 'branch_length'});
+		   $lastevent = $prev_event;
+	       } else { 
+		   $self->debug("id with no branchlength is $chars\n");
+		   $self->_eventHandler->start_element( { 'Name' => 'node' } );
+		   $self->_eventHandler->start_element( { 'Name' => 'id' } );
+		   $self->_eventHandler->characters($chars);
+		   $self->_eventHandler->end_element( { 'Name' => 'id' } );
+		   $id = $chars;
+	       }
+	       my $leafstatus = 0;
+	       if( $lastevent ne ')' ) {
+		   $leafstatus = 1;
+	       }
+
+	       $self->_eventHandler->start_element({'Name' => 'leaf'});
+	       $self->_eventHandler->characters($leafstatus);
+	       $self->_eventHandler->end_element({'Name' => 'leaf'});
+	       $id = '';
+	   } else {
+	       $self->_eventHandler->start_element( {'Name' => 'node'} );
+	   }
+
+	   $self->_eventHandler->end_element( {'Name' => 'node'} );
+	   $self->_eventHandler->end_element( {'Name' => 'tree'} );
+	   $chars = '';
+       } elsif ( $ch eq ',' ) {
+	   if( $chars ) {
+	       if( $lastevent eq ':' ) {
+		   $self->_eventHandler->start_element( { 'Name' => 'branch_length'});
+		   $self->_eventHandler->characters($chars);
+		   $self->_eventHandler->end_element( {'Name' => 'branch_length'});
+		   $lastevent = $prev_event;
+		   $chars = '';		   
+	       } else { 
+		   $self->debug("id with no branchlength is $chars\n");
+		   $self->_eventHandler->start_element( { 'Name' => 'node' } );
+		   $self->_eventHandler->start_element( { 'Name' => 'id' } );
+		   $self->_eventHandler->characters($chars);
+		   $self->_eventHandler->end_element( { 'Name' => 'id' } );
+		   $id = $chars;
+	       }
+	   } else {
+	       $self->_eventHandler->start_element( { 'Name' => 'node' } );
+	   }
+	   my $leafstatus = ( $lastevent ne ')' ) ? 1 : 0;
+
+	   $self->_eventHandler->start_element({'Name' => 'leaf'});
+	   $self->_eventHandler->characters($leafstatus);
+	   $self->_eventHandler->end_element({'Name' => 'leaf'});
+	   $self->_eventHandler->end_element( {'Name' => 'node'} );
+	   $chars = '';
+	   $id    = '';
+       } elsif( $ch eq ':' ) {
+	   $self->debug("id with a branchlength coming is $chars\n");
+	   $self->_eventHandler->start_element( { 'Name' => 'node' } );
+	   $self->_eventHandler->start_element( { 'Name' => 'id' } );	   
+	   $self->_eventHandler->characters($chars);
+	   $self->_eventHandler->end_element( { 'Name' => 'id' } );	   
+	   $id = $chars;
+	   $chars = '';
+       } else { 	   
+	   $chars .= $ch;
+	   next;
+       }
+       $prev_event = $lastevent;
+       $lastevent = $ch;
+   }
+   return undef;
+}
+
+=head2 write_tree
+
+ Title   : write_tree
+ Usage   : $treeio->write_tree($tree);
+ Function: Write a tree out to data stream in newick/phylip format
+ Returns : none
+ Args    : Bio::Tree::TreeI object
+
+=cut
+
+sub write_tree{
+   my ($self,@trees) = @_;      
+   foreach my $tree( @trees ) {
+       my @data = _write_tree_Helper($tree->get_root_node);
+       if($data[-1] !~ /\)$/ ) {
+	   $data[0] = "(".$data[0];
+	   $data[-1] .= ")";
+       }
+       $self->_print(join(',', @data), ";\n");   
+   }
+   $self->flush if $self->_flush_on_write && defined $self->_fh;
+   return;
+}
+
+sub _write_tree_Helper {
+    my ($node) = @_;
+    return () if (!defined $node);
+
+    my @data;
+    
+    foreach my $n ( $node->each_Descendent() ) {
+	push @data, _write_tree_Helper($n);
+    }
+
+    if( @data > 1 ) {
+	$data[0] = "(" . $data[0];
+	$data[-1] .= ")";
+	# let's explicitly write out the bootstrap if we've got it
+	my $b;
+	if( defined ($b = $node->bootstrap) ) {
+	    $data[-1] .= $b;
+	} elsif( defined ($b = $node->id) ) {
+	    $data[-1] .= $b;
+	}
+	$data[-1] .= ":". $node->branch_length if( $node->branch_length);
+	
+    } else {
+	if( defined $node->id || defined $node->branch_length ) { 
+	    push @data, sprintf("%s%s",
+				defined $node->id ? $node->id : '', 
+				defined $node->branch_length ? ":" .
+				$node->branch_length : '');
+	}
+    }
+    return @data;
+}
+
+
+1;