File Coverage

Bio/Matrix/PSM/InstanceSite.pm
Criterion Covered Total %
statement 36 69 52.1
branch 7 26 26.9
condition 3 5 60.0
subroutine 5 11 45.4
pod 9 9 100.0
total 60 120 50.0


line stmt bran cond sub pod time code
1              
2             =head1 NAME
3              
4             Bio::Matrix::PSM::InstanceSite - A PSM site occurance
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) 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
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 4     4   450 use strict;
  4         4  
  4         114  
89              
90 4     4   11 use base qw(Bio::LocatableSeq Bio::Matrix::PSM::InstanceSiteI);
  4         3  
  4         1328  
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 206     206 1 595 my ($class, @args) = @_;
111 206         625 my %args = @args; #Too many things to rearrange, and I am creating >1K such objects routinely, so this is a performance issue
112 206   100     492 $args{'-start'} ||= 1;
113 206         328 my $end = $args{'-start'} + length($args{-seq}) -1;
114 206 100       309 if (!defined($args{-strand})) {
115 107         120 $args{-strand}=1;
116 107         351 @args=%args;
117             }
118 206         418 my $self = $class->SUPER::new(@args,'-end',$end);
119            
120 206         291 while( @args ) {
121 1633         1995 (my $key = shift @args) =~ s/-//gi; #deletes all dashes (only dashes)!
122 1633         2472 $args{$key} = shift @args;
123             }
124             #should throw exception if seq is null, for now just warn
125 206 50 33     730 if (($args{seq} eq '') || (!defined($args{seq}))) {
126 0         0 $args{seq}="AGCT";
127 0         0 warn "No sequence?!\n";
128             }
129 206         219 $self->{mid}=$args{mid};
130 206         301 $self->seq($args{seq});
131 206         322 $self->desc($args{desc});
132 206         256 $self->{score}=$args{score};
133 206         261 $self->{relpos}=$args{relpos};
134 206         293 $self->{frame}=$args{frame};
135 206         274 $self->{anchor}=$args{anchor};
136 206         893 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 0     0 1 0 my $self = shift;
155 0         0 my $prev = $self->{mid};
156 0 0       0 if (@_) { $self->{mid} = shift; }
  0         0  
157 0         0 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 17     17 1 16 my $self = shift;
175 17         18 my $prev = $self->{score};
176 17 50       25 if (@_) { $self->{score} = shift; }
  0         0  
177 17         29 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 0     0 1 0 my $self = shift;
194 0         0 my $prev = $self->{anchor};
195 0 0       0 if (@_) { $self->{anchor} = shift; }
  0         0  
196 0         0 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 0     0 1 0 my $self = shift;
229 0         0 my $prev = $self->{minstance};
230 0 0       0 if (@_) { $self->{minstance} = shift; }
  0         0  
231 0         0 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 0     0 1 0 my $self = shift;
249 0         0 my $prev = $self->{relpos};
250 0 0       0 if (@_) { $self->{relpos} = shift; }
  0         0  
251 0         0 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 object
260             Args : None or L object
261              
262             See L and L
263             for more information
264              
265             =cut
266              
267             sub annotation {
268 0     0 1 0 my ($obj,$value) = @_;
269 0 0       0 if( defined $value ) {
    0          
270 0 0       0 $obj->throw("object of class ".ref($value)." does not implement ".
271             "Bio::AnnotationCollectionI. Too bad.")
272             unless $value->isa("Bio::AnnotationCollectionI");
273 0         0 $obj->{'_annotation'} = $value;
274             } elsif( ! defined $obj->{'_annotation'}) {
275 0         0 $obj->{'_annotation'} = Bio::Annotation::Collection->new();
276             }
277 0         0 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 object
286             Args : None or L object
287              
288             See L for more information
289              
290             =cut
291              
292             sub species {
293 0     0 1 0 my ($self, $species) = @_;
294 0 0       0 if ($species) {
295 0         0 $self->{'species'} = $species;
296             } else {
297 0         0 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 104     104 1 97 my $self = shift;
317 104         88 my $prev = $self->{frame};
318 104 50       131 if (@_) { $self->{frame} = shift; $self->throw("This is not a legitimate frame") unless (grep(/$self->{frame}/,qw[0 1 2])); }
  87 100       75  
  87         741  
319 104         145 return $prev;
320             }
321              
322             1;