t/Tree/Compatible.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4 use strict;
   5
   6 BEGIN {
   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
  20 my $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
  26 my $t1 = $in->next_tree;
  27 my $t2 = $in->next_tree;
  28 my $common = Bio::Tree::Compatible::common_labels($t1,$t2);
  29 my $labels = Set::Scalar->new(qw(A B E G));
  30 ok($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
  36 Bio::Tree::Compatible::topological_restriction($t1,$common);
  37 Bio::Tree::Compatible::topological_restriction($t2,$common);
  38 my $t3 = $in->next_tree;
  39 my $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
  47 my ($incompat, $ilabels, $inodes) = Bio::Tree::Compatible::is_compatible($t3,$t4);
  48 ok(!$incompat);
  49
  50 # (((B,A),C),D); and ((A,(D,B)),C); are incompatible
  51
  52 my $t5 = $in->next_tree;
  53 my $t6 = $in->next_tree;
  54 ($incompat, $ilabels, $inodes) = Bio::Tree::Compatible::is_compatible($t5,$t6);
  55 ok($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);