Bio/SeqFeature/Primer.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::SeqFeature::Primer
   4 #
   5 # This is the original copyright statement. I have relied on Chad's module
   6 # extensively for this module.
   7 #
   8 # Copyright (c) 1997-2001 bioperl, Chad Matsalla. All Rights Reserved.
   9 #           This module is free software; you can redistribute it and/or
  10 #           modify it under the same terms as Perl itself.
  11 #
  12 # Copyright Chad Matsalla
  13 #
  14 # You may distribute this module under the same terms as perl itself
  15 # POD documentation - main docs before the code
  16 #
  17 # But I have modified lots of it, so I guess I should add:
  18 #
  19 # Copyright (c) 2003 bioperl, Rob Edwards. All Rights Reserved.
  20 #           This module is free software; you can redistribute it and/or
  21 #           modify it under the same terms as Perl itself.
  22 #
  23 # Copyright Rob Edwards
  24 #
  25 # You may distribute this module under the same terms as perl itself
  26 # POD documentation - main docs before the code
  27
  28 =head1 NAME
  29
  30 Bio::SeqFeature::Primer - Primer Generic SeqFeature
  31
  32 =head1 SYNOPSIS
  33
  34  # set up a single primer that can be used in a PCR reaction
  35
  36  use Bio::SeqFeature::Primer;
  37
  38  # initiate a primer with raw sequence
  39  my $primer=Bio::SeqFeature::Primer->new(-seq=>'CTTTTCATTCTGACTGCAACG');
  40
  41  # get the primery tag for the primer # should return Primer
  42  my $tag=$primer->primary_tag;
  43
  44  # get or set the location that the primer binds to the target at
  45  $primer->location(500);
  46  my $location=$primer->location(500);
  47
  48  # get or set the 5' end of the primer homology, as the primer doesn't
  49  # have to be the same as the target sequence
  50  $primer->start(2);
  51  my $start=$primer->start;
  52
  53  # get or set the 3' end of the primer homology
  54  $primer->end(19);
  55  my $end = $primer->end;
  56
  57  # get or set the strand of the primer. Strand should be 1, 0, or -1
  58  $primer->strand(-1);
  59  my $strand=$primer->strand;
  60
  61  # get or set the id of the primer
  62  $primer->display_id('test_id');
  63  my $id=$primer->display_id;
  64
  65  # get the tm of the primer. This is calculated for you by the software.
  66  # however, see the docs.
  67  my $tm = $primer->Tm;
  68
  69  print "These are the details of the primer:\n\tTag:\t\t$tag\n\tLocation\t$location\n\tStart:\t\t$start\n";
  70  print "\tEnd:\t\t$end\n\tStrand:\t\t$strand\n\tID:\t\t$id\n\tTm:\t\t$tm\n";
  71
  72
  73
  74 =head1 DESCRIPTION
  75
  76 Handle primer sequences. This will allow you to generate a primer
  77 object required for a Bio::Seq::PrimedSeq object. This module is
  78 designed to integrate with Bio::Tools::Primer3 and
  79 Bio::Seq::PrimedSeq.
  80
  81 In addition, you can calculate the melting temperature of the primer.
  82
  83 This module is supposed to implement location and range, presumably
  84 through generic.pm, but does not do so yet. However, it does allow you
  85 to set primers, and use those objects as the basis for
  86 Bio::Seq::PrimedSeq objects.
  87
  88 See also the POD for Bio::Seq::PrimedSeq and
  89 Bio::Tools::Nucleotide::Analysis::Primer3
  90
  91 =head1 FEEDBACK
  92
  93 =head2 Mailing Lists
  94
  95 User feedback is an integral part of the evolution of this and other
  96 Bioperl modules. Send your comments and suggestions preferably to one
  97 of the Bioperl mailing lists.  Your participation is much appreciated.
  98
  99   bioperl-l@bioperl.org                  - General discussion
 100   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
 101
 102 =head2 Support
 103
 104 Please direct usage questions or support issues to the mailing list:
 105
 106 I<bioperl-l@bioperl.org>
 107
 108 rather than to the module maintainer directly. Many experienced and
 109 reponsive experts will be able look at the problem and quickly
 110 address it. Please include a thorough description of the problem
 111 with code and data examples if at all possible.
 112
 113 =head2 Reporting Bugs
 114
 115 Report bugs to the Bioperl bug tracking system to help us keep track
 116 the bugs and their resolution.  Bug reports can be submitted via the
 117 web:
 118
 119   http://bugzilla.open-bio.org/
 120
 121 =head1 AUTHOR
 122
 123 Rob Edwards, redwards@utmem.edu
 124
 125 The original concept and much of the code was written by
 126 Chad Matsalla, bioinformatics1@dieselwurks.com
 127
 128 =head1 APPENDIX
 129
 130         The rest of the documentation details each of the object
 131         methods. Internal methods are usually preceded with a _
 132
 133 =cut
 134
 135
 136 # Let the code begin...
 137
 138
 139 package Bio::SeqFeature::Primer;
 140 use strict;
 141
 142 use Bio::Seq;
 143 use Bio::Tools::SeqStats;
 144
 145
 146 use vars qw ($AUTOLOAD @RES %OK_FIELD $ID);
 147
 148 BEGIN {
 149  @RES=qw(); # nothing here yet, not sure what we want!
 150
 151  foreach my $attr (@RES) {$OK_FIELD{$attr}++}
 152 }
 153
 154 use base qw(Bio::Root::Root Bio::SeqFeature::Generic);
 155
 156 $ID = 'Bio::SeqFeature::Primer';
 157
 158 sub AUTOLOAD {
 159  my $self = shift;
 160  my $attr = $AUTOLOAD;
 161  $attr =~ s/.*:://;
 162  $self->throw("Unallowed parameter: $attr !") unless $OK_FIELD{$attr};
 163  $self->{$attr} = shift if @_;
 164  return $self->{$attr};
 165 }
 166
 167 =head2 new()
 168
 169  Title   : new()
 170  Usage   : $primer = Bio::SeqFeature::Primer(-seq=>sequence_object);
 171  Function: Instantiate a new object
 172  Returns : A SeqPrimer object
 173  Args    : You must pass either a sequence object (preferable) or a sequence.
 174
 175 =cut
 176
 177
 178 sub new {
 179   # I have changed some of Chad's code. I hope he doesn't mind. Mine is more stupid than his, but my simple mind gets it.
 180   # I also removed from of the generic.pm things, but we can put them back....
 181
 182   my ($class, %args) = @_;
 183   my $self = $class->SUPER::new(%args);
 184   # i am going to keep an array of the things that have been passed
 185   # into the object on construction. this will aid retrieval of these
 186   # things later
 187   foreach my $argument (keys %args) {
 188    if ($argument eq "-SEQUENCE" || $argument eq "-sequence" || $argument eq "-seq") {
 189     if (ref($args{$argument}) eq "Bio::Seq") {$self->{seq} = $args{$argument}}
 190     else {
 191      unless ($args{-id}) {$args{-id}="SeqFeature Primer object"}
 192      $self->{seq} = Bio::Seq->new( -seq => $args{$argument}, -id => $args{-id});
 193     }
 194     $self->{$argument} = $self->{seq};
 195     push (@{$self->{arguments}}, "seq");
 196    }
 197    else {
 198     $self->{$argument} = $args{$argument};
 199     push (@{$self->{arguments}}, $argument); # note need to check the BioPerl way of doing this.
 200    }
 201   }
 202
 203   # now error check and make sure that we at least got a sequence
 204   if (!$self->{seq}) {$self->throw("You must pass in a sequence to construct this object.")}
 205
 206    # a bunch of things now need to be set for this SeqFeature
 207    # things like:
 208    # TARGET=513,26
 209    # PRIMER_FIRST_BASE_INDEX=1
 210    # PRIMER_LEFT=484,20
 211
 212    # these can be added in, and we won't demand them, but provide a mechanism to check that they exist
 213
 214    $self->Tm();
 215    return $self;
 216 }
 217
 218
 219 =head2 seq()
 220
 221  Title   : seq()
 222  Usage   : $seq = $primer->seq();
 223  Function: Return the sequence associated with this Primer.
 224  Returns : A Bio::Seq object
 225  Args    : None.
 226
 227 =cut
 228
 229 sub seq {
 230      my $self = shift;
 231      return $self->{seq};
 232 }
 233
 234 sub primary_tag {
 235      return "Primer";
 236 }
 237
 238 =head2 source_tag()
 239
 240  Title   : source_tag()
 241  Usage   : $tag = $feature->source_tag();
 242  Function: Returns the source of this tag.
 243  Returns : A string.
 244  Args    : If an argument is provided, the source of this SeqFeature
 245            is set to that argument.
 246
 247 =cut
 248
 249 sub source_tag {
 250      my ($self,$insource) = @_;
 251      if ($insource) { $self->{source} = $insource; }
 252      return $self->{source};
 253 }
 254
 255 =head2 location()
 256
 257  Title   : location()
 258  Usage   : $tag = $primer->location();
 259  Function: Gets or sets the location of the primer on the sequence
 260  Returns : If the location is set, returns that, if not returns 0.
 261            Note: At the moment I am using the primer3 notation of location
 262            (although you can set whatever you want).
 263            In this form, both primers are given from their 5' ends and a length.
 264            In this case, the left primer is given from the leftmost end, but
 265            the right primer is given from the rightmost end.
 266            You can use start() and end() to get the leftmost and rightmost base
 267            of each sequence.
 268  Args    : If supplied will set a location
 269
 270 =cut
 271
 272 sub location {
 273      my ($self, $location) = @_;
 274      if ($location) {$self->{location}=$location}
 275      if ($self->{location}) {return $self->{location}}
 276      else {return 0}
 277 }
 278
 279 =head2 start()
 280
 281  Title   : start()
 282  Usage   : $start_position = $primer->start($new_position);
 283  Function: Return the start position of this Primer.
 284            This is the leftmost base, regardless of whether it is a left or right primer.
 285  Returns : The start position of this primer or 0 if not set.
 286  Args    : If supplied will set a start position.
 287
 288 =cut
 289
 290 sub start {
 291      my ($self,$start) = @_;
 292      if ($start) {$self->{start_position} = $start}
 293      if ($self->{start_position}) {return $self->{start_position}}
 294      else {return 0}
 295 }
 296
 297 =head2 end()
 298
 299  Title   : end()
 300  Usage   : $end_position = $primer->end($new_position);
 301  Function: Return the end position of this primer.
 302            This is the rightmost base, regardless of whether it is a left or right primer.
 303  Returns : The end position of this primer.
 304  Args    : If supplied will set an end position.
 305
 306 =cut
 307
 308 sub end {
 309      my ($self,$end) = @_;
 310      if ($end) {$self->{end_position} = $end}
 311      if ($self->{end_position}) {return $self->{end_position}}
 312      else {return 0}
 313 }
 314
 315 =head2 strand()
 316
 317  Title   : strand()
 318  Usage   : $strand=$primer->strand()
 319  Function: Get or set the strand.
 320  Returns : The strand that the primer binds to.
 321  Args    :  If an argument is supplied will set the strand, otherwise will return it. Should be 1, 0 (not set), or -1
 322
 323 =cut
 324
 325 sub strand {
 326      my ($self, $strand) = @_;
 327      if ($strand) {
 328       unless ($strand == -1 || $strand == 0 ||$strand == 1) {$self->throw("Strand must be either 1, 0, or -1 not $strand")}
 329       $self->{strand}=$strand;
 330      }
 331      if ($self->{strand}) {return $self->{strand}}
 332      else {return 0}
 333 }
 334
 335 =head2 display_id()
 336
 337  Title   : display_id()
 338  Usage   : $id = $primer->display_id($new_id)
 339  Function: Returns the display ID for this Primer feature
 340  Returns : A scalar.
 341  Args    : If an argument is provided, the display_id of this primer is
 342            set to that value.
 343
 344 =cut
 345
 346 sub display_id {
 347      my ($self,$newid) = @_;
 348      if ($newid) {$self->seq()->display_id($newid)}
 349      return $self->seq()->display_id();
 350 }
 351
 352
 353 =head2 Tm()
 354
 355   Title   : Tm()
 356   Usage   : $tm = $primer->Tm(-salt=>'0.05', -oligo=>'0.0000001')
 357   Function: Calculates and returns the Tm (melting temperature) of the primer
 358   Returns : A scalar containing the Tm.
 359   Args    : -salt  : set the Na+ concentration on which to base the calculation
 360                      (default=0.05 molar).
 361           : -oligo : set the oligo concentration on which to base the
 362                      calculation (default=0.00000025 molar).
 363   Notes   : Calculation of Tm as per Allawi et. al Biochemistry 1997
 364             36:10581-10594. Also see documentation at
 365             http://www.idtdna.com/Scitools/Scitools.aspx as they use this
 366             formula and have a couple nice help pages. These Tm values will be
 367             about are about 0.5-3 degrees off from those of the idtdna web tool.
 368             I don't know why.
 369
 370             This was suggested by Barry Moore (thanks!). See the discussion on
 371             the bioperl-l with the subject "Bio::SeqFeature::Primer Calculating
 372             the PrimerTM"
 373
 374 =cut
 375
 376 sub Tm  {
 377      my ($self, %args) = @_;
 378      my $salt_conc = 0.05; #salt concentration (molar units)
 379      my $oligo_conc = 0.00000025; #oligo concentration (molar units)
 380      if ($args{'-salt'}) {$salt_conc = $args{'-salt'}} #accept object defined salt concentration
 381      if ($args{'-oligo'}) {$oligo_conc = $args{'-oligo'}} #accept object defined oligo concentration
 382      my $seqobj = $self->seq();
 383      my $length = $seqobj->length();
 384      my $sequence = uc $seqobj->seq();
 385      my @dinucleotides;
 386      my $enthalpy;
 387      my $entropy;
 388      #Break sequence string into an array of all possible dinucleotides
 389      while ($sequence =~ /(.)(?=(.))/g) {
 390          push @dinucleotides, $1.$2;
 391      }
 392      #Build a hash with the thermodynamic values
 393      my %thermo_values = ('AA' => {'enthalpy' => -7.9,
 394                                    'entropy'  => -22.2},
 395                           'AC' => {'enthalpy' => -8.4,
 396                                    'entropy'  => -22.4},
 397                           'AG' => {'enthalpy' => -7.8,
 398                                    'entropy'  => -21},
 399                           'AT' => {'enthalpy' => -7.2,
 400                                    'entropy'  => -20.4},
 401                           'CA' => {'enthalpy' => -8.5,
 402                                    'entropy'  => -22.7},
 403                           'CC' => {'enthalpy' => -8,
 404                                    'entropy'  => -19.9},
 405                           'CG' => {'enthalpy' => -10.6,
 406                                    'entropy'  => -27.2},
 407                           'CT' => {'enthalpy' => -7.8,
 408                                    'entropy'  => -21},
 409                           'GA' => {'enthalpy' => -8.2,
 410                                    'entropy'  => -22.2},
 411                           'GC' => {'enthalpy' => -9.8,
 412                                    'entropy'  => -24.4},
 413                           'GG' => {'enthalpy' => -8,
 414                                    'entropy'  => -19.9},
 415                           'GT' => {'enthalpy' => -8.4,
 416                                    'entropy'  => -22.4},
 417                           'TA' => {'enthalpy' => -7.2,
 418                                    'entropy'  => -21.3},
 419                           'TC' => {'enthalpy' => -8.2,
 420                                    'entropy'  => -22.2},
 421                           'TG' => {'enthalpy' => -8.5,
 422                                    'entropy'  => -22.7},
 423                           'TT' => {'enthalpy' => -7.9,
 424                                    'entropy'  => -22.2},
 425                           'A' =>  {'enthalpy' => 2.3,
 426                                    'entropy'  => 4.1},
 427                           'C' =>  {'enthalpy' => 0.1,
 428                                    'entropy'  => -2.8},
 429                           'G' =>  {'enthalpy' => 0.1,
 430                                    'entropy'  => -2.8},
 431                           'T' =>  {'enthalpy' => 2.3,
 432                                    'entropy'  => 4.1}
 433                          );
 434      #Loop through dinucleotides and calculate cumulative enthalpy and entropy values
 435      for (@dinucleotides) {
 436         $enthalpy += $thermo_values{$_}{enthalpy};
 437         $entropy += $thermo_values{$_}{entropy};
 438      }
 439      #Account for initiation parameters
 440      $enthalpy += $thermo_values{substr($sequence, 0, 1)}{enthalpy};
 441      $entropy += $thermo_values{substr($sequence, 0, 1)}{entropy};
 442      $enthalpy += $thermo_values{substr($sequence, -1, 1)}{enthalpy};
 443      $entropy += $thermo_values{substr($sequence, -1, 1)}{entropy};
 444      #Symmetry correction
 445      $entropy -= 1.4;
 446      my $r = 1.987; #molar gas constant
 447      my $tm = ($enthalpy * 1000 / ($entropy + ($r * log($oligo_conc))) - 273.15 + (12* (log($salt_conc)/log(10))));
 448      $self->{'Tm'}=$tm;
 449      return $tm;
 450  }
 451
 452 =head2 Tm_estimate
 453
 454  Title   : Tm_estimate
 455  Usage   : $tm = $primer->Tm_estimate(-salt=>'0.05')
 456  Function: Calculates and returns the Tm (melting temperature) of the primer
 457  Returns : A scalar containing the Tm.
 458  Args    : -salt set the Na+ concentration on which to base the calculation.
 459  Notes   : This is an estimate of the Tm that is kept in for comparative reasons.
 460            You should probably use Tm instead!
 461
 462            This Tm calculations are taken from the Primer3 docs: They are
 463            based on Bolton and McCarthy, PNAS 84:1390 (1962)
 464            as presented in Sambrook, Fritsch and Maniatis,
 465            Molecular Cloning, p 11.46 (1989, CSHL Press).
 466
 467            Tm = 81.5 + 16.6(log10([Na+])) + .41*(%GC) - 600/length
 468
 469            where [Na+] is the molar sodium concentration, %GC is the
 470            %G+C of the sequence, and length is the length of the sequence.
 471
 472            However.... I can never get this calculation to give me the same result
 473            as primer3 does. Don't ask why, I never figured it out. But I did
 474            want to include a Tm calculation here becuase I use these modules for
 475            other things besides reading primer3 output.
 476
 477            The primer3 calculation is saved as 'PRIMER_LEFT_TM' or 'PRIMER_RIGHT_TM'
 478            and this calculation is saved as $primer->Tm so you can get both and
 479            average them!
 480
 481 =cut
 482
 483 sub Tm_estimate {
 484
 485  # note I really think that this should be put into seqstats as it is more generic, but what the heck.
 486
 487  my ($self, %args) = @_;
 488  my $salt=0.2;
 489  if ($args{'-salt'}) {$salt=$args{'-salt'}}
 490  my $seqobj=$self->seq();
 491  my $length=$seqobj->length();
 492  my $seqdata = Bio::Tools::SeqStats->count_monomers($seqobj);
 493  my $gc=$$seqdata{'G'} + $$seqdata{'C'};
 494  my $percent_gc=($gc/$length)*100;
 495
 496
 497  my $tm= 81.5+(16.6*(log($salt)/log(10)))+(0.41*$percent_gc) - (600/$length);
 498
 499  # and now error check compared to primer3
 500  # note that this NEVER gives me the same values, so I am ignoring it
 501  # you can get these out separately anyway
 502
 503 # if ($self->{'PRIMER_LEFT_TM'}) {
 504 #  unless ($self->{'PRIMER_LEFT_TM'} == $tm) {
 505 #   $self->warn("Calculated $tm for Left primer but received ".$self->{'PRIMER_LEFT_TM'}." from primer3\n");
 506 #  }
 507 # }
 508 # elsif ($self->{'PRIMER_RIGHT_TM'}) {
 509 #  unless ($self->{'PRIMER_RIGHT_TM'} == $tm) {
 510 #    $self->warn("Calculated $tm for Right primer but received ".$self->{'PRIMER_RIGHT_TM'}." from primer3\n");
 511 #  }
 512 # }
 513
 514  $self->{'Tm'}=$tm;
 515  return $tm;
 516 }
 517
 518 1;