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