Add tests for memory leaks and weaken for Issue #81
[bioperl-live.git] / Bio / Map / Relative.pm
blobbbe3dcb2fa16bf29a2b0d7b54b38f188d79bcf6a
2 # BioPerl module for Bio::Map::Relative
4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
6 # Cared for by Sendu Bala <bix@sendu.me.uk>
8 # Copyright Sendu Bala
10 # You may distribute this module under the same terms as perl itself
12 # POD documentation - main docs before the code
14 =head1 NAME
16 Bio::Map::Relative - Represents what a Position's coordiantes are relative to.
18 =head1 SYNOPSIS
20 # Get a Bio::Map::PositionI somehow
21 my $pos = Bio::Map::Position->new(-value => 100);
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
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);
33 # Get the start co-ordinate of $pos relative to $pos_we_are_relative_to
34 my $start = $pos->start; # $start == 100
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);
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
48 =head1 DESCRIPTION
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.
56 =head1 FEEDBACK
58 =head2 Mailing Lists
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.
64 bioperl-l@bioperl.org - General discussion
65 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
67 =head2 Support
69 Please direct usage questions or support issues to the mailing list:
71 I<bioperl-l@bioperl.org>
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.
78 =head2 Reporting Bugs
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:
84 https://github.com/bioperl/bioperl-live/issues
86 =head1 AUTHOR - Sendu Bala
88 Email bix@sendu.me.uk
90 =head1 APPENDIX
92 The rest of the documentation details each of the object methods.
93 Internal methods are usually preceded with a _
95 =cut
97 # Let the code begin...
99 package Bio::Map::Relative;
100 use strict;
101 use Scalar::Util qw(looks_like_number);
103 use base qw(Bio::Root::Root Bio::Map::RelativeI);
105 =head2 new
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)
122 -description => string: Free text description of what this relative
123 describes
125 (To say a Position is relative to something and upstream of it,
126 the Position's start() co-ordinate should be set negative)
128 =cut
130 sub new {
131 my ($class, @args) = @_;
132 my $self = $class->SUPER::new(@args);
134 my ($map, $element, $position, $desc) =
135 $self->_rearrange([qw( MAP ELEMENT POSITION DESCRIPTION )], @args);
137 if (defined($map) + defined($element) + defined($position) > 1) {
138 $self->throw("-map, -element and -position are mutually exclusive");
141 defined($map) && $self->map($map);
142 $element && $self->element($element);
143 $position && $self->position($position);
144 $desc && $self->description($desc);
146 return $self;
149 =head2 absolute_conversion
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
158 =cut
160 sub absolute_conversion {
161 my ($self, $pos) = @_;
162 $self->throw("Must supply an object") unless ref($pos);
163 $self->throw("This is [$pos], not a Bio::Map::PositionI") unless $pos->isa('Bio::Map::PositionI');
165 # get the raw start position of our position
166 my $prior_abs = $pos->absolute;
167 $pos->absolute(0) if $prior_abs;
168 my $raw = $pos->start;
169 $pos->absolute($prior_abs) if $prior_abs;
170 $self->throw("Can't convert co-ordinates when start isn't set") unless defined($raw); #*** needed? return undef?
172 # what are we relative to?
173 my $type = $self->type;
174 my $value = $self->$type;
175 $self->throw("Details not yet set for this Relative, cannot convert") unless $type && defined($value);
177 # get the absolute start of the thing we're relative to
178 my $map = $pos->map;
179 if ($type eq 'element') {
180 $self->throw("Relative to a Mappable, but the Position has no map") unless $map;
181 my @positions = $value->get_positions($map);
182 $value = shift(@positions);
183 $self->throw("Relative to a Mappable, but this Mappable has no positions on the supplied Position's map") unless $value;
185 if (ref($value)) {
186 # psuedo-recurse
187 my $rel = $value->relative;
188 $value = $rel->absolute_conversion($value);
191 if (defined($value)) {
192 return $value + $raw;
194 return;
197 =head2 type
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;
205 Note that type is set by the last method that was set, or during
206 new().
208 Returns : the string 'map', 'element' or 'position', or undef
209 Args : none
211 =cut
213 sub type {
214 my $self = shift;
215 return $self->{_use} || return;
218 =head2 map
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.
229 =cut
231 sub map {
232 my ($self, $num) = @_;
233 if (defined($num)) {
234 $self->throw("This is [$num], not a number") unless looks_like_number($num);
235 $self->{_use} = 'map';
236 $self->{_map} = $num;
238 return defined($self->{_map}) ? $self->{_map} : return;
241 =head2 element
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
253 =cut
255 sub element {
256 my ($self, $element) = @_;
257 if ($element) {
258 $self->throw("Must supply an object") unless ref($element);
259 $self->throw("This is [$element], not a Bio::Map::MappableI") unless $element->isa('Bio::Map::MappableI');
260 $self->{_use} = 'element';
261 $self->{_element} = $element;
263 return $self->{_element} || return;
266 =head2 position
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
278 =cut
280 sub position {
281 my ($self, $pos) = @_;
282 if ($pos) {
283 $self->throw("Must supply an object") unless ref($pos);
284 $self->throw("This is [$pos], not a Bio::Map::PositionI") unless $pos->isa('Bio::Map::PositionI');
285 $self->{_use} = 'position';
286 $self->{_position} = $pos;
288 return $self->{_position} || return;
291 =head2 description
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
301 =cut
303 sub description {
304 my $self = shift;
305 if (@_) { $self->{desc} = shift }
306 return $self->{desc} || '';