~ubuntu-branches/ubuntu/lucid/bioperl/lucid

« back to all changes in this revision

Viewing changes to Bio/Tools/Analysis/Protein/Sopma.pm

  • Committer: Bazaar Package Importer
  • Author(s): Matt Hope
  • Date: 2004-04-18 14:24:11 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040418142411-gr92uexquw4w8liq
Tags: 1.4-1
* New upstream release
* Examples and working code are installed by default to usr/bin,
  this has been moved to usr/share/doc/bioperl/bin

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
# $Id: Sopma.pm,v 1.0 2003/07/ 11
 
2
#
 
3
# BioPerl module for Bio::Tools::Analysis::Protein::Sopma
 
4
#
 
5
# Copyright Richard Adams
 
6
#
 
7
# You may distribute this module under the same terms as perl itself
 
8
 
 
9
# POD documentation - main docs before the code
 
10
 
 
11
 
 
12
=head1 NAME
 
13
 
 
14
Bio::Tools::Analysis::Protein::Sopma - a wrapper around
 
15
Sopma protein secondary structure prediction server
 
16
 
 
17
=head1  SYNOPSIS
 
18
 
 
19
  use Bio::Tools::Analysis::Protein::Sopma;
 
20
  #get a Bio::Seq or Bio::PrimarySeq
 
21
  my $seq;
 
22
 
 
23
  my $sopma = Bio::Tools::Analysis::Protein::Sopma->new
 
24
      (-seq=>$seq, states=>4);
 
25
  $sopma->run;
 
26
  print $sopma->result;# #raw text to standard error
 
27
 
 
28
=head1  DESCRIPTION
 
29
 
 
30
A module to remotely retrieve predictions of protein secondary
 
31
structure.  Each residue in the protein receives a score representing
 
32
the likelihood of existing in each of four different states (helix,
 
33
coil, turn or sheet), e.g.,
 
34
 
 
35
  my $analysis_object = Bio::Tools::SimpleAnalysis::Protein::Sopma->new
 
36
      ( -seq          => $seq,
 
37
        -states       =>4,
 
38
        -window_width =>15,
 
39
      );
 
40
 
 
41
creates a new object.  Compulsory arguments -seq.  Optional arguments
 
42
-states, -window_width,-similarity_threshold. These values can also be
 
43
set by direct methods , e.g.,
 
44
 
 
45
  $analysis_object->states(4);
 
46
  $analysis_object->run   ;
 
47
 
 
48
submits the query to the server and obtains raw text output Given an
 
49
amino acid sequence the results can be obtained in 4 formats,
 
50
determined by the argument to the result method
 
51
 
 
52
=over 4
 
53
 
 
54
=item 1
 
55
 
 
56
The raw text of the program output
 
57
 
 
58
  my $rawdata = $analysis_object->result;
 
59
 
 
60
=item 2
 
61
 
 
62
A reference to an array of hashes of scores for each state and the
 
63
assigned state.
 
64
 
 
65
  my $data_ref = $analysis_object->result('parsed');
 
66
  print "score for helix at residue 2 is $data_ref->[1]{'helix'}\n";
 
67
  print "predicted struc  at residue 2 is $data_ref->[1]{'struc}\n";
 
68
Hash keys are 'helix', 'struc', 'sheet', 'coil', 'turn'.
 
69
 
 
70
 
 
71
=item 3
 
72
 
 
73
An array of Bio::SeqFeature::Generic objects where each feature is a
 
74
predicted unit of secondary structure. Only stretches of helix/sheet
 
75
predictions for longer than 4 residues are defined as helices/sheets.
 
76
 
 
77
  my @fts = $analysis_object->result(Bio::SeqFeatureI);
 
78
  for my $ft (@fts) {
 
79
      print " From ",  $ft->start, " to  ",$ft->end, " struc: " ,
 
80
             ($ft->each_tag_value('type'))[0]  ,"\n";
 
81
  }
 
82
 
 
83
=item 4
 
84
 
 
85
A Bio::Seq::Meta::Array implementing sequence.
 
86
 
 
87
This is a Bio::Seq object that can also hold data about each residue
 
88
in the sequence.  In this case, the sequence can be associated with a
 
89
arrays of Sopma prediction scores.  e.g.,
 
90
 
 
91
  my $meta_sequence = $analysis_object->result('meta');
 
