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   32 use strict;
  9         11  
  9         222  
101 9     9   31 use Scalar::Util qw(looks_like_number);
  9         8  
  9         402  
102              
103 9     9   33 use base qw(Bio::Root::Root Bio::Map::RelativeI);
  9         9  
  9         2680  
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 3265     3265 1 3908 my ($class, @args) = @_;
132 3265         5256 my $self = $class->SUPER::new(@args);
133            
134 3265         7500 my ($map, $element, $position, $desc) =
135             $self->_rearrange([qw( MAP ELEMENT POSITION DESCRIPTION )], @args);
136            
137 3265 50       6937 if (defined($map) + defined($element) + defined($position) > 1) {
138 0         0 $self->throw("-map, -element and -position are mutually exclusive");
139             }
140            
141 3265 100       6018 defined($map) && $self->map($map);
142 3265 100       3884 $element && $self->element($element);
143 3265 100       3644 $position && $self->position($position);
144 3265 100       5798 $desc && $self->description($desc);
145            
146 3265         7709 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 2127     2127 1 1664 my ($self, $pos) = @_;
162 2127 50       2863 $self->throw("Must supply an object") unless ref($pos);
163 2127 50       4172 $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 2127         2821 my $prior_abs = $pos->absolute;
167 2127 100       2962 $pos->absolute(0) if $prior_abs;
168 2127         2986 my $raw = $pos->start;
169 2127 100       2717 $pos->absolute($prior_abs) if $prior_abs;
170 2127 50       2448 $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 2127         2335 my $type = $self->type;
174 2127         2941 my $value = $self->$type;
175 2127 50 33     5637 $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 2127         3432 my $map = $pos->map;
179 2127 100       3242 if ($type eq 'element') {
180 483 50       676 $self->throw("Relative to a Mappable, but the Position has no map") unless $map;
181 483         764 my @positions = $value->get_positions($map);
182 483         413 $value = shift(@positions);
183 483 50       603 $self->throw("Relative to a Mappable, but this Mappable has no positions on the supplied Position's map") unless $value;
184             }
185 2127 100       2510 if (ref($value)) {
186             # psuedo-recurse
187 540         860 my $rel = $value->relative;
188 540         820 $value = $rel->absolute_conversion($value);
189             }
190            
191 2127 50       2650 if (defined($value)) {
192 2127         3560 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 6704     6704 1 4628 my $self = shift;
215 6704   100     12033 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 5110     5110 1 3750 my ($self, $num) = @_;
233 5110 100       6069 if (defined($num)) {
234 2517 50       4786 $self->throw("This is [$num], not a number") unless looks_like_number($num);
235 2517         2504 $self->{_use} = 'map';
236 2517         2356 $self->{_map} = $num;
237             }
238 5110 50       8166 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 845 my ($self, $element) = @_;
257 1220 100       1333 if ($element) {
258 1 50       3 $self->throw("Must supply an object") unless ref($element);
259 1 50       5 $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     2547 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 74 my ($self, $pos) = @_;
282 79 100       133 if ($pos) {
283 4 50       11 $self->throw("Must supply an object") unless ref($pos);
284 4 50       15 $self->throw("This is [$pos], not a Bio::Map::PositionI") unless $pos->isa('Bio::Map::PositionI');
285 4         8 $self->{_use} = 'position';
286 4         10 $self->{_position} = $pos;
287             }
288 79   50     186 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 3257     3257 1 2649 my $self = shift;
305 3257 100       4754 if (@_) { $self->{desc} = shift }
  3255         3569  
306 3257   50     4793 return $self->{desc} || '';
307             }
308              
309             1;