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