Advertisement
Guest User

Xiaoyu

a guest
Dec 29th, 2009
89
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 1.31 KB | None | 0 0
  1. use lib '/home/egstation/applications/bioperl-live'; #we check out the latest SVN code
  2. use Bio::TreeIO;
  3. use Bio::Tree::Tree;
  4. use Data::Dumper;
  5. use Bio::Tree::Draw::Cladogram;
  6.  
  7.  
  8. my $treeio = Bio::TreeIO->new(-file   => "HSF.phyloxml",
  9.                             -format => "phyloxml");
  10. my $tree = $treeio->next_tree;
  11. my @nodes = $tree->get_nodes;
  12. my $nodeid;
  13. for (my $i=0; $i<=$#nodes;$i++){
  14.     if($nodes[$i]->id eq 'LOC_Os08g43334.2'){
  15.         $nodeid=$i;
  16.     }
  17. }
  18.  
  19. my $ance = $nodes[$nodeid]->ancestor;
  20. my $count=0;
  21. for my $child($ance->get_all_Descendents){
  22.     if($child->id){
  23.         $count++;
  24.     }
  25. }
  26. my $copy = $ance;
  27. while($count<5){
  28.     $count=0;
  29.     my $new_anc = $copy->ancestor;
  30.     for my $child($new_anc->get_all_Descendents){
  31.         if($child->id){
  32.             $count++;
  33.         }
  34.     }
  35.     $copy = $new_anc;
  36. }
  37. my @children;
  38. for my $child($copy->get_all_Descendents){
  39.     push(@children,$child);
  40. }
  41.  
  42. my $new_root = $tree->get_lca( -nodes => \@children);
  43. my $subtree = Bio::Tree::Tree->new(-root => $new_root, -nodelete => 1);
  44.  
  45. my $image_output = "test.eps";
  46. my $obj1 = Bio::Tree::Draw::Cladogram->new(-tree   => $subtree,  
  47.                                             -top    => 10,
  48.                                              -bottom => 10,);
  49. $obj1->print(-file => $image_output);
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement