Bio/Tools/Eponine.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::Tools::Eponine
   4 #
   5 # Cared for by Tania Oh <gisoht@nus.edu.sg>
   6 #
   7 # Copyright Tania Oh
   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::Eponine - Results of one Eponine run
  16
  17 =head1 SYNOPSIS
  18
  19  use Bio::Tools::Eponine;
  20  use strict;
  21     my $seq = "/data/seq.fa";
  22     my $threshold  = "0.999";
  23     my @params = ( -seq => $seq,
  24                    -threshold => $threshold);
  25
  26    my $factory = Bio::Tools::Run::Eponine->new(@params);
  27      # run eponine against fasta
  28         my $r = $factory->run_eponine($seq);
  29         my $parser = Bio::Tools::Eponine->new($r);
  30
  31        while (my $feat = $parser->next_prediction){
  32                 #$feat contains array of SeqFeature
  33                foreach my $orf($feat) {
  34                    print $orf->seq_id. "\n";
  35                }
  36        }
  37
  38 =head1 DESCRIPTION
  39
  40 Parser for Eponine, a probabilistic transcription start site detector
  41 optimized for mammalian genomic sequence. This module inherits off
  42 Bio::Tools::AnalysisResult and therefore implements
  43 Bio::SeqAnalysisParserI (see L<Bio::Tools::AnalysisResult> and
  44 L<Bio::SeqAnalysisParserI>).
  45
  46 =head1 FEEDBACK
  47
  48 =head2 Mailing Lists
  49
  50 User feedback is an integral part of the evolution of this and other
  51 Bioperl modules. Send your comments and suggestions preferably to one
  52 of the Bioperl mailing lists.  Your participation is much appreciated.
  53
  54   bioperl-l@bioperl.org                  - General discussion
  55   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  56
  57 =head2 Reporting Bugs
  58
  59 Report bugs to the Bioperl bug tracking system to help us keep track
  60 the bugs and their resolution.  Bug reports can be submitted via the
  61 web:
  62
  63   http://bugzilla.open-bio.org/
  64
  65 =head1 AUTHOR - Tania Oh
  66
  67 E<lt>gisoht-at-nus.edu.sgE<gt>
  68
  69 =head1 APPENDIX
  70
  71 The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _
  72
  73 =cut
  74
  75
  76 # Let the code begin...
  77
  78
  79 package Bio::Tools::Eponine;
  80 use strict;
  81
  82 use Bio::Tools::Prediction::Gene;
  83 use Bio::Tools::Prediction::Exon;
  84
  85 use base qw(Bio::Tools::AnalysisResult);
  86
  87 sub _initialize_state {
  88     my($self,@args) = @_;
  89
  90     # first call the inherited method!
  91     my $make = $self->SUPER::_initialize_state(@args);
  92
  93     # handle our own parameters
  94
  95     # our private state variables
  96     $self->{'_preds_parsed'} = 0;
  97     #array of Bio::SeqFeatures
  98     $self->{'_flist'} =[];
  99 }
 100
 101 =head2 analysis_method
 102
 103  Usage     : $mzef->analysis_method();
 104  Purpose   : Inherited method. Overridden to ensure that the name matches
 105              /mzef/i.
 106  Returns   : String
 107  Argument  : n/a
 108
 109 =cut
 110
 111 #-------------
 112 sub analysis_method {
 113 #-------------
 114     my ($self, $method) = @_;
 115     if($method && ($method !~ /epo/i)) {
 116         $self->throw("method $method not supported in " . ref($self));
 117     }
 118     return $self->SUPER::analysis_method($method);
 119 }
 120
 121 =head2 next_feature
 122
 123  Title   : next_feature
 124  Usage   : while($gene = $mzef->next_feature()) {
 125                   # do something
 126            }
 127  Function: Returns the next gene structure prediction of the MZEF result
 128            file. Call this method repeatedly until FALSE is returned.
 129
 130            The returned object is actually a SeqFeatureI implementing object.
 131            This method is required for classes implementing the
 132            SeqAnalysisParserI interface, and is merely an alias for
 133            next_prediction() at present.
 134
 135            Note that with the present version of MZEF there will only be one
 136            object returned, because MZEF does not predict individual genes
 137            but just potential internal exons.
 138  Example :
 139  Returns : A Bio::Tools::Prediction::Gene object.
 140  Args    :
 141
 142 =cut
 143
 144 sub next_feature {
 145     my ($self,@args) = @_;
 146     # even though next_prediction doesn't expect any args (and this method
 147     # does neither), we pass on args in order to be prepared if this changes
 148     # ever
 149     return $self->next_prediction(@args);
 150 }
 151
 152 =head2 next_prediction
 153
 154  Title   : next_prediction
 155  Usage   : while($gene = $mzef->next_prediction()) {
 156                   # do something
 157            }
 158  Function: Returns the next gene structure prediction of the MZEF result
 159            file. Call this method repeatedly until FALSE is returned.
 160
 161            Note that with the present version of MZEF there will only be one
 162            object returned, because MZEF does not predict individual genes
 163            but just potential internal exons.
 164  Example :
 165  Returns : A Bio::Tools::Prediction::Gene object.
 166  Args    :
 167
 168 =cut
 169
 170 sub next_prediction {
 171     my ($self) = @_;
 172     my $gene;
 173
 174     # if the prediction section hasn't been parsed yet, we do this now
 175     $self->_parse_predictions() unless $self->_predictions_parsed();
 176
 177     # return the next gene structure (transcript)
 178     return $self->_prediction();
 179 }
 180
 181 =head2 _parse_predictions
 182
 183  Title   : _parse_predictions()
 184  Usage   : $obj->_parse_predictions()
 185  Function: Parses the prediction section. Automatically called by
 186            next_prediction() if not yet done.
 187  Example :
 188  Returns :
 189
 190 =cut
 191
 192 sub _parse_predictions {
 193     my ($self) = @_;
 194
 195     while(defined($_ = $self->_readline())) {
 196         if (! /^\#/){ #ignore introductory lines
 197
 198               my @element = split;
 199               my (%feature);
 200               $feature {name} = $element[0];
 201               $feature {score} = $element[5];
 202               $feature {start} = $element[3];
 203               $feature {end} = $element[4];
 204               $feature {strand} = $element[6];
 205               $feature {source}= 'Eponine';
 206               $feature {primary}= 'TSS';
 207               $feature {program} = 'eponine-scan';
 208               $feature {program_version} = '2';
 209
 210               $self->create_feature(\%feature);
 211                     next;
 212
 213         }
 214     }
 215     $self->_predictions_parsed(1);
 216 }
 217
 218 =head2 create_feature
 219
 220     Title   :   create_feature
 221     Usage   :   obj->create_feature($feature)
 222     Function:   Returns an array of features
 223     Returns :   Returns an array of features
 224     Args    :   none
 225
 226 =cut
 227
 228 sub create_feature {
 229     my ($self, $feat) = @_;
 230      #create and fill Bio::EnsEMBL::Seqfeature object
 231
 232       my $tss = Bio::SeqFeature::Generic->new
 233                     (   -seq_id  => $feat->{'name'},
 234                         -start   => $feat->{'start'},
 235                         -end     => $feat->{'end'},
 236                         -strand  => $feat->{'strand'},
 237                         -score   => $feat->{'score'},
 238                         -source_tag  => $feat->{'source'},
 239                         -primary_tag => $feat->{'primary'});
 240
 241
 242
 243   if ($tss) {
 244          # add to _flist
 245       push(@{$self->{'_flist'}}, $tss);
 246    }
 247
 248    #print $tss->gff_string;
 249 }
 250
 251
 252
 253
 254
 255
 256 =head2 _prediction
 257
 258  Title   : _prediction()
 259  Usage   : $gene = $obj->_prediction()
 260  Function: internal
 261  Example :
 262  Returns :
 263
 264 =cut
 265
 266 sub _prediction {
 267     my ($self) = @_;
 268
 269     return unless(exists($self->{'_flist'}) && @{$self->{'_flist'}});
 270     return shift(@{$self->{'_flist'}});
 271 }
 272
 273 =head2 _predictions_parsed
 274
 275  Title   : _predictions_parsed
 276  Usage   : $obj->_predictions_parsed
 277  Function: internal
 278  Example :
 279  Returns : TRUE or FALSE
 280
 281 =cut
 282
 283 sub _predictions_parsed {
 284     my ($self, $val) = @_;
 285
 286     $self->{'_preds_parsed'} = $val if $val;
 287     # array of pre-parsed predictions
 288     if(! exists($self->{'_preds_parsed'})) {
 289         $self->{'_preds_parsed'} = 0;
 290     }
 291     return $self->{'_preds_parsed'};
 292 }
 293
 294
 295 1;