Bio/Matrix/PSM/InstanceSite.pm

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