Bioperl Training Exercise 10

• In aggregation, an object contains a reference to another object, e.g. an attribute of the object is a reference to another object. In this exercise, bioperl comes into the picture. Make changes to BITS::Training::Primer and use a Bio::Seq object as attribute to store primer sequence information. Have a look at the Bio::Seq constructor in perldoc.
• Delegation is the simple concept of an object handing the task to another object. Use delegation in the getLength() method.
• Also add a method to fetch the embedded sequence object, say getSeqObject().

aggregation and delegation

sub new { my ( $class, $sequence ) = @_; my $self = { # embedd a Bio::Seq object for storing sequence data (= aggregation) _obj => Bio::Seq->new( -seq => $sequence, -alphabet => 'dna' ), _degenerate => ( /[^ACGT]/i ? 1 : 0 ), _composition => { A => $sequence =~ tr/A/A/, # count number of A's C => $sequence =~ tr/C/C/, # count number of C's G => $sequence =~ tr/G/G/, # count number of G's T => $sequence =~ tr/T/T/ # count number of T's }, _tm => undef, }; bless $self, $class; }   sub getSequence { my $self = shift; return $self->{_obj}->seq; }   sub getSeqObject { my $self = shift; return $self->{_obj}; }

• OK, now we have created an issue because if you can lay your hands on the embedded Bio::Seq object, it is possible to change the sequence itself and thus the primer sequence. We do not want that, we want to make the primer sequence immutable: new sequence = new primer. A trick that is often used to prevent tampering with an embedded object is simply to create a deep copy of the embedded object and return that instead of the original. The consumer may make changes to the object at wish, the primer object will not be changed.

  Use the FreezeThaw module and make the appropriate changes in the getSeqObject() to return a copy. Alternatively, have a look at the available methods that a Bio::Seq object can call. There is an inherited method available that does just that.

getSeqObject() returning a deep copy
use FreezeThaw qw/freeze thaw/;   sub getSeqObject { my $self = shift; # don't want to tamper with the embedded seq object # return a copy instead my ($seq) = thaw(freeze($self->{_obj})); return $seq; }

• At this point, Tm calculation is not dealing with degeneracy. Create a method to return a list of all possible non-degenerate primers, say getUniquePrimers(). perldoc Bio::Tools::IUPAC.
• Adjust getTm() in such way that the mean Tm is returned.

BITS::Training::Primer

package BITS::Training::Primer; use strict; use Bio::Seq; use Bio::Tools::IUPAC; use FreezeThaw qw/freeze thaw/;   sub new { my ( $class, $sequence ) = @_; my $obj; # this allows to pass a Bio::Seq object or a sequence string if ( ref $sequence && $sequence->isa('Bio::Seq') ) { $obj = $sequence; $sequence = $obj->seq; } else { $obj = Bio::Seq->new( -seq => $sequence, -alphabet => 'dna' ); } my $self = {   _obj => $obj, _degenerate => ( $sequence =~ /[^ACGT]/i ? 1 : 0 ), _composition => { A => $sequence =~ tr/A/A/, # count number of A's C => $sequence =~ tr/C/C/, # count number of C's G => $sequence =~ tr/G/G/, # count number of G's T => $sequence =~ tr/T/T/ # count number of T's }, _tm => undef, }; bless $self, ref($class) || $class; }   sub getSequence { my $self = shift; return $self->{_obj}->seq; }   sub getSeqObject { my $self = shift;   # don't want to temper with the embedded seq object # return a copy instead my ($seq) = thaw( freeze( $self->{_obj} ) ); return $seq; }   sub getLength { my $self = shift; return $self->{_obj}->length; }   sub isDegenerate { my $self = shift; return $self->{_degenerate}; }   sub numberOf { my $self = shift; my $nt = shift; $nt = uc $nt; return exists $self->{_composition}->{$nt} ? $self->{_composition}->{$nt} : 0; }   sub getTm { my $self = shift;   # if called the first time # _tm attribute is not set # so, calculate and set the attribute first unless ( defined $self->{_tm} ) { $self->_calculateTm(); } return $self->{_tm}; }   sub getUniquePrimers() { my $self = shift; if ( !$self->isDegenerate ) { return wantarray ? ($self) : $self; } my $stream = Bio::Tools::IUPAC->new( -seq => $self->{_obj} ); my @uniques = (); while ( my $unique_seq = $stream->next_seq ) { push @uniques, $self->new($unique_seq); # directly pass the seq object as argument for the constructor } return wantarray ? @uniques : \@uniques; }   sub _calculateTm { my $self = shift; my $sum = 0; my @uniques = $self->getUniquePrimers; foreach my $primer (@uniques) { $sum += ( $primer->numberOf('A') + $primer->numberOf('T') ) * 2 + ( $primer->numberOf('G') + $primer->numberOf('C') ) * 4; } $self->{_tm} = $sum / @uniques; }   'Just Another True Value';

BITS::Training::LongPrimer

package BITS::Training::LongPrimer; use strict; use base 'BITS::Training::Primer';   sub _calculateTm { my $self = shift; my $sum = 0; my @uniques = $self->getUniquePrimers; foreach my $primer (@uniques) { $sum += 64.9 + 41 * ( $primer->numberOf('G') + $primer->numberOf('C') - 16.4 ) / ( $primer->numberOf('A') + $primer->numberOf('T') + $primer->numberOf('G') + $primer->numberOf('C') ); } $self->{_tm} = $sum / @uniques; }   1;