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
   6 BEGIN {
   7     use lib '.';
   8     use Bio::Root::Test;
   9
  10     test_begin(-tests => 42);
  11
  12     use_ok('Bio::TreeIO');
  13     use_ok('Bio::Tree::Statistics');
  14 }
  15
  16
  17 use Data::Dumper;
  18 my $in = Bio::TreeIO->new(-format => 'nexus',
  19                           -file   => test_input_file('traittree.nexus'));
  20 my $tree = $in->next_tree;
  21 my $node = $tree->find_node(-id => 'N14');
  22
  23
  24 my $stats = Bio::Tree::Statistics->new();
  25 is $stats->cherries($tree), 8, 'cherries';
  26 is $stats->cherries($tree, $node), 4, 'cherries';
  27
  28 # traits
  29 my $key = $tree->add_trait(test_input_file('traits.tab'), 4);
  30 is $key, undef, 'read traits'; # exceeded column number
  31
  32 $key = $tree->add_trait(test_input_file('traits.tab'), 2, 1);
  33 is $key, 'disp'; # one leaf has a missing trait value, but ignore it
  34
  35 $key = $tree->add_trait(test_input_file('traits.tab'), 3);
  36 is $key, 'intermediate';
  37
  38 is $stats->ps($tree, $key), 4, 'parsimony score';
  39 is $stats->ps($tree, $key, $node), 1, 'subtree parsimony score';
  40
  41 my $node_i = $tree->find_node(-id => 'N10');
  42 my @values = sort $node_i->get_tag_values('ps_trait');
  43 ok eq_set (\@values, ['red', 'blue']), 'ps value';
  44
  45 is $stats->fitch_down($tree), 1, 'fitch_down';
  46 is $node_i->get_tag_values('ps_trait'), 'red', 'ps value after fitch_down';
  47
  48
  49
  50 $node_i = $tree->find_node(-id => '2'); # leaf
  51 is $stats->persistence($tree, $node_i), 1, 'persistence of a leaf';
  52
  53 $node_i = $tree->find_node(-id => 'N1');
  54 is $stats->persistence($tree, $node_i), 1, 'persistence of an internal node value ';
  55
  56 $node_i = $tree->find_node(-id => 'N13');
  57 is $stats->persistence($tree, $node_i), 3,  'persistence of an internal node value';
  58
  59 $node_i = $tree->find_node(-id => 'N6');
  60 is $stats->persistence($tree, $node_i), 2,  'persistence of an internal node value';
  61
  62 my $value;
  63
  64 $node_i = $tree->find_node(-id => '1');
  65 is $stats->count_subclusters($tree, $node_i), 0,  'leaf node: number of clusters = 0 ';
  66
  67 $node_i = $tree->find_node(-id => 'N3');
  68 is $stats->count_subclusters($tree, $node_i), 1,  'number of clusters ';
  69
  70 $node_i = $tree->find_node(-id => 'N14');
  71 is $stats->count_subclusters($tree, $node_i), 1,  'number of clusters ';
  72
  73 $node_i = $tree->find_node(-id => 'N7');
  74 is $stats->count_subclusters($tree, $node_i), 2,  'number of clusters ';
  75
  76
  77
  78 $node_i = $tree->find_node(-id => 'N12');
  79 is $stats->count_leaves($tree, $node_i), 2,  'number of leaves in phylotype ';
  80
  81 $node_i = $tree->find_node(-id => 'N13');
  82 is $stats->count_leaves($tree, $node_i), 4,  'number of leaves in phylotype ';
  83
  84 $node_i = $tree->find_node(-id => 'N14');
  85 is $stats->count_leaves($tree, $node_i), 6,  'number of leaves in phylotype ';
  86
  87 $node_i = $tree->find_node(-id => 'N7');
  88 is $stats->count_leaves($tree, $node_i), 6,  'number of leaves in phylotype ';
  89
  90
  91
  92 $node_i = $tree->find_node(-id => 'N4');
  93 is $stats->phylotype_length($tree, $node_i), 1,  'phylotype length';
  94
  95 $node_i = $tree->find_node(-id => 'N6');
  96 is $stats->phylotype_length($tree, $node_i), 5,  'phylotype length';
  97
  98 $node_i = $tree->find_node(-id => 'N7');
  99 is $stats->phylotype_length($tree, $node_i), 12,  'phylotype length';
 100
 101 $node_i = $tree->find_node(-id => 'N13');
 102 is $stats->phylotype_length($tree, $node_i), 6,  'phylotype length';
 103
 104 $node_i = $tree->find_node(-id => 'N14');
 105 is $stats->phylotype_length($tree, $node_i), 11,  'phylotype length';
 106
 107
 108 $node_i = $tree->find_node(-id => 'N4');
 109 is $stats->sum_of_leaf_distances($tree, $node_i), 1,  'sum of leaf distances';
 110
 111 $node_i = $tree->find_node(-id => 'N6');
 112 is $stats->sum_of_leaf_distances($tree, $node_i), 6,  'sum of leaf distances';
 113
 114 $node_i = $tree->find_node(-id => 'N7');
 115 is $stats->sum_of_leaf_distances($tree, $node_i), 18,  'sum of leaf distances';
 116
 117 $node_i = $tree->find_node(-id => 'N13');
 118 is $stats->sum_of_leaf_distances($tree, $node_i), 8,  'sum of leaf distances';
 119
 120 $node_i = $tree->find_node(-id => 'N14');
 121 is $stats->sum_of_leaf_distances($tree, $node_i), 18,  'sum of leaf distances';
 122
 123
 124
 125 is sprintf ("%.3f", $stats->genetic_diversity($tree, $node_i)), '3.000',  'genetic diversity';
 126
 127 is sprintf ("%.3f", $stats->statratio($tree, $node_i)), '0.333',  'separation';
 128
 129
 130 is $stats->ai($tree, $key), 0.628906, 'association index';
 131 is $stats->ai($tree, $key, $node), 0.062500, 'subtree association index';
 132
 133 my $mc = $stats->mc($tree, $key);
 134 is ($mc->{blue}, 2, 'monophyletic clade size');
 135 is ($mc->{red}, 4, 'monophyletic clade size');
 136 $node = $tree->find_node(-id => 'N10');
 137 $mc = $stats->mc($tree, $key, $node);
 138 is ($mc->{blue}, 2, 'monophyletic clade size');
 139 is ($mc->{red}, 2, 'monophyletic clade size');
 140
 141