92
  print "scores from residues 10 -20 are ",
 
93
      $meta_sequence->named_submeta_text("Sopma_helix",10,20), "\n";
 
94
 
 
95
Meta sequence names are : Sopma_helix, Sopma_sheet, Sopma_turn,
 
96
Sopma_coil, Sopma_struc, representing the scores for each residue.
 
97
 
 
98
Many methods common to all analyses are inherited from
 
99
Bio::Tools::Analysis::SimpleAnalysisBase.
 
100
 
 
101
=back
 
102
 
 
103
=head1 SEE ALSO
 
104
 
 
105
L<Bio::SimpleAnalysisI>, 
 
106
L<Bio::Tools::Analysis::SimpleAnalysisBase>
 
107
L<Bio::Seq::Meta::Array>, 
 
108
L<Bio::WebAgent>
 
109
 
 
110
=head1 FEEDBACK
 
111
 
 
112
=head2 Mailing Lists
 
113
 
 
114
User feedback is an integral part of the evolution of this and other
 
115
Bioperl modules. Send your comments and suggestions preferably to one
 
116
of the Bioperl mailing lists.  Your participation is much appreciated.
 
117
 
 
118
  bioperl-l@bioperl.org                       - General discussion
 
119
  http://bio.perl.org/MailList.html           - About the mailing lists
 
120
 
 
121
=head2 Reporting Bugs
 
122
 
 
123
Report bugs to the Bioperl bug tracking system to help us keep track
 
124
the bugs and their resolution.  Bug reports can be submitted via email
 
125
or the web:
 
126
 
 
127
  bioperl-bugs@bio.perl.org
 
128
  http://bugzilla.bioperl.org/
 
129
 
 
130
=head1 AUTHORS
 
131
 
 
132
Richard Adams, Richard.Adams@ed.ac.uk, 
 
133
 
 
134
=head1 APPENDIX
 
135
 
 
136
=cut
 
137
 
 
138
use strict;
 
139
 
 
140
package Bio::Tools::Analysis::Protein::Sopma;
 
141
use vars qw(@ISA );
 
142
 
 
143
use IO::String;
 
144
use Bio::SeqIO;
 
145
use HTTP::Request::Common qw (POST);
 
146
use Bio::SeqFeature::Generic;
 
147
use Bio::Tools::Analysis::SimpleAnalysisBase;
 
148
use Bio::Seq::Meta::Array;
 
149
 
 
150
 
 
151
@ISA = qw(Bio::Tools::Analysis::SimpleAnalysisBase);
 
152
 
 
153
#extends array for 2struc.
 
154
my $URL = 'http://npsa-pbil.ibcp.fr/cgi-bin/secpred_sopma.pl';
 
155
my $ANALYSIS_NAME= 'Sopma';
 
156
my $ANALYSIS_SPEC= {name => 'Sopma', type => 'Protein'};
 
157
my $INPUT_SPEC = [
 
158
                  {mandatory=>'true',
 
159
                   type     => 'Bio::PrimarySeqI',
 
160
                   'name'   => 'seq',
 
161
                  },
 
162
                  {mandatory =>'false',
 
163
                   type      => 'integer',
 
164
                   name      => 'similarity_threshold',
 
165
                   default   => 8,
 
166
                  },
 
167
                  {mandatory  =>'false',
 
168
                   type       => 'integer',
 
169
                   name       => 'window_width',
 
170
                   default    => 17,
 
171
                  },
 
172
                  {mandatory  =>'false',
 
173
                   type       => 'integer',
 
174
                   name       => 'states',
 
175
                   default    => 4,
 
176
                  },
 
177
                 ];
 
178
my  $RESULT_SPEC =
 
179
    {
 
180
     ''   => 'bulk',              # same as undef
 
181
     raw  => '[{struc=>, helix=>, turn=>, coil=>, sheet=>}]',
 
182
     meta => 'Bio::Seq::Meta::Array object',
 
183
     'Bio::SeqFeatureI' => 'ARRAY of Bio::SeqFeature::Generic',
 
184
    };
 
185
use constant MIN_STRUC_LEN => 3; 
 
186
 
 
187
 
 
188
=head2  similarity_threshold
 
189
 
 
190
  Useage  : $job->similarity_threshold(...)
 
