Bio-GeneDesign

 view release on metacpan or  search on metacpan

lib/Bio/GeneDesign/RestrictionEnzyme.pm  view on Meta::CPAN

#
# GeneDesign module for restriction enzyme handing
#

=head1 NAME

Bio::GeneDesign::RestrictionEnzyme

=head1 VERSION

Version 5.56

=head1 DESCRIPTION

GeneDesign object that represents a type II restriction enzyme

=head1 AUTHOR

Sarah Richardson <SMRichardson@lbl.gov>

=cut

package Bio::GeneDesign::RestrictionEnzyme;

use Bio::GeneDesign::Basic qw(:GD);
use Carp;

use strict;
use warnings;

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

our $VERSION = 5.56;

my $IIPreg  = qr/   ([A-Z]*)   \^ ([A-Z]*)      /x;
my $IIAreg  = qr/\A \w+ \(([\-]*\d+) \/ ([\-]*\d+)\)\Z  /x;
my $IIBreg  = qr/\A\(([\-]*\d+) \/ ([\-]*\d+)\) \w+ \(([\-]*\d+) \/ ([\-]*\d+)\)\Z  /x;

my %RE_vendors = (
  B => "Invitrogen", C => "Minotech", E => "Stratagene Agilent",
  F => "Thermo Scientific Fermentas", I => "SibEnzyme", J => "Nippon Gene Co.",
  K => "Takara", M => "Roche Applied Science", N => "New England Biolabs",
  O => "Toyobo Technologies", Q => "Molecular Biology Resources",
  R => "Promega", S => "Sigma Aldrich", U => "Bangalore Genei", V => "Vivantis",
  X => "EURx", Y => "CinnaGen"
);

my %methtrans = (b => "blocked", blocked => "blocked",
                 i => "inhibited", inhibited => "inhibited",
                 u => "unknown", unknown => "unknown"
);

=head1 CONSTRUCTOR METHODS

=head2 new

You can create a new enzyme or clone an existing enzyme to create a new instance
of an abstract enzyme definition. To do this, provide the -enzyme flag; the
constructor will ignore every other argument except for -start.

Required arguments:

    EITHER

        -enzyme : a Bio::GeneDesign::RestrictionEnzyme object to clone

    OR
        -id     : The name of the enzyme (i.e., BamHI)
        -cutseq : The string describing the enzyme's recognition and cleavage
                  site

Optional arguments:

        -temp     : The incubation temperature for the enzyme
        -tempin   : The heat inactivation temperature for the enzyme
        -score    : A float score, usually the price of the enzyme in dollars
        -methdam  : Sensitivity to dam methylation; can take the values
                      b or blocked,
                      i or inhibited,
                      u or unknown,
                    if undefined, will take the value indifferent.
        -methdcm  : Sensitivity to dcm methylation; can take the values
                      b or blocked,
                      i or inhibited,
                      u or unknown,
                    if undefined, will take the value indifferent.
        -methcpg  : Sensitivity to cpg methylation; can take the values
                      b or blocked,
                      i or inhibited,
                      u or unknown,
                    if undefined, will take the value indifferent.
        -vendors  : a string of single letter codes that represent vendor
                    availability - no spaces.  see vendor() for a list of the
                    codes.
        -staract  : Whether or not the enzyme exhibits star activity - 1 or 0.
        -buffers  : a hash reference; keys are buffer names and values are the
                    enzyme activity in that buffer. For example:
                    NEB1 => 50, NEB2 => 100, etc.
        -start    : An integer representing an offset; usually used only in
                    cloned instances, as opposed to abstract instances.
        -exclude  : An arrayref full of ids for enzymes that should be
                    considered mutually exclusive to this enzyme - see exclude()

=cut

sub new
{
  my ($class, @args) = @_;
  my $self = $class->SUPER::new(@args);

  my ($object, $id, $cutseq, $temp, $tempin, $score, $methdam, $methdcm,
      $methcpg, $vendors, $staract, $buffers, $start, $exclude, $aggress) =
     $self->_rearrange([qw(ENZYME ID CUTSEQ TEMP TEMPIN SCORE METHDAM METHDCM
       METHCPG VENDORS STARACT BUFFERS START EXCLUDE AGGRESS)], @args);

  if ($object)
  {
    $self->throw("object of class " . ref($object) . " does not implement ".
        "Bio::GeneDesign::RestrictionEnzyme.")
      unless $object->isa("Bio::GeneDesign::RestrictionEnzyme");
    $self = $object->clone();
  }
  else
  {

    $self->throw("No enzyme id defined") unless ($id);
    $self->{id} = $id;

    $self->throw("No cut sequence defined") unless ($cutseq);
    $self->{cutseq} = $cutseq;

    my $recseq = $cutseq;
    $recseq =~ s/\W*\d*//xg;
    $self->{recseq} = $recseq;

    #Regular expression arrayref to use for enzyme searching
    #Should store as compiled regexes instead
    $self->{regex} = _regarr($recseq);

    my $sitelen = length($recseq);
    $self->{length} = $sitelen;

    #Enzyme Class and Palindromy
    my ($lef, $rig) = (q{}, q{});
    if ($cutseq =~ $IIPreg)
    {
      $lef = length($1);
      $rig = length($2);

lib/Bio/GeneDesign/RestrictionEnzyme.pm  view on Meta::CPAN

    }
  }
  return $total;
}

