File Coverage

Bio/Map/Relative.pm
Criterion Covered Total %
statement 66 68 97.0
branch 38 52 73.0
condition 6 11 54.5
subroutine 10 10 100.0
pod 7 7 100.0
total 127 148 85.8


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::Map::Relative
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Sendu Bala
7             #
8             # Copyright Sendu Bala
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::Map::Relative - Represents what a Position's coordiantes are relative to.
17              
18             =head1 SYNOPSIS
19              
20             # Get a Bio::Map::PositionI somehow
21             my $pos = Bio::Map::Position->new(-value => 100);
22              
23             # its co-ordinates are implicitly relative to the start of its map
24             my $implicit_relative = $pos->relative;
25             my $type = $implicit_relative->type; # $type eq 'map'
26             my $value = $implicit_relative->$type(); # $value == 0
27              
28             # make its co-ordinates relative to another Position
29             my $pos_we_are_relative_to = Bio::Map::Position->new(-value => 200);
30             my $relative = Bio::Map::Relative->new(-position => $pos_we_are_relative_to);
31             $pos->relative($relative);
32              
33             # Get the start co-ordinate of $pos relative to $pos_we_are_relative_to
34             my $start = $pos->start; # $start == 100
35              
36             # Get the start co-ordinate of $pos relative to the start of the map
37             my $abs_start = $relative->absolute_conversion($pos); # $abs_start == 300
38             # - or -
39             $pos->absolute(1);
40             my $abs_start = $pos->start; # $abs_start == 300
41             $pos->absolute(0);
42              
43             # Get the start co-ordinate of $pos relative to a third Position
44             my $pos_frame_of_reference = Bio::Map::Position->new(-value => 10);
45             my $relative2 = Bio::Map::Relative->new(-position => $pos_frame_of_reference);
46             my $start = $pos->start($relative2); # $start == 290
47              
48             =head1 DESCRIPTION
49              
50             A Relative object is used to describe what the co-ordinates (numerical(),
51             start(), end()) of a Position are relative to. By default they are
52             implicitly assumed to be relative to the start of the map the Position is on.
53             But setting the relative() of a Position to one of these objects lets us
54             define otherwise.
55              
56             =head1 FEEDBACK
57              
58             =head2 Mailing Lists
59              
60             User feedback is an integral part of the evolution of this and other
61             Bioperl modules. Send your comments and suggestions preferably to
62             the Bioperl mailing list. Your participation is much appreciated.
63              
64             bioperl-l@bioperl.org - General discussion
65             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
66              
67             =head2 Support
68              
69             Please direct usage questions or support issues to the mailing list:
70              
71             I
72              
73             rather than to the module maintainer directly. Many experienced and
74             reponsive experts will be able look at the problem and quickly
75             address it. Please include a thorough description of the problem
76             with code and data examples if at all possible.
77              
78             =head2 Reporting Bugs
79              
80             Report bugs to the Bioperl bug tracking system to help us keep track
81             of the bugs and their resolution. Bug reports can be submitted via the
82             web:
83              
84             https://github.com/bioperl/bioperl-live/issues
85              
86             =head1 AUTHOR - Sendu Bala
87              
88             Email bix@sendu.me.uk
89              
90             =head1 APPENDIX
91              
92             The rest of the documentation details each of the object methods.
93             Internal methods are usually preceded with a _
94              
95             =cut
96              
97             # Let the code begin...
98              
99             package Bio::Map::Relative;
100 9     9   54 use strict;
  9         15  
  9         248  
101 9     9   44 use Scalar::Util qw(looks_like_number);
  9         14  
  9         352  
102              
103 9     9   42 use base qw(Bio::Root::Root Bio::Map::RelativeI);
  9         14  
  9         2465  
