This week only. Pastebin PRO Accounts Christmas Special! Don't miss out!Want more features on Pastebin? Sign Up, it's FREE!
Guest

Xiaoyu

By: a guest on Dec 29th, 2009  |  syntax: Perl  |  size: 1.62 KB  |  views: 55  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
This paste has a previous version, view the difference. Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  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 $savefile = "save.phyloxml";
  46. my $treeout = Bio::TreeIO->new(-format =>'phyloxml',
  47.                                -file => ">$savefile");
  48.  
  49. $treeout->write_tree($subtree);
  50.  
  51. my $tree2 = Bio::TreeIO->new(-format =>'phyloxml',
  52.                                -file => "save.phyloxml");
  53. my $t1 = $tree2->next_tree;
  54. my $image_output = "test.eps";
  55. my $obj1 = Bio::Tree::Draw::Cladogram->new(-tree   => $t1,  
  56.                                             -top    => 10,
  57.                                              -bottom => 10,);
  58. $obj1->print(-file => $image_output);
clone this paste RAW Paste Data