t/Neighbor.t

   1 # -*-Perl-*-
   2 ## Bioperl Test Harness Script for Modules
   3
   4 use strict;
   5 use vars qw($DEBUG);
   6 $DEBUG = test_debug();
   7 BEGIN {
   8     use Bio::Root::Test;
   9     test_begin(-tests => 19);
  10     use_ok('Bio::Tools::Run::Phylo::Phylip::ProtDist');
  11     use_ok('Bio::Tools::Run::Phylo::Phylip::Neighbor');
  12 }
  13
  14 my $verbose = -1;
  15 my @params = ('type'    =>'UPGMA',
  16 #             'outgroup'=>2,
  17               'lowtri'  =>1,
  18               'upptri'  =>1,
  19               'subrep'  =>1,
  20               'jumble'  =>13);
  21
  22 my $tree_factory = Bio::Tools::Run::Phylo::Phylip::Neighbor->new(@params);
  23
  24 SKIP: {
  25     test_skip(-requires_executable => $tree_factory,
  26               -tests => 17);
  27     isa_ok $tree_factory,'Bio::Tools::Run::Phylo::Phylip::Neighbor';
  28
  29     my $type= "NEIGHBOR";
  30     $tree_factory->type($type);
  31     my $new_type = $tree_factory->type();
  32     is $new_type, "NEIGHBOR", " couldn't set factory parameter";
  33
  34     my $outgroup= 1;
  35     $tree_factory->outgroup($outgroup);
  36     my $new_outgroup = $tree_factory->outgroup();
  37     is $new_outgroup, 1, " couldn't set factory parameter";
  38
  39     my $lowtri= 0;
  40     $tree_factory->lowtri($lowtri);
  41     my $new_lowtri = $tree_factory->lowtri();
  42     is $new_lowtri, 0, " couldn't set factory parameter";
  43
  44     my $upptri= 0;
  45     $tree_factory->upptri($upptri);
  46     my $new_upptri = $tree_factory->upptri();
  47     is $new_upptri, 0, " couldn't set factory parameter";
  48
  49     my $subrep= 0;
  50     $tree_factory->subrep($subrep);
  51     my $new_subrep = $tree_factory->subrep();
  52     is $new_subrep,0, " couldn't set factory parameter";
  53
  54     my $jumble= 1;
  55     $tree_factory->jumble($jumble);
  56     my $new_jumble = $tree_factory->jumble();
  57     is $new_jumble, 1, " couldn't set factory parameter";
  58
  59     my $bequiet = 1;
  60     $tree_factory->quiet($bequiet);  # Suppress protpars messages to terminal
  61
  62     my $inputfilename = test_input_file("neighbor.dist");
  63     my $tree;
  64
  65     ($tree) = $tree_factory->create_tree($inputfilename);
  66
  67     my ($tip1) = $tree->find_node('SINFRUP002');
  68     ok($tip1);
  69     is($tip1->id, 'SINFRUP002');
  70     # get the OTHER node
  71     my ($other) = grep { $_->id ne $tip1->id } $tip1->ancestor->each_Descendent;
  72     ok($other);
  73     is($other->id, 'ENSP000002');
  74     is($tip1->branch_length, '0.07854');
  75     is($other->branch_length,'0.20141');
  76
  77     my ($hum) = $tree->find_node('SINFRUP001');
  78     is($hum->branch_length,'0.08462');
  79
  80     $inputfilename = test_input_file("protpars.phy");
  81     my  $protdist_factory = Bio::Tools::Run::Phylo::Phylip::ProtDist->new();
  82     $protdist_factory->quiet(1);
  83
  84     my ($matrix) = $protdist_factory->create_distance_matrix($inputfilename);
  85
  86     $tree_factory->outgroup('ENSP000003');
  87     ($tree) = $tree_factory->create_tree($matrix);
  88
  89     my @nodes = sort { defined $a->id &&
  90                        defined $b->id &&
  91                        $a->id cmp $b->id } $tree->get_nodes();
  92     is ($nodes[1]->id, 'ENSP000003',"failed creating tree by neighbor");
  93
  94     # Test name preservation and restoration:
  95     $inputfilename = test_input_file("longnames.aln");
  96     my $aln = Bio::AlignIO->new(-file=>$inputfilename, -format=>'clustalw')->next_aln;
  97     my ($aln_safe, $ref_name) =$aln->set_displayname_safe(3);
  98     $protdist_factory = Bio::Tools::Run::Phylo::Phylip::ProtDist->new();
  99     ($matrix) = $protdist_factory->create_distance_matrix($aln_safe);
 100     $tree_factory->outgroup(undef);
 101     my ($tree2) = $tree_factory->create_tree($matrix);
 102     @nodes = sort { defined $a->id &&
 103                     defined $b->id &&
 104                     $a->id cmp $b->id } $tree2->get_nodes();
 105     is ($nodes[2]->id, 'S01',"failed to assign serial names");
 106     foreach my $nd (@nodes){
 107         $nd->id($ref_name->{$nd->id_output}) if $nd->is_Leaf;
 108     }
 109     is ($nodes[2]->id, 'Spar_21273',"failed to restore original names");
 110 }