File Coverage

blib/lib/Bio/Gonzales/Range/Overlap.pm
Criterion Covered Total %
statement 43 45 95.5
branch 8 14 57.1
condition 1 3 33.3
subroutine 11 11 100.0
pod 4 4 100.0
total 67 77 87.0


line stmt bran cond sub pod time code
1             package Bio::Gonzales::Range::Overlap;
2              
3 1     1   120711 use Mouse;
  1         29626  
  1         5  
4              
5 1     1   416 use warnings;
  1         2  
  1         71  
6 1     1   7 use strict;
  1         2  
  1         20  
7 1     1   4 use Carp;
  1         3  
  1         93  
8 1     1   8 use Set::IntervalTree;
  1         7  
  1         41  
9              
10 1     1   23 use 5.010;
  1         3  
11              
12             our $VERSION = '0.083'; # VERSION
13              
14             has _tree => ( is => 'rw', default => sub { Set::IntervalTree->new } );
15             has keep_coords => ( is => 'rw', default => 1 );
16              
17             sub BUILD {
18 2     2 1 6 my $self = shift;
19 2         3 my $args = shift;
20              
21 2 50       7 if ( $args->{ranges} ) {
22 2         7 $self->insert( $args->{ranges} );
23             }
24             }
25              
26             sub insert {
27 2     2 1 5 my $self = shift;
28              
29 2 50 33     14 if ( @_ == 1 && ref $_[0] eq 'ARRAY' ) {
30 2         3 for my $r ( @{ $_[0] } ) {
  2         7  
31 4         10 $self->_insert(@$r);
32             }
33             } else {
34 0         0 $self->_insert(@_);
35             }
36              
37 2         7 return;
38             }
39              
40             sub _insert {
41 4     4   10 my ( $self, $start, $end, @rest ) = @_;
42              
43 4 50       19 ( $start, $end ) = ( $end, $start )
44             if ( $start > $end );
45              
46 4         5 my $obj;
47 4 100       16 if ( $self->keep_coords ) {
    50          
48 2         5 $obj = [ $start, $end, @rest ];
49             } elsif ( @rest > 1 ) {
50 0         0 $obj = \@rest;
51             } else {
52 2         4 $obj = $rest[0];
53             }
54              
55 4         23 $self->_tree->insert( $obj, $start, $end );
56              
57 4         8 return;
58             }
59              
60             sub contained_in {
61 10     10 1 23 my ( $self, $from, $to ) = @_;
62              
63 10 50       29 ( $from, $to ) = ( $to, $from )
64             if ( $from > $to );
65             #$to--;
66             #$from++;
67              
68 10         88 return $self->_tree->fetch_window( $from, $to );
69             }
70              
71             sub overlaps_with {
72 8     8 1 28 my ( $self, $from, $to ) = @_;
73              
74 8 50       21 ( $from, $to ) = ( $to, $from )
75             if ( $from > $to );
76 8         11 $from--;
77 8         13 $to++;
78              
79 8         95 return $self->_tree->fetch( $from, $to );
80             }
81              
82             __PACKAGE__->meta->make_immutable();
83              
84             __END__
85              
86             =head1 NAME
87              
88             Bio::Gonzales::Range::Overlap - find overlapping ranges
89              
90             =head1 SYNOPSIS
91              
92             use 5.010;
93             use Bio::Gonzales::Range::Overlap;
94             use Data::Dumper;
95              
96             my @ranges1 = (
97             [ 0, 5, 'some', 'information' ],
98             [ 6, 8, 'some', 'other', 'information' ],
99             [ 7, 10, 'nonsense', 'information' ],
100             [ 11, 100, { 'very' => 'complicated', "data" => 'structure' } ],
101             );
102              
103             my $ro = Bio::Gonzales::Range::Overlap->new;
104              
105             #build query db from 1st set of intervals
106             for my $r (@ranges1) {
107             $ro->insert(@$r);
108             }
109              
110             # in this case (from and to are elements 0 and 1)
111             # insert could be called with all ranges
112             #$ro->insert(\@ranges1);
113              
114             my @ranges2 = ( [ 8, 10 ], [ 1, 3 ], [99,200],);
115              
116             # query the db with ranges
117             for my $r (@ranges2) {
118             say "Range (" . join(",", @$r) . ") overlaps with:";
119             say Dumper $ro->overlaps_with(@$r);
120             }
121              
122             =head1 DESCRIPTION
123              
124             A C<@range> has the form C<($from, $to, @additional elements)>. Lists of
125             ranges have the form C<([$from, $to, @add_elems], [$from, $to, @add_elems], ...)>.
126              
127             =head1 OPTIONS
128              
129             =head1 METHODS
130              
131             =over 4
132              
133             =item B<< $ro->insert(@range) >>
134              
135             =item B<< $ro->insert(\@list_of_ranges) >>
136              
137             =item B<< \@ranges_contained_in_given_range = $ro->contained_in(@range) >>
138              
139             =item B<< \@ranges_that_overlap_with_given_range = $ro->overlaps_with(@range) >>
140              
141             =back
142              
143             =head1 SEE ALSO
144              
145             =over 4
146              
147             =item L<Bio::Gonzales::Matrix::IO> for reading in ranges from files
148              
149             =item L<Bio::Gonzales::Range::GroupedOverlap> for grouped ranges such as genes
150             that are grouped by chromosomes.
151              
152             =back
153              
154             =head1 AUTHOR
155              
156             jw bargsten, C<< <jwb at cpan dot org> >>
157              
158             =cut