t/Compatible.t

   1 # -*-Perl-*-
   2 # $Id$
   3 # Bioperl Test Harness Script for Modules
   4 #
   5
   6 my $error;
   7 use strict;
   8 use vars qw($DEBUG);
   9 $DEBUG = $ENV{'BIOPERLDEBUG'} || 0;
  10
  11 BEGIN {
  12   # to handle systems with no installed Test module
  13   # we include the t dir (where a copy of Test.pm is located)
  14   # as a fallback
  15   $error = 0;
  16   eval { require Test; };
  17   if( $@ ) {
  18     use lib 't';
  19   }
  20   use Test;
  21   use vars qw($TESTCOUNT);
  22   $TESTCOUNT = 3;
  23   plan tests => $TESTCOUNT;
  24
  25   eval {
  26           require Set::Scalar;
  27   };
  28   if( $@ ) {
  29           $error = 1;
  30           warn("No Set::Scalar. Unable to test Bio::Tree::Compatible\n");
  31   }
  32 }
  33
  34 END {
  35    foreach ( $Test::ntest..$TESTCOUNT) {
  36       skip('No Set::Scalar: unable to run tests',1);
  37    }
  38 }
  39
  40 exit if $error;
  41
  42 # we have to protect Bio::Tree::Compatible from being compiled because
  43 # Set::Scalar may not be installed.
  44 eval { require Bio::Tree::Compatible; };
  45 die "failed to load Bio::Tree::Compatible: $@\n" if $@;
  46
  47 use Bio::TreeIO;
  48 my $verbose = 0;
  49
  50 my $in = new Bio::TreeIO(-format => 'newick',
  51                                                                  -fh     => \*DATA);
  52
  53 # the common labels of (((A,B)C,D),(E,F,G)); and ((A,B)H,E,(J,(K)G)I);
  54 # are [A,B,E,G]
  55
  56 my $t1 = $in->next_tree;
  57 my $t2 = $in->next_tree;
  58 my $common = Bio::Tree::Compatible::common_labels($t1,$t2);
  59 my $labels = Set::Scalar->new(qw(A B E G));
  60 ok($common->is_equal($labels));
  61
  62 # the topological restrictions of (((A,B)C,D),(E,F,G)); and
  63 # ((A,B)H,E,(J,(K)G)I); to their common labels, [A,B,E,G], are,
  64 # respectively, ((A,B),(E,G)); and ((A,B),E,(G));
  65
  66 Bio::Tree::Compatible::topological_restriction($t1,$common);
  67 Bio::Tree::Compatible::topological_restriction($t2,$common);
  68 my $t3 = $in->next_tree;
  69 my $t4 = $in->next_tree;
  70 # ok($t1->is_equal($t3)); # is_equal method missing in Bio::Tree::Tree
  71 # ok($t2->is_equal($t4)); # is_equal method missing in Bio::Tree::Tree
  72
  73 # the topological restrictions of (((A,B)C,D),(E,F,G)); and
  74 # ((A,B)H,E,(J,(K)G)I); to their common labels, [A,B,E,G], are
  75 # compatible
  76
  77 my ($incompat, $ilabels, $inodes) = Bio::Tree::Compatible::is_compatible($t3,$t4);
  78 ok(!$incompat);
  79
  80 # (((B,A),C),D); and ((A,(D,B)),C); are incompatible
  81
  82 my $t5 = $in->next_tree;
  83 my $t6 = $in->next_tree;
  84 ($incompat, $ilabels, $inodes) = Bio::Tree::Compatible::is_compatible($t5,$t6);
  85 ok($incompat);
  86
  87 __DATA__
  88 (((A,B)C,D),(E,F,G));
  89 ((A,B)H,E,(J,(K)G)I);
  90 ((A,B),(E,G));
  91 ((A,B),E,(G));
  92 (((B,A),C),D);
  93 ((A,(D,B)),C);