104              
105             =head2 new
106              
107             Title : new
108             Usage : my $relative = Bio::Map::Relative->new();
109             Function: Build a new Bio::Map::Relative object.
110             Returns : Bio::Map::Relative object
111             Args : -map => int : coordinates are relative to this point on the
112             Position's map [default is map => 0, ie.
113             relative to the start of the map],
114             -element => Mappable : or relative to this element's (a
115             Bio::Map::MappableI) position in the map
116             (only works if the given element has only one
117             position in the map the Position belongs to),
118             -position => Position : or relative to this other Position (a
119             Bio::Map::PositionI, fails if the other
120             Position is on a different map to this map)
121              
122             -description => string: Free text description of what this relative
123             describes
124              
125             (To say a Position is relative to something and upstream of it,
126             the Position's start() co-ordinate should be set negative)
127              
128             =cut
129              
130             sub new {
131 3241     3241 1 5241 my ($class, @args) = @_;
132 3241         5707 my $self = $class->SUPER::new(@args);
133            
134 3241         8070 my ($map, $element, $position, $desc) =
135             $self->_rearrange([qw( MAP ELEMENT POSITION DESCRIPTION )], @args);
136            
137 3241 50       6943 if (defined($map) + defined($element) + defined($position) > 1) {
138 0         0 $self->throw("-map, -element and -position are mutually exclusive");
139             }
140            
141 3241 100       6461 defined($map) && $self->map($map);
142 3241 100       4149 $element && $self->element($element);
143 3241 100       3720 $position && $self->position($position);
144 3241 100       6251 $desc && $self->description($desc);
145            
146 3241         8337 return $self;
147             }
148              
149             =head2 absolute_conversion
150              
151             Title : absolute_conversion
152             Usage : my $absolute_coord = $relative->absolute_conversion($pos);
153             Function: Convert the start co-ordinate of the supplied position into a number
154             relative to the start of its map.
155             Returns : scalar number
156             Args : Bio::Map::PositionI object
157              
158             =cut
159              
160             sub absolute_conversion {
161 2124     2124 1 2527 my ($self, $pos) = @_;
162 2124 50       2974 $self->throw("Must supply an object") unless ref($pos);
163 2124 50       4276 $self->throw("This is [$pos], not a Bio::Map::PositionI") unless $pos->isa('Bio::Map::PositionI');
164            
165             # get the raw start position of our position
166 2124         2999 my $prior_abs = $pos->absolute;
167 2124 100       2802 $pos->absolute(0) if $prior_abs;
168 2124         3124 my $raw = $pos->start;
169 2124 100       2851 $pos->absolute($prior_abs) if $prior_abs;
170 2124 50       2512 $self->throw("Can't convert co-ordinates when start isn't set") unless defined($raw); #*** needed? return undef?
171            
172             # what are we relative to?
173 2124         2809 my $type = $self->type;
174 2124         3324 my $value = $self->$type;
175 2124 50 33     4862 $self->throw("Details not yet set for this Relative, cannot convert") unless $type && defined($value);
176            
177             # get the absolute start of the thing we're relative to
178 2124         3190 my $map = $pos->map;
179 2124 100       3430 if ($type eq 'element') {
180 483 50       620 $self->throw("Relative to a Mappable, but the Position has no map") unless $map;
181 483         829 my @positions = $value->get_positions($map);
182 483         525 $value = shift(@positions);
183 483 50       752 $self->throw("Relative to a Mappable, but this Mappable has no positions on the supplied Position's map") unless $value;
184             }
185 2124 100       2696 if (ref($value)) {
186             # pseudo-recurse
187 540         862 my $rel = $value->relative;
188 540         849 $value = $rel->absolute_conversion($value);
189             }
190            
191 2124 50       2794 if (defined($value)) {
192 2124         4161 return $value + $raw;
193             }
194 0         0 return;
195             }
196              
197             =head2 type
198              
199             Title : type
200             Usage : my $type = $relative->type();
201             Function: Get the type of thing we are relative to. The types correspond
202             to a method name, so the value of what we are relative to can
203             subsequently be found by $value = $relative->$type;
204              
205             Note that type is set by the last method that was set, or during
206             new().
207              
208             Returns : the string 'map', 'element' or 'position', or undef
209             Args : none
210              
211             =cut
212              
213             sub type {
214 6671     6671 1 6233 my $self = shift;
215 6671   100     11906 return $self->{_use} || return;
216             }
217              
218             =head2 map
219              
220             Title : map
221             Usage : my $int = $relative->map();
222             $relative->map($int);
223             Function: Get/set the distance from the start of the map that the Position's
224             co-ordiantes are relative to.
225             Returns : int
226             Args : none to get, OR
227             int to set; a value of 0 means relative to the start of the map.
228              
229             =cut
230              
231             sub map {
232 5104     5104 1 5704 my ($self, $num) = @_;
233 5104 100       6255 if (defined($num)) {
234 2514 50       4815 $self->throw("This is [$num], not a number") unless looks_like_number($num);
235 2514         3552 $self->{_use} = 'map';
236 2514         2535 $self->{_map} = $num;
237             }
238 5104 50       8124 return defined($self->{_map}) ? $self->{_map} : return;
239             }
240              
241             =head2 element
242              
243             Title : element
244             Usage : my $element = $relative->element();
245             $relative->element($element);
246             Function: Get/set the map element (Mappable) the Position is relative to. If
247             the Mappable has more than one Position on the Position's map, we
248             will be relative to the Mappable's first Position on the map.
249             Returns : Bio::Map::MappableI
250             Args : none to get, OR
251             Bio::Map::MappableI to set
252              
253             =cut
254              
255             sub element {
256 1220     1220 1 1516 my ($self, $element) = @_;
257 1220 100       1465 if ($element) {
258 1 50       2 $self->throw("Must supply an object") unless ref($element);
259 1 50       10 $self->throw("This is [$element], not a Bio::Map::MappableI") unless $element->isa('Bio::Map::MappableI');
260 1         2 $self->{_use} = 'element';
261 1         2 $self->{_element} = $element;
262             }
263 1220   50     2514 return $self->{_element} || return;
264             }
265              
266             =head2 position
267              
268             Title : position
269             Usage : my $position = $relative->position();
270             $relative->position($position);
271             Function: Get/set the Position your Position is relative to. Your Position
272             will be made relative to the start of this supplied Position. It
273             makes no difference what maps the Positions are on.
274             Returns : Bio::Map::PositionI
275             Args : none to get, OR
276             Bio::Map::PositionI to set
277              
278             =cut
279              
280             sub position {
281 79     79 1 96 my ($self, $pos) = @_;
282 79 100       132 if ($pos) {
283 4 50       8 $self->throw("Must supply an object") unless ref($pos);
284 4 50       10 $self->throw("This is [$pos], not a Bio::Map::PositionI") unless $pos->isa('Bio::Map::PositionI');
285 4         6 $self->{_use} = 'position';
286 4         5 $self->{_position} = $pos;
287             }
288 79   50     159 return $self->{_position} || return;
289             }
290              
291             =head2 description
292              
293             Title : description
294             Usage : my $description = $relative->description();
295             $relative->description($description);
296             Function: Get/set a textual description of what this relative describes.
297             Returns : string
298             Args : none to get, OR
299             string to set
300              
301             =cut
302              
303             sub description {
304 3233     3233 1 3478 my $self = shift;
305 3233 100       4508 if (@_) { $self->{desc} = shift }
  3231         3750  
306 3233   50     4618 return $self->{desc} || '';
307             }
308              
309             1;