1 # -*-Perl-*- Test Harness script for Bioperl
2 # $Id: RandomTreeFactory.t 11525 2007-06-27 10:16:38Z sendu $
10 test_begin(-tests => 40);
12 use_ok('Bio::TreeIO');
13 use_ok('Bio::Tree::Statistics');
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');
24 my $stats = Bio::Tree::Statistics->new();
25 is $stats->cherries($tree), 8, 'cherries';
26 is $stats->cherries($tree, $node), 4, 'cherries';
29 my $key = $tree->add_trait(test_input_file('traits.tab'), 3);
30 is ($key, 'intermediate', 'read traits');
32 is $stats->ps($tree, $key), 4, 'parsimony score';
33 is $stats->ps($tree, $key, $node), 1, 'subtree parsimony score';
35 my $node_i = $tree->find_node(-id => 'N10');
36 my @values = sort $node_i->get_tag_values('ps_trait');
37 ok eq_set (\@values, ['red', 'blue']), 'ps value';
39 is $stats->fitch_down($tree), 1, 'fitch_down';
40 is $node_i->get_tag_values('ps_trait'), 'red', 'ps value after fitch_down';
44 $node_i = $tree->find_node(-id => '2'); # leaf
45 is $stats->persistence($tree, $node_i), 1, 'persistence of a leaf';
47 $node_i = $tree->find_node(-id => 'N1');
48 is $stats->persistence($tree, $node_i), 1, 'persistence of an internal node value ';
50 $node_i = $tree->find_node(-id => 'N13');
51 is $stats->persistence($tree, $node_i), 3, 'persistence of an internal node value';
53 $node_i = $tree->find_node(-id => 'N6');
54 is $stats->persistence($tree, $node_i), 2, 'persistence of an internal node value';
58 $node_i = $tree->find_node(-id => '1');
59 is $stats->count_subclusters($tree, $node_i), 0, 'leaf node: number of clusters = 0 ';
61 $node_i = $tree->find_node(-id => 'N3');
62 is $stats->count_subclusters($tree, $node_i), 1, 'number of clusters ';
64 $node_i = $tree->find_node(-id => 'N14');
65 is $stats->count_subclusters($tree, $node_i), 1, 'number of clusters ';
67 $node_i = $tree->find_node(-id => 'N7');
68 is $stats->count_subclusters($tree, $node_i), 2, 'number of clusters ';
72 $node_i = $tree->find_node(-id => 'N12');
73 is $stats->count_leaves($tree, $node_i), 2, 'number of leaves in phylotype ';
75 $node_i = $tree->find_node(-id => 'N13');
76 is $stats->count_leaves($tree, $node_i), 4, 'number of leaves in phylotype ';
78 $node_i = $tree->find_node(-id => 'N14');
79 is $stats->count_leaves($tree, $node_i), 6, 'number of leaves in phylotype ';
81 $node_i = $tree->find_node(-id => 'N7');
82 is $stats->count_leaves($tree, $node_i), 6, 'number of leaves in phylotype ';
86 $node_i = $tree->find_node(-id => 'N4');
87 is $stats->phylotype_length($tree, $node_i), 1, 'phylotype length';
89 $node_i = $tree->find_node(-id => 'N6');
90 is $stats->phylotype_length($tree, $node_i), 5, 'phylotype length';
92 $node_i = $tree->find_node(-id => 'N7');
93 is $stats->phylotype_length($tree, $node_i), 12, 'phylotype length';
95 $node_i = $tree->find_node(-id => 'N13');
96 is $stats->phylotype_length($tree, $node_i), 6, 'phylotype length';
98 $node_i = $tree->find_node(-id => 'N14');
99 is $stats->phylotype_length($tree, $node_i), 11, 'phylotype length';
102 $node_i = $tree->find_node(-id => 'N4');
103 is $stats->sum_of_leaf_distances($tree, $node_i), 1, 'sum of leaf distances';
105 $node_i = $tree->find_node(-id => 'N6');
106 is $stats->sum_of_leaf_distances($tree, $node_i), 6, 'sum of leaf distances';
108 $node_i = $tree->find_node(-id => 'N7');
109 is $stats->sum_of_leaf_distances($tree, $node_i), 18, 'sum of leaf distances';
111 $node_i = $tree->find_node(-id => 'N13');
112 is $stats->sum_of_leaf_distances($tree, $node_i), 8, 'sum of leaf distances';
114 $node_i = $tree->find_node(-id => 'N14');
115 is $stats->sum_of_leaf_distances($tree, $node_i), 18, 'sum of leaf distances';
119 is sprintf ("%.3f", $stats->genetic_diversity($tree, $node_i)), '3.000', 'genetic diversity';
121 is sprintf ("%.3f", $stats->statratio($tree, $node_i)), '0.333', 'separation';
124 is $stats->ai($tree, $key), 0.628906, 'association index';
125 is $stats->ai($tree, $key, $node), 0.062500, 'subtree association index';
127 my $mc = $stats->mc($tree, $key);
128 is ($mc->{blue}, 2, 'monophyletic clade size');
129 is ($mc->{red}, 4, 'monophyletic clade size');
130 $node = $tree->find_node(-id => 'N10');
131 $mc = $stats->mc($tree, $key, $node);
132 is ($mc->{blue}, 2, 'monophyletic clade size');
133 is ($mc->{red}, 2, 'monophyletic clade size');