Bio/Coordinate/Result.pm

   1 # $Id$
   2 #
   3 # bioperl module for Bio::Coordinate::Result
   4 #
   5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   6 #
   7 # Cared for by Heikki Lehvaslaiho <heikki-at-bioperl-dot-org>
   8 #
   9 # Copyright Heikki Lehvaslaiho
  10 #
  11 # You may distribute this module under the same terms as perl itself
  12
  13 # POD documentation - main docs before the code
  14
  15 =head1 NAME
  16
  17 Bio::Coordinate::Result - Results from coordinate transformation
  18
  19 =head1 SYNOPSIS
  20
  21   use Bio::Coordinate::Result;
  22
  23   #get results from a Bio::Coordinate::MapperI
  24   $matched = $result->each_match;
  25
  26 =head1 DESCRIPTION
  27
  28 The results from Bio::Coordinate::MapperI are kept in an object which
  29 itself is a split location, See L<Bio::Location::Split>. The results
  30 are either Matches or Gaps.  See L<Bio::Coordinate::Result::Match> and
  31 L<Bio::Coordinate::Result::Gap>.
  32
  33 If only one Match is returned, there is a convenience method of
  34 retrieving it or accessing its methods. Same holds true for a Gap.
  35
  36 =head1 FEEDBACK
  37
  38 =head2 Mailing Lists
  39
  40 User feedback is an integral part of the evolution of this and other
  41 Bioperl modules. Send your comments and suggestions preferably to the
  42 Bioperl mailing lists  Your participation is much appreciated.
  43
  44   bioperl-l@bioperl.org                  - General discussion
  45   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  46
  47 =head2 Support
  48
  49 Please direct usage questions or support issues to the mailing list:
  50
  51 L<bioperl-l@bioperl.org>
  52
  53 rather than to the module maintainer directly. Many experienced and
  54 reponsive experts will be able look at the problem and quickly
  55 address it. Please include a thorough description of the problem
  56 with code and data examples if at all possible.
  57
  58 =head2 Reporting Bugs
  59
  60 report bugs to the Bioperl bug tracking system to help us keep track
  61 the bugs and their resolution.  Bug reports can be submitted via the
  62 web:
  63
  64   http://bugzilla.open-bio.org/
  65
  66 =head1 AUTHOR - Heikki Lehvaslaiho
  67
  68 Email:  heikki-at-bioperl-dot-org
  69
  70 =head1 APPENDIX
  71
  72 The rest of the documentation details each of the object
  73 methods. Internal methods are usually preceded with a _
  74
  75 =cut
  76
  77
  78 # Let the code begin...
  79
  80 package Bio::Coordinate::Result;
  81 use strict;
  82
  83
  84 use base qw(Bio::Location::Split Bio::Coordinate::ResultI);
  85
  86
  87 =head2 add_location
  88
  89  Title   : add_sub_Location
  90  Usage   : $obj->add_sub_Location($variant)
  91  Function:
  92
  93            Pushes one Bio::LocationI into the list of variants.
  94
  95  Example :
  96  Returns : 1 when succeeds
  97  Args    : Location object
  98
  99 =cut
 100
 101 sub add_sub_Location {
 102   my ($self,$value) = @_;
 103   if( ! $value ) {
 104       $self->warn("provding an empty value for location\n");
 105       return;
 106   }
 107   $self->throw("Is not a Bio::LocationI but [$value]")
 108       unless $value->isa('Bio::LocationI');
 109
 110   $self->{'_match'} = $value
 111       if $value->isa('Bio::Coordinate::Result::Match');
 112
 113   $self->{'_gap'} = $value
 114       if $value->isa('Bio::Coordinate::Result::Gap');
 115
 116   $self->SUPER::add_sub_Location($value);
 117
 118 }
 119
 120 =head2 add_result
 121
 122  Title   : add_result
 123  Usage   : $obj->add_result($result)
 124  Function: Adds the contents of one Bio::Coordinate::Result
 125  Example :
 126  Returns : 1 when succeeds
 127  Args    : Result object
 128
 129 =cut
 130
 131 sub add_result {
 132   my ($self,$value) = @_;
 133
 134   $self->throw("Is not a Bio::Coordinate::Result but [$value]")
 135       unless $value->isa('Bio::Coordinate::Result');
 136
 137   map { $self->add_sub_Location($_) } $value->each_Location;
 138 }
 139
 140 =head2 seq_id
 141
 142   Title   : seq_id
 143   Usage   : my $seqid = $location->seq_id();
 144   Function: Get/Set seq_id that location refers to
 145
 146             We override this here in order to propagate to all sublocations
 147             which are not remote (provided this root is not remote either)
 148
 149   Returns : seq_id
 150   Args    : [optional] seq_id value to set
 151
 152
 153 =cut
 154
 155 sub seq_id {
 156     my ($self, $seqid) = @_;
 157
 158     my @ls = $self->each_Location;
 159     if (@ls) {
 160         return $ls[0]->seq_id;
 161     } else {
 162         return;
 163     }
 164 }
 165
 166
 167 =head2 Convenience methods
 168
 169 These methods are shortcuts to Match and Gap locations.
 170
 171 =cut
 172
 173 =head2 each_gap
 174
 175  Title   : each_gap
 176  Usage   : $obj->each_gap();
 177  Function:
 178
 179             Returns a list of Bio::Coordianate::Result::Gap objects.
 180
 181  Returns : list of gaps
 182  Args    : none
 183
 184 =cut
 185
 186 sub each_gap {
 187    my ($self) = @_;
 188
 189    my @gaps;
 190    foreach my $gap ($self->each_Location) {
 191        push @gaps, $gap if $gap->isa('Bio::Coordinate::Result::Gap');
 192    }
 193    return @gaps;
 194
 195 }
 196
 197
 198 =head2 each_match
 199
 200  Title   : each_match
 201  Usage   : $obj->each_match();
 202  Function:
 203
 204             Returns a list of Bio::Coordinate::Result::Match objects.
 205
 206  Returns : list of Matchs
 207  Args    : none
 208
 209 =cut
 210
 211 sub each_match {
 212    my ($self) = @_;
 213
 214    my @matches;
 215    foreach my $match ($self->each_Location) {
 216        push @matches, $match if $match->isa('Bio::Coordinate::Result::Match');
 217    }
 218    return @matches;
 219 }
 220
 221 =head2 match
 222
 223  Title   : match
 224  Usage   : $match_object = $obj->match(); #or
 225            $gstart = $obj->gap->start;
 226  Function: Read only method for retrieving or accessing the match object.
 227  Returns : one Bio::Coordinate::Result::Match
 228  Args    :
 229
 230 =cut
 231
 232 sub match {
 233    my ($self) = @_;
 234
 235    $self->warn("More than one match in results")
 236        if $self->each_match > 1 and $self->verbose > 0;
 237    unless (defined $self->{'_match'} ) {
 238        my @m = $self->each_match;
 239        $self->{'_match'} = $m[-1];
 240    }
 241    return $self->{'_match'};
 242 }
 243
 244 =head2 gap
 245
 246  Title   : gap
 247  Usage   : $gap_object = $obj->gap(); #or
 248            $gstart = $obj->gap->start;
 249  Function: Read only method for retrieving or accessing the gap object.
 250  Returns : one Bio::Coordinate::Result::Gap
 251  Args    :
 252
 253 =cut
 254
 255 sub gap {
 256    my ($self) = @_;
 257
 258    $self->warn("More than one gap in results")
 259        if $self->each_gap > 1 and $self->verbose > 0;
 260    unless (defined $self->{'_gap'} ) {
 261        my @m = $self->each_gap;
 262        $self->{'_gap'} = $m[-1];
 263    }
 264    return $self->{'_gap'};
 265 }
 266
 267
 268 =head2 purge_gaps
 269
 270  Title   : purge_gaps
 271  Usage   : $gap_count = $obj->purge_gaps;
 272  Function: remove all gaps from the Result
 273  Returns : count of removed gaps
 274  Args    :
 275
 276 =cut
 277
 278 sub purge_gaps {
 279     my ($self) = @_;
 280     my @matches;
 281     my $count = 0;
 282
 283     foreach my $loc ($self->each_Location) {
 284         if ($loc->isa('Bio::Coordinate::Result::Match')) {
 285             push @matches, $loc;
 286         } else {
 287             $count++
 288         }
 289     }
 290     @{$self->{'_sublocations'}} = ();
 291     delete $self->{'_gap'} ;
 292     push @{$self->{'_sublocations'}}, @matches;
 293     return $count;
 294 }
 295
 296
 297 1;