t/Tree/TreeStatistics.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id: RandomTreeFactory.t 11525 2007-06-27 10:16:38Z sendu $
   3
   4 use strict;
   5 use FindBin qw/$RealBin/;
   6 use lib "$RealBin/../../lib";
   7
   8 BEGIN {
   9     use Bio::Root::Test;
  10
  11     test_begin(-tests => 44);
  12
  13     use_ok('Bio::TreeIO');
  14     use_ok('Bio::Tree::Statistics');
  15 }
  16
  17
  18 use Data::Dumper;
  19 my $in = Bio::TreeIO->new(-format => 'nexus',
  20                           -file   => test_input_file('traittree.nexus'));
  21 my $tree = $in->next_tree;
  22 my $node = $tree->find_node(-id => 'N14');
  23
  24 # Create some "bootstrap" trees for the next couple of tests
  25 my @bs_trees = (1) x 10; # earmark the memory but clone the tree in the next loop
  26 # Alter the the trees so that they end up with less
  27 # than 100% support
  28
  29 for(my $bsTreeIndex=0; $bsTreeIndex < @bs_trees; $bsTreeIndex+=1){
  30
  31   $bs_trees[$bsTreeIndex] = $tree->clone;
  32   my @bsLeaf = sort {$a->id <=> $b->id } grep{$_->is_Leaf} $bs_trees[$bsTreeIndex]->get_nodes;
  33   # Mix the first node with the $bsTreeIndex node
  34   my $leafIndex = $bsTreeIndex % int(scalar(@bsLeaf)/2); # only messing with 1/2 the leaves
  35   my($name1,$name2) = ($bsLeaf[0]->id, $bsLeaf[$leafIndex]->id);
  36   $bsLeaf[0]         ->id($name2);
  37   $bsLeaf[$leafIndex]->id($name1);
  38
  39   # Mess with a second taxon
  40   my $leafIndex = $bsTreeIndex % scalar(@bsLeaf); # mess with all leaves
  41   my($name3,$name4) = ($bsLeaf[-1]->id, $bsLeaf[$leafIndex]->id);
  42   $bsLeaf[-1]        ->id($name4);
  43   $bsLeaf[$leafIndex]->id($name3);
  44 }
  45
  46 my $stats = Bio::Tree::Statistics->new();
  47 is $stats->cherries($tree), 8, 'cherries';
  48 is $stats->cherries($tree, $node), 4, 'cherries';
  49
  50 subtest 'transfer-bootstrap-expectation (experimental)' => sub{
  51   plan tests=>15;
  52   my %expectation = (''=>100, N1=>27, N2=>82, N3=>64, N4=>82, N5=>82, N8=>82, N6=>82, N7=>82, N9=>100, N10=>91, N11=>100, N12=>9, N13=>55, N14=>82);
  53   my $bs_tree  = $stats->transfer_bootstrap_expectation(\@bs_trees, $tree);
  54   my @node = $bs_tree->get_nodes;
  55   for(my $i=0;$i<@node;$i++){
  56     next if($node[$i]->is_Leaf);
  57     is $node[$i]->bootstrap , $expectation{$node[$i]->id}, "Testing TBE for node ".$node[$i]->id;
  58   }
  59 };
  60
  61
  62 subtest 'assess_bootstrap' => sub{
  63   plan tests=>15;
  64   my %expectation = (''=>100, N1=>20, N2=>80, N3=>20, N4=>80, N5=>80, N8=>80, N6=>60, N7=>20, N9=>100, N10=>80, N11=>100, N12=>9, N13=>55, N14=>20);
  65   my $bs_tree  = $stats->assess_bootstrap(\@bs_trees, $tree);
  66   my @node = $bs_tree->get_nodes;
  67   for(my $i=0;$i<@node;$i++){
  68     next if($node[$i]->is_Leaf);
  69     is $node[$i]->bootstrap, $expectation{$node[$i]->id}, "Testing bootstrap for node ".$node[$i]->id;
  70   }
  71 };
  72
  73 # traits
  74 my $key = $tree->add_trait(test_input_file('traits.tab'), 4);
  75 is $key, undef, 'read traits'; # exceeded column number
  76
  77 $key = $tree->add_trait(test_input_file('traits.tab'), 2, 1);
  78 is $key, 'disp', "Add traits in second column and ignore missing"; # one leaf has a missing trait value, but ignore it
  79
  80 $key = $tree->add_trait(test_input_file('traits.tab'), 3);
  81 is $key, 'intermediate', "Add traits in third column";
  82
  83 is $stats->ps($tree, $key), 4, 'parsimony score';
  84 is $stats->ps($tree, $key, $node), 1, 'subtree parsimony score';
  85
  86 my $node_i = $tree->find_node(-id => 'N10');
  87 my @values = sort $node_i->get_tag_values('ps_trait');
  88 ok eq_set (\@values, ['red', 'blue']), 'ps value';
  89
  90 is $stats->fitch_down($tree), 1, 'fitch_down';
  91 is $node_i->get_tag_values('ps_trait'), 'red', 'ps value after fitch_down';
  92
  93
  94
  95 $node_i = $tree->find_node(-id => '2'); # leaf
  96 is $stats->persistence($tree, $node_i), 1, 'persistence of a leaf';
  97
  98 $node_i = $tree->find_node(-id => 'N1');
  99 is $stats->persistence($tree, $node_i), 1, 'persistence of an internal node value ';
 100
 101 $node_i = $tree->find_node(-id => 'N13');
 102 is $stats->persistence($tree, $node_i), 3,  'persistence of an internal node value';
 103
 104 $node_i = $tree->find_node(-id => 'N6');
 105 is $stats->persistence($tree, $node_i), 2,  'persistence of an internal node value';
 106
 107 my $value;
 108
 109 $node_i = $tree->find_node(-id => '1');
 110 is $stats->count_subclusters($tree, $node_i), 0,  'leaf node: number of clusters = 0 ';
 111
 112 $node_i = $tree->find_node(-id => 'N3');
 113 is $stats->count_subclusters($tree, $node_i), 1,  'number of clusters ';
 114
 115 $node_i = $tree->find_node(-id => 'N14');
 116 is $stats->count_subclusters($tree, $node_i), 1,  'number of clusters ';
 117
 118 $node_i = $tree->find_node(-id => 'N7');
 119 is $stats->count_subclusters($tree, $node_i), 2,  'number of clusters ';
 120
 121
 122
 123 $node_i = $tree->find_node(-id => 'N12');
 124 is $stats->count_leaves($tree, $node_i), 2,  'number of leaves in phylotype ';
 125
 126 $node_i = $tree->find_node(-id => 'N13');
 127 is $stats->count_leaves($tree, $node_i), 4,  'number of leaves in phylotype ';
 128
 129 $node_i = $tree->find_node(-id => 'N14');
 130 is $stats->count_leaves($tree, $node_i), 6,  'number of leaves in phylotype ';
 131
 132 $node_i = $tree->find_node(-id => 'N7');
 133 is $stats->count_leaves($tree, $node_i), 6,  'number of leaves in phylotype ';
 134
 135
 136
 137 $node_i = $tree->find_node(-id => 'N4');
 138 is $stats->phylotype_length($tree, $node_i), 1,  'phylotype length';
 139
 140 $node_i = $tree->find_node(-id => 'N6');
 141 is $stats->phylotype_length($tree, $node_i), 5,  'phylotype length';
 142
 143 $node_i = $tree->find_node(-id => 'N7');
 144 is $stats->phylotype_length($tree, $node_i), 12,  'phylotype length';
 145
 146 $node_i = $tree->find_node(-id => 'N13');
 147 is $stats->phylotype_length($tree, $node_i), 6,  'phylotype length';
 148
 149 $node_i = $tree->find_node(-id => 'N14');
 150 is $stats->phylotype_length($tree, $node_i), 11,  'phylotype length';
 151
 152
 153 $node_i = $tree->find_node(-id => 'N4');
 154 is $stats->sum_of_leaf_distances($tree, $node_i), 1,  'sum of leaf distances';
 155
 156 $node_i = $tree->find_node(-id => 'N6');
 157 is $stats->sum_of_leaf_distances($tree, $node_i), 6,  'sum of leaf distances';
 158
 159 $node_i = $tree->find_node(-id => 'N7');
 160 is $stats->sum_of_leaf_distances($tree, $node_i), 18,  'sum of leaf distances';
 161
 162 $node_i = $tree->find_node(-id => 'N13');
 163 is $stats->sum_of_leaf_distances($tree, $node_i), 8,  'sum of leaf distances';
 164
 165 $node_i = $tree->find_node(-id => 'N14');
 166 is $stats->sum_of_leaf_distances($tree, $node_i), 18,  'sum of leaf distances';
 167
 168
 169
 170 is sprintf ("%.3f", $stats->genetic_diversity($tree, $node_i)), '3.000',  'genetic diversity';
 171
 172 is sprintf ("%.3f", $stats->statratio($tree, $node_i)), '0.333',  'separation';
 173
 174
 175 is $stats->ai($tree, $key), 0.628906, 'association index';
 176 is $stats->ai($tree, $key, $node), 0.062500, 'subtree association index';
 177
 178 my $mc = $stats->mc($tree, $key);
 179 is ($mc->{blue}, 2, 'monophyletic clade size');
 180 is ($mc->{red}, 4, 'monophyletic clade size');
 181 $node = $tree->find_node(-id => 'N10');
 182 $mc = $stats->mc($tree, $key, $node);
 183 is ($mc->{blue}, 2, 'monophyletic clade size');
 184 is ($mc->{red}, 2, 'monophyletic clade size');
 185