191
  Returns : The  similarity threshold used in the analysis
 
192
  Args    : None (retrieves value) or  an integer (default = 8) 
 
193
            that sets the similarity threshold .
 
194
 
 
195
This method gets/sets the  similarity threshold for the prediction.
 
196
 
 
197
=cut
 
198
 
 
199
sub similarity_threshold {
 
200
    my ($self, $value) = @_;
 
201
    if ($value) {
 
202
        $self->throw ("similarity_threshold must be integer")
 
203
            unless $value =~ /^\d+$/;
 
204
        $self->{'_similarity_threshold'} = $value;
 
205
    }
 
206
    $self->{'_similarity_threshold'} ||= $self->input_spec->[1]{'default'};
 
207
    return $self->{'_similarity_threshold'};
 
208
}
 
209
 
 
210
=head2  window_width
 
211
 
 
212
  Useage   : $job->window_width(...)
 
213
  Returns  : The  window width used in the analysis
 
214
  Args     : None (retrieves value) or  an integer (default = 17)
 
215
             that sets the window width.
 
216
 
 
217
This method gets/sets the window width for the prediction, .  If
 
218
attempted to set longer than the sequence, warns of error.
 
219
 
 
220
=cut
 
221
 
 
222
sub window_width {
 
223
    my ($self, $value) = @_;
 
224
    if ($value) {
 
225
        $self->throw ("window_width must be integer")
 
226
            unless $value =~ /^\d+$/;
 
227
        $self->{'_window_width'} = $value;
 
228
    }
 
229
    $self->{'_window_width'} ||= $self->input_spec->[2]{'default'};
 
230
    $self->warn ("window width longer than sequence!")
 
231
        unless $self->{'_window_width'} < $self->seq->length;
 
232
    return $self->{'_window_width'};
 
233
}
 
234
 
 
235
=head2  states
 
236
 
 
237
  Useage   : $job->states(...)
 
238
  Returns  : The number of secondary structure prediction states
 
239
  Args     : None (retrieves value) or either '3' or '4' to set
 
240
             prior to running analysis.
 
241
 
 
242
This method gets/sets the number of states for the prediction, either
 
243
3 or 4 (includes turns).
 
244
 
 
245
=cut
 
246
 
 
247
sub states {
 
248
    my ($self, $value) = @_;
 
249
    if ($value) {
 
250
        $self->throw ("number of states must be 3 or 4")
 
251
            unless $value == 3 or $value ==4;
 
252
        $self->{'_states'} = $value;
 
253
    }
 
254
    $self->{'_states'} ||= $self->input_spec->[3]{'default'};
 
255
    return $self->{'_states'};
 
256
}
 
257
 
 
258
=head2 result
 
259
 
 
260
  Usage   : $job->result (...)
 
261
  Returns : a result created by running an analysis
 
262
  Args    : various
 
263
 
 
264
The method returns a result of an executed job. If the job was
 
265
terminated by an error the result may contain an error message instead
 
266
of the real data.
 
267
 
 
268
This implementation returns differently processed data depending on
 
269
argument:
 
270
 
 
271
=over 3
 
272
 
 
273
=item undef
 
274
 
 
275
Returns the raw ASCII data stream but without HTML tags
 
276
 
 
277
=item 'Bio::SeqFeatureI'
 
278
 
 
279
The argument string defines the type of bioperl objects returned in an
 
280
array.  The objects are L<Bio::SeqFeature::Generic>.  Feature primary
 
281
tag is "2ary".  Feature tags are "type" (which can be helix, sheet
 
282
coil, or turn if 4 state prediction requested) "method" (Sopma)
 
283
 
 
284
=item 'parsed'
 
285
 
 
286
Array of hash references of scores/structure assignations { helix =E<gt>,
 
287
sheet =E<gt> , coil =E<gt> , struc=E<gt>}.
 
288
 
 
289
=item 'all'
 
290
 
 
291
A Bio::Seq::Meta::Array object. Scores can be accessed using methods
 
292
from this class. Meta sequence names are Sopma_helix, Sopma_sheet,
 
293
Sopma_coil, Sopma_turn (if defined) Sopma_struc.
 
294
 
 
295
 
 
296
=back
 
297
 
 
298
 
 
299
=cut
 
