lib/Bio/Tools/Coil.pm

   1 # Parser module for Coil Bio::Tools::Coil
   2 #
   3 # Based on the EnsEMBL module Bio::EnsEMBL::Pipeline::Runnable::Protein::Coil
   4 # originally written by Marc Sohrmann (ms2@sanger.ac.uk)
   5 # Written in BioPipe by Balamurugan Kumarasamy <savikalpa@fugu-sg.org>
   6 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   7 #
   8 # Cared for by the Fugu Informatics team (fuguteam@fugu-sg.org)
   9
  10 # You may distribute this module under the same terms as perl itself
  11 #
  12 # POD documentation - main docs before the code
  13
  14 =head1 NAME
  15
  16 Bio::Tools::Coil - parser for Coil output
  17
  18 =head1 SYNOPSIS
  19
  20  use Bio::Tools::Coil
  21  my $parser = Bio::Tools::Coil->new();
  22  while( my $sp_feat = $parser->next_result($file) ) {
  23        #do something
  24        #eg
  25        push @sp_feat, $sp_feat;
  26  }
  27
  28 =head1 DESCRIPTION
  29
  30  Parser for Coil output
  31
  32 =head1 FEEDBACK
  33
  34 =head2 Mailing Lists
  35
  36  User feedback is an integral part of the evolution of this and other
  37  Bioperl modules. Send your comments and suggestions preferably to
  38  the Bioperl mailing list.  Your participation is much appreciated.
  39
  40   bioperl-l@bioperl.org                  - General discussion
  41   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  42
  43 =head2 Support
  44
  45 Please direct usage questions or support issues to the mailing list:
  46
  47 I<bioperl-l@bioperl.org>
  48
  49 rather than to the module maintainer directly. Many experienced and
  50 reponsive experts will be able look at the problem and quickly
  51 address it. Please include a thorough description of the problem
  52 with code and data examples if at all possible.
  53
  54 =head2 Reporting Bugs
  55
  56 Report bugs to the Bioperl bug tracking system to help us keep track
  57 of the bugs and their resolution. Bug reports can be submitted via the
  58 web:
  59
  60   https://github.com/bioperl/bioperl-live/issues
  61
  62 =head1 AUTHOR
  63
  64  Based on the EnsEMBL module Bio::EnsEMBL::Pipeline::Runnable::Protein::Coil
  65  originally written by Marc Sohrmann (ms2@sanger.ac.uk)
  66  Written in BioPipe by Balamurugan Kumarasamy <savikalpa@fugu-sg.org>
  67 # Please direct questions and support issues to <bioperl-l@bioperl.org>
  68 #
  69  Cared for by the Fugu Informatics team (fuguteam@fugu-sg.org)
  70
  71 =head1 APPENDIX
  72
  73  The rest of the documentation details each of the object methods.
  74  Internal methods are usually preceded with a _
  75
  76
  77 =cut
  78
  79 package Bio::Tools::Coil;
  80
  81 use strict;
  82
  83 use Bio::SeqFeature::FeaturePair;
  84 use Bio::SeqFeature::Generic;
  85 use base qw(Bio::Root::Root Bio::Root::IO);
  86
  87
  88
  89 sub new {
  90     my($class,@args) = @_;
  91
  92     my $self = $class->SUPER::new(@args);
  93     $self->_initialize_io(@args);
  94
  95     return $self;
  96 }
  97
  98 =head2 parse_results
  99
 100  Title   : parse_results
 101  Usage   : obj->parse_results
 102  Function: Parses the coil output. Automatically called by
 103            next_result() if not yet done.
 104  Example :
 105  Returns :
 106
 107 =cut
 108
 109 sub parse_results {
 110     my ($self,$resfile) = @_;
 111     my $filehandle = $resfile;
 112     my %result_hash =_read_fasta($filehandle);#bala no file handle
 113         my @ids = keys %result_hash;
 114     my @feats;
 115     foreach my $id (keys %result_hash){
 116         my $pep = reverse ($result_hash{$id});
 117         my $count = my $switch = 0;
 118         my ($start, $end);
 119         while (my $aa = chop $pep) {
 120             $count++;
 121             if (!$switch && $aa eq "x") {
 122                 $start = $count;
 123                 $switch = 1;
 124             }
 125             elsif ($switch && $aa ne "x") {
 126                 $end = $count-1;
 127                 my (%feature);
 128                 $feature{name}       = $id;
 129                 $feature{start}      = $start;
 130                 $feature{end}        = $end;
 131                 $feature{source}     = "Coils";
 132                 $feature{primary}    = 'ncoils';
 133                 ($feature{program})   = 'ncoils';
 134                 $feature{logic_name} = 'Coils';
 135                 my $new_feat = $self->create_feature (\%feature);
 136                 $self->_add_prediction($new_feat);
 137                 $switch = 0;
 138             }
 139         }
 140     }
 141
 142     $self->_predictions_parsed(1);
 143
 144 }
 145
 146
 147 =head2 next_result
 148
 149  Title   : next_result
 150  Usage   : while($feat = $coil->next_result($file)) {
 151                   # do something
 152            }
 153  Function: Returns the next protein feature of the coil output file
 154  Returns :
 155  Args    :
 156
 157 =cut
 158
 159 sub next_result {
 160
 161     my ($self,$resfile) = @_;
 162     my $gene;
 163
 164     $self->parse_results($resfile) unless $self->_predictions_parsed();
 165
 166     $gene = $self->_result();
 167
 168     return $gene;
 169
 170 }
 171
 172 =head2 _result
 173
 174  Title   : _result
 175  Usage   : $feat = $obj->_result()
 176  Function: internal
 177  Example :
 178  Returns :
 179
 180 =cut
 181
 182 sub _result {
 183     my ($self) = @_;
 184
 185     return unless(exists($self->{'_feats'}) && @{$self->{'_feats'}});
 186     return shift(@{$self->{'_feats'}});
 187 }
 188
 189 =head2 _add_prediction
 190
 191  Title   : _add_prediction()
 192  Usage   : $obj->_add_prediction($feat)
 193  Function: internal
 194  Example :
 195  Returns :
 196
 197 =cut
 198
 199 sub _add_prediction {
 200     my ($self, $gene) = @_;
 201
 202     if(! exists($self->{'_feats'})) {
 203         $self->{'_feats'} = [];
 204     }
 205     push(@{$self->{'_feats'}}, $gene);
 206 }
 207
 208 =head2 _predictions_parsed
 209
 210  Title   : _predictions_parsed
 211  Usage   : $obj->_predictions_parsed
 212  Function: internal
 213  Example :
 214  Returns : TRUE or FALSE
 215
 216 =cut
 217
 218 sub _predictions_parsed {
 219     my ($self, $val) = @_;
 220
 221     $self->{'_preds_parsed'} = $val if $val;
 222     if(! exists($self->{'_preds_parsed'})) {
 223         $self->{'_preds_parsed'} = 0;
 224     }
 225     return $self->{'_preds_parsed'};
 226 }
 227
 228
 229 =head2 create_feature
 230
 231  Title   : create_feature
 232  Usage   : obj->create_feature(\%feature)
 233  Function: Internal(not to be used directly)
 234  Returns :
 235  Args    :
 236
 237
 238 =cut
 239
 240 sub create_feature {
 241     my ($self, $feat) = @_;
 242
 243
 244     # create feature object
 245     my $feature = Bio::SeqFeature::Generic->new
 246         (-seq_id     => $feat->{name},
 247          -start       => $feat->{start},
 248          -end         => $feat->{end},
 249          -score       => $feat->{score},
 250          -source      => $feat->{source},
 251          -primary     => $feat->{primary},
 252          -logic_name  => $feat->{logic_name},
 253          );
 254     $feature->add_tag_value('evalue',0);
 255     $feature->add_tag_value('percent_id','NULL');
 256     $feature->add_tag_value("hid",$feat->{primary});
 257
 258
 259     return $feature;
 260
 261 }
 262
 263 =head2 _read_fasta
 264
 265  Title   : _read_fasta
 266  Usage   : obj->_read_fasta($file)
 267  Function: Internal(not to be used directly)
 268  Returns :
 269  Args    :
 270
 271
 272 =cut
 273
 274 sub _read_fasta {
 275     local (*FILE) = @_;
 276     my( $id , $seq , %name2seq);#bala
 277         while (<FILE>) {
 278             chomp;              #bala
 279             if (/^>(\S+)/) {
 280
 281                 my $new_id = $1;
 282                 if ($id) {
 283                     $name2seq{$id} = $seq;
 284                 }
 285                 $id = $new_id ; $seq = "" ;
 286             } elsif (eof) {
 287                 if ($id) {
 288                     $seq .= $_ ;#bala line instead of $_
 289                     $name2seq{$id} = $seq;
 290                 }
 291             }
 292             else {
 293                 $seq .= $_;
 294             }
 295         }
 296     return %name2seq;
 297 }
 298
 299 1;
 300
 301