~ubuntu-branches/ubuntu/saucy/bioperl/saucy-proposed

« back to all changes in this revision

Viewing changes to Bio/Tools/Infernal.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
# $Id: Infernal.pm 15231 2008-12-22 21:51:02Z cjfields $
 
2
#
 
3
# BioPerl module for Bio::Tools::Infernal
 
4
#
 
5
# Cared for by Chris Fields <cjfields-at-uiuc-dot-edu>
 
6
#
 
7
# Copyright Chris Fields
 
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::Infernal - A parser for Infernal output
 
16
 
 
17
=head1 SYNOPSIS
 
18
 
 
19
  use Bio::Tools::Infernal;
 
20
  my $parser = Bio::Tools::Infernal->new(-file => $rna_output,
 
21
                                        -motiftag => 'misc_binding'
 
22
                                        -desctag => 'Lysine riboswitch',
 
23
                                        -cm    => 'RF00168',
 
24
                                        -rfam  =>  'RF00168',
 
25
                                        -minscore => 20);
 
26
  #parse the results, get a Bio::SeqFeature::FeaturePair
 
27
  while( my $motif = $parser->next_prediction) {
 
28
    # do something here
 
29
  }
 
30
 
 
31
=head1 DESCRIPTION
 
32
 
 
33
This is a highly experimental parser for Infernal output from the cmsearch
 
34
program.  At some point it is anticipated that this will morph into a proper
 
35
SearchIO parser, along with the related RNAMotif and ERPIN tools.
 
36
 
 
37
The Infernal suite of programs are used for generating RNA CM (covariance
 
38
models) and searching sequences using CMs to locate potentially similar
 
39
structures.  The program is under active development; it is anticiapted that
 
40
this will support the latest version available.
 
41
 
 
42
This parser has been tested and is capable of parsing Infernal 0.7 and 0.71
 
43
output.  However, future Infernal versions may break parsing as the output is
 
44
constantly evolving, so keep an eye on this space for additional notes.
 
45
 
 
46
Currently data is parsed into a Bio::SeqFeature::FeaturePair object, consisting
 
47
of a query (the covariance model) and the hit (sequence searched).  
 
48
 
 
49
Model data is accessible via the following:
 
50
 
 
51
  Data            SeqFeature::FeaturePair         Note
 
52
  --------------------------------------------------------------------------
 
53
  primary tag     $sf->primary_tag                Rfam ID (if passed to new())
 
54
  start           $sf->start                      Based on CM length
 
55
  end             $sf->end                        Based on CM length
 
56
  score           $sf->score                      Bit score
 
57
  strand          $sf->strand                     0 (CM does not have a strand)
 
58
  seqid           $sf->seq_id                     Rfam ID (if passed to new())
 
59
  display name    $sf->feature1->display_name     CM name (if passed to new())
 
60
  source          $sf->feature1->source tag      'Infernal' followed by version
 
61
 
 
62
Hit data is accessible via the following:
 
63
 
 
64
  Data            SeqFeature::FeaturePair         Note
 
65
  ------------------------------------------------------------------
 
66
  start           $sf->hstart
 
67
  end             $sf->hend
 
68
  score(bits)     $sf->hscore
 
69
  strand          $sf->hstrand
 
70
  seqid           $sf->hseqid
 
71
  Primary Tag     $sf->hprimary_tag
 
72
  Source Tag      $sf->hsource_tag
 
73
 
 
74
Added FeaturePair tags are : 
 
