t/Tree/Node.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4 use strict;
   5
   6 BEGIN {
   7   use Bio::Root::Test;
   8   use File::Temp qw(tempfile);
   9   test_begin( -tests => 33 );
  10   use_ok('Bio::Tree::Node');
  11   use_ok('Bio::TreeIO');
  12 }
  13
  14 my $node1 = Bio::Tree::Node->new();
  15 my $node2 = Bio::Tree::Node->new();
  16 ok( $node1->is_Leaf() );
  17 is( $node1->ancestor, undef );
  18
  19 # tests for tags
  20 ok !$node1->has_tag('test');
  21 is $node1->add_tag_value( 'test', 'a' ), 1;
  22 ok $node1->has_tag('test');
  23 is $node1->add_tag_value( 'test', 'b' ), 2;
  24 my @tags = $node1->get_tag_values('test');
  25 is scalar @tags, 2;
  26 is scalar $node1->get_tag_values('test'), 'a', 'retrieve the first value';
  27
  28 is $node1->remove_tag('test2'), 0;
  29 is $node1->remove_tag('test'),  1;
  30 ok !$node1->has_tag('test');
  31 is $node1->set_tag_value( 'test', ( 'a', 'b', 'c' ) ), 3;
  32 is $node1->remove_all_tags(), undef;
  33 ok !$node1->has_tag('test');
  34
  35 my $pnode = Bio::Tree::Node->new();
  36 $pnode->add_Descendent($node1);
  37 is( $node1->ancestor, $pnode );
  38 $pnode->add_Descendent($node2);
  39 is( $node2->ancestor, $pnode );
  40
  41 ok( !$pnode->is_Leaf );
  42
  43 my $phylo_node = Bio::Tree::Node->new(
  44   -bootstrap => 0.25,
  45   -id        => 'ADH_BOV',
  46   -desc      => 'Taxon 1'
  47 );
  48 $node1->add_Descendent($phylo_node);
  49 ok( !$node1->is_Leaf );
  50 is( $phylo_node->ancestor,    $node1 );
  51 is( $phylo_node->id,          'ADH_BOV' );
  52 is( $phylo_node->bootstrap,   0.25 );
  53 is( $phylo_node->description, 'Taxon 1' );
  54
  55 is $phylo_node->ancestor($node2), $node2;
  56 ok $node1->is_Leaf;
  57 is my @descs = $node2->each_Descendent, 1;
  58 is $descs[0], $phylo_node;
  59
  60
  61 # bug 2877
  62 my $str = "(A:52,(B:46,C:50):11,D:70)68";
  63 my $in = Bio::TreeIO->new(
  64   -internal_node_id => 'bootstrap',
  65   -format => 'nhx',
  66   -string => $str,
  67 );
  68 my $t = $in->next_tree;
  69   my $s;
  70   my $old_root = $t->get_root_node();
  71   my ($b) = $t->find_node( -id => "B" );
  72   my $b_anc = $b->ancestor;
  73
  74   my $r = $b->create_node_on_branch( -FRACTION => 0.5 );
  75   $r->id('fake');
  76
  77   # before reroot
  78   is( $t->as_text('newick',$in->params), "(A:52,(C:50,(B:23)fake:23):11,D:70)68;", 'with fake node' );
  79
  80   # after reroot
  81   $t->reroot($r);
  82   is( $t->as_text('newick',$in->params), "(B:23,(C:50,(A:52,D:70)68:11):23)fake;",
  83     "after reroot on fake node" );
  84   $t->reroot($b);
  85
  86   is( $t->as_text('newick',$in->params), "(((C:50,(A:52,D:70)68:11):23)fake:23)B;", "reroot on B" );
  87
  88   $t->reroot($b_anc);
  89   $t->splice( -remove_id => 'fake' );
  90
  91   is(
  92     $t->as_text('newick',$in->params),
  93     "(B:23,C:50,(A:52,D:70)68:11);",
  94     "remove fake node, reroot on former B anc"
  95   );
  96   $t->reroot($old_root);
  97   is( $t->as_text('newick',$in->params), "(A:52,(B:23,C:50):11,D:70)68;", "roundtrip" );