300
 
 
301
sub result {
 
302
    my ($self,$value, $run_id) = @_;
 
303
 
 
304
    my @score;
 
305
    my @fts;
 
306
 
 
307
    if ($value ) {
 
308
        if (!exists($self->{'_parsed'} )) {
 
309
            my $result = IO::String->new($self->{'_result'});
 
310
            while (my $line = <$result>) {
 
311
                next unless $line =~ /^[HCET]\s/; # or for sopma/hnn  /^[A-Z]\s/
 
312
                $line =~/^([A-Z])\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/; # or for so
 
313
                push @score, { struc => $1,
 
314
                               helix => $2,
 
315
                               sheet => $3,
 
316
                               coil => $5,
 
317
                             };
 
318
                #include turn if 4states are requested
 
319
                $score[$#score]{'turn'} = $4 if $self->states == 4;
 
320
                #can optimize by duplicating code here
 
321
            }
 
322
            $self->{'_parsed'} = \@score;
 
323
        }
 
324
        if ($value eq 'Bio::SeqFeatureI') {
 
325
            $self->_get_2ary_coords();
 
326
            for my $type (keys %{$self->{'_parsed_coords'}} ) {
 
327
                next if $type =~  /\w{2,}/; #if not H,C,E or T
 
328
 
 
329
                                ## these 2 are added to distinguish features on same
 
330
               ## sequence run with different params
 
331
                                my $tag_hash = {
 
332
                                                                type   => $type,
 
333
                                method => $self->analysis_name,
 
334
                                                                };
 
335
                                $self->_add_params_to_result($tag_hash);
 
336
 
 
337
                                ## now make feature object
 
338
                for my $loc (@{$self->{'_parsed_coords'}{$type}} ) {
 
339
                    push  @fts,   Bio::SeqFeature::Generic->new
 
340
                        (-start   => $loc->{'start'},
 
341
                         -end     => $loc->{'end'},
 
342
                         -source  => 'Sopma',
 
343
                         -primary => 'Domain',
 
344
                         -tag => $tag_hash,
 
345
                                 );
 
346
                }               #end of array of strucs of type
 
347
            }                   # end of all 2nd struc elements
 
348
            delete $self->{'_parsed_coords'}; #remove temp data
 
349
            return @fts;
 
350
        }                       #endif BioSeqFeature
 
351
 
 
352
        elsif ($value eq 'meta') {
 
353
            #1st of all make 3 or 4 arrays of scores for each type from column data
 
354
            my %type_scores;
 
355
            for my $aa (@{$self->{'_parsed'}}) {
 
356
                for my $type (qw(struc helix sheet  coil)) {
 
357
                    push @{$type_scores{$type}}, $aa->{$type};
 
358
                }
 
359
                push @{$type_scores{'turn'}}, $aa->{'turn'} if  exists $aa->{'turn'};
 
360
            }
 
361
                        
 
362
                        ## convert to meta sequence array ##
 
363
                        if (!$self->seq->isa("Bio::Seq::Meta::Array")) {
 
364
                         bless ($self->seq, "Bio::Seq::Meta::Array");
 
365
                                }
 
366
            $self->seq->isa("Bio::Seq::MetaI")
 
367
                || $self->throw("$self is not a Bio::Seq::MetaI");
 
368
 
 
369
 
 
370
            $Bio::Seq::Meta::Array::DEFAULT_NAME = 'Sopma_struc';
 
371
            for my $struc_type (keys %type_scores) {
 
372
                my $meta_name = "Sopma". "_" . "$struc_type";
 
373
                                if ($run_id) {
 
374
                                        $meta_name .= "|$run_id";
 
375
                                }
 
376
                my @meta = map{$_->{$struc_type}} @{$self->{'_parsed'}};
 
377
                if (grep{$_ eq $meta_name}$self->seq->meta_names >0) {
 
378
                    $self->warn ("$meta_name already exists , not overwriting!");
 
379
                    next;
 
380
                }
 
381
                $self->seq->named_meta($meta_name,\@meta );
 
382
            }
 
383
            # return  seq array object implementing meta sequence #
 
384
            return $self->seq;
 
385
 
 
386
        }
 
387
                ## else return parsed data if $value is defined
 
388
                 else {
 
389
            return $self->{'_parsed'};
 
390
        }
 
391
 
 
392
    }                           #endif ($value)
 
393
    #return raw result if no return format stated
 
394
    return $self->{'_result'};
 
395
}
 
396
 
 
397
sub _init {
 
398
    my $self = shift;
 
399
    $self->url($URL);
 
400
    $self->{'_ANALYSIS_SPEC'} = $ANALYSIS_SPEC;
 
401
    $self->{'_INPUT_SPEC'}    = $INPUT_SPEC;
 
402
    $self->{'_RESULT_SPEC'}   = $RESULT_SPEC;
 
403
    $self->{'_ANALYSIS_NAME'} = $ANALYSIS_NAME;
 
404
    return $self;
 
405
}
 
406
 
 
407
sub _get_2ary_coords {
 
408
    #helper sub for result;
 
409
    ##extracts runs of structure > MIN_STRUC_LENresidues or less if Turn:
 
410
    #i.e., helical prediction for 1 residue isn't very meaningful...
 
411
    ## and poulates array of hashes with start/end values.
 
412
    ##keys of $Result are 'H' 'T' 'C' 'E'. 
 
413
    my ($self) = @_;
 
414
    my @prot = @{$self->{'_parsed'}};
 
415
    my %Result;
 
416
    for (my $index = 0; $index <= $#prot; $index++) {
 
417
 
 
418
        my $type        = $prot[$index]{'struc'};
 
419
        next unless $type && $type =~ /[HTCE]/;
 
420
        my $length = 1;
 
421
        for (my $j = $index + 1; $j <= $#prot; $j++) {
 
422
            my $test = $prot[$j];
 
423
            if ($test->{'struc'} eq $type) {
 
424
                $length++;
 
425
            } elsif (  $length > MIN_STRUC_LEN  ||
 
426
                       ($length <= MIN_STRUC_LEN && $type eq 'T') ) {
 
427
                push @{$Result{$type}}, {start => $index + 1 ,  end => $j};
 
428
                $index += $length -1;
 
429
                last;
 
430
            } else {
 
431
                $index += $length - 1;
 
432
                last;
 
433
            }
 
434
        }
 
435
    }
 
436
    $self->{'_parsed_coords'} = \%Result; #temp assignment
 
437
}
 
438
 
 
439
sub  _run {
 
440
    my $self  = shift;
 
441
    $self->delay(1);
 
442
    # delay repeated calls by default by 3 sec, set delay() to change
 
443
    $self->sleep;
 
444
    $self->status('TERMINATED_BY_ERROR');
 
445
    my $request = POST 'http://npsa-pbil.ibcp.fr/cgi-bin/secpred_sopma.pl',
 
446
        Content_Type => 'form-data',
 
447
            Content  => [title     => "",
 
448
                         notice    => $self->seq->seq,
 
449
                         ali_width => 70,
 
450
                         states    => $self->states,
 
451
                         threshold => $self->similarity_threshold ,
 
452
                         width     => $self->window_width,
 
453
                        ];
 
454
 
 
455
    my $text = $self->request($request)->content;
 
456
    return $self unless $text;
 
457
 
 
458
    #### get text only version of results ## 
 
459
    my ($next) = $text =~ /Prediction.*?=(.*?)>/;
 
460
    my $out    = "http://npsa-pbil.ibcp.fr/". "$next";
 
461
    my $req2   = HTTP::Request->new(GET=>$out);
 
462
    my $resp2  = $self->request ($req2);
 
463
    $self->{'_result'} = $resp2->content;
 
464
    $self->status('COMPLETED') if $resp2 ne '';
 
465
    return $self;
 
466
}
 
467
 
 
468
sub _add_params_to_result{
 
469
        ## called when making Seqfeature objects
 
470
        my ($self, $tag_hash) = @_;
 
471
        my $hash;
 
472
        ## adds input parameter values to SeqFeatureI results where multiple
 
473
    ##  parameter values are possible. Only adds value if not default. 
 
474
        map{$hash->{$_->{'name'}} = $_}@{$self->input_spec()};
 
475
 
 
476
        for my $p (keys %$hash) {
 
477
                if (!ref($self->$p) && $self->$p ne $hash->{$p}{'default'}) {
 
478
                        $tag_hash->{$p} = $self->$p;
 
479
                }
 
480
        }
 
481
                                 
 
482
}
 
483
 
 
484
 
 
485
1;