t/Neighbor.t

   1 # -*-Perl-*-
   2 ## Bioperl Test Harness Script for Modules
   3 ## $Id$
   4
   5 use strict;
   6 use vars qw($DEBUG);
   7 $DEBUG = $ENV{'BIOPERLDEBUG'} || 0;
   8 BEGIN {
   9     eval { require Test; };
  10     if( $@ ) {
  11         use lib 't';
  12     }
  13     use Test;
  14     use vars qw($NTESTS);
  15     $NTESTS = 15;
  16     plan tests => $NTESTS;
  17 }
  18
  19 use Bio::Tools::Run::Phylo::Phylip::ProtDist;
  20 use Bio::Tools::Run::Phylo::Phylip::Neighbor;
  21 END {
  22     for ( $Test::ntest..$NTESTS ) {
  23         skip("Neighbor not found. Skipping.",1);
  24     }
  25 }
  26
  27 my $verbose = -1;
  28 my @params = ('type'    =>'UPGMA',
  29 #             'outgroup'=>2,
  30               'lowtri'  =>1,
  31               'upptri'  =>1,
  32               'subrep'  =>1,
  33               'jumble'  =>13);
  34
  35 my $tree_factory = Bio::Tools::Run::Phylo::Phylip::Neighbor->new(@params);
  36 unless ($tree_factory->executable) {
  37     warn("neighbor program not found. Skipping tests $Test::ntest to $NTESTS.\n") if( $DEBUG);
  38     exit 0;
  39 }
  40 ok $tree_factory->isa('Bio::Tools::Run::Phylo::Phylip::Neighbor');
  41
  42 my $type= "NEIGHBOR";
  43 $tree_factory->type($type);
  44 my $new_type = $tree_factory->type();
  45 ok $new_type, "NEIGHBOR", " couldn't set factory parameter";
  46
  47 my $outgroup= 1;
  48 $tree_factory->outgroup($outgroup);
  49 my $new_outgroup = $tree_factory->outgroup();
  50 ok $new_outgroup, 1, " couldn't set factory parameter";
  51
  52 my $lowtri= 0;
  53 $tree_factory->lowtri($lowtri);
  54 my $new_lowtri = $tree_factory->lowtri();
  55 ok $new_lowtri, 0, " couldn't set factory parameter";
  56
  57 my $upptri= 0;
  58 $tree_factory->upptri($upptri);
  59 my $new_upptri = $tree_factory->upptri();
  60 ok $new_upptri, 0, " couldn't set factory parameter";
  61
  62 my $subrep= 0;
  63 $tree_factory->subrep($subrep);
  64 my $new_subrep = $tree_factory->subrep();
  65 ok $new_subrep,0, " couldn't set factory parameter";
  66
  67 my $jumble= 1;
  68 $tree_factory->jumble($jumble);
  69 my $new_jumble = $tree_factory->jumble();
  70 ok $new_jumble, 1, " couldn't set factory parameter";
  71
  72 my $bequiet = 1;
  73 $tree_factory->quiet($bequiet);  # Suppress protpars messages to terminal
  74
  75 my $inputfilename = Bio::Root::IO->catfile("t","data","neighbor.dist");
  76 my $tree;
  77
  78 ($tree) = $tree_factory->create_tree($inputfilename);
  79
  80 my ($tip1) = $tree->find_node('SINFRUP002');
  81 ok($tip1);
  82 ok($tip1->id, 'SINFRUP002');
  83 # get the OTHER node
  84 my ($other) = grep { $_->id ne $tip1->id } $tip1->ancestor->each_Descendent;
  85 ok($other);
  86 ok($other->id, 'ENSP000002');
  87 ok($tip1->branch_length, '0.07854');
  88 ok($other->branch_length,'0.20141');
  89
  90 my ($hum) = $tree->find_node('SINFRUP001');
  91 ok($hum->branch_length,'0.08462');
  92
  93 $inputfilename = Bio::Root::IO->catfile("t","data","protpars.phy");
  94 my  $protdist_factory = Bio::Tools::Run::Phylo::Phylip::ProtDist->new();
  95 $protdist_factory->quiet(1);
  96
  97 my ($matrix) = $protdist_factory->create_distance_matrix($inputfilename);
  98
  99 $tree_factory->outgroup('ENSP000003');
 100 ($tree) = $tree_factory->create_tree($matrix);
 101
 102 my @nodes = sort { defined $a->id &&
 103                     defined $b->id &&
 104                     $a->id cmp $b->id } $tree->get_nodes();
 105 ok ($nodes[1]->id, 'ENSP000003',"failed creating tree by neighbor");