1# -*-Perl-*- Test Harness script for Bioperl
2# $Id$
3
4use strict;
5
6BEGIN {
7  use Bio::Root::Test;
8
9  test_begin(-tests => 5,
10			 -requires_module => 'Set::Scalar');
11
12  use_ok('Bio::Tree::Compatible');
13  use_ok('Bio::TreeIO');
14}
15
16# these tests are done with direct access to Bio::Tree::Compatible methods,
17# instead of via creating a Bio::Tree::Compatible->new() object or similar...
18# the docs seem to indicate that is normally possible? TODO?
19
20my $in = Bio::TreeIO->new(-format => 'newick',
21						  -fh     => \*DATA);
22
23# the common labels of (((A,B)C,D),(E,F,G)); and ((A,B)H,E,(J,(K)G)I);
24# are [A,B,E,G]
25
26my $t1 = $in->next_tree;
27my $t2 = $in->next_tree;
28my $common = Bio::Tree::Compatible::common_labels($t1,$t2);
29my $labels = Set::Scalar->new(qw(A B E G));
30ok($common->is_equal($labels));
31
32# the topological restrictions of (((A,B)C,D),(E,F,G)); and
33# ((A,B)H,E,(J,(K)G)I); to their common labels, [A,B,E,G], are,
34# respectively, ((A,B),(E,G)); and ((A,B),E,(G));
35
36Bio::Tree::Compatible::topological_restriction($t1,$common);
37Bio::Tree::Compatible::topological_restriction($t2,$common);
38my $t3 = $in->next_tree;
39my $t4 = $in->next_tree;
40# ok($t1->is_equal($t3)); # is_equal method missing in Bio::Tree::Tree
41# ok($t2->is_equal($t4)); # is_equal method missing in Bio::Tree::Tree
42
43# the topological restrictions of (((A,B)C,D),(E,F,G)); and
44# ((A,B)H,E,(J,(K)G)I); to their common labels, [A,B,E,G], are
45# compatible
46
47my ($incompat, $ilabels, $inodes) = Bio::Tree::Compatible::is_compatible($t3,$t4);
48ok(!$incompat);
49
50# (((B,A),C),D); and ((A,(D,B)),C); are incompatible
51
52my $t5 = $in->next_tree;
53my $t6 = $in->next_tree;
54($incompat, $ilabels, $inodes) = Bio::Tree::Compatible::is_compatible($t5,$t6);
55ok($incompat);
56
57__DATA__
58(((A,B)C,D),(E,F,G));
59((A,B)H,E,(J,(K)G)I);
60((A,B),(E,G));
61((A,B),E,(G));
62(((B,A),C),D);
63((A,(D,B)),C);
64