[Bioperl-guts-l] bioperl-live/Bio/Tree/Draw Cladogram.pm,1.5,1.6

[Gabriel Valiente]

Update of /home/repository/bioperl/bioperl-live/Bio/Tree/Draw
In directory pub.open-bio.org:/tmp/cvs-serv13503/Bio/Tree/Draw

Modified Files:
	Cladogram.pm 
Log Message:
use branch lengths to draw phylograms


Index: Cladogram.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Tree/Draw/Cladogram.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** Cladogram.pm	5 Jul 2005 12:08:39 -0000	1.5
--- Cladogram.pm	3 Sep 2005 12:41:43 -0000	1.6
***************
*** 271,278 ****
    for my $node (@queue) {
      if (!$node->is_Leaf) {
!       my $xmin = 1000;
!       my $ymin = 1000;
!       my $ymax = 0;
!       foreach my $child ($node->each_Descendent) {
  	$xmin = $xx{$child} if $xx{$child} < $xmin;
  	$ymax = $yy{$child} if $yy{$child} > $ymax;
--- 271,279 ----
    for my $node (@queue) {
      if (!$node->is_Leaf) {
!       my @children = $node->each_Descendent;
!       my $child = shift @children;
!       my $xmin = $xx{$child};
!       my $ymin = my $ymax = $yy{$child};
!       foreach $child (@children) {
  	$xmin = $xx{$child} if $xx{$child} < $xmin;
  	$ymax = $yy{$child} if $yy{$child} > $ymax;
***************
*** 284,287 ****
--- 285,320 ----
    }
  
+   ######################################################################
+   # ragged right
+   ######################################################################
+   my @preorder = $t1->get_nodes(-order => 'depth');
+   shift @preorder; # skip root
+   for my $node (@preorder) {
+     $xx{$node} = $xx{$node->ancestor} + $xstep;
+   }
+   ######################################################################
+ 
+   ######################################################################
+   # set to 3/4 aspect ratio and use branch length if available
+   ######################################################################
+   $xx{$t1->get_root_node} = $left + $xstep;
+   my $total_height = (scalar($t1->get_leaf_nodes) - 1) * $ystep;
+   my $scale_factor = $total_height * 3 / 4 / $t1->get_root_node->height;
+   
+   $width = $t1->get_root_node->height * $scale_factor;
+   $width += $left + $xstep;
+   $width += $tip + $tipwidth1 + $right;
+ 
+   # $tipwidth1 has a different meaning if ragged right
+   
+   my @preorder = $t1->get_nodes(-order => 'depth');
+   shift @preorder; # skip root
+   for my $node (@preorder) {
+     my $bl = $node->branch_length;
+     $bl = 1 unless (defined $bl && $bl =~ /^\-?\d+(\.\d+)?$/);
+     $xx{$node} = $xx{$node->ancestor} + $bl * $scale_factor;
+   }
+   ######################################################################
+ 
    if ($t2) {
  
***************
*** 311,318 ****
      for my $node (@queue) {
        if (!$node->is_Leaf) {
! 	my $xmax = 0;
! 	my $ymin = 1000;
! 	my $ymax = 0;
! 	foreach my $child ($node->each_Descendent) {
  	  $xmax = $xx{$child} if $xx{$child} > $xmax;
  	  $ymax = $yy{$child} if $yy{$child} > $ymax;
--- 344,352 ----
      for my $node (@queue) {
        if (!$node->is_Leaf) {
! 	my @children = $node->each_Descendent;
! 	my $child = shift @children;
! 	my $xmax = $xx{$child};
! 	my $ymin = my $ymax = $yy{$child};
! 	foreach $child (@children) {
  	  $xmax = $xx{$child} if $xx{$child} > $xmax;
  	  $ymax = $yy{$child} if $yy{$child} > $ymax;
***************
*** 370,375 ****
      }
    }
!   my $ymin = 1000;
!   my $ymax = 0;
    foreach my $child ($root1->each_Descendent) {
      $ymax = $yy{$child} if $yy{$child} > $ymax;
--- 404,409 ----
      }
    }
!   my $ymin = $yy{$root1};
!   my $ymax = $yy{$root1};
    foreach my $child ($root1->each_Descendent) {
      $ymax = $yy{$child} if $yy{$child} > $ymax;
***************
*** 399,404 ****
  
      my $root2 = $t2->get_root_node;
!     my $ymin = 1000;
!     my $ymax = 0;
      foreach my $child2 ($root2->each_Descendent) {
        $ymax = $yy{$child2} if $yy{$child2} > $ymax;
--- 433,438 ----
  
      my $root2 = $t2->get_root_node;
!     my $ymin = $yy{$root2};
!     my $ymax = $yy{$root2};
      foreach my $child2 ($root2->each_Descendent) {
        $ymax = $yy{$child2} if $yy{$child2} > $ymax;