Bio/Matrix/PSM/InstanceSite.pm

   1 # $Id$
   2
   3 =head1 NAME
   4
   5 Bio::Matrix::PSM::InstanceSite - A PSM site occurance
   6
   7 =head1 SYNOPSIS
   8
   9   use Bio::Matrix::PSM::InstanceSite;
  10
  11   #You can get an InstanceSite object either from a file:
  12
  13   my ($instances,$matrix)=$SomePSMFile->parse_next;
  14
  15   #or from memory
  16
  17   my %params=(seq=>'TATAAT',
  18     id=>"TATAbox1", accession=>'ENSG00000122304', mid=>'TB1',
  19     desc=>'TATA box, experimentally verified in PRM1 gene',
  20     -relpos=>-35, -anchor=>'CHR7', -start=>35000921, -end=>35000926);
  21
  22   #Last 2 arguments are passed to create a Bio::LocatableSeq object
  23   #Anchor shows the coordinates system for the Bio::LocatableSeq object
  24
  25 =head1 DESCRIPTION
  26
  27 Abstract interface to PSM site occurrence (PSM sequence
  28 match). InstanceSite objects may be used to describe a PSM (See
  29 L<Bio::Matrix::PSM::SiteMatrix>) sequence matches.  The usual
  30 characteristic of such a match is sequence coordinates, score,
  31 sequence and sequence (gene) identifier- accession number or other id.
  32
  33 This object inherits from Bio::LocatableSeq (which defines the real
  34 sequence) and might hold a SiteMatrix object, used to detect the CRE
  35 (cis-regulatory element), or created from this CRE.
  36
  37 While the documentation states that the motif id and gene id
  38 (accession) combination should be unique, this is not entirely true-
  39 there might be more than one occurrence of the same cis-regulatory
  40 element in the upstream region of the same gene.  Therefore relpos
  41 would be the third element to create a really unique combination.
  42
  43 =head1 FEEDBACK
  44
  45 =head2 Mailing Lists
  46
  47 User feedback is an integral part of the evolution of this and other
  48 Bioperl modules. Send your comments and suggestions preferably to one
  49 of the Bioperl mailing lists.  Your participation is much appreciated.
  50
  51   bioperl-l@bioperl.org                  - General discussion
  52   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  53
  54 =head2 Support
  55
  56 Please direct usage questions or support issues to the mailing list:
  57
  58 L<bioperl-l@bioperl.org>
  59
  60 rather than to the module maintainer directly. Many experienced and
  61 reponsive experts will be able look at the problem and quickly
  62 address it. Please include a thorough description of the problem
  63 with code and data examples if at all possible.
  64
  65 =head2 Reporting Bugs
  66
  67 Report bugs to the Bioperl bug tracking system to help us keep track
  68 the bugs and their resolution.  Bug reports can be submitted via the
  69 web:
  70
  71   http://bugzilla.open-bio.org/
  72
  73 =head2 Description
  74
  75 Bio::Matrix::PSM::InstanceSiteI implementation
  76
  77 =head1 AUTHOR - Stefan Kirov
  78
  79 Email skirov@utk.edu
  80
  81
  82 =head1 APPENDIX
  83
  84 =cut
  85
  86
  87 # Let the code begin...
  88 package Bio::Matrix::PSM::InstanceSite;
  89 use strict;
  90
  91 use base qw(Bio::LocatableSeq Bio::Matrix::PSM::InstanceSiteI);
  92
  93 =head2 new
  94
  95  Title   : new
  96  Usage   : my $isntance=Bio::Matrix::PSM::InstanceSite->new
  97                          (-seq=>'TATAAT', -id=>"TATAbox1",
  98                           -accession_number='ENSG00000122304', -mid=>'TB1',
  99                           -desc=>'TATA box, experimentally verified in PRM1 gene',
 100                           -relpos=>-35, -anchor=>'CHR7', -start=>35000921, -end=>35000926, strand=>1)
 101  Function: Creates an InstanceSite object from memory.
 102  Throws  :
 103  Example :
 104  Returns : Bio::Matrix::PSM::InstanceSite object
 105  Args    : hash
 106
 107
 108 =cut
 109
 110 sub new {
 111     my ($class, @args) = @_;
 112     my %args = @args; #Too many things to rearrange, and I am creating >1K such objects routinely, so this is a performance issue
 113     $args{'-start'} ||= 1;
 114     my $end = $args{'-start'} + length($args{-seq}) -1;
 115     if (!defined($args{-strand})) {
 116         $args{-strand}=1;
 117         @args=%args;
 118     }
 119     my $self = $class->SUPER::new(@args,'-end',$end);
 120
 121     while( @args ) {
 122         (my $key = shift @args) =~ s/-//gi; #deletes all dashes (only dashes)!
 123         $args{$key} = shift @args;
 124     }
 125 #should throw exception if seq is null, for now just warn
 126     if (($args{seq} eq '') || (!defined($args{seq}))) {
 127         $args{seq}="AGCT";
 128         warn "No sequence?!\n";
 129     }
 130     $self->{mid}=$args{mid};
 131     $self->seq($args{seq});
 132     $self->desc($args{desc});
 133     $self->{score}=$args{score};
 134     $self->{relpos}=$args{relpos};
 135     $self->{frame}=$args{frame};
 136     $self->{anchor}=$args{anchor};
 137     return $self;
 138 }
 139
 140
 141 =head2 mid
 142
 143  Title   : mid
 144  Usage   : my $mid=$instance->mid;
 145  Function: Get/Set the motif id
 146  Throws  :
 147  Example :
 148  Returns : scalar
 149  Args    : scalar
 150
 151
 152 =cut
 153
 154 sub mid {
 155     my $self = shift;
 156     my $prev = $self->{mid};
 157     if (@_) { $self->{mid} = shift; }
 158     return $prev;
 159 }
 160
 161 =head2 score
 162
 163  Title   : score
 164  Usage   : my $score=$instance->score;
 165  Function: Get/Set the score (mismatches) between the instance and the attached (or
 166             initial) PSM
 167  Throws  :
 168  Example :
 169  Returns : real number
 170  Args    : real number
 171
 172 =cut
 173
 174 sub score {
 175     my $self = shift;
 176     my $prev = $self->{score};
 177     if (@_) { $self->{score} = shift; }
 178     return $prev;
 179 }
 180
 181 =head2 anchor
 182
 183  Title   : anchor
 184  Usage   : my $anchor=$instance->anchor;
 185  Function: Get/Set the anchor which shows what coordinate system start/end use
 186  Throws  :
 187  Example :
 188  Returns : string
 189  Args    : string
 190
 191 =cut
 192
 193 sub anchor {
 194     my $self = shift;
 195     my $prev = $self->{anchor};
 196     if (@_) { $self->{anchor} = shift; }
 197     return $prev;
 198 }
 199
 200 =head2 start
 201
 202  Title   : start
 203  Usage   : my $start=$instance->start;
 204  Function: Get/Set the position of the instance on the sequence used
 205  Throws  :
 206  Example :
 207  Returns : integer
 208  Args    : integer
 209
 210 =cut
 211
 212
 213 #Provided by LocatableSeq
 214
 215 =head2 minstance
 216
 217  Title   : minstance
 218  Usage   : my $minstance=$misntance->score;
 219  Function: Get/Set the unique identifier- sequence id/motif id, for example PRM1_TATAbox.
 220           Not necessarily human readable.
 221  Throws  :
 222  Example :
 223  Returns : string
 224  Args    : string
 225
 226 =cut
 227
 228 sub minstance {
 229     my $self = shift;
 230     my $prev = $self->{minstance};
 231     if (@_) { $self->{minstance} = shift; }
 232     return $prev;
 233 }
 234
 235 =head2 relpos
 236
 237  Title   : relpos
 238  Usage   : my $seqpos=$instance->relpos;
 239  Function: Get/Set the relative position of the instance with respect to the transcription start
 240             site (if known). Can and usually is negative.
 241  Throws  :
 242  Example :
 243  Returns : integer
 244  Args    : integer
 245
 246 =cut
 247
 248 sub relpos {
 249     my $self = shift;
 250     my $prev = $self->{relpos};
 251     if (@_) { $self->{relpos} = shift; }
 252     return $prev;
 253 }
 254
 255 =head2 annotation
 256
 257  Title   : annotation
 258  Usage   : $ann = $seq->annotation or $seq->annotation($annotation)
 259  Function: Gets or sets the annotation
 260  Returns : L<Bio::AnnotationCollectionI> object
 261  Args    : None or L<Bio::AnnotationCollectionI> object
 262
 263 See L<Bio::AnnotationCollectionI> and L<Bio::Annotation::Collection>
 264 for more information
 265
 266 =cut
 267
 268 sub annotation {
 269     my ($obj,$value) = @_;
 270     if( defined $value ) {
 271         $obj->throw("object of class ".ref($value)." does not implement ".
 272                     "Bio::AnnotationCollectionI. Too bad.")
 273             unless $value->isa("Bio::AnnotationCollectionI");
 274         $obj->{'_annotation'} = $value;
 275     } elsif( ! defined $obj->{'_annotation'}) {
 276         $obj->{'_annotation'} = Bio::Annotation::Collection->new();
 277     }
 278     return $obj->{'_annotation'};
 279 }
 280
 281 =head2 species
 282
 283  Title   : species
 284  Usage   : $species = $seq->species() or $seq->species($species)
 285  Function: Gets or sets the species
 286  Returns : L<Bio::Species> object
 287  Args    : None or L<Bio::Species> object
 288
 289 See L<Bio::Species> for more information
 290
 291 =cut
 292
 293 sub species {
 294     my ($self, $species) = @_;
 295     if ($species) {
 296         $self->{'species'} = $species;
 297     } else {
 298         return $self->{'species'};
 299     }
 300 }
 301
 302
 303 =head2 frame
 304
 305  Title   : frame
 306  Usage   : my $frane=$instance->frame;
 307  Function: Get/Set the frame of a DNA instance with respect to a protein motif used.
 308             Returns undef if the motif was not protein or the DB is protein.
 309  Throws  :
 310  Example :
 311  Returns : integer
 312  Args    : integer (0, 1, 2)
 313
 314 =cut
 315
 316 sub frame {
 317     my $self = shift;
 318     my $prev = $self->{frame};
 319     if (@_) { $self->{frame} = shift; $self->throw("This is not a legitimate frame") unless (grep(/$self->{frame}/,qw[0 1 2])); }
 320     return $prev;
 321 }
 322
 323 1;