=head2 overhang

Given a nucleotide sequence context, what overhang does this enzyme leave, and
how far away from the cutsite is it?

Arguments:

=cut

sub overhang
{
  my ($self, $dna, $context, $strand) = @_;
  my ($ohangstart, $mattersbit) = (0, q{});
  my $lef;
  my $rig;
  if ($self->{class} eq "IIP")
  {
    ($lef, $rig) = (length($1), length($2)) if ($self->{cutseq} =~ $IIPreg);
    ($lef, $rig) = ($rig, $lef) if ($rig < $lef);
    $ohangstart = $lef + 1;
    $mattersbit = substr($dna, $ohangstart-1, $rig-$lef);
  }
  elsif ($self->{class} eq "IIA")
  {
    ($lef, $rig) = ($1, $2) if ($self->{cutseq} =~ $IIAreg);
    ($lef, $rig) = ($rig, $lef) if ($rig < $lef);
    if ($strand == 1)
    {
      $ohangstart = length($dna) + $lef + 1;
    }
    else
    {
      $ohangstart = length($context) - length($dna) - $rig + 1;
    }
    $mattersbit = substr($context, $ohangstart-1, $rig-$lef);
    $ohangstart = $strand == 1  ? length($dna) + $lef :   0 - ($rig);
  }
  else
  {
    return ();
  }
  return ($ohangstart, $mattersbit);
}

=head2 display

Generates a tab delimited display string that can be used to print enzyme
information out in a tabular format.

=cut

sub display
{
  my ($self) = @_;
  my $staract = $self->{staract}  ? "*" : q{};
  my (@blocked, @inhibed) = ((), ());
  push @blocked, "cpg" if ($self->{methcpg} eq "blocked");
  push @blocked, "dam" if ($self->{methdam} eq "blocked");
  push @blocked, "dcm" if ($self->{methdcm} eq "blocked");
  push @inhibed, "cpg" if ($self->{methcpg} eq "inhibited");
  push @inhibed, "dam" if ($self->{methdam} eq "inhibited");
  push @inhibed, "dcm" if ($self->{methdcm} eq "inhibited");
  my $buffstr = undef;
  foreach (sort keys %{$self->{buffers}})
  {
    $buffstr .= "$_ (" . $self->{buffers}->{$_} . ") " if ($self->{buffers}->{$_});
  }
  my $vendstr = join(", ", values %{$self->{vendors}});
  my $display = undef;
  my $inact = $self->{tempin} ? " (". $self->{timein} . q{@} . $self->{tempin} . ")" : q{};
  $display .= $self->{id} . "\t";
  $display .= $self->{cutseq} . $staract . "\t";
  $display .= $self->{type} . "\t";
  $display .= $self->{start} . "\t" if ($self->{start});
  $display .= $self->{temp} . $inact . "\t";
  $display .= join(", ", @blocked) . "\t";
  $display .= join(", ", @inhibed) . "\t";
  $display .= $self->{score} . "\t";
  $display .= $buffstr . "\t";
  $display .= $vendstr . "\t";
  return $display;
}

=head2 common_buffers

Returns an array reference listing the buffers, if any, in which two enzymes
both have 100% activity. in boolean mode returns the number of buffers

=cut

sub common_buffers
{
  my ($self, $buddy, $bool) = @_;
  $self->throw("Argument is not a Bio::GeneDesign::RestrictionEnzyme")
    unless $buddy->isa("Bio::GeneDesign::RestrictionEnzyme");

  my $sbuffs = $self->{buffers};
  my $bbuffs = $buddy->{buffers};
  my @answer;
  foreach my $skey (sort keys %{$sbuffs})
  {
    my $sval = $sbuffs->{$skey};
    my $bval = $bbuffs->{$skey};
    if ($skey eq "Other" && $sval && $bval && "$sval" eq "$bval")
    {
      push @answer, $skey;
    }
    elsif ($sval && $bval && "$sval" == 100 && "$bval" == 100)
    {
      push @answer, $skey;
    }
  }
  return $bool  ? scalar(@answer)  : \@answer;
}

=head2 acceptable_buffer

Returns a buffer in which both enzymes will have at least a thresholded amount
of activity.

=cut

