|
0
|
1 # $Id: Domain.pm,v 1.11 2002/10/08 08:38:34 lapp Exp $
|
|
|
2 #
|
|
|
3 # BioPerl module for Bio::Tools::HMMER::Domain
|
|
|
4 #
|
|
|
5 # Cared for by Ewan Birney <birney@sanger.ac.uk>
|
|
|
6 #
|
|
|
7 # Copyright Ewan Birney
|
|
|
8 #
|
|
|
9 # You may distribute this module under the same terms as perl itself
|
|
|
10
|
|
|
11 # POD documentation - main docs before the code
|
|
|
12
|
|
|
13 =head1 NAME
|
|
|
14
|
|
|
15 Bio::Tools::HMMER::Domain - One particular domain hit from HMMER
|
|
|
16
|
|
|
17 =head1 SYNOPSIS
|
|
|
18
|
|
|
19 Read the Bio::Tools::HMMER::Results docs
|
|
|
20
|
|
|
21 =head1 DESCRIPTION
|
|
|
22
|
|
|
23 A particular domain score. We reuse the Homol SeqFeature system
|
|
|
24 here, so this inherits off Homol SeqFeature. As this code
|
|
|
25 originally came from a separate project, there are some backward
|
|
|
26 compatibility stuff provided to keep this working with old code.
|
|
|
27
|
|
|
28 Don't forget this inherits off Bio::SeqFeature, so all your usual
|
|
|
29 nice start/end/score stuff is ready for use.
|
|
|
30
|
|
|
31 =head1 CONTACT
|
|
|
32
|
|
|
33 Ewan Birney, birney@ebi.ac.uk
|
|
|
34
|
|
|
35 =head1 CONTRIBUTORS
|
|
|
36
|
|
|
37 Jason Stajich, jason@bioperl.org
|
|
|
38
|
|
|
39 =head1 APPENDIX
|
|
|
40
|
|
|
41 The rest of the documentation details each of the object
|
|
|
42 methods. Internal methods are usually preceded with a _
|
|
|
43
|
|
|
44 =cut
|
|
|
45
|
|
|
46 #'
|
|
|
47 package Bio::Tools::HMMER::Domain;
|
|
|
48
|
|
|
49 use vars qw(@ISA);
|
|
|
50 use Bio::SeqFeature::FeaturePair;
|
|
|
51 use Bio::SeqFeature::Generic;
|
|
|
52 use strict;
|
|
|
53
|
|
|
54
|
|
|
55 @ISA = qw(Bio::SeqFeature::FeaturePair);
|
|
|
56
|
|
|
57 sub new {
|
|
|
58 my($class,@args) = @_;
|
|
|
59 my $self = $class->SUPER::new(@args);
|
|
|
60
|
|
|
61 $self->{'alignlines'} = [];
|
|
|
62
|
|
|
63 my $hmmf1 = Bio::SeqFeature::Generic->new(@args);
|
|
|
64 my $hmmf2 = Bio::SeqFeature::Generic->new(@args);
|
|
|
65
|
|
|
66 $self->feature1($hmmf1);
|
|
|
67 $self->feature2($hmmf2);
|
|
|
68
|
|
|
69 return $self;
|
|
|
70 }
|
|
|
71
|
|
|
72 =head2 add_alignment_line
|
|
|
73
|
|
|
74 Title : add_alignment_line
|
|
|
75 Usage : $domain->add_alignment_line($line_from_hmmer_output);
|
|
|
76 Function: add an alignment line to this Domain object
|
|
|
77 Returns : Nothing
|
|
|
78 Args : scalar
|
|
|
79
|
|
|
80 Adds an alignment line, mainly for storing the HMMER alignments
|
|
|
81 as flat text which can be reguritated. You're right. This is *not
|
|
|
82 nice* and not the right way to do it. C'est la vie.
|
|
|
83
|
|
|
84 =cut
|
|
|
85
|
|
|
86 sub add_alignment_line {
|
|
|
87 my $self = shift;
|
|
|
88 my $line = shift;
|
|
|
89 push(@{$self->{'alignlines'}},$line);
|
|
|
90 }
|
|
|
91
|
|
|
92 =head2 each_alignment_line
|
|
|
93
|
|
|
94 Title : each_alignment_line
|
|
|
95 Usage : foreach $line ( $domain->each_alignment_line )
|
|
|
96 Function: reguritates the alignment lines as they were fed in.
|
|
|
97 only useful realistically for printing.
|
|
|
98 Example :
|
|
|
99 Returns :
|
|
|
100 Args : None
|
|
|
101
|
|
|
102
|
|
|
103 =cut
|
|
|
104
|
|
|
105 sub each_alignment_line {
|
|
|
106 my $self = shift;
|
|
|
107 return @{$self->{'alignlines'}};
|
|
|
108 }
|
|
|
109
|
|
|
110 =head2 get_nse
|
|
|
111
|
|
|
112 Title : get_nse
|
|
|
113 Usage : $domain->get_nse()
|
|
|
114 Function: Provides a seqname/start-end format, useful
|
|
|
115 for unique keys. nse stands for name-start-end
|
|
|
116 It is used alot in Pfam
|
|
|
117 Example :
|
|
|
118 Returns : A string
|
|
|
119 Args : Optional seperator 1 and seperator 2 (default / and -)
|
|
|
120
|
|
|
121
|
|
|
122 =cut
|
|
|
123
|
|
|
124
|
|
|
125
|
|
|
126 sub get_nse {
|
|
|
127 my $self = shift;
|
|
|
128 my $sep1 = shift;
|
|
|
129 my $sep2 = shift;
|
|
|
130
|
|
|
131 if( !defined $sep2 ) {
|
|
|
132 $sep2 = "-";
|
|
|
133 }
|
|
|
134 if( !defined $sep1 ) {
|
|
|
135 $sep1 = "/";
|
|
|
136 }
|
|
|
137
|
|
|
138 return sprintf("%s%s%d%s%d",$self->seq_id,$sep1,$self->start,$sep2,$self->end);
|
|
|
139 }
|
|
|
140
|
|
|
141
|
|
|
142 # =head2 start_seq
|
|
|
143
|
|
|
144 # Title : start_seq
|
|
|
145 # Usage : Backward compatibility with old HMMER modules.
|
|
|
146 # should use $domain->start
|
|
|
147 # Function:
|
|
|
148 # Example :
|
|
|
149 # Returns :
|
|
|
150 # Args :
|
|
|
151
|
|
|
152 # =cut
|
|
|
153
|
|
|
154 sub start_seq {
|
|
|
155 my $self = shift;
|
|
|
156 my $start = shift;
|
|
|
157
|
|
|
158 $self->warn("Using old domain->start_seq. Should use domain->start");
|
|
|
159 return $self->start($start);
|
|
|
160 }
|
|
|
161
|
|
|
162 # =head2 end_seq
|
|
|
163
|
|
|
164 # Title : end_seq
|
|
|
165 # Usage : Backward compatibility with old HMMER modules.
|
|
|
166 # should use $domain->end
|
|
|
167 # Function:
|
|
|
168 # Example :
|
|
|
169 # Returns :
|
|
|
170 # Args :
|
|
|
171
|
|
|
172 # =cut
|
|
|
173
|
|
|
174 sub end_seq {
|
|
|
175 my $self = shift;
|
|
|
176 my $end = shift;
|
|
|
177
|
|
|
178 $self->warn("Using old domain->end_seq. Should use domain->end");
|
|
|
179 return $self->end($end);
|
|
|
180 }
|
|
|
181
|
|
|
182 # =head2 start_hmm
|
|
|
183
|
|
|
184 # Title : start_hmm
|
|
|
185 # Usage : Backward compatibility with old HMMER modules, and
|
|
|
186 # for convience. Equivalent to $self->homol_SeqFeature->start
|
|
|
187 # Function:
|
|
|
188 # Example :
|
|
|
189 # Returns :
|
|
|
190 # Args :
|
|
|
191
|
|
|
192 # =cut
|
|
|
193
|
|
|
194 sub start_hmm {
|
|
|
195 my $self = shift;
|
|
|
196 my $start = shift;
|
|
|
197 $self->warn("Using old domain->start_hmm. Should use domain->hstart");
|
|
|
198 return $self->hstart($start);
|
|
|
199 }
|
|
|
200
|
|
|
201 # =head2 end_hmm
|
|
|
202
|
|
|
203 # Title : end_hmm
|
|
|
204 # Usage : Backward compatibility with old HMMER modules, and
|
|
|
205 # for convience. Equivalent to $self->homol_SeqFeature->start
|
|
|
206 # Function:
|
|
|
207 # Example :
|
|
|
208 # Returns :
|
|
|
209 # Args :
|
|
|
210
|
|
|
211 # =cut
|
|
|
212
|
|
|
213 sub end_hmm {
|
|
|
214 my $self = shift;
|
|
|
215 my $end = shift;
|
|
|
216
|
|
|
217 $self->warn("Using old domain->end_hmm. Should use domain->hend");
|
|
|
218 return $self->hend($end);
|
|
|
219 }
|
|
|
220
|
|
|
221 =head2 hmmacc
|
|
|
222
|
|
|
223 Title : hmmacc
|
|
|
224 Usage : $domain->hmmacc($newacc)
|
|
|
225 Function: set get for HMM accession number. This is placed in the homol
|
|
|
226 feature of the HMM
|
|
|
227 Example :
|
|
|
228 Returns :
|
|
|
229 Args :
|
|
|
230
|
|
|
231
|
|
|
232 =cut
|
|
|
233
|
|
|
234 sub hmmacc{
|
|
|
235 my ($self,$acc) = @_;
|
|
|
236 if( defined $acc ) {
|
|
|
237 $self->feature2->add_tag_value('accession',$acc);
|
|
|
238 }
|
|
|
239 my @vals = $self->feature2->each_tag_value('accession');
|
|
|
240 return shift @vals;
|
|
|
241 }
|
|
|
242
|
|
|
243 =head2 hmmname
|
|
|
244
|
|
|
245 Title : hmmname
|
|
|
246 Usage : $domain->hmmname($newname)
|
|
|
247 Function: set get for HMM accession number. This is placed in the homol
|
|
|
248 feature of the HMM
|
|
|
249 Example :
|
|
|
250 Returns :
|
|
|
251 Args :
|
|
|
252
|
|
|
253 =cut
|
|
|
254
|
|
|
255 sub hmmname {
|
|
|
256 my ($self,$hname) = @_;
|
|
|
257
|
|
|
258
|
|
|
259 if( defined $hname ) {
|
|
|
260 $self->hseqname($hname);
|
|
|
261 }
|
|
|
262
|
|
|
263 return $self->hseqname();
|
|
|
264 }
|
|
|
265
|
|
|
266 =head2 bits
|
|
|
267
|
|
|
268 Title : bits
|
|
|
269 Usage :
|
|
|
270 Function: backward compatibility. Same as score
|
|
|
271 Example :
|
|
|
272 Returns :
|
|
|
273 Args :
|
|
|
274
|
|
|
275 =cut
|
|
|
276
|
|
|
277 sub bits{
|
|
|
278 my ($self,$sc) = @_;
|
|
|
279
|
|
|
280 return $self->score($sc);
|
|
|
281 }
|
|
|
282
|
|
|
283 =head2 evalue
|
|
|
284
|
|
|
285 Title : evalue
|
|
|
286 Usage :
|
|
|
287 Function: $domain->evalue($value);
|
|
|
288 Example :
|
|
|
289 Returns :
|
|
|
290 Args :
|
|
|
291
|
|
|
292 =cut
|
|
|
293
|
|
|
294 sub evalue{
|
|
|
295 my ($self,$value) = @_;
|
|
|
296
|
|
|
297 if( defined $value ) {
|
|
|
298 $self->add_tag_value('evalue',$value);
|
|
|
299 }
|
|
|
300 my @vals = $self->each_tag_value('evalue');
|
|
|
301 return shift @vals;
|
|
|
302 }
|
|
|
303
|
|
|
304 =head2 seqbits
|
|
|
305
|
|
|
306 Title : seqbits
|
|
|
307 Usage :
|
|
|
308 Function: $domain->seqbits($value);
|
|
|
309 Example :
|
|
|
310 Returns :
|
|
|
311 Args :
|
|
|
312
|
|
|
313 =cut
|
|
|
314
|
|
|
315 sub seqbits {
|
|
|
316 my ($self,$value) = @_;
|
|
|
317 if( defined $value ) {
|
|
|
318 $self->add_tag_value('seqbits',$value);
|
|
|
319 }
|
|
|
320 my @vals = $self->each_tag_value('seqbits');
|
|
|
321 return shift @vals;
|
|
|
322 }
|
|
|
323
|
|
|
324 =head2 seq_range
|
|
|
325
|
|
|
326 Title : seq_range
|
|
|
327 Usage :
|
|
|
328 Function: Throws an exception to catch scripts which need to upgrade
|
|
|
329 Example :
|
|
|
330 Returns :
|
|
|
331 Args :
|
|
|
332
|
|
|
333 =cut
|
|
|
334
|
|
|
335 sub seq_range{
|
|
|
336 my ($self,@args) = @_;
|
|
|
337
|
|
|
338 $self->throw("You have accessed an old method. Please recode your script to the new bioperl HMMER module");
|
|
|
339 }
|
|
|
340
|
|
|
341 =head2 hmm_range
|
|
|
342
|
|
|
343 Title : hmm_range
|
|
|
344 Usage :
|
|
|
345 Function: Throws an exception to catch scripts which need to upgrade
|
|
|
346 Example :
|
|
|
347 Returns :
|
|
|
348 Args :
|
|
|
349
|
|
|
350
|
|
|
351 =cut
|
|
|
352
|
|
|
353 sub hmm_range{
|
|
|
354 my ($self,@args) = @_;
|
|
|
355
|
|
|
356 $self->throw("You have accessed an old method. Please recode your script to the new bioperl HMMER module");
|
|
|
357 }
|
|
|
358
|
|
|
359 1; # says use was ok
|
|
|
360 __END__
|
|
|
361
|
|
|
362
|
|
|
363
|
