Bio/Tools/Grail.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::Tools::Grail
   4 #
   5 # Cared for by Jason Stajich <jason-at-bioperl.org>
   6 #
   7 # Copyright Jason Stajich
   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::Grail - Results of one Grail run
  16
  17 =head1 SYNOPSIS
  18
  19    $grail = Bio::Tools::Grail->new(-file => 'result.grail');
  20    # filehandle:
  21    $grail = Bio::Tools::Grail->new( -fh  => \*INPUT );
  22
  23    # parse the results
  24    while($gene = $grail->next_prediction()) {
  25        # $gene is an instance of Bio::Tools::Prediction::Gene
  26
  27        # $gene->exons() returns an array of
  28        # Bio::Tools::Prediction::Exon objects
  29        # all exons:
  30        @exon_arr = $gene->exons();
  31
  32        # initial exons only
  33        @init_exons = $gene->exons('Initial');
  34        # internal exons only
  35        @intrl_exons = $gene->exons('Internal');
  36        # terminal exons only
  37        @term_exons = $gene->exons('Terminal');
  38        # singleton exons only -- should be same as $gene->exons() because
  39        # there are no other exons supposed to exist in this structure
  40        @single_exons = $gene->exons('Single');
  41    }
  42
  43    # essential if you gave a filename at initialization (otherwise the file
  44    # will stay open)
  45    $genscan->close();
  46
  47 =head1 DESCRIPTION
  48
  49 The Grail module provides a parser for Grail gene structure prediction
  50 output.
  51
  52
  53 =head1 FEEDBACK
  54
  55 =head2 Mailing Lists
  56
  57 User feedback is an integral part of the evolution of this and other
  58 Bioperl modules. Send your comments and suggestions preferably to one
  59 of the Bioperl mailing lists.  Your participation is much appreciated.
  60
  61   bioperl-l@bioperl.org                  - General discussion
  62   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  63
  64 =head2 Reporting Bugs
  65
  66 Report bugs to the Bioperl bug tracking system to help us keep track
  67 the bugs and their resolution.  Bug reports can be submitted via the
  68 web:
  69
  70   http://bugzilla.open-bio.org/
  71
  72 =head1 AUTHOR - Jason Stajich
  73
  74 Email jason-at-bioperl.org
  75
  76 =head1 APPENDIX
  77
  78 The rest of the documentation details each of the object
  79 methods. Internal methods are usually preceded with a _
  80
  81 =cut
  82
  83 # Let the code begin...
  84
  85 package Bio::Tools::Grail;
  86 use strict;
  87
  88 use Bio::Tools::Prediction::Gene;
  89 use Bio::Tools::Prediction::Exon;
  90 use Symbol;
  91
  92 use base qw(Bio::Root::IO Bio::Root::Root);
  93
  94 sub new {
  95   my($class,@args) = @_;
  96
  97   my $self = $class->SUPER::new(@args);
  98   $self->_initialize_io(@args);
  99
 100   return $self;
 101 }
 102
 103 =head2 next_prediction
 104
 105  Title   : next_prediction
 106  Usage   : while($gene = $grail->next_prediction()) {
 107                   # do something
 108            }
 109  Function: Returns the next gene structure prediction of the Grail result
 110            file. Call this method repeatedly until FALSE is returned.
 111
 112  Example :
 113  Returns : A Bio::Tools::Prediction::Gene object.
 114  Args    :
 115
 116 =cut
 117
 118 sub next_prediction {
 119     my ($self) = @_;
 120
 121     # get next gene structure
 122     my $gene = $self->_prediction();
 123
 124     if($gene) {
 125         # fill in predicted protein, and if available the predicted CDS
 126         #
 127         my ($id, $seq);
 128         # use the seq stack if there's a seq on it
 129         my $seqobj = pop(@{$self->{'_seqstack'}});
 130         if(! $seqobj) {
 131             # otherwise read from input stream
 132             ($id, $seq) = $self->_read_fasta_seq();
 133             $seqobj = Bio::PrimarySeq->new('-seq' => $seq,
 134                                            '-display_id' => $id,
 135                                            '-alphabet' => "protein");
 136         }
 137         # check that prediction number matches the prediction number
 138         # indicated in the sequence id (there may be incomplete gene
 139         # predictions that contain only signals with no associated protein
 140         # and CDS, like promoters, poly-A sites etc)
 141         $gene->primary_tag() =~ /[^0-9]([0-9]+)$/;
 142         my $prednr = $1;
 143         if($seqobj->display_id() !~ /_predicted_\w+_$prednr\|/) {
 144             # this is not our sequence, so push back for the next prediction
 145             push(@{$self->{'_seqstack'}}, $seqobj);
 146         } else {
 147             $gene->predicted_protein($seqobj);
 148             # CDS prediction, too?
 149             if($self->_has_cds()) {
 150                 ($id, $seq) = $self->_read_fasta_seq();
 151                 $seqobj = Bio::PrimarySeq->new('-seq' => $seq,
 152                                                '-display_id' => $id,
 153                                                '-alphabet' => "dna");
 154                 $gene->predicted_cds($seqobj);
 155             }
 156         }
 157     }
 158     return $gene;
 159 }
 160
 161 =head2 _parse_predictions
 162
 163  Title   : _parse_predictions()
 164  Usage   : $obj->_parse_predictions()
 165  Function: Parses the prediction section. Automatically called by
 166            next_prediction() if not yet done.
 167  Example :
 168  Returns :
 169
 170 =cut
 171
 172 sub _parse_predictions {
 173     my ($self) = @_;
 174
 175     # code needs to go here
 176
 177     $self->_predictions_parsed(1);
 178 }
 179
 180 =head2 _prediction
 181
 182  Title   : _prediction()
 183  Usage   : $gene = $obj->_prediction()
 184  Function: internal
 185  Example :
 186  Returns :
 187
 188 =cut
 189
 190 sub _prediction {
 191     my ($self) = @_;
 192
 193     return unless(exists($self->{'_preds'}) && @{$self->{'_preds'}});
 194     return shift(@{$self->{'_preds'}});
 195 }
 196
 197 =head2 _add_prediction
 198
 199  Title   : _add_prediction()
 200  Usage   : $obj->_add_prediction($gene)
 201  Function: internal
 202  Example :
 203  Returns :
 204
 205 =cut
 206
 207 sub _add_prediction {
 208     my ($self, $gene) = @_;
 209
 210     if(! exists($self->{'_preds'})) {
 211         $self->{'_preds'} = [];
 212     }
 213     push(@{$self->{'_preds'}}, $gene);
 214 }
 215
 216 =head2 _predictions_parsed
 217
 218  Title   : _predictions_parsed
 219  Usage   : $obj->_predictions_parsed
 220  Function: internal
 221  Example :
 222  Returns : TRUE or FALSE
 223
 224 =cut
 225
 226 sub _predictions_parsed {
 227     my ($self, $val) = @_;
 228
 229     $self->{'_preds_parsed'} = $val if $val;
 230     if(! exists($self->{'_preds_parsed'})) {
 231         $self->{'_preds_parsed'} = 0;
 232     }
 233     return $self->{'_preds_parsed'};
 234 }
 235
 236 =head2 _has_cds
 237
 238  Title   : _has_cds()
 239  Usage   : $obj->_has_cds()
 240  Function: Whether or not the result contains the predicted CDSs, too.
 241  Example :
 242  Returns : TRUE or FALSE
 243
 244 =cut
 245
 246 sub _has_cds {
 247     my ($self, $val) = @_;
 248
 249     $self->{'_has_cds'} = $val if $val;
 250     if(! exists($self->{'_has_cds'})) {
 251         $self->{'_has_cds'} = 0;
 252     }
 253     return $self->{'_has_cds'};
 254 }
 255
 256 1;