sub acceptable_buffer
{
  my ($self, $buddy, $level) = @_;
  $self->throw("Argument is not a Bio::GeneDesign::RestrictionEnzyme")
    unless $buddy->isa("Bio::GeneDesign::RestrictionEnzyme");

  $level = $level || 75;
  my $sbuffs = $self->{buffers};
  my $bbuffs = $buddy->{buffers};
  my %answers;
  foreach my $skey (sort keys %{$sbuffs})
  {
    my $sval = $sbuffs->{$skey};
    my $bval = $bbuffs->{$skey};

lib/Bio/GeneDesign/RestrictionEnzyme.pm  view on Meta::CPAN

  my ($self, $score) = @_;
  my $result = 1;
  $result = 0 if ($self->{score} > $score);
  return $result;
}

=head2 filter_by_vendor

  Arguments : an arrayref of vendor abbreviations; see vendor().

  Returns   : 1 if the enzyme is supplied by any of the vendors queried,
              0 else.

=cut

sub filter_by_vendor
{
  my ($self, $vendlist) = @_;
  my $result = 1;
  my $flag = 0;
  foreach my $vend (@$vendlist)
  {
    unless (exists($RE_vendors{$vend}))
    {
      print "\tWARNING: Cannot parse vendor argument $vend - ignoring.\n";
      next;
    }
    $flag++ if ( exists( $self->{vendors}->{$vend} ) );
  }
  $result = $flag == 0 ? 0 : 1;
  return $result;
}

=head2 filter_by_buffer_activity

  Arguments : a hashref of buffer thresholds; the key is the buffer name, the
                value is an activity threshold.

  Returns   : 1 if the enzyme meets all the buffer requirements,
              0 else.

=cut

sub filter_by_buffer_activity
{
  my ($self, $hshref) = @_;
  my $result = 1;
  my $rebuff = $self->{buffers};
  foreach my $buff (keys %$hshref)
  {
    my $val = $hshref->{$buff};
    $result = 0 if ( ! exists($rebuff->{$buff}) || $rebuff->{$buff} < $val );
  }

  return $result;
}

=head2 filter_by_dcm_sensitivity

  Arguments : an arrayref of sensitivity values; the key is the sensitivity
                blocked, inhibited, or indifferent

  Returns   : 1 if the enzyme meets the dcm sensitivity requirements,
              0 else.

=cut

sub filter_by_dcm_sensitivity
{
  my ($self, $arrref) = @_;
  my $result = 1;
  my %sensehsh;
  foreach my $sense (@$arrref)
  {
    if ($sense ne "blocked" && $sense ne "inhibited" && $sense ne "indifferent")
    {
      $sense = lc $sense;
      print "\tWARNING: Cannot parse dcmsense argument $sense - ignoring.\n";
      next;
    }
    $sensehsh{$sense}++;
  }
  $result = 0 unless ( exists($sensehsh{$self->{methdcm}}) );
  return $result;
}

=head2 filter_by_dam_sensitivity

  Arguments : an arrayref of sensitivity values; the key is the sensitivity
                blocked, inhibited, or indifferent

  Returns   : 1 if the enzyme meets the dam sensitivity requirements,
              0 else.

=cut

sub filter_by_dam_sensitivity
{
  my ($self, $arrref) = @_;
  my $result = 1;
  my %sensehsh;
  foreach my $sense (@$arrref)
  {
    if ($sense ne "blocked" && $sense ne "inhibited" && $sense ne "indifferent")
    {
      $sense = lc $sense;
      print "\tWARNING: Cannot parse damsense argument $sense - ignoring.\n";
      next;
    }
    $sensehsh{$sense}++;
  }
  $result = 0 unless ( exists($sensehsh{$self->{methdam}}) );
  return $result;
}

=head2 filter_by_cpg_sensitivity

  Arguments : an arrayref of sensitivity values; the key is the sensitivity
                blocked, inhibited, or indifferent

  Returns   : 1 if the enzyme meets the cpg sensitivity requirements,
              0 else.

=cut

sub filter_by_cpg_sensitivity
{
  my ($self, $arrref) = @_;
  my $result = 1;
  my %sensehsh;
  foreach my $sense (@$arrref)
  {
    if ($sense ne "blocked" && $sense ne "inhibited" && $sense ne "indifferent")
    {
      $sense = lc $sense;
      print "\tWARNING: Cannot parse cpgsense argument $sense - ignoring.\n";
      next;
    }
    $sensehsh{$sense}++;
  }
  $result = 0 unless ( exists($sensehsh{$self->{methcpg}}) );
  return $result;
}

=head2 filter_by_star_activity

  Arguments : 1 if star activity required, 0 else

  Returns   : 1 if the enzyme meets the star activity requirements,
              0 else.

=cut

sub filter_by_star_activity
{
  my ($self, $star) = @_;
  my $result = 1;
  $star = 0 unless ($star);
  $result = 0 if (($star && ! $self->{staract}) || (! $star && $self->{staract}));
  return $result;
}

=head2 filter_by_incubation_temperature

  Arguments : an arrayref of acceptable integer incubation temperatures

  Returns   : 1 if the enzyme meets the incubation temperature requirements,
              0 else.

=cut

sub filter_by_incubation_temperature
{
  my ($self, $arrref) = @_;
  my $result = 1;
  my %temps;
  foreach my $temp (@$arrref)
  {
    if ($temp !~ /\d/x || $temp <= 0)
    {
      print "\tWARNING: Cannot parse incubation argument $temp - ignoring.\n";
    }
    $temps{$temp}++;
  }
  $result = 0 unless ( exists $temps{$self->{temp}});
  return $result;
}

=head2 filter_by_inactivation_temperature

  Arguments : an acceptable integer inactivation temperature maximum

  Returns   : 1 if the enzyme meets the inactivation temperature requirement,



( run in 2.734 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )