Bio/Coordinate/ExtrapolatingPair.pm

   1 #
   2 # bioperl module for Bio::Coordinate::ExtrapolatingPair
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Heikki Lehvaslaiho <heikki-at-bioperl-dot-org>
   7 #
   8 # Copyright Heikki Lehvaslaiho
   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::Coordinate::ExtrapolatingPair - Continuous match between two coordinate sets
  17
  18 =head1 SYNOPSIS
  19
  20
  21   use Bio::Location::Simple;
  22   use Bio::Coordinate::ExtrapolatingPair;
  23
  24
  25   $match1 = Bio::Location::Simple->new
  26     (-seq_id => 'propeptide', -start => 21, -end => 40, -strand=>1 );
  27   $match2 = Bio::Location::Simple->new
  28     (-seq_id => 'peptide', -start => 1, -end => 20, -strand=>1 );
  29
  30   $pair = Bio::Coordinate::ExtrapolatingPair->
  31     new(-in => $match1,
  32         -out => $match2,
  33         -strict => 1
  34        );
  35
  36   $pos = Bio::Location::Simple->new
  37       (-start => 40, -end => 60, -strand=> 1 );
  38   $res = $pair->map($pos);
  39   $res->start eq 20;
  40   $res->end eq 20;
  41
  42 =head1 DESCRIPTION
  43
  44 This class represents a one continuous match between two coordinate
  45 systems represented by Bio::Location::Simple objects. The relationship
  46 is directed and reversible. It implements methods to ensure internal
  47 consistency, and map continuous and split locations from one
  48 coordinate system to another.
  49
  50 This class is an elaboration of Bio::Coordinate::Pair. The map
  51 function returns only matches which is the mode needed most of
  52 tehtime. By default the matching regions between coordinate systems
  53 are boundless, so that you can say e.g. that gene starts from here in
  54 the chromosomal coordinate system and extends indefinetely in both
  55 directions. If you want to define the matching regions exactly, you
  56 can do that and set strict() to true.
  57
  58
  59 =head1 FEEDBACK
  60
  61 =head2 Mailing Lists
  62
  63 User feedback is an integral part of the evolution of this and other
  64 Bioperl modules. Send your comments and suggestions preferably to the
  65 Bioperl mailing lists  Your participation is much appreciated.
  66
  67   bioperl-l@bioperl.org                  - General discussion
  68   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  69
  70 =head2 Support
  71
  72 Please direct usage questions or support issues to the mailing list:
  73
  74 I<bioperl-l@bioperl.org>
  75
  76 rather than to the module maintainer directly. Many experienced and
  77 reponsive experts will be able look at the problem and quickly
  78 address it. Please include a thorough description of the problem
  79 with code and data examples if at all possible.
  80
  81 =head2 Reporting Bugs
  82
  83 report bugs to the Bioperl bug tracking system to help us keep track
  84 the bugs and their resolution.  Bug reports can be submitted via the
  85 web:
  86
  87   http://bugzilla.open-bio.org/
  88
  89 =head1 AUTHOR - Heikki Lehvaslaiho
  90
  91 Email:  heikki-at-bioperl-dot-org
  92
  93 =head1 APPENDIX
  94
  95 The rest of the documentation details each of the object
  96 methods. Internal methods are usually preceded with a _
  97
  98 =cut
  99
 100
 101 # Let the code begin...
 102
 103 package Bio::Coordinate::ExtrapolatingPair;
 104 use strict;
 105
 106 # Object preamble - inherits from Bio::Root::Root
 107 use Bio::Root::Root;
 108 use Bio::LocationI;
 109
 110 use base qw(Bio::Coordinate::Pair);
 111
 112
 113 sub new {
 114     my($class,@args) = @_;
 115     my $self = $class->SUPER::new(@args);
 116
 117     my($strict) =
 118         $self->_rearrange([qw(STRICT
 119                              )],
 120                          @args);
 121
 122     $strict  && $self->strict($strict);
 123     return $self;
 124 }
 125
 126
 127 =head2 strict
 128
 129  Title   : strict
 130  Usage   : $obj->strict(1);
 131  Function: Set and read the strictness of the coordinate system.
 132  Example :
 133  Returns : value of input system
 134  Args    : boolean
 135
 136 =cut
 137
 138 sub strict {
 139    my ($self,$value) = @_;
 140    if( defined $value) {
 141        $self->{'_strict'} = 1 if $value;
 142    }
 143    return $self->{'_strict'};
 144 }
 145
 146
 147 =head2 map
 148
 149  Title   : map
 150  Usage   : $newpos = $obj->map($loc);
 151  Function: Map the location from the input coordinate system
 152            to a new value in the output coordinate system.
 153
 154            In extrapolating coodinate system there is no location zero.
 155            Locations are...
 156  Example :
 157  Returns : new location in the output coordinate system or undef
 158  Args    : Bio::Location::Simple
 159
 160 =cut
 161
 162 sub map {
 163    my ($self,$value) = @_;
 164
 165    $self->throw("Need to pass me a value.")
 166        unless defined $value;
 167    $self->throw("I need a Bio::Location, not [$value]")
 168        unless $value->isa('Bio::LocationI');
 169    $self->throw("Input coordinate system not set")
 170        unless $self->in;
 171    $self->throw("Output coordinate system not set")
 172        unless $self->out;
 173
 174    my $match;
 175
 176    if ($value->isa("Bio::Location::SplitLocationI")) {
 177
 178        my $split = Bio::Coordinate::Result->new(-seq_id=>$self->out->seq_id);
 179        foreach my $loc ( sort { $a->start <=> $b->start }
 180                          $value->sub_Location ) {
 181
 182            $match = $self->_map($loc);
 183            $split->add_sub_Location($match) if $match;
 184
 185        }
 186        $split->each_Location ? (return $split) : return ;
 187
 188    } else {
 189        return $self->_map($value);
 190    }
 191 }
 192
 193
 194 =head2 _map
 195
 196  Title   : _map
 197  Usage   : $newpos = $obj->_map($simpleloc);
 198  Function: Internal method that does the actual mapping. Called
 199            multiple times by map() if the location to be mapped is a
 200            split location
 201
 202  Example :
 203  Returns : new location in the output coordinate system or undef
 204  Args    : Bio::Location::Simple
 205
 206 =cut
 207
 208 sub _map {
 209    my ($self,$value) = @_;
 210
 211    my ($offset, $start, $end);
 212
 213    if ($self->strand == -1) {
 214        $offset = $self->in->end + $self->out->start;
 215        $start = $offset - $value->end;
 216        $end = $offset - $value->start ;
 217    } else { # undef, 0 or 1
 218        $offset = $self->in->start - $self->out->start;
 219        $start = $value->start - $offset;
 220        $end = $value->end - $offset;
 221    }
 222
 223    # strict prevents matches outside stated range
 224    if ($self->strict) {
 225        return if $start < 0 and $end < 0;
 226        return if $start > $self->out->end;
 227        $start = 1 if $start < 0;
 228        $end = $self->out->end if $end > $self->out->end;
 229    }
 230
 231    my $match = Bio::Location::Simple->
 232        new(-start => $start,
 233            -end => $end,
 234            -strand => $self->strand,
 235            -seq_id => $self->out->seq_id,
 236            -location_type => $value->location_type
 237           );
 238    $match->strand($match->strand * $value->strand) if $value->strand;
 239    bless $match, 'Bio::Coordinate::Result::Match';
 240
 241    return $match;
 242 }
 243
 244 1;