t/QuickTree.t

   1 # -*-Perl-*-
   2 ## Bioperl Test Harness Script for Modules
   3
   4 use strict;
   5
   6 BEGIN {
   7     use Bio::Root::Test;
   8     test_begin(-tests => 13);
   9     use_ok('Bio::Tools::Run::Phylo::QuickTree');
  10     use_ok('Bio::AlignIO');
  11 }
  12
  13
  14 # setup input files etc
  15 my $inputfilename = test_input_file('cysprot.stockholm');
  16 ok (-e $inputfilename, 'Found input file');
  17
  18 my $factory = Bio::Tools::Run::Phylo::QuickTree->new();
  19 isa_ok($factory, 'Bio::Tools::Run::Phylo::QuickTree');
  20
  21 # test default factory values
  22 is ($factory->program_dir, $ENV{'QUICKTREEDIR'}, 'program_dir returned correct default');
  23 is ($factory->program_name(), 'quicktree', 'Correct exe default name');
  24
  25 # test the program itself
  26 SKIP: {
  27     test_skip(-requires_executable => $factory,
  28               -tests => 7);
  29
  30     # using filename input
  31     my $tree = $factory->run($inputfilename);
  32     isa_ok($tree, 'Bio::Tree::Tree');
  33     my @leaves = $tree->get_leaf_nodes;
  34     is (@leaves, 7, 'Result tree from filename input had correct number of leaves');
  35
  36     # using align input
  37     my $alignio = Bio::AlignIO->new(-file => $inputfilename);
  38     my $aln = $alignio->next_aln;
  39     $tree = $factory->run($aln);
  40     @leaves = $tree->get_leaf_nodes;
  41     is (@leaves, 7, 'Result tree from SimpleAlign input had correct number of leaves');
  42
  43     # do simple checks on possible options
  44     is ($factory->upgma(1), 1, 'UPGMA could be set');
  45     is ($factory->kimura(1), 1, 'kimura could be set');
  46     is ($factory->boot(100), 100, 'boot could be set');
  47     $tree = $factory->run($inputfilename);
  48
  49     my @nodes = $tree->get_nodes;
  50     my %non_internal = map { $_ => 1 } ($tree->get_leaf_nodes, $tree->get_root_node);
  51     my @bootstraps;
  52     foreach my $node (@nodes) {
  53         next if exists $non_internal{$node};
  54         push(@bootstraps, $node->bootstrap);
  55     }
  56     is_deeply([sort { $a <=> $b } @bootstraps], [qw(74 84 100 100 100)], 'bootstraps were correct');
  57 }