t/Tree/Compatible.t

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