File Coverage

blib/lib/Number/RangeTracker.pm
Criterion Covered Total %
statement 156 165 94.5
branch 45 60 75.0
condition 13 15 86.6
subroutine 23 23 100.0
pod 9 9 100.0
total 246 272 90.4


line stmt bran cond sub pod time code
1             package Number::RangeTracker;
2 2     2   70528 use strict;
  2         6  
  2         84  
3 2     2   12 use warnings;
  2         5  
  2         69  
4 2     2   16 use List::Util 'max';
  2         10  
  2         285  
5 2     2   2239 use List::MoreUtils qw(lastidx lastval);
  2         15118  
  2         355  
6 2     2   23 use Scalar::Util 'looks_like_number';
  2         3  
  2         176  
7 2     2   13 use Carp;
  2         4  
  2         124  
8 2     2   2162 use Mouse;
  2         75208  
  2         13  
9              
10             =head1 NAME
11              
12             Number::RangeTracker - Keep track of numerical ranges quickly
13              
14             =head1 VERSION
15              
16             Version 0.6.1
17              
18             =cut
19              
20             our $VERSION = '0.6.1';
21              
22             =head1 SYNOPSIS
23              
24             Create and modify ranges (three range syntaxes shown):
25              
26             my $range = Number::RangeTracker->new;
27             $range->add( [ 1, 10 ], '11..20' );
28             $range->remove( 6, 15 );
29              
30             Output ranges, their complement, or integers within ranges
31             (differences between scalar and list contexts shown):
32              
33             $range->output;
34             # Scalar context: '1..5,16..20'
35             # List context: ( 1 => 5, 16 => 20 )
36              
37             $range->complement;
38             # Scalar context: '-inf..0,6..15,21..+inf'
39             # List context: ( -inf => 0, 6 => 15, 21 => +inf )
40              
41             $range->integers;
42             # Scalar context: '1,2,3,4,5,16,17,18,19,20'
43             # List context: ( 1, 2, 3, 4, 5, 16, 17, 18, 19, 20 )
44              
45             Examine range characteristics:
46              
47             $range->length; # 8
48             $range->size; # 10
49              
50             $range->is_in_range(100); # 0
51             $range->is_in_range(18); # 1, 16, 20
52              
53             =head1 DESCRIPTION
54              
55             An instance of the Number::RangeTracker class is used to keep track of
56             a set of numerical ranges. Ranges can be added to and removed from
57             this collection of ranges. Overlapping ranges are collapsed to form a
58             single, longer range. Ranges can be manipulated, examined, and output
59             in a variety of ways.
60              
61             While some other modules associate values with a range of keys (see
62             L), the objective of Number::RangeTracker is to quickly and
63             easily monitor the integers on a number line that are covered by at
64             least one range. Number::RangeTracker performs significantly faster
65             than other modules that have similar functions (see L).
66              
67             =over 4
68              
69             =item new
70              
71             Initializes a new Number::RangeTracker object.
72              
73             =cut
74              
75             has '_added' => ( is => 'rw', isa => 'HashRef', default => sub { {} } );
76             has '_removed' => ( is => 'rw', isa => 'HashRef', default => sub { {} } );
77             has '_messy_add' => ( is => 'rw', isa => 'Bool', default => 0 );
78             has '_messy_rem' => ( is => 'rw', isa => 'Bool', default => 0 );
79             has 'units' => ( is => 'ro', isa => 'Num', default => 1 );
80             has 'start' => ( is => 'rw', isa => 'Num' );
81             has 'end' => ( is => 'rw', isa => 'Num' );
82              
83             =item add( START, END )
84              
85             Add one or more ranges. This can be used multiple times to add ranges
86             to the object. Ranges can be added in several ways. The following are
87             equivalent.
88              
89             $range->add( [ 1, 10 ], [ 16, 20 ] );
90             $range->add( 1, 10, 16, 20 );
91             $range->add( '1..10', '16..20' );
92              
93             =cut
94              
95             sub add {
96 72     72 1 6220 my $self = shift;
97              
98 72         155 my $ranges = _get_range_inputs(@_);
99 72         176 while ( scalar @$ranges ) {
100 254         527 my ( $start, $end ) = splice @$ranges, 0, 2;
101 254         545 $self->_update_range( $start, $end, '_added' );
102             }
103             }
104              
105             sub _get_range_inputs {
106 93     93   331 my @range_input = @_;
107              
108 93         115 my @ranges;
109 93         178 for (@range_input) {
110 568 50       1630 if ( ref $_ eq "ARRAY" ) { # [ 1, 10 ], [ 16, 20 ]
    50          
111 0         0 push @ranges, @$_;
112             }
113             elsif (/^\d+\.\.\d+$/) { # '1..10', '16..20'
114 0         0 push @ranges, split /\.\./;
115             }
116             else { # 1, 10, 16, 20
117 568         1084 push @ranges, $_;
118             }
119             }
120              
121 93 50       312 croak "Odd number of elements in input ranges (start/stop pairs expected)"
122             if scalar @ranges % 2 != 0;
123              
124 93         271 return \@ranges;
125             }
126              
127             =item remove( START, END )
128              
129             Remove one or more ranges from the current set of ranges. This can be
130             used multiple times to remove ranges from the object. Ranges can be
131             removed with the same syntax used for adding ranges.
132              
133             =cut
134              
135             sub remove {
136 21     21 1 13171 my $self = shift;
137              
138 21         47 my $ranges = _get_range_inputs(@_);
139 21         73 while ( scalar @$ranges ) {
140 30         66 my ( $start, $end ) = splice @$ranges, 0, 2;
141 30         75 $self->_update_range( $start, $end, '_removed' );
142             }
143             }
144              
145             sub _update_range {
146 284     284   349 my $self = shift;
147              
148 284         446 my ( $start, $end, $add_or_rem ) = @_;
149              
150 284 100 100     1397 $self->collapse
151             if $self->_messy_rem && $add_or_rem eq '_added';
152              
153 284 50       960 croak "'$start' not a number in range '$start to $end'"
154             unless looks_like_number $start;
155 284 50       1151 croak "'$end' not a number in range '$start to $end'"
156             unless looks_like_number $end;
157              
158 284 50       758 if ( $start > $end ) {
159 0         0 carp
160             "Warning: Range start ($start) is greater than range end ($end); values have been swapped";
161 0         0 ( $start, $end ) = ( $end, $start );
162             }
163              
164 284 50       855 if ( exists $self->{$add_or_rem}{$start} ) {
165 0         0 $self->{$add_or_rem}{$start}
166             = max( $end, $self->{$add_or_rem}{$start} );
167             }
168             else {
169 284         722 $self->{$add_or_rem}{$start} = $end;
170             }
171              
172 284 100       612 if ( $add_or_rem eq '_added' ) {
173 254         1287 $self->_messy_add(1);
174             }
175             else {
176 30         166 $self->_messy_rem(1);
177             }
178             }
179              
180             =item collapse
181              
182             When ranges are added or removed, overlapping ranges are not collapsed
183             until necessary. This allows range Number::RangeTracker to be very
184             fast.
185              
186             Ranges can be manually collapsed to avoid memory issues when
187             working with very large amounts of ranges. In one test, a million
188             overlapping ranges required ~100 MB of memory. This requirement was
189             cut drastically by collapsing ranges after every 100,000th range was
190             added.
191              
192             Ranges are automatically collapsed (and merged or removed where
193             appropriate) (1) before ranges are added (if there are ranges still
194             waiting to be removed) and (2) before each of the following methods is
195             executed.
196              
197             =cut
198              
199             sub collapse {
200 88     88 1 508 my $self = shift;
201              
202 88 100 100     442 return unless $self->_messy_add || $self->_messy_rem;
203              
204 79 100       424 $self->_collapse_ranges('_added') if $self->_messy_add;
205              
206 79 100       369 if ( $self->_messy_rem ) {
207 18         45 $self->_collapse_ranges('_removed');
208 18         63 $self->_remove_ranges;
209             }
210              
211 79         227 $self->_messy_add(0);
212 79         330 $self->_messy_rem(0);
213             }
214              
215             sub _collapse_ranges {
216 82     82   113 my $self = shift;
217              
218 82         101 my $add_or_rem = shift;
219              
220 82         89 my @cur_interval;
221             my %temp_ranges;
222              
223 82         129 for my $start ( sort { $a <=> $b } keys %{ $self->{$add_or_rem} } ) {
  677         1125  
  82         403  
224 402         782 my $end = $self->{$add_or_rem}{$start};
225              
226 402 100       1192 unless (@cur_interval) {
227 82         178 @cur_interval = ( $start, $end );
228 82         154 next;
229             }
230              
231 320         460 my ( $cur_start, $cur_end ) = @cur_interval;
232 320 100       681 if ( $start <= $cur_end + 1 ) { # +1 makes it work for integer ranges only
233 66         335 @cur_interval = ( $cur_start, max( $end, $cur_end ) );
234             }
235             else {
236 254         818 $temp_ranges{ $cur_interval[0] } = $cur_interval[1];
237 254         720 @cur_interval = ( $start, $end );
238             }
239             }
240 82         211 $temp_ranges{ $cur_interval[0] } = $cur_interval[1];
241 82         247 $self->{$add_or_rem} = \%temp_ranges;
242             }
243              
244             sub _remove_ranges {
245 18     18   26 my $self = shift;
246              
247 18         28 my @starts = sort { $a <=> $b } keys %{ $self->_added };
  119         177  
  18         140  
248              
249 18         32 for my $start ( sort { $a <=> $b } keys %{ $self->_removed } ) {
  21         32  
  18         84  
250 30         57 my $end = $self->{_removed}{$start};
251              
252 30     78   169 my $left_start_idx = lastidx { $_ < $start } @starts;
  78         107  
253 30     65   147 my $right_start_idx = lastidx { $_ <= $end } @starts;
  65         84  
254              
255 30         76 my $left_start = $starts[$left_start_idx];
256 30         35 my $right_start = $starts[$right_start_idx];
257 30 50 33     134 next unless defined $left_start && defined $right_start;
258              
259 30         63 my $left_end = $self->{_added}{$left_start};
260 30         46 my $right_end = $self->{_added}{$right_start};
261              
262             # range to remove touches the start of at least one added range
263 30 100       66 if ( $right_start_idx - $left_start_idx > 0 ) {
264 11         30 delete @{ $self->{_added} }
  11         33  
265             { @starts[ $left_start_idx + 1 .. $right_start_idx ] };
266 11 50       39 splice @starts, 0, $right_start_idx + 1 if $right_start_idx > -1;
267             }
268             else {
269 19 100       54 splice @starts, 0, $left_start_idx + 1 if $left_start_idx > -1;
270             }
271              
272             # range to remove starts inside an added range
273 30 100 100     143 if ( $start <= $left_end && $left_start_idx != -1 ) {
274 18         42 $self->{_added}{$left_start} = $start - 1;
275             }
276              
277             # range to remove ends inside an added range
278 30 100 100     133 if ( $end >= $right_start && $end < $right_end ) {
279 21         29 my $new_start = $end + 1;
280 21         56 $self->{_added}{$new_start} = $right_end;
281 21         40 unshift @starts, $new_start;
282             }
283              
284 30         34 delete ${ $self->{_removed} }{$start};
  30         122  
285             }
286             }
287              
288             =item length
289              
290             Returns the total length of all ranges combined.
291              
292             =cut
293              
294             sub length {
295 1     1 1 2736 my $self = shift;
296              
297 1         5 $self->collapse;
298              
299 1         2 my $length = 0;
300 1         2 for ( keys %{ $self->_added } ) {
  1         5  
301 7         17 $length += $self->{_added}{$_} - $_;
302             }
303 1         4 return $length;
304             }
305              
306             =item size
307              
308             Returns the total number of elements (i.e., integers) of all ranges.
309              
310             =cut
311              
312             sub size {
313 1     1 1 2327 my $self = shift;
314              
315 1         4 $self->collapse;
316              
317 1         2 my $size = 0;
318 1         2 for ( keys %{ $self->_added } ) {
  1         7  
319 7         16 $size += $self->{_added}{$_} - $_ + 1; # +1 makes it work for integer ranges only
320             }
321 1         3 return $size;
322             }
323              
324             =item is_in_range( VALUE )
325              
326             Test whether a VALUE is contained within one of the ranges. Returns 0
327             for a negative result. Returns a list of three numbers for a positive
328             result: 1, start position of the containing range, end position of the
329             containing range.
330              
331             =cut
332              
333             sub is_in_range {
334 7     7 1 4064 my $self = shift;
335              
336 7         8 my $query = shift;
337              
338 7         14 $self->collapse;
339              
340 7         7 my @starts = sort { $a <=> $b } keys %{ $self->_added };
  98         102  
  7         25  
341 7     30   33 my $start = lastval { $_ <= $query } @starts;
  30         32  
342              
343 7 100       24 return 0 unless defined $start;
344              
345 6         11 my $end = $self->{_added}{$start};
346 6 100       16 if ( $end < $query ) {
347 2         17 return 0;
348             }
349             else {
350 4         14 return ( 1, $start, $end );
351             }
352              
353             }
354              
355             =item output
356              
357             Returns all ranges sorted by their start positions. In list context,
358             returns a list of all ranges sorted by start positions. This is
359             suitable for populating a hash, an array, or even another range
360             object. In scalar context, returns a string of ranges formatted as:
361             C<1..10,16..20>.
362              
363             =cut
364              
365             sub output {
366 8     8 1 17 my $self = shift;
367              
368 8         17 $self->collapse;
369              
370 8 100       21 if ( wantarray() ) {
    50          
    0          
371 5         7 return %{ $self->_added };
  5         56  
372             }
373             elsif ( defined wantarray() ) {
374 12         44 return join ',', map {"$_..$self->{_added}{$_}"}
  17         25  
375 3         5 sort { $a <=> $b } keys %{ $self->_added };
  3         15  
376             }
377             elsif ( !defined wantarray() ) {
378 0         0 carp 'Useless use of output() in void context';
379             }
380 0         0 else { croak 'Bad context for output()'; }
381             }
382              
383             =item integers
384              
385             Returns each integer contained within the ranges. In list context,
386             returns a sorted list. In scalar context, returns a sorted,
387             comma-delimited string of integers.
388              
389             =cut
390              
391             sub integers {
392 2     2 1 10 my $self = shift;
393              
394 2         5 my @ranges = split ",", $self->output;
395 2         5 my @elements;
396              
397 2         6 for (@ranges) {
398 4         252 for my $value ( eval $_ ) {
399 27         44 push @elements, $value;
400             }
401             }
402              
403 2 100       9 if ( wantarray() ) {
    50          
    0          
404 1         6 return @elements;
405             }
406             elsif ( defined wantarray() ) {
407 1         10 return join ',', @elements;
408             }
409             elsif ( !defined wantarray() ) {
410 0         0 carp 'Useless use of output_elements() in void context';
411             }
412 0         0 else { croak 'Bad context for output_elements()'; }
413             }
414              
415             =item complement( UNIVERSE_START, UNIVERSE_END )
416              
417             Returns the complement of a set of ranges. The output is in list
418             context sorted by range start positions.
419              
420             my $original_range = Number::RangeTracker->new;
421             $original_range->add( [ 11, 20 ], [ 41, 60 ], [ 91, 110 ] );
422              
423             my %complement = $original_range->complement;
424             # -inf => 10,
425             # 21 => 40,
426             # 61 => 90,
427             # 111 => +inf
428              
429             UNIVERSE_START and UNIVERSE_END can be used to specify a finite subset
430             of the 'universe' of numbers (defaults are -/+ infinity. The
431             complement ranges are bounded by these values.
432              
433             %complement = $original_range->complement( 1, 50 );
434             # 1 => 10,
435             # 21 => 40
436              
437             A new object with the complement of a set of ranges can be created
438             quickly and easily.
439              
440             my $complement_range = Number::RangeTracker->new;
441             $complement_range->add( $original_range->complement );
442              
443             =cut
444              
445             sub complement {
446 2     2 1 930 my ( $self, $universe_start, $universe_end ) = @_;
447              
448 2 100       8 $universe_start = '-inf' unless defined $universe_start;
449 2 100       7 $universe_end = '+inf' unless defined $universe_end;
450              
451 2         24 my $complement = Number::RangeTracker->new;
452 2         18 $complement->add( $universe_start, $universe_end );
453 2         6 $complement->remove( $self->output );
454              
455 2         8 return $complement->output;
456             }
457              
458             =back
459              
460             =head1 SEE ALSO
461              
462             =over 4
463              
464             =item Monitor the integers covered by at least one range
465              
466             Although there is some functional overlap between this module,
467             L, and
468             L, Number::RangeTracker
469             is significantly faster.
470              
471             It takes less than one second for Number::RangeTracker to add 100,000
472             overlapping ranges. Over this same period of time, Number::Range and
473             Range::Serial::Object are only able to add 1,000 and 300 ranges,
474             respectively.
475              
476             Some tasks require even higher throughput. When adding 1 million
477             overlapping ranges, Number::Range took >250 times as long as
478             Number::RangeTracker (35 min 31 sec vs. 8 sec). Range::Object::Serial
479             slows exponentially as ranges are added and, therefore, it was not
480             feasible to test this many ranges.
481              
482             =begin HTML
483              
484            

485             width="675" alt="Speed comparison of range modules" />

486              
487             =end HTML
488              
489             =begin text
490              
491             A figure comparing the speed of the three modules is available at:
492             https://raw.githubusercontent.com/mfcovington/Number-RangeTracker/master/compare-modules/speed-comparison.png
493              
494              
495             =end text
496              
497             =back
498              
499             =begin markdown
500              
501             ![See https://raw.githubusercontent.com/mfcovington/Number-RangeTracker/master/compare-modules/speed-comparison.png for a speed comparison of range modules](https://raw.githubusercontent.com/mfcovington/Number-RangeTracker/master/compare-modules/speed-comparison.png "Speed comparison of range modules")
502              
503             =end markdown
504              
505             =over 4
506              
507             =item Ranges with strandedness (like double-stranded DNA or mile posts
508             on a two-way road)
509              
510             L
511              
512             =item Compare numbers in an imprecision-tolerant manner
513              
514             L
515              
516             =item Named ranges
517              
518             L,
519             L
520              
521             =back
522              
523             =head1 SOURCE AVAILABILITY
524              
525             The source code is on Github:
526             L
527              
528             =head1 AUTHOR
529              
530             Michael F. Covington,
531              
532             =head1 BUGS
533              
534             Please report any bugs or feature requests at
535             L.
536              
537             =head1 INSTALLATION
538              
539             To install this module from GitHub using cpanm:
540              
541             cpanm git@github.com:mfcovington/Number-RangeTracker.git
542              
543             Alternatively, download and run the following commands:
544              
545             perl Build.PL
546             ./Build
547             ./Build test
548             ./Build install
549              
550             =head1 SUPPORT AND DOCUMENTATION
551              
552             You can find documentation for this module with the perldoc command.
553              
554             perldoc Number::RangeTracker
555              
556             =head1 LICENSE AND COPYRIGHT
557              
558             Copyright 2014 Michael F. Covington.
559              
560             This program is free software; you can redistribute it and/or modify it
561             under the terms of the the Artistic License (2.0). You may obtain a
562             copy of the full license at:
563              
564             L
565              
566             Any use, modification, and distribution of the Standard or Modified
567             Versions is governed by this Artistic License. By using, modifying or
568             distributing the Package, you accept this license. Do not use, modify,
569             or distribute the Package, if you do not accept this license.
570              
571             If your Modified Version has been derived from a Modified Version made
572             by someone other than you, you are nevertheless required to ensure that
573             your Modified Version complies with the requirements of this license.
574              
575             This license does not grant you the right to use any trademark, service
576             mark, tradename, or logo of the Copyright Holder.
577              
578             This license includes the non-exclusive, worldwide, free-of-charge
579             patent license to make, have made, use, offer to sell, sell, import and
580             otherwise transfer the Package with respect to any patent claims
581             licensable by the Copyright Holder that are necessarily infringed by the
582             Package. If you institute patent litigation (including a cross-claim or
583             counterclaim) against any party alleging that the Package constitutes
584             direct or contributory patent infringement, then this Artistic License
585             to you shall terminate on the date that such litigation is filed.
586              
587             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
588             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
589             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
590             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
591             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
592             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
593             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
594             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
595              
596             =cut
597              
598             __PACKAGE__->meta->make_immutable();