75
 
 
76
   secstructure - entire description line (in case the regex used for
 
77
                  sequence ID doesn't adequately catch the name
 
78
   model        - name of the descriptor file (may include path to file)
 
79
   midline      - contains structural information from the descriptor
 
80
                  used as a query
 
81
   hit          - sequence of motif, separated by spaces according to
 
82
                  matches to the structure in the descriptor (in
 
83
                  SecStructure).
 
84
   seqname      - raw sequence name (for downstream parsing if needed)
 
85
 
 
86
An additional parameter ('minscore') is added due to the huge number
 
87
of spurious hits generated by cmsearch.  This screens data, only building
 
88
and returning objects when a minimal bitscore is present.  
 
89
 
 
90
See t/rnamotif.t for example usage.
 
91
 
 
92
=head1 FEEDBACK
 
93
 
 
94
=head2 Mailing Lists
 
95
 
 
96
User feedback is an integral part of the evolution of this and other
 
97
Bioperl modules. Send your comments and suggestions preferably to
 
98
the Bioperl mailing list.  Your participation is much appreciated.
 
99
 
 
100
  bioperl-l@bioperl.org                  - General discussion
 
101
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
 
102
 
 
103
=head2 Reporting Bugs
 
104
 
 
105
Report bugs to the Bioperl bug tracking system to help us keep track
 
106
of the bugs and their resolution. Bug reports can be submitted via the
 
107
web:
 
108
 
 
109
  http://bugzilla.open-bio.org/
 
110
 
 
111
=head1 AUTHOR - Chris Fields
 
112
 
 
113
Email cjfields-at-uiuc-dot-edu
 
114
 
 
115
=head1 APPENDIX
 
116
 
 
117
The rest of the documentation details each of the object methods.
 
118
Internal methods are usually preceded with a _
 
119
 
 
120
=cut
 
121
 
 
122
# Let the code begin...
 
123
 
 
124
package Bio::Tools::Infernal;
 
125
use strict;
 
126
 
 
127
use Bio::SeqFeature::Generic;
 
128
use Bio::SeqFeature::FeaturePair;
 
129
use Data::Dumper;
 
130
use base qw(Bio::Tools::AnalysisResult);
 
131
 
 
132
our($MotifTag,$SrcTag,$DescTag) = qw(misc_binding Infernal infernal);
 
133
 
 
134
our $MINSCORE = 0;
 
135
our $DEFAULT_VERSION = '0.71';
 
136
 
 
137
=head2 new
 
138
 
 
139
 Title   : new
 
140
 Usage   : my $obj = Bio::Tools::Infernal->new();
 
141
 Function: Builds a new Bio::Tools::Infernal object 
 
142
 Returns : an instance of Bio::Tools::Infernal
 
143
 Args    : -fh/-file  - for input filehandle/filename
 
144
           -motiftag  - primary tag used in gene features (default 'misc_binding')
 
145
           -desctag   - tag used for display_name name (default 'infernal')
 
146
           -srctag    - source tag used in all features (default 'Infernal')
 
147
           -rfam      - Rfam id number
 
148
           -cm        - covariance model used in analysis (may be same as rfam #)
 
149
           -minscore  - minimum score (simple screener, since Infernal generates
 
150
                        a ton of spurious hits)
 
151
           -version   - Infernal program version
 
152
 
 
153
=cut
 
154
 
 
155
# yes, this is actually _initialize, but the args are passed to
 
156
# the constructor.
 
157
# see Bio::Tools::AnalysisResult for further details
 
158
 
 
159
sub _initialize {
 
160
  my($self,@args) = @_;
 
161
  $self->warn('Use of this module is deprecated.  Use Bio::SearchIO::infernal instead');  
 
162
  $self->SUPER::_initialize(@args);
 
163
  my ($motiftag,$desctag,$srctag,$rfam,$cm,$ms,$ver) =
 
164
        $self->SUPER::_rearrange([qw(MOTIFTAG
 
165
                                    DESCTAG
 
166
                                    SRCTAG
 
167
                                    RFAM
 
168
                                    CM
 
169
                                    MINSCORE
 
170
                                    VERSION
 
171
                                 )],@args);
 
172
  $self->motif_tag(defined $motiftag ? $motiftag : $MotifTag);
 
173
  $self->source_tag(defined $srctag ? $srctag : $SrcTag);
 
174
  $self->desc_tag(defined $desctag ? $desctag : $DescTag);
 
175
  $cm        && $self->covariance_model($cm);
 
176
  $rfam      && $self->rfam($rfam);
 
177
  $self->program_version(defined $ver ? $ver : $DEFAULT_VERSION);
 
178
  $self->minscore(defined $ms ? $ms : $MINSCORE);
 
179
}
 
180
 
 
181
=head2 motif_tag
 
182
 
 
183
 Title   : motif_tag
 
184
 Usage   : $obj->motif_tag($newval)
 
185
 Function: Get/Set the value used for 'motif_tag', which is used for setting the
 
186
           primary_tag.
 
187
           Default is 'misc_binding' as set by the global $MotifTag.
 
188
           'misc_binding' is used here because a conserved RNA motif is capable
 
189
           of binding proteins (regulatory proteins), antisense RNA (siRNA),
 
190
           small molecules (riboswitches), or nothing at all (tRNA,
 
191
           terminators, etc.).  It is recommended that this be changed to other
 
192
           tags ('misc_RNA', 'protein_binding', 'tRNA', etc.) where appropriate.
 
193
           For more information, see:
 
194
           http://www.ncbi.nlm.nih.gov/collab/FT/index.html
 
195
 Returns : value of motif_tag (a scalar)
 
196
 Args    : on set, new value (a scalar or undef, optional)
 
197
 
 
198
=cut
 
199
 
 
200
sub motif_tag{
 
201
    my $self = shift;
 
202
 
 
203
    return $self->{'motif_tag'} = shift if @_;
 
204
    return $self->{'motif_tag'};
 
205
}
 
206
 
 
207
=head2 source_tag
 
208
 
 
209
 Title   : source_tag
 
210
 Usage   : $obj->source_tag($newval)
 
211
 Function: Get/Set the value used for the 'source_tag'.
 
212
           Default is 'Infernal' as set by the global $SrcTag
 
213
 Returns : value of source_tag (a scalar)
 
214
 Args    : on set, new value (a scalar or undef, optional)
 
215
 
 
216
 
 
217
=cut
 
218
 
 
219
sub source_tag{
 
220
    my $self = shift;
 
221
 
 
222
    return $self->{'source_tag'} = shift if @_;
 
223
    return $self->{'source_tag'};
 
224
}
 
225
 
 
226
=head2 desc_tag
 
227
 
 
228
 Title   : desc_tag
 
229
 Usage   : $obj->desc_tag($newval)
 
230
 Function: Get/Set the value used for the query motif.  This will be placed in
 
231
           the tag '-display_name'.  Default is 'infernal' as set by the global
 
232
           $DescTag.  Use this to manually set the descriptor (motif searched for).
 
233
           Since there is no way for this module to tell what the motif is from the
 
234
           name of the descriptor file or the Infernal output, this should
 
235
           be set every time an Infernal object is instantiated for clarity
 
236
 Returns : value of exon_tag (a scalar)
 
237
 Args    : on set, new value (a scalar or undef, optional)
 
238
 
 
239
=cut
 
240
 
 
241
sub desc_tag{
 
242
    my $self = shift;
 
243
 
 
244
    return $self->{'desc_tag'} = shift if @_;
 
245
    return $self->{'desc_tag'};
 
246
}
 
247
 
 
248
=head2 covariance_model
 
249
 
 
250
 Title   : covariance_model
 
251
 Usage   : $obj->covariance_model($newval)
 
252
 Function: Get/Set the value used for the covariance model used in the analysis.
 
253
 Returns : value of exon_tag (a scalar)
 
254
 Args    : on set, new value (a scalar or undef, optional)
 
255
 
 
256
=cut
 
257
 
 
258
sub covariance_model{
 
259
    my $self = shift;
 
260
 
 
261
    return $self->{'_cmodel'} = shift if @_;
 
262
    return $self->{'_cmodel'};
 
263
}
 
264
 
 
265
=head2 rfam
 
266
 
 
267
 Title   : rfam
 
268
 Usage   : $obj->rfam($newval)
 
269
 Function: Get/Set the Rfam accession number
 
270
 Returns : value of exon_tag (a scalar)
 
271
 Args    : on set, new value (a scalar or undef, optional)
 
272
 
 
273
=cut
 
274
 
 
275
sub rfam {
 
276
    my $self = shift;
 
277
 
 
278
    return $self->{'_rfam'} = shift if @_;
 
279
    return $self->{'_rfam'};
 
280
}
 
281
 
 
282
=head2 minscore
 
283
 
 
284
 Title   : minscore
 
285
 Usage   : $obj->minscore($newval)
 
286
 Function: Get/Set the minimum score threshold for generating SeqFeatures
 
287
 Returns : value of exon_tag (a scalar)
 
288
 Args    : on set, new value (a scalar or undef, optional)
 
289
 
 
290
=cut
 
291
 
 
292
sub minscore {
 
293
    my $self = shift;
 
294
 
 
295
    return $self->{'_minscore'} = shift if @_;
 
296
    return $self->{'_minscore'};
 
297
}
 
298
 
 
299
=head2 program_version
 
300
 
 
301
 Title   : program_version
 
302
 Usage   : $obj->program_version($newval)
 
303
 Function: Get/Set the Infernal program version
 
304
 Returns : value of exon_tag (a scalar)
 
305
 Args    : on set, new value (a scalar or undef, optional)
 
306
           Note: this is set to $DEFAULT_VERSION by, um, default
 
307
 
 
308
=cut
 
309
 
 
310
sub program_version {
 
311
    my $self = shift;
 
312
 
 
313
    return $self->{'_program_version'} = shift if @_;
 
314
    return $self->{'_program_version'};
 
315
}
 
316
 
 
317
=head2 analysis_method
 
318
 
 
319
 Usage     : $obj->analysis_method();
 
320
 Purpose   : Inherited method. Overridden to ensure that the name matches
 
321
             /Infernal/i.
 
322
 Returns   : String
 
323
 Argument  : n/a
 
324
 
 
325
=cut
 
326
 
 
327
sub analysis_method { 
 
328
    my ($self, $method) = @_;  
 
329
    if($method && ($method !~ /Infernal/i)) {
 
330
    $self->throw("method $method not supported in " . ref($self));
 
331
    }
 
332
    return $self->SUPER::analysis_method($method);
 
333
}
 
334
 
 
335
=head2 next_feature
 
336
 
 
337
 Title   : next_feature
 
338
 Usage   : while($gene = $obj->next_feature()) {
 
339
                  # do something
 
340
           }
 
341
 Function: Returns the next gene structure prediction of the RNAMotif result
 
342
           file. Call this method repeatedly until FALSE is returned.
 
343
           The returned object is actually a SeqFeatureI implementing object.
 
344
           This method is required for classes implementing the
 
345
           SeqAnalysisParserI interface, and is merely an alias for 
 
346
           next_prediction() at present.
 
347
 Returns : A Bio::Tools::Prediction::Gene object.
 
348
 Args    : None (at present)
 
349
 
 
350
=cut
 
351
 
 
352
sub next_feature {
 
353
    my ($self,@args) = @_;
 
354
    # even though next_prediction doesn't expect any args (and this method
 
355
    # does neither), we pass on args in order to be prepared if this changes
 
356
    # ever
 
357
    return $self->next_prediction(@args);
 
358
}
 
359
 
 
360
=head2 next_prediction
 
361
 
 
362
 Title   : next_prediction
 
363
 Usage   : while($gene = $obj->next_prediction()) {
 
364
                  # do something
 
365
           }
 
366
 Function: Returns the next gene structure prediction of the RNAMotif result
 
367
           file. Call this method repeatedly until FALSE is returned.
 
368
 Returns : A Bio::SeqFeature::Generic object
 
369
 Args    : None (at present)
 
370
 
 
371
=cut
 
372
 
 
373
sub next_prediction {
 
374
    my ($self) = @_;
 
375
    
 
376
    my ($start, $end, $strand, $score);
 
377
    
 
378
    my %hsp_key = ('0' => 'structure',
 
379
                   '1' => 'model',
 
380
                   '2' => 'midline',
 
381
                   '3' => 'hit');
 
382
    my $line;
 
383
    PARSER:
 
384
    while($line = $self->_readline) {
 
385
        next if $line =~ m{^\s+$};
 
386
        if ($line =~ m{^sequence:\s+(\S+)} ){
 
387
            $self->_current_hit($1);
 
388
            next PARSER;
 
389
        } elsif ($line =~ m{^hit\s+\d+\s+:\s+(\d+)\s+(\d+)\s+(\d+\.\d+)\s+bits}xms) {
 
390
            $strand = 1;
 
391
            ($start, $end, $score) = ($1, $2, $3);
 
392
            if ($start > $end) {
 
393
                ($start, $end) = ($end, $start);
 
394
                $strand = -1;
 
395
            }
 
396
            #$self->debug(sprintf("Hit: %-30s\n\tStrand:%-4d Start:%-6d End:%-6d Score:%-10s\n",
 
397
            #       $self->_current_hit, $strand, $start, $end, $score));
 
398
        } elsif ($line =~ m{^(\s+)[<>\{\}\(\)\[\]:_,-\.]+}xms) { # start of HSP
 
399
            $self->_pushback($line); # set up for loop
 
400
            # what is length of the gap to the structure data?
 
401
            my $offset = length($1);
 
402
            my ($ct, $strln) = 0;
 
403
            my $hsp;
 
404
            HSP:
 
405
            while ($line = $self->_readline) {
 
406
                next if $line =~ m{^\s*$}; # toss empty lines
 
407
                chomp $line;
 
408
                # exit loop if at end of file or upon next hit/HSP
 
409
                if (!defined($line) || $line =~ m{^(sequence|hit)}) {
 
410
                    $self->_pushback($line);
 
411
                    last HSP;
 
412
                }
 
413
                # iterate to keep track of each line (4 lines per hsp block)
 
414
                my $iterator = $ct%4;
 
415
                # strlen set only with structure lines (proper length)
 
416
                $strln = length($line) if $iterator == 0;
 
417
                # only grab the data needed (hit start and stop in hit line above;
 
418
                # query start, end are from the actual query length (entire hit is
 
419
                # mapped to CM data, so all CM data is represented
 
420
                
 
421
                # yes this is kinda clumsy, but I'll probably morph this into
 
422
                # a proper SearchIO module soon.  For now this works...
 
423
                my $data = substr($line, $offset, $strln-$offset);
 
424
                $hsp->{ $hsp_key{$iterator} } .= $data;
 
425
                $ct++;
 
426
            }
 
427
            if ($self->minscore < $score) {
 
428
                my ($name, $program, $rfam, $cm, $dt, $st, $mt) =
 
429
                  ($self->_current_hit, $self->analysis_method, $self->rfam,
 
430
                   $self->covariance_model, $self->desc_tag, $self->source_tag,
 
431
                   $self->motif_tag);
 
432
                my $ver = $self->program_version || '';
 
433
                my $qid = $name;
 
434
                if ($name =~ m{(?:gb|gi|emb|dbj|sp|pdb|bbs|ref|lcl)\|(\d+)((?:\:|\|)\w+\|(\S*.\d+)\|)?}xms) {
 
435
                    $qid = $1; 
 
436
                }
 
437
                my $fp = Bio::SeqFeature::FeaturePair->new();
 
438
                my $strlen = $hsp->{'model'} =~ tr{A-Za-z}{A-Za-z}; # gaps don't count
 
439
                my $qf = Bio::SeqFeature::Generic->new( -primary_tag => $mt,
 
440
                              -source_tag  => "$st $ver",
 
441
                              -display_name => $cm || '',
 
442
                              -score       => $score,
 
443
                              -start       => 1,
 
444
                              -end         => $strlen,
 
445
                              -seq_id      => $rfam || '',
 
446
                              -strand      => 0, # covariance model does not have a strand
 
447
                            );
 
448
                my $hf = Bio::SeqFeature::Generic->new( -primary_tag => $mt,
 
449
                              -source_tag  => "$st $ver",
 
450
                              -display_name => $dt || '',
 
451
                              -score       => $score,
 
452
                              -start       => $start,
 
453
                              -end         => $end,
 
454
                              -seq_id      => $qid,
 
455
                              -strand      => $strand
 
456
                            );
 
457
                $fp->feature1($qf);
 
458
                $fp->feature2($hf); # should emphasis be on the hit?
 
459
                $fp->add_tag_value('secstructure', $hsp->{'structure'});
 
460
                $fp->add_tag_value('model', $hsp->{'model'});
 
461
                $fp->add_tag_value('midline', $hsp->{'midline'});
 
462
                $fp->add_tag_value('hit', $hsp->{'hit'});
 
463
                $fp->add_tag_value('seq_name', $name);
 
464
                $fp->display_name($dt);
 
465
                return $fp;
 
466
            } else {
 
467
                next PARSER;
 
468
            }
 
469
        }
 
470
    }
 
471
    return (defined($line)) ? 1 : 0;
 
472
}
 
473
 
 
474
sub _current_hit {
 
475
    my $self = shift;
 
476
    return $self->{'_currhit'} = shift if @_;
 
477
    return $self->{'_currhit'};
 
478
}
 
479
 
 
480
1;