Permalink
Browse files

Fixes for bug 3381

Additionally, clarified Hyphy.t to give better feedback.
  • Loading branch information...
1 parent a552dc3 commit 512380541696ffd931502a993101b98e0a7ac5af @daisieh daisieh committed Aug 23, 2012
Showing with 112 additions and 96 deletions.
  1. +79 −75 lib/Bio/Tools/Run/Phylo/Hyphy/REL.pm
  2. +33 −21 t/Hyphy.t
View
154 lib/Bio/Tools/Run/Phylo/Hyphy/REL.pm
@@ -2,7 +2,7 @@
#
# BioPerl module for Bio::Tools::Run::Phylo::Hyphy::REL
#
-# Please direct questions and support issues to <bioperl-l@bioperl.org>
+# Please direct questions and support issues to <bioperl-l@bioperl.org>
#
# Cared for by Albert Vilella <avilella-at-gmail-dot-com>
#
@@ -56,15 +56,15 @@ the Bioperl mailing list. Your participation is much appreciated.
bioperl-l@bioperl.org - General discussion
http://bioperl.org/wiki/Mailing_lists - About the mailing lists
-=head2 Support
+=head2 Support
Please direct usage questions or support issues to the mailing list:
I<bioperl-l@bioperl.org>
-rather than to the module maintainer directly. Many experienced and
-reponsive experts will be able look at the problem and quickly
-address it. Please include a thorough description of the problem
+rather than to the module maintainer directly. Many experienced and
+reponsive experts will be able look at the problem and quickly
+address it. Please include a thorough description of the problem
with code and data examples if at all possible.
=head2 Reporting Bugs
@@ -115,23 +115,24 @@ INCOMPLETE DOCUMENTATION OF ALL METHODS
=cut
-BEGIN {
- @VALIDVALUES =
+BEGIN {
+ @VALIDVALUES =
(
{'geneticCode' => [ "Universal","VertebratemtDNA","YeastmtDNA","Mold/ProtozoanmtDNA",
"InvertebratemtDNA","CiliateNuclear","EchinodermmtDNA","EuplotidNuclear",
"Alt.YeastNuclear","AscidianmtDNA","FlatwormmtDNA","BlepharismaNuclear"]},
{'tempalnfile' => undef }, # aln file goes here
{'temptreefile' => undef }, # tree file goes here
{'Model' => [ "Null for Test 1", "Null for Test 2", "Alternative"]},
+ {'temptsvfile' => undef } # site-by-site conditional probabilities go to this file
);
}
=head2 new
Title : new
Usage : my $obj = Bio::Tools::Run::Phylo::Hyphy::REL->new();
- Function: Builds a new Bio::Tools::Run::Phylo::Hyphy::REL object
+ Function: Builds a new Bio::Tools::Run::Phylo::Hyphy::REL object
Returns : Bio::Tools::Run::Phylo::Hyphy::REL
Args : -alignment => the Bio::Align::AlignI object
-save_tempfiles => boolean to save the generated tempfiles and
@@ -147,20 +148,22 @@ See also: L<Bio::Tree::TreeI>, L<Bio::Align::AlignI>
sub new {
my($class,@args) = @_;
- my $self = $class->SUPER::new(@args);
- my ($aln, $tree, $st, $params, $exe,
- $ubl) = $self->_rearrange([qw(ALIGNMENT TREE SAVE_TEMPFILES
- PARAMS EXECUTABLE)],
- @args);
- defined $aln && $self->alignment($aln);
- defined $tree && $self->tree($tree);
- defined $st && $self->save_tempfiles($st);
- defined $exe && $self->executable($exe);
-
- $self->set_default_parameters();
- if( defined $params ) {
- if( ref($params) !~ /HASH/i ) {
- $self->warn("Must provide a valid hash ref for parameter -FLAGS");
+ my $self = $class->SUPER::new(@args);
+ my ($aln, $tree, $st, $params, $exe,
+ $ubl) = $self->_rearrange([qw(ALIGNMENT TREE SAVE_TEMPFILES PARAMS EXECUTABLE)], @args);
+ defined $aln && $self->alignment($aln);
+ defined $tree && $self->tree($tree);
+ defined $st && $self->save_tempfiles($st);
+ defined $exe && $self->executable($exe);
+
+ my $tsvfile = $self->tempdir() . "/results.tsv";
+ $self->{'_params'}{'temptsvfile'} = $tsvfile;
+
+
+ $self->set_default_parameters();
+ if( defined $params ) {
+ if( ref($params) !~ /HASH/i ) {
+ $self->warn("Must provide a valid hash ref for parameter -FLAGS");
} else {
map { $self->set_parameter($_, $$params{$_}) } keys %$params;
}
@@ -188,33 +191,33 @@ sub run {
$self->prepare($aln,$tree) unless (defined($self->{'_prepared'}));
my ($rc,$results) = (1);
{
- my $commandstring;
- my $exit_status;
- my $tempdir = $self->tempdir;
- my $relexe = $self->executable();
- $self->throw("unable to find or run executable for 'HYPHY'") unless $relexe && -e $relexe && -x _;
- $commandstring = $relexe . " BASEPATH=" . $self->program_dir . " " . $self->{'_wrapper'};
- open(RUN, "$commandstring |") or $self->throw("Cannot open exe $relexe");
- my @output = <RUN>;
- $exit_status = close(RUN);
- $self->error_string(join('',@output));
- if( (grep { /\berr(or)?: /io } @output) || !$exit_status) {
- $self->warn("There was an error - see error_string for the program output");
- $rc = 0;
- }
- my $outfile = $self->outfile_name;
- eval {
- open(OUTFILE, ">$outfile") or $self->throw("cannot open $outfile for writing");
- # FIXME -- needs output parsing -- ask hyphy to clean that up into a tsv?
- foreach my $output (@output) {
- print OUTFILE $output;
- $results .= sprintf($output);
- }
- close(OUTFILE);
- };
- if( $@ ) {
- $self->warn($self->error_string);
- }
+ my $commandstring;
+ my $exit_status;
+ my $tempdir = $self->tempdir;
+
+ my $relexe = $self->executable();
+ $self->throw("unable to find or run executable for 'HYPHY'") unless $relexe && -e $relexe && -x _;
+ $commandstring = $relexe . " BASEPATH=" . $self->program_dir . " " . $self->{'_wrapper'};
+ open(RUN, "$commandstring |") or $self->throw("Cannot open exe $relexe");
+ my @output = <RUN>;
+ $exit_status = close(RUN);
+ $self->error_string(join('',@output));
+ if( (grep { /\berr(or)?: /io } @output) || !$exit_status) {
+ $self->warn("There was an error - see error_string for the program output");
+ $rc = 0;
+ }
+ my $outfile = $self->outfile_name;
+ eval {
+ open(OUTFILE, ">$outfile") or $self->throw("cannot open $outfile for writing");
+ foreach my $output (@output) {
+ print OUTFILE $output;
+ $results .= sprintf($output);
+ }
+ close(OUTFILE);
+ };
+ if( $@ ) {
+ $self->warn($self->error_string);
+ }
}
unless ( $self->save_tempfiles ) {
unlink($self->{'_wrapper'});
@@ -230,7 +233,7 @@ sub run {
Usage : $self->create_wrapper
Function: It will create the wrapper file that interfaces with the analysis bf file
Example :
- Returns :
+ Returns :
Args :
@@ -249,7 +252,7 @@ sub create_wrapper {
Title : set_default_parameters
Usage : $rel->set_default_parameters(0);
Function: (Re)set the default parameters from the defaults
- (the first value in each array in the
+ (the first value in each array in the
%VALIDVALUES class variable)
Returns : none
Args : boolean: keep existing parameter values
@@ -261,28 +264,29 @@ sub set_default_parameters {
my ($self,$keepold) = @_;
$keepold = 0 unless defined $keepold;
foreach my $elem (@VALIDVALUES) {
- my ($param,$val) = each %$elem;
- # skip if we want to keep old values and it is already set
- if (ref($val)=~/ARRAY/i ) {
- unless (ref($val->[0])=~/HASH/i) {
- push @{ $self->{'_orderedparams'} }, {$param, $val->[0]};
- } else {
- $val = $val->[0];
- }
- }
- if ( ref($val) =~ /HASH/i ) {
- my $prevparam;
- while (defined($val)) {
- last unless (ref($val) =~ /HASH/i);
- last unless (defined($param));
- $prevparam = $param;
- ($param,$val) = each %{$val};
- push @{ $self->{'_orderedparams'} }, {$prevparam, $param};
- push @{ $self->{'_orderedparams'} }, {$param, $val} if (defined($val));
- }
- } elsif (ref($val) !~ /HASH/i && ref($val) !~ /ARRAY/i) {
- push @{ $self->{'_orderedparams'} }, {$param, $val};
- }
+ keys %$elem; #reset hash iterator
+ my ($param,$val) = each %$elem;
+ # skip if we want to keep old values and it is already set
+ if (ref($val)=~/ARRAY/i ) {
+ unless (ref($val->[0])=~/HASH/i) {
+ push @{ $self->{'_orderedparams'} }, {$param, $val->[0]};
+ } else {
+ $val = $val->[0];
+ }
+ }
+ if ( ref($val) =~ /HASH/i ) {
+ my $prevparam;
+ while (defined($val)) {
+ last unless (ref($val) =~ /HASH/i);
+ last unless (defined($param));
+ $prevparam = $param;
+ ($param,$val) = each %{$val};
+ push @{ $self->{'_orderedparams'} }, {$prevparam, $param};
+ push @{ $self->{'_orderedparams'} }, {$param, $val} if (defined($val));
+ }
+ } elsif (ref($val) !~ /HASH/i && ref($val) !~ /ARRAY/i) {
+ push @{ $self->{'_orderedparams'} }, {$param, $val};
+ }
}
}
@@ -296,7 +300,7 @@ sub set_default_parameters {
Title : no_param_checks
Usage : $obj->no_param_checks($newval)
Function: Boolean flag as to whether or not we should
- trust the sanity checks for parameter values
+ trust the sanity checks for parameter values
Returns : value of no_param_checks
Args : newvalue (optional)
@@ -307,7 +311,7 @@ sub set_default_parameters {
Title : save_tempfiles
Usage : $obj->save_tempfiles($newval)
- Function:
+ Function:
Returns : value of save_tempfiles
Args : newvalue (optional)
View
54 t/Hyphy.t
@@ -7,53 +7,65 @@ use strict;
BEGIN {
use Bio::Root::Test;
- test_begin(-tests => 15, -requires_module =>'IO::String');
-
- use_ok('Bio::Root::IO');
+ test_begin(-tests => 8, -requires_module =>'IO::String');
+
+# use Bio::Root::IO;
use_ok('Bio::Tools::Run::Phylo::Hyphy::SLAC');
use_ok('Bio::Tools::Run::Phylo::Hyphy::FEL');
use_ok('Bio::Tools::Run::Phylo::Hyphy::REL');
use_ok('Bio::Tools::Run::Phylo::Hyphy::Modeltest');
- use_ok('Bio::AlignIO');
- use_ok('Bio::TreeIO');
+# use Bio::AlignIO;
+# use Bio::TreeIO;
}
-ok my $slac = Bio::Tools::Run::Phylo::Hyphy::SLAC->new();
-ok my $rel = Bio::Tools::Run::Phylo::Hyphy::REL->new();
-ok my $fel = Bio::Tools::Run::Phylo::Hyphy::FEL->new();
-ok my $modeltest = Bio::Tools::Run::Phylo::Hyphy::Modeltest->new();
+ my $slac = Bio::Tools::Run::Phylo::Hyphy::SLAC->new();
SKIP: {
test_skip(-requires_executable => $slac, -tests => 4);
-
+
my $alignio = Bio::AlignIO->new(-format => 'fasta',
-file => 't/data/hyphy1.fasta');
-
+
my $treeio = Bio::TreeIO->new(-format => 'newick',
-file => 't/data/hyphy1.tree');
-
+
my $aln = $alignio->next_aln;
my $tree = $treeio->next_tree;
-
+
$slac->alignment($aln);
$slac->tree($tree);
my ($rc,$results) = $slac->run();
- ok defined($results);
-
+ if ($rc == 0) {
+ self->warn("ERROR in SLAC module $rc:" . $slac->error_string() . "\n");
+ }
+ ok ($rc != 0, "SLAC module");
+
+ my $rel = Bio::Tools::Run::Phylo::Hyphy::REL->new();
$rel->alignment($aln);
$rel->tree($tree);
($rc,$results) = $rel->run();
- ok defined($results);
-
+ if ($rc == 0) {
+ self->warn(print "ERROR in REL module $rc:" . $rel->error_string() . "\n");
+ }
+ ok ($rc != 0, "REL module");
+
+ my $fel = Bio::Tools::Run::Phylo::Hyphy::FEL->new();
$fel->alignment($aln);
$fel->tree($tree);
($rc,$results) = $fel->run();
- ok defined($results);
-
+ if ($rc == 0) {
+ self->warn("ERROR in FEL module $rc:" . $fel->error_string() . "\n");
+ }
+ ok ($rc != 0, "FEL module");
+
+ my $modeltest = Bio::Tools::Run::Phylo::Hyphy::Modeltest->new();
$modeltest->alignment($aln);
$modeltest->tree($tree);
($rc,$results) = $modeltest->run();
- ok defined($results);
-
+ if ($rc == 0) {
+ self->warn("ERROR in Modeltest module $rc:" . print $modeltest->error_string() . "\n");
+ }
+ ok ($rc != 0, "Modeltest module");
+
#*** where are the tests?!
}

0 comments on commit 5123805

Please sign in to comment.