File Coverage

blib/lib/Bio/Tools/Phylo/PAML/ModelResult.pm

Criterion	Covered	Total	%
statement	101	117	86.3
branch	47	66	71.2
condition	6	13	46.1
subroutine	21	23	91.3
pod	19	19	100.0
total	194	238	81.5

package Bio::Tools::Phylo::PAML::ModelResult;
$Bio::Tools::Phylo::PAML::ModelResult::VERSION = '1.7.2';
use utf8;
use strict;
use warnings;

use base qw(Bio::Root::Root);

# ABSTRACT: A container for NSSite Model Result from PAML
# AUTHOR: Jason Stajich
# OWNER: Jason Stajich
# LICENSE: Perl_5



sub new {
  my($class,@args) = @_;

  my $self = $class->SUPER::new(@args);
  my ($modelnum,$modeldesc,$kappa,
      $timeused,$trees,
      $pos_sites,$neb_sites,$beb_sites,
      $num_site_classes, $shape_params,
      $dnds_classes,
      $likelihood) =          $self->_rearrange([qw(MODEL_NUM
                              MODEL_DESCRIPTION
                              KAPPA
                              TIME_USED
                              TREES
                              POS_SITES
                                                      NEB_SITES BEB_SITES
                              NUM_SITE_CLASSES
                              SHAPE_PARAMS
                              DNDS_SITE_CLASSES
                              LIKELIHOOD)],
                         @args);
  if( $trees ) {
      if(ref($trees) !~ /ARRAY/i ) {
      $self->warn("Must provide a valid array reference to initialize trees");
      } else {
      foreach my $t ( @$trees ) {
          $self->add_tree($t);
      }
      }
  }
  $self->{'_treeiterator'} = 0;
  if( $pos_sites ) {
      if(ref($pos_sites) !~ /ARRAY/i ) {
      $self->warn("Must provide a valid array reference to initialize pos_sites");
      } else {
      foreach my $s ( @$pos_sites ) {
          if( ref($s) !~ /ARRAY/i ) {
          $self->warn("Need an array reference for each entry in the pos_sites object");
          next;
          }
          $self->add_pos_selected_site(@$s);
      }
      }
  }
  if( $beb_sites ) {
    if(ref($beb_sites) !~ /ARRAY/i ) {
      $self->warn("Must provide a valid array reference to initialize beb_sites");
      } else {
      foreach my $s ( @$beb_sites ) {
          if( ref($s) !~ /ARRAY/i ) {
          $self->warn("need an array ref for each entry in the beb_sites object");
          next;
          }
          $self->add_BEB_pos_selected_site(@$s);
      }
      }
  }
  if( $neb_sites ) {
    if(ref($neb_sites) !~ /ARRAY/i ) {
      $self->warn("Must provide a valid array reference to initialize neb_sites");
      } else {
      foreach my $s ( @$neb_sites ) {
          if( ref($s) !~ /ARRAY/i ) {
          $self->warn("need an array ref for each entry in the neb_sites object");
          next;
          }
          $self->add_NEB_pos_selected_site(@$s);
      }
      }
  }

  defined $modelnum  && $self->model_num($modelnum);
  defined $modeldesc && $self->model_description($modeldesc);
  defined $kappa     && $self->kappa($kappa);
  defined $timeused  && $self->time_used($timeused);
  defined $likelihood  && $self->likelihood($likelihood);

  $self->num_site_classes($num_site_classes || 0);
  if( defined $dnds_classes ) {
      if( ref($dnds_classes) !~ /HASH/i ||
      ! defined $dnds_classes->{'p'} ||
      ! defined $dnds_classes->{'w'} ) {
      $self->warn("-dnds_site_classes expects a hashref with keys p and w");
      } else {
      $self->dnds_site_classes($dnds_classes);
      }
  }
  if( defined $shape_params ) {
      if( ref($shape_params) !~ /HASH/i ) {
      $self->warn("-shape_params expects a hashref not $shape_params\n");
      } else {
      $self->shape_params($shape_params);
      }
  }
  return $self;
}



sub model_num {
    my $self = shift;
    return $self->{'_num'} = shift if @_;
    return $self->{'_num'};
}


sub model_description{
    my $self = shift;
    return $self->{'_model_description'} = shift if @_;
    return $self->{'_model_description'};
}


sub time_used{
    my $self = shift;
    return $self->{'_time_used'} = shift if @_;
    return $self->{'_time_used'};
}


sub kappa{
    my $self = shift;
    return $self->{'_kappa'} = shift if @_;
    return $self->{'_kappa'};
}


sub num_site_classes{
    my $self = shift;
    return $self->{'_num_site_classes'} = shift if @_;
    return $self->{'_num_site_classes'};
}


sub dnds_site_classes{
    my $self = shift;
    return $self->{'_dnds_site_classes'} = shift if @_;
    return $self->{'_dnds_site_classes'};
}


sub get_pos_selected_sites{
   return @{$_[0]->{'_posselsites'} || []};
}


sub add_pos_selected_site{
   my ($self,$site,$aa,$pvalue,$signif) = @_;
   push @{$self->{'_posselsites'}}, [ $site,$aa,$pvalue,$signif ];
   return scalar @{$self->{'_posselsites'}};
}


sub get_NEB_pos_selected_sites{
   return @{$_[0]->{'_NEBposselsites'} || []};
}


sub add_NEB_pos_selected_site{
   my ($self,@args) = @_;
   push @{$self->{'_NEBposselsites'}}, [ @args ];
   return scalar @{$self->{'_NEBposselsites'}};
}




sub get_BEB_pos_selected_sites{
   return @{$_[0]->{'_BEBposselsites'} || []};
}


sub add_BEB_pos_selected_site{
   my ($self,@args) = @_;
   push @{$self->{'_BEBposselsites'}}, [ @args ];
   return scalar @{$self->{'_BEBposselsites'}};
}


sub next_tree{
   my ($self,@args) = @_;
   return $self->{'_trees'}->[$self->{'_treeiterator'}++] || undef;
}


sub get_trees{
   my ($self) = @_;
   return @{$self->{'_trees'} || []};
}


sub rewind_tree_iterator {
    shift->{'_treeiterator'} = 0;
}


sub add_tree{
   my ($self,$tree) = @_;
   if( $tree && ref($tree) && $tree->isa('Bio::Tree::TreeI') ) {
       push @{$self->{'_trees'}},$tree;
   }
   return scalar @{$self->{'_trees'}};
}


sub shape_params{
    my $self = shift;
    return $self->{'_shape_params'} = shift if @_;
    return $self->{'_shape_params'};
}


sub likelihood{
    my $self = shift;
    return $self->{'likelihood'} = shift if @_;
    return $self->{'likelihood'};
}

1;

__END__