2 # BioPerl module for Bio::Map::Mappable
4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
6 # Cared for by Sendu Bala <bix@sendu.me.uk>
10 # You may distribute this module under the same terms as perl itself
12 # POD documentation - main docs before the code
16 Bio::Map::Mappable - An object representing a generic map element
17 that can have multiple locations in several maps.
21 # a map element in two different positions on the same map
22 $map1 = Bio::Map::SimpleMap->new();
23 $position1 = Bio::Map::Position->new(-map => $map1, -value => 100);
24 $position2 = Bio::Map::Position->new(-map => $map1, -value => 200);
25 $mappable = Bio::Map::Mappable->new(-positions => [$position1, $position2] );
27 # add another position on a different map
28 $map2 = Bio::Map::SimpleMap->new();
29 $position3 = Bio::Map::Position->new(-map => $map2, $value => 50);
30 $mappable->add_position($position3);
32 # get all the places our map element is found, on a particular map of interest
33 foreach $pos ($mappable->get_positions($map1)) {
34 print $pos->value, "\n";
39 This object handles the notion of a generic map element. Mappables are
40 entities with one or more positions on one or more maps.
42 This object is a pure perl implementation of L<Bio::Map::MappableI>. That
43 interface implements some of its own methods so check the docs there for
50 User feedback is an integral part of the evolution of this and other
51 Bioperl modules. Send your comments and suggestions preferably to the
52 Bioperl mailing list. Your participation is much appreciated.
54 bioperl-l@bioperl.org - General discussion
55 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
59 Please direct usage questions or support issues to the mailing list:
61 I<bioperl-l@bioperl.org>
63 rather than to the module maintainer directly. Many experienced and
64 reponsive experts will be able look at the problem and quickly
65 address it. Please include a thorough description of the problem
66 with code and data examples if at all possible.
70 Report bugs to the Bioperl bug tracking system to help us keep track
71 of the bugs and their resolution. Bug reports can be submitted via the
74 https://github.com/bioperl/bioperl-live/issues
76 =head1 AUTHOR - Sendu Bala
82 The rest of the documentation details each of the object methods.
83 Internal methods are usually preceded with a _
87 # Let the code begin...
89 package Bio
::Map
::Mappable
;
91 use Bio
::Map
::Relative
;
92 use Bio
::Map
::Position
;
94 use base
qw(Bio::Root::Root Bio::Map::MappableI);
99 Usage : my $mappable = Bio::Map::Mappable->new();
100 Function: Builds a new Bio::Map::Mappable object
101 Returns : Bio::Map::Mappable
102 Args : -name => string : name of the mappable element
103 -id => string : id of the mappable element
108 my ($class, @args) = @_;
109 my $self = $class->SUPER::new
(@args);
111 my ($name, $id) = $self->_rearrange([qw(NAME ID)], @args);
112 $self->name($name) if $name;
113 $self->id($id) if $id;
121 Usage : $mappable->name($new_name);
122 my $name = $mappable->name();
123 Function: Get/Set the name for this Mappable
124 Returns : A scalar representing the current name of this Mappable
132 if (@_) { $self->{_name
} = shift }
133 return $self->{_name
} || '';
139 Usage : my $id = $mappable->id();
140 $mappable->id($new_id);
141 Function: Get/Set the id for this Mappable.
142 Returns : A scalar representing the current id of this Mappable
150 if (@_) { $self->{_id
} = shift }
151 return $self->{_id
} || return;
157 Usage : if ($mappable->in_map($map)) {...}
158 Function: Tests if this mappable is found on a specific map
160 Args : L<Bio::Map::MapI>
165 my ($self, $query_map) = @_;
166 $self->throw("Must supply an argument") unless $query_map;
167 $self->throw("This is [$query_map], not an object") unless ref($query_map);
168 $self->throw("This is [$query_map], not a Bio::Map::MapI object") unless $query_map->isa('Bio::Map::MapI');
170 foreach my $map ($self->known_maps) {
171 ($map eq $query_map) && return 1;
177 =head2 Comparison methods
184 Usage : if ($mappable->equals($other_mappable)) {...}
185 my @equal_positions = $mappable->equals($other_mappable);
186 Function: Finds the positions in this mappable that are equal to any
187 comparison positions.
188 Returns : array of L<Bio::Map::PositionI> objects
189 Args : arg #1 = L<Bio::Map::MappableI> OR L<Bio::Map::PositionI> to compare
190 this one to (mandatory)
191 arg #2 = optionally, one or more of the key => value pairs below
192 -map => MapI : a Bio::Map::MapI to only consider positions
194 -relative => RelativeI : a Bio::Map::RelativeI to calculate in terms
195 of each Position's relative position to the
196 thing described by that Relative
202 return $self->_compare('equals', @_);
208 Usage : if ($mappable->less_than($other_mappable)) {...}
209 my @lesser_positions = $mappable->less_than($other_mappable);
210 Function: Finds the positions in this mappable that are less than all
211 comparison positions.
212 Returns : array of L<Bio::Map::PositionI> objects
213 Args : arg #1 = L<Bio::Map::MappableI> OR L<Bio::Map::PositionI> to compare
214 this one to (mandatory)
215 arg #2 = optionally, one or more of the key => value pairs below
216 -map => MapI : a Bio::Map::MapI to only consider positions
218 -relative => RelativeI : a Bio::Map::RelativeI to calculate in terms
219 of each Position's relative position to the
220 thing described by that Relative
226 return $self->_compare('less_than', @_);
232 Usage : if ($mappable->greater_than($other_mappable)) {...}
233 my @greater_positions = $mappable->greater_than($other_mappable);
234 Function: Finds the positions in this mappable that are greater than all
235 comparison positions.
236 Returns : array of L<Bio::Map::PositionI> objects
237 Args : arg #1 = L<Bio::Map::MappableI> OR L<Bio::Map::PositionI> to compare
238 this one to (mandatory)
239 arg #2 = optionally, one or more of the key => value pairs below
240 -map => MapI : a Bio::Map::MapI to only consider positions
242 -relative => RelativeI : a Bio::Map::RelativeI to calculate in terms
243 of each Position's relative position to the
244 thing described by that Relative
250 return $self->_compare('greater_than', @_);
256 Usage : if ($mappable->overlaps($other_mappable)) {...}
257 my @overlapping_positions = $mappable->overlaps($other_mappable);
258 Function: Finds the positions in this mappable that overlap with any
259 comparison positions.
260 Returns : array of L<Bio::Map::PositionI> objects
261 Args : arg #1 = L<Bio::Map::MappableI> OR L<Bio::Map::PositionI> to compare
262 this one to (mandatory)
263 arg #2 = optionally, one or more of the key => value pairs below
264 -map => MapI : a Bio::Map::MapI to only consider positions
266 -relative => RelativeI : a Bio::Map::RelativeI to calculate in terms
267 of each Position's relative position to the
268 thing described by that Relative
274 return $self->_compare('overlaps', @_);
280 Usage : if ($mappable->contains($other_mappable)) {...}
281 my @container_positions = $mappable->contains($other_mappable);
282 Function: Finds the positions in this mappable that contain any comparison
284 Returns : array of L<Bio::Map::PositionI> objects
285 Args : arg #1 = L<Bio::Map::MappableI> OR L<Bio::Map::PositionI> to compare
286 this one to (mandatory)
287 arg #2 = optionally, one or more of the key => value pairs below
288 -map => MapI : a Bio::Map::MapI to only consider positions
290 -relative => RelativeI : a Bio::Map::RelativeI to calculate in terms
291 of each Position's relative position to the
292 thing described by that Relative
298 return $self->_compare('contains', @_);
301 =head2 overlapping_groups
303 Title : overlapping_groups
304 Usage : my @groups = $mappable->overlapping_groups($other_mappable);
305 my @groups = Bio::Map::Mappable->overlapping_groups(\@mappables);
306 Function: Look at all the positions of all the supplied mappables and group
307 them according to overlap.
308 Returns : array of array refs, each ref containing the Bio::Map::PositionI
309 objects that overlap with each other
310 Args : arg #1 = L<Bio::Map::MappableI> OR L<Bio::Map::PositionI> to compare
311 this one to, or an array ref of such objects (mandatory)
312 arg #2 = optionally, one or more of the key => value pairs below
313 -map => MapI : a Bio::Map::MapI to only consider positions
315 -relative => RelativeI : a Bio::Map::RelativeI to calculate in terms
316 of each Position's relative position to the
317 thing described by that Relative
318 -min_pos_num => int : the minimum number of positions that must
319 be in a group before it will be returned
321 -min_mappables_num => int : the minimum number of different
322 mappables represented by the
323 positions in a group before it
324 will be returned [default is 1]
325 -min_mappables_percent => number : as above, but the minimum
326 percentage of input mappables
328 -min_map_num => int : the minimum number of different
329 maps represented by the positions
330 in a group before it will be
331 returned [default is 1]
332 -min_map_percent => number : as above, but the minimum
333 percentage of maps known by the
334 input mappables [default is 0]
335 -require_self => 1|0 : require that at least one of the
336 calling object's positions be in
337 each group [default is 1, has no
338 effect when the second usage form
340 -required => \@mappables : require that at least one position
341 for each mappable supplied in this
342 array ref be in each group
346 sub overlapping_groups
{
348 return $self->_compare('overlapping_groups', @_);
351 =head2 disconnected_intersections
353 Title : disconnected_intersections
354 Usage : @positions = $mappable->disconnected_intersections($other_mappable);
355 @positions = Bio::Map::Mappable->disconnected_intersections(\@mappables);
356 Function: Make the positions that are at the intersection of each group of
357 overlapping positions, considering all the positions of the supplied
359 Returns : new Bio::Map::Mappable who's positions on maps are the calculated
361 Args : arg #1 = L<Bio::Map::MappableI> OR L<Bio::Map::PositionI> to compare
362 this one to, or an array ref of such objects (mandatory)
363 arg #2 = optionally, one or more of the key => value pairs below
364 -map => MapI : a Bio::Map::MapI to only consider positions
366 -relative => RelativeI : a Bio::Map::RelativeI to calculate in terms
367 of each Position's relative position to the
368 thing described by that Relative
369 -min_pos_num => int : the minimum number of positions that must
370 be in a group before the intersection will
371 be calculated and returned [default is 1]
372 -min_mappables_num => int : the minimum number of different
373 mappables represented by the
374 positions in a group before the
375 intersection will be calculated
376 and returned [default is 1]
377 -min_mappables_percent => number : as above, but the minimum
378 percentage of input mappables
380 -min_map_num => int : the minimum number of different
381 maps represented by the positions
382 in a group before the intersection
383 will be calculated and returned
385 -min_map_percent => number : as above, but the minimum
386 percentage of maps known by the
387 input mappables [default is 0]
388 -require_self => 1|0 : require that at least one of the
389 calling object's positions be in
390 each group [default is 1, has no
391 effect when the second usage form
393 -required => \@mappables : require that at least one position
394 for each mappable supplied in this
395 array ref be in each group
399 sub disconnected_intersections
{
401 return $self->_compare('intersection', @_);
404 =head2 disconnected_unions
406 Title : disconnected_unions
407 Usage : my @positions = $mappable->disconnected_unions($other_mappable);
408 my @positions = Bio::Map::Mappable->disconnected_unions(\@mappables);
409 Function: Make the positions that are the union of each group of overlapping
410 positions, considering all the positions of the supplied mappables.
411 Returns : new Bio::Map::Mappable who's positions on maps are the calculated
413 Args : arg #1 = L<Bio::Map::MappableI> OR L<Bio::Map::PositionI> to compare
414 this one to, or an array ref of such objects (mandatory)
415 arg #2 = optionally, one or more of the key => value pairs below
416 -map => MapI : a Bio::Map::MapI to only consider positions
418 -relative => RelativeI : a Bio::Map::RelativeI to calculate in terms
419 of each Position's relative position to the
420 thing described by that Relative
421 -min_pos_num => int : the minimum number of positions that must
422 be in a group before the union will be
423 calculated and returned [default is 1]
424 -min_mappables_num => int : the minimum number of different
425 mappables represented by the
426 positions in a group before the
427 union will be calculated and
428 returned [default is 1]
429 -min_mappables_percent => number : as above, but the minimum
430 percentage of input mappables
432 -min_map_num => int : the minimum number of different
433 maps represented by the positions
434 in a group before the union will
435 be calculated and returned
437 -min_map_percent => number : as above, but the minimum
438 percentage of maps known by the
439 input mappables [default is 0]
440 -require_self => 1|0 : require that at least one of the
441 calling object's positions be in
442 each group [default is 1, has no
443 effect when the second usage form
445 -required => \@mappables : require that at least one position
446 for each mappable supplied in this
447 array ref be in each group
451 sub disconnected_unions
{
453 return $self->_compare('union', @_);
456 # do a RangeI-related comparison by calling the corresponding PositionI method
457 # on all the requested Positions of our Mappables
459 my ($self, $method, $input, @extra_args) = @_;
460 $self->throw("Must supply an object or array ref of them") unless ref($input);
461 $self->throw("Wrong number of extra args (should be key => value pairs)") unless @extra_args % 2 == 0;
462 my @compares = ref($input) eq 'ARRAY' ? @
{$input} : ($input);
464 my %args = (-map => undef, -relative
=> undef, -min_pos_num
=> 1,
465 -min_mappables_num
=> 1, -min_mappables_percent
=> 0,
466 -min_map_num
=> 1, -min_map_percent
=> 0,
467 -require_self
=> 0, -required
=> undef, -min_overlap_percent
=> 0, @extra_args);
468 my $map = $args{-map};
469 my $rel = $args{-relative
};
470 my $overlap = $args{-min_overlap_percent
};
471 my $min_pos_num = $args{-min_pos_num
};
472 my $min_pables_num = $args{-min_mappables_num
};
473 if ($args{-min_mappables_percent
}) {
474 my $mn = (@compares + (ref($self) ?
1 : 0)) / 100 * $args{-min_mappables_percent
};
475 if ($mn > $min_pables_num) {
476 $min_pables_num = $mn;
479 my $min_map_num = $args{-min_map_num
};
480 if ($args{-min_map_percent
}) {
482 foreach my $pable (@compares, ref($self) ?
($self) : ()) {
483 foreach my $known ($pable->known_maps) {
484 $known_maps{$known->unique_id} = 1;
487 my $mn = scalar(keys %known_maps) / 100 * $args{-min_map_percent
};
488 if ($mn > $min_map_num) {
492 my %required = map { $_ => 1 } $args{-required
} ? @
{$args{-required
}} : ();
496 @mine = $self->get_positions($map);
497 if ($args{-require_self
}) {
499 $required{$self} = 1;
502 my @required = sort keys %required;
504 foreach my $compare (@compares) {
505 if ($compare->isa('Bio::Map::PositionI')) {
506 push(@yours, $compare);
508 elsif ($compare->isa('Bio::Map::MappableI')) {
509 push(@yours, $compare->get_positions($map));
512 $self->throw("This is [$compare], not a Bio::Map::MappableI or Bio::Map::PositionI");
515 @yours > 0 or return;
518 SWITCH
: for ($method) {
519 /equals|overlaps|contains/ && do {
521 foreach my $my_pos (@mine) {
522 foreach my $your_pos (@yours) {
523 if ($my_pos->$method($your_pos, undef, $rel)) {
531 /less_than|greater_than/ && do {
533 if ($method eq 'greater_than') {
534 @mine = map { $_->[1] }
535 sort { $b->[0] <=> $a->[0] }
536 map { [$_->end($_->absolute_relative), $_] }
538 @yours = map { $_->[1] }
539 sort { $b->[0] <=> $a->[0] }
540 map { [$_->end($_->absolute_relative), $_] }
543 my $test_pos = shift(@yours);
545 foreach my $my_pos (@mine) {
546 if ($my_pos->$method($test_pos, $rel)) {
554 if ($method eq 'greater_than') {
555 @ok = map { $_->[1] }
556 sort { $a->[0] <=> $b->[0] }
557 map { [$_->sortable, $_] }
563 /overlapping_groups|intersection|union/ && do {
564 my @positions = (@mine, @yours);
565 my $start_pos = shift(@positions);
567 my $dr_able = $start_pos->disconnected_ranges(\
@positions, $rel, $overlap) || return;
568 my @disconnected_ranges = $dr_able->get_positions;
570 #print "got ", scalar(@disconnected_ranges), " disconnected_ranges, first has range ", $disconnected_ranges[0]->toString, "\n";
572 #use Benchmark qw(:all);
573 #my $t0 = new Benchmark;
577 for my $i (0..$#disconnected_ranges) {
578 my $range = $disconnected_ranges[$i];
579 my $range_string = $range->toString;
580 next if $done_ranges{$range_string};
581 $done_ranges{$range_string} = 1;
583 foreach my $pos ($start_pos, @positions) {
584 if ($pos->overlaps($range, undef, $rel)) {
585 $all_groups{$range_string}->{$pos} = $pos;
590 #my $t1 = new Benchmark;
591 #my $td = timediff($t1, $t0);
592 #print "grouping took: ",timestr($td),"\n";
594 # purge the temporary working (not $dr_able->purge_positions since
595 # that removes the element from each position, but leaves it on
596 # the map. *** need complete purge that removes position from
598 foreach my $pos (@disconnected_ranges) {
599 my $map = $pos->map || next;
600 $map->purge_positions($pos);
604 GROUPS
: foreach my $group_range (sort keys %all_groups) {
605 my $group = $all_groups{$group_range};
606 my @group = sort values %{$group};
607 #print "* in group $group_range, there are ", scalar(@group), " members\n";
609 @group >= $min_pos_num or next;
610 @group >= $min_pables_num or next; # shortcut before having to work it out properly
611 @group >= $min_map_num or next; # shortcut before having to work it out properly
614 foreach my $pos (@group) {
615 my $mappable = $pos->element || next;
616 $mappables{$mappable} = 1;
618 keys %mappables >= $min_pables_num || next;
621 foreach my $pos (@group) {
622 my $map = $pos->map || next;
623 $maps{$map->unique_id} = 1;
625 keys %maps >= $min_map_num || next;
627 foreach my $required (@required) {
628 exists $mappables{$required} or next GROUPS
;
631 my @sorted = map { $_->[1] }
632 sort { $a->[0] <=> $b->[0] }
633 map { [$_->sortable, $_] }
635 push(@groups, \
@sorted);
638 if ($method eq 'overlapping_groups') {
642 foreach my $group (@groups) {
643 my $start_pos = shift(@
{$group});
646 # we'll consider the 'intersection' or 'union' of just
647 # one position as the position itself
648 push(@ok, Bio
::Map
::Position
->new(-map => $start_pos->map,
649 -start
=> $start_pos->start,
650 -end
=> $start_pos->end));
653 my @rel_arg = $method eq 'intersection' ?
(undef, $rel) : ($rel);
654 my $result = $start_pos->$method($group, @rel_arg) || next;
655 push(@ok, $result->get_positions);
659 # assign all the positions to a result mappable
660 my $result = $self->new();
661 $result->add_position(@ok) if @ok; # add_position can actually take a list
669 $self->throw("Unknown method '$method'");
679 Function: tuple was supposed to be a private method; this method no longer
683 Status : deprecated, will be removed in next version
689 $self->warn("The tuple method was supposed to be a private method, don't call it!");
695 Usage : $mappable->annotation($an_col);
696 my $an_col = $mappable->annotation();
697 Function: Get the annotation collection (see Bio::AnnotationCollectionI)
698 for this annotatable object.
699 Returns : a Bio::AnnotationCollectionI implementing object, or undef
700 Args : none to get, OR
701 a Bio::AnnotationCollectionI implementing object to set
707 if (@_) { $self->{_annotation
} = shift }
708 return $self->{_annotation
} || return;