File Coverage

blib/lib/AlignDB/IntSpan.pm
Criterion Covered Total %
statement 551 569 96.8
branch 145 166 87.3
condition 34 45 75.5
subroutine 89 92 96.7
pod 67 74 90.5
total 886 946 93.6


line stmt bran cond sub pod time code
1             package AlignDB::IntSpan;
2 14     14   282322 use strict;
  14         25  
  14         488  
3 14     14   61 use warnings;
  14         24  
  14         436  
4              
5 14     14   56 use Carp;
  14         22  
  14         1188  
6 14     14   69 use Scalar::Util;
  14         23  
  14         777  
7 14     14   7928 use Scalar::Util::Numeric;
  14         10065  
  14         1418  
8              
9             use overload (
10 0     0   0 q{0+} => sub { Carp::confess "Can't numerify an AlignDB::IntSpan\n" },
11 14         175 q{bool} => q{is_not_empty},
12             q{""} => q{as_string},
13              
14             # use Perl standard behaviours for other operations
15             fallback => 1,
16 14     14   19454 );
  14         15516  
17              
18             our $VERSION = '1.1.1';
19              
20             my $POS_INF = 2_147_483_647 - 1; # INT_MAX - 1
21             my $NEG_INF = ( -2_147_483_647 - 1 ) + 1; # INT_MIN + 1
22              
23             sub POS_INF {
24 40     40 1 69 return $POS_INF - 1;
25             }
26              
27             sub NEG_INF {
28 40     40 1 68 return $NEG_INF;
29             }
30              
31             sub EMPTY_STRING {
32 973     973 1 4030 return '-';
33             }
34              
35             sub new {
36 12257     12257 1 2409723 my $class = shift;
37 12257         15021 my $self = {};
38 12257         23012 $self->{edges} = [];
39 12257         14728 bless $self, $class;
40 12257 100       26135 $self->add(@_) if @_ > 0;
41 12251         23815 return $self;
42             }
43              
44             sub valid {
45 6     6 1 3120 my $this = shift;
46 6         6 my $runlist = shift;
47              
48 6   33     31 my $class = ref($this) || $this;
49 6         11 my $set = new $class;
50              
51 6         9 eval { $set->_runlist_to_ranges($runlist) };
  6         10  
52 6 50       492 return $@ ? 0 : 1;
53             }
54              
55             sub clear {
56 2     2 1 4 my $self = shift;
57 2         7 $self->{edges} = [];
58 2         5 return $self;
59             }
60              
61             sub edges_ref {
62 231342     231342 1 181034 my $self = shift;
63 231342         326340 return $self->{edges};
64             }
65              
66             sub edges {
67 105340     105340 1 83748 my $self = shift;
68 105340         82139 return @{ $self->edges_ref };
  105340         117606  
69             }
70              
71             sub edge_size {
72 87530     87530 1 67201 my $self = shift;
73 87530         98914 return scalar $self->edges;
74             }
75              
76             sub span_size {
77 11     11 1 10 my $self = shift;
78 11         14 return $self->edge_size / 2;
79             }
80              
81             sub as_string {
82 498     498 1 8338 my $self = shift;
83              
84 498 100       805 if ( $self->is_empty ) {
85 107         191 return $self->EMPTY_STRING;
86             }
87              
88 391         359 my @runs;
89 391         541 my @edges = $self->edges;
90 391         856 while (@edges) {
91 597         665 my $lower = shift @edges;
92 597         620 my $upper = shift(@edges) - 1;
93 597 100       1890 push @runs, $lower == $upper ? $lower : "$lower-$upper";
94             }
95              
96 391         5069 return join( ',', @runs );
97             }
98              
99             sub as_array {
100 6015     6015 1 389014 my $self = shift;
101              
102 6015         5546 my @elements;
103 6015         8050 my @edges = $self->edges;
104 6015         14145 while (@edges) {
105 25814         23268 my $lower = shift @edges;
106 25814         22889 my $upper = shift(@edges) - 1;
107 25814         55870 push @elements, ( $lower .. $upper );
108             }
109              
110 6015         29574 return @elements;
111             }
112              
113             sub ranges {
114 10374     10374 1 1950227 my $self = shift;
115              
116 10374         9477 my @ranges;
117 10374         13925 my @edges = $self->edges;
118 10374         21018 while (@edges) {
119 18917         17303 my $lower = shift @edges;
120 18917         17927 my $upper = shift(@edges) - 1;
121 18917         39170 push @ranges, ( $lower, $upper );
122             }
123              
124 10374         23483 return @ranges;
125             }
126              
127             sub spans {
128 24     24 1 62 my $self = shift;
129              
130 24         21 my @spans;
131 24         39 my @edges = $self->edges;
132 24         63 while (@edges) {
133 27         33 my $lower = shift @edges;
134 27         31 my $upper = shift(@edges) - 1;
135 27         80 push @spans, [ $lower, $upper ];
136             }
137              
138 24 100       46 if (@spans) {
139 21         58 return @spans;
140             }
141             else {
142 3         9 return;
143             }
144             }
145              
146             sub sets {
147 128     128 1 143 my $self = shift;
148              
149 128         94 my @sets;
150 128         158 my @edges = $self->edges;
151 128         229 while (@edges) {
152 163         173 my $lower = shift @edges;
153 163         176 my $upper = shift(@edges) - 1;
154 163         598 push @sets, Scalar::Util::blessed($self)->new("$lower-$upper");
155             }
156              
157 128 100       224 if (@sets) {
158 125         252 return @sets;
159             }
160             else {
161 3         9 return;
162             }
163             }
164              
165             sub runlists {
166 19     19 1 72 my $self = shift;
167              
168 19 100       47 if ( $self->is_empty ) {
169 2         8 return $self->EMPTY_STRING;
170             }
171              
172 17         23 my @runlists;
173 17         46 my @edges = $self->edges;
174 17         46 while (@edges) {
175 20         28 my $lower = shift @edges;
176 20         29 my $upper = shift(@edges) - 1;
177 20 100       94 my $string = $lower == $upper ? $lower : $lower . '-' . $upper;
178 20         67 push @runlists, $string;
179             }
180              
181 17 50       34 if (@runlists) {
182 17         76 return @runlists;
183             }
184             else {
185 0         0 return;
186             }
187             }
188              
189             sub cardinality {
190 168     168 1 1275 my $self = shift;
191              
192 168         140 my $cardinality = 0;
193 168         196 my @edges = $self->edges;
194 168         309 while (@edges) {
195 218         202 my $lower = shift @edges;
196 218         191 my $upper = shift(@edges) - 1;
197 218         369 $cardinality += $upper - $lower + 1;
198             }
199              
200 168         423 return $cardinality;
201             }
202              
203             sub is_empty {
204 6404     6404 1 5856 my $self = shift;
205 6404 100       8746 my $result = $self->edge_size == 0 ? 1 : 0;
206 6404         10859 return $result;
207             }
208              
209             sub is_not_empty {
210 8     8 1 21 my $self = shift;
211 8         20 return !$self->is_empty;
212             }
213              
214             sub is_neg_inf {
215 19     19 1 19 my $self = shift;
216 19         26 return $self->edges_ref->[0] == $NEG_INF;
217             }
218              
219             sub is_pos_inf {
220 14     14 1 15 my $self = shift;
221 14         17 return $self->edges_ref->[-1] == $POS_INF;
222             }
223              
224             sub is_infinite {
225 2     2 1 3 my $self = shift;
226 2   33     8 return $self->is_neg_inf || $self->is_pos_inf;
227             }
228              
229             sub is_finite {
230 1     1 1 9 my $self = shift;
231 1         3 return !$self->is_infinite;
232             }
233              
234             sub is_universal {
235 13     13 1 12 my $self = shift;
236 13   33     17 return $self->edge_size == 2 && $self->is_neg_inf && $self->is_pos_inf;
237             }
238              
239             sub contains_all {
240 184     184 1 141 my $self = shift;
241              
242 184         182 for my $i (@_) {
243 184         218 my $pos = $self->_find_pos( $i + 1, 0 );
244 184 100       383 return 0 unless $pos & 1;
245             }
246              
247 100         114 return 1;
248             }
249              
250             sub contains_any {
251 3     3 1 7 my $self = shift;
252              
253 3         6 for my $i (@_) {
254 7         13 my $pos = $self->_find_pos( $i + 1, 0 );
255 7 100       17 return 1 if $pos & 1;
256             }
257              
258 2         7 return 0;
259             }
260              
261             #@returns AlignDB::IntSpan
262             sub add_pair {
263 40155     40155 1 32921 my $self = shift;
264 40155         52145 my @ranges = @_;
265              
266 40155 50       64680 if ( scalar(@ranges) != 2 ) {
267 0         0 Carp::confess "Number of ranges must be two: @ranges\n";
268             }
269              
270 40155         53171 my $edges_ref = $self->edges_ref;
271              
272 40155         37914 my $from = shift @ranges;
273 40155         40330 my $to = shift(@ranges) + 1;
274 40155 50       63279 if ( $from > $to ) {
275 0         0 Carp::confess "Bad order: $from-$to\n";
276             }
277 40155         53112 my $from_pos = $self->_find_pos( $from, 0 );
278 40155         59450 my $to_pos = $self->_find_pos( $to + 1, $from_pos );
279              
280 40155 100       66468 if ( $from_pos & 1 ) {
281 9936         11996 $from = $edges_ref->[ --$from_pos ];
282             }
283 40155 100       55684 if ( $to_pos & 1 ) {
284 7291         7819 $to = $edges_ref->[ $to_pos++ ];
285             }
286              
287 40155         30759 splice @{$edges_ref}, $from_pos, $to_pos - $from_pos, ( $from, $to );
  40155         81978  
288              
289 40155         88430 return $self;
290             }
291              
292             #@returns AlignDB::IntSpan
293             sub add_range {
294 31307     31307 1 832207 my $self = shift;
295 31307         46116 my @ranges = @_;
296              
297 31307 50       60331 if ( scalar(@ranges) % 2 == 1 ) {
298 0         0 Carp::confess "Number of ranges must be even: @ranges\n";
299             }
300              
301 31307         51854 while (@ranges) {
302 39277         39537 my $from = shift @ranges;
303 39277         32485 my $to = shift @ranges;
304 39277         55461 $self->add_pair( $from, $to );
305             }
306              
307 31307         38663 return $self;
308             }
309              
310             #@returns AlignDB::IntSpan
311             sub add_runlist {
312 0     0 1 0 my $self = shift;
313 0         0 my $first = shift;
314              
315 0         0 $self->add_range( $self->_runlist_to_ranges($first) );
316              
317 0         0 return $self;
318             }
319              
320             #@returns AlignDB::IntSpan
321             sub add {
322 8120     8120 1 15882 my $self = shift;
323 8120         6589 my $first = shift;
324              
325 8120 100       16698 if ( ref $first eq __PACKAGE__ ) {
    100          
326 6447         8267 $self->add_range( $first->ranges );
327             }
328             elsif ( Scalar::Util::Numeric::isint($first) ) {
329 815 100       1372 if ( scalar @_ > 0 ) {
330 41         90 $self->add_range( $self->_list_to_ranges( $first, @_ ) );
331             }
332             else {
333 774         1146 $self->add_pair( $first, $first );
334             }
335             }
336             else {
337 858         1536 $self->add_range( $self->_runlist_to_ranges($first) );
338             }
339              
340 8114         10539 return $self;
341             }
342              
343             #@returns AlignDB::IntSpan
344             sub invert {
345 5180     5180 1 5033 my $self = shift;
346              
347             # $edges_ref is an ArrayRef, which points to the same array as the
348             # 'edges' attribute. So manipulate $edges_ref affects the attribute
349 5180         7029 my $edges_ref = $self->edges_ref;
350              
351 5180 100       8496 if ( $self->is_empty ) {
352 41         128 $self->{edges} = [ $NEG_INF, $POS_INF ]; # Universal set
353             }
354             else {
355              
356             # Either add or remove infinity from each end. The net
357             # effect is always an even number of additions and deletions
358 5139 100       8186 if ( $edges_ref->[0] == $NEG_INF ) {
359 2536         2171 shift @{$edges_ref};
  2536         3193  
360             }
361             else {
362 2603         2176 unshift @{$edges_ref}, $NEG_INF;
  2603         6468  
363             }
364              
365 5139 100       7843 if ( $edges_ref->[-1] == $POS_INF ) {
366 2536         1966 pop @{$edges_ref};
  2536         2794  
367             }
368             else {
369 2603         2177 push @{$edges_ref}, $POS_INF;
  2603         3655  
370             }
371             }
372              
373 5180         5688 return $self;
374             }
375              
376             #@returns AlignDB::IntSpan
377             sub remove_range {
378 2429     2429 1 735560 my $self = shift;
379              
380 2429         4310 $self->invert;
381 2429         4235 $self->add_range(@_);
382 2429         3702 $self->invert;
383              
384 2429         3374 return $self;
385             }
386              
387             #@returns AlignDB::IntSpan
388             sub remove {
389 861     861 1 2509 my $self = shift;
390 861         704 my $first = shift;
391              
392 861 50       1754 if ( ref $first eq __PACKAGE__ ) {
    0          
393 861         1306 $self->remove_range( $first->ranges );
394             }
395             elsif ( Scalar::Util::Numeric::isint($first) ) {
396 0 0       0 if ( scalar @_ > 0 ) {
397 0         0 $self->remove_range( $self->_list_to_ranges( $first, @_ ) );
398             }
399             else {
400 0         0 $self->remove_range( $first, $first );
401             }
402             }
403             else {
404 0         0 $self->remove_range( $self->_runlist_to_ranges($first) );
405             }
406              
407 861         2275 return $self;
408             }
409              
410             #@returns AlignDB::IntSpan
411             sub merge {
412 167     167 1 1144 my $self = shift;
413              
414 167         256 for my $supplied (@_) {
415 173         277 my @ranges = $self->_real_set($supplied)->ranges;
416 173         353 $self->add_range(@ranges);
417             }
418              
419 167         366 return $self;
420             }
421              
422             #@returns AlignDB::IntSpan
423             sub subtract {
424 141     141 1 135 my $self = shift;
425 141 50       197 return $self if $self->is_empty;
426              
427 141         211 for my $supplied (@_) {
428 141         199 my @ranges = $self->_real_set($supplied)->ranges;
429 141         253 $self->remove_range(@ranges);
430             }
431              
432 141         131 return $self;
433             }
434              
435             #@returns AlignDB::IntSpan
436             sub copy {
437 419     419 1 401 my $self = shift;
438              
439 419         1491 my $copy = Scalar::Util::blessed($self)->new;
440 419         724 $copy->{edges} = [ $self->edges ];
441              
442 419         688 return $copy;
443             }
444              
445             #@returns AlignDB::IntSpan
446             sub union {
447 33     33 1 1059 my $self = shift;
448              
449 33         81 my $new = $self->copy;
450 33         96 $new->merge(@_);
451              
452 33         81 return $new;
453             }
454              
455             #@returns AlignDB::IntSpan
456             sub complement {
457 224     224 1 202 my $self = shift;
458              
459 224         319 my $new = $self->copy;
460 224         368 $new->invert;
461              
462 224         281 return $new;
463             }
464              
465             #@returns AlignDB::IntSpan
466             sub diff {
467 167     167 1 204 my $self = shift;
468              
469 167 100       273 return $self if $self->is_empty;
470              
471 141         240 my $new = $self->copy;
472 141         253 $new->subtract(@_);
473              
474 141         234 return $new;
475             }
476              
477             #@returns AlignDB::IntSpan
478             sub intersect {
479 102     102 1 159 my $self = shift;
480              
481 102 100       168 return $self if $self->is_empty;
482              
483 98         157 my $new = $self->complement;
484 98         149 for my $supplied (@_) {
485 102         160 my $temp_set = $self->_real_set($supplied)->complement;
486 102         194 $new->merge($temp_set);
487             }
488 98         151 $new->invert;
489              
490 98         171 return $new;
491             }
492              
493             #@method
494             #@returns AlignDB::IntSpan
495             sub xor {
496 10     10 1 64 return intersect( union(@_), intersect(@_)->complement );
497             }
498              
499             sub equal {
500 115     115 1 395 my $self = shift;
501              
502 115         220 for (@_) {
503 128         188 my $supplied = $self->_real_set($_);
504              
505 128 100       179 if ( $self->edge_size != $supplied->edge_size ) {
506 40         93 return 0;
507             }
508              
509 88         147 my @edges_a = $self->edges;
510 88         137 my @edges_b = $supplied->edges;
511              
512 88         198 for ( my $i = 0; $i < $self->edge_size; $i++ ) {
513 268 100       542 if ( $edges_a[$i] != $edges_b[$i] ) {
514 18         95 return 0;
515             }
516             }
517             }
518              
519 57         151 return 1;
520             }
521              
522             sub subset {
523 74     74 1 116 my $self = shift;
524 74         107 my $supplied = $self->_real_set(shift);
525              
526 74         126 return $self->diff($supplied)->is_empty;
527             }
528              
529             sub superset {
530 74     74 1 320 my $self = shift;
531 74         97 my $supplied = $self->_real_set(shift);
532              
533 74         130 return $supplied->diff($self)->is_empty;
534             }
535              
536             sub smaller_than {
537 36     36 1 80 my $self = shift;
538 36         26 my $supplied = shift;
539              
540 36   100     58 my $result = $self->subset($supplied) && !$self->equal($supplied);
541              
542 36 100       92 return $result ? 1 : 0;
543             }
544              
545             sub larger_than {
546 36     36 1 84 my $self = shift;
547 36         29 my $supplied = shift;
548              
549 36   100     58 my $result = $self->superset($supplied) && !$self->equal($supplied);
550              
551 36 100       110 return $result ? 1 : 0;
552             }
553              
554             sub at {
555 21     21 1 71 my $self = shift;
556 21         14 my $index = shift;
557 21 100 66     78 if ( $index == 0 || abs($index) > $self->cardinality ) {
558 8         44 return;
559             }
560 13 100       42 my $member = $index < 0 ? $self->_at_neg( -$index ) : $self->_at_pos($index);
561 13         46 return $member;
562             }
563              
564             sub _at_pos {
565 6     6   7 my $self = shift;
566 6         6 my $index = shift;
567              
568 6         6 my $member;
569 6         6 my $element_before = 0;
570              
571 6         9 my @edges = $self->edges;
572 6         16 while (@edges) {
573 9         12 my $lower = shift @edges;
574 9         13 my $upper = shift(@edges) - 1;
575 9         15 my $span_size = $upper - $lower + 1;
576              
577 9 100       14 if ( $index > $element_before + $span_size ) {
578 3         7 $element_before += $span_size;
579             }
580             else {
581 6         9 $member = $index - $element_before - 1 + $lower;
582 6         12 last;
583             }
584             }
585              
586 6         10 return $member;
587             }
588              
589             sub _at_neg {
590 7     7   5 my $self = shift;
591 7         8 my $index = shift;
592              
593 7         5 my $member;
594 7         8 my $element_after = 0;
595              
596 7         9 my @r_edges = reverse $self->edges;
597 7         16 while (@r_edges) {
598 12         13 my $upper = shift(@r_edges) - 1;
599 12         13 my $lower = shift @r_edges;
600 12         13 my $span_size = $upper - $lower + 1;
601              
602 12 100       19 if ( $index > $element_after + $span_size ) {
603 5         7 $element_after += $span_size;
604             }
605             else {
606 7         10 $member = $upper - ( $index - $element_after ) + 1;
607 7         11 last;
608             }
609             }
610              
611 7         11 return $member;
612             }
613              
614             sub index {
615 11     11 1 72 my $self = shift;
616 11         8 my $member = shift;
617              
618 11         11 my $index;
619 11         9 my $element_before = 0;
620              
621 11         17 my @edges = $self->edges;
622 11         27 while (@edges) {
623 16         18 my $lower = shift @edges;
624 16         19 my $upper = shift(@edges) - 1;
625 16         14 my $span_size = $upper - $lower + 1;
626              
627 16 100 100     69 if ( $member >= $lower and $member <= $upper ) {
628 8         11 $index = $member - $lower + 1 + $element_before;
629 8         10 last;
630             }
631             else {
632 8         24 $element_before += $span_size;
633             }
634             }
635              
636 11         55 return $index;
637             }
638              
639             #@returns AlignDB::IntSpan
640             sub slice {
641 11     11 1 36 my $self = shift;
642 11         8 my $from = shift;
643 11         9 my $to = shift;
644              
645 11 100       22 if ( $from < 1 ) {
646 2         277 carp "Start index less than 1\n";
647 2         127 $from = 1;
648             }
649 11         22 my $slice = $self->_splice( $from, $to - $from + 1 );
650              
651 11         25 return $slice;
652             }
653              
654             sub _splice {
655 56     56   146 my $self = shift;
656 56         46 my $offset = shift;
657 56         51 my $length = shift;
658              
659             #@type AlignDB::IntSpan
660 56         229 my $slice = Scalar::Util::blessed($self)->new;
661              
662 56         94 my @edges = $self->edges;
663              
664 56         118 while ( @edges > 1 ) {
665 75         101 my ( $lower, $upper ) = @edges[ 0, 1 ];
666 75         69 my $span_size = $upper - $lower;
667              
668 75 100       95 if ( $offset <= $span_size ) {
669 45         64 last;
670             }
671             else {
672 30         40 splice( @edges, 0, 2 );
673 30         53 $offset -= $span_size;
674             }
675             }
676              
677             @edges
678 56 100       115 or return $slice; # empty set
679              
680 45         56 $edges[0] += $offset - 1;
681              
682 45         93 my @slices = $self->_splice_length( \@edges, $length );
683 45         97 while (@slices) {
684 67         67 my $lower = shift @slices;
685 67         71 my $upper = shift(@slices) - 1;
686 67         96 $slice->add_pair( $lower, $upper );
687             }
688              
689 45         97 return $slice;
690             }
691              
692             sub _splice_length {
693 45     45   42 my $self = shift;
694 45         39 my $edges_ref = shift;
695 45         32 my $length = shift;
696              
697 45 100       87 if ( !defined $length ) {
698 8         7 return @{$edges_ref}; # everything
  8         24  
699             }
700              
701 37 100       56 if ( $length <= 0 ) {
702 2         5 return (); # empty
703             }
704              
705 35         24 my @slices;
706              
707 35         68 while ( @$edges_ref > 1 ) {
708 54         63 my ( $lower, $upper ) = @$edges_ref[ 0, 1 ];
709 54         53 my $span_size = $upper - $lower;
710              
711 54 100       62 if ( $length <= $span_size ) {
712 28         28 last;
713             }
714             else {
715 26         40 push @slices, splice( @$edges_ref, 0, 2 );
716 26         53 $length -= $span_size;
717             }
718             }
719              
720 35 100       71 if (@$edges_ref) {
721 28         31 my $lower = shift @$edges_ref;
722 28         55 push @slices, $lower, $lower + $length;
723             }
724              
725 35         76 return @slices;
726             }
727              
728             sub min {
729 63     63 1 52 my $self = shift;
730              
731 63 50       79 if ( $self->is_empty ) {
732 0         0 return;
733             }
734             else {
735 63         75 return $self->edges_ref->[0];
736             }
737             }
738              
739             sub max {
740 63     63 1 53 my $self = shift;
741              
742 63 50       75 if ( $self->is_empty ) {
743 0         0 return;
744             }
745             else {
746 63         75 return $self->edges_ref->[-1] - 1;
747             }
748             }
749              
750             sub grep_set {
751 30     30 1 198 my $self = shift;
752 30         32 my $code_ref = shift;
753              
754 30         34 my @sub_elements;
755 30         64 for ( $self->elements ) {
756 150 100       2787 if ( $code_ref->() ) {
757 60         2541 push @sub_elements, $_;
758             }
759              
760             }
761 30         776 my $sub_set = Scalar::Util::blessed($self)->new(@sub_elements);
762              
763 30         96 return $sub_set;
764             }
765              
766             sub map_set {
767 48     48 1 271 my $self = shift;
768 48         47 my $code_ref = shift;
769              
770 48         49 my @map_elements;
771 48         104 for ( $self->elements ) {
772 227         769 for my $element ( $code_ref->() ) {
773 224 50       7998 if ( defined $element ) {
774 224         645 push @map_elements, $element;
775             }
776             }
777              
778             }
779 48         332 my $map_set = Scalar::Util::blessed($self)->new(@map_elements);
780              
781 48         118 return $map_set;
782             }
783              
784             sub substr_span {
785 5     5 1 29 my $self = shift;
786 5         7 my $string = shift;
787              
788 5         6 my $sub_string = "";
789 5         14 my @spans = $self->spans;
790              
791 5         13 for (@spans) {
792 7         17 my ( $lower, $upper ) = @$_;
793 7         13 my $length = $upper - $lower + 1;
794              
795 7         21 $sub_string .= substr( $string, $lower - 1, $length );
796             }
797              
798 5         20 return $sub_string;
799             }
800              
801             #@returns AlignDB::IntSpan
802             sub banish_span {
803 6     6 1 37 my $self = shift;
804 6         8 my $start = shift;
805 6         8 my $end = shift;
806              
807 6         14 my $remove_length = $end - $start + 1;
808              
809             my $new = $self->map_set(
810             sub {
811 17 100   17   56 $_ < $start ? $_
    100          
812             : $_ > $end ? $_ - $remove_length
813             : ();
814             }
815 6         39 );
816              
817 6         36 return $new;
818             }
819              
820             #@returns AlignDB::IntSpan
821             sub cover {
822 6     6 1 26 my $self = shift;
823              
824 6         49 my $cover = Scalar::Util::blessed($self)->new;
825 6 100       14 if ( $self->is_not_empty ) {
826 5         12 $cover->add_pair( $self->min, $self->max );
827             }
828 6         16 return $cover;
829             }
830              
831             #@returns AlignDB::IntSpan
832             sub holes {
833 14     14 1 32 my $self = shift;
834              
835 14         42 my $holes = Scalar::Util::blessed($self)->new;
836              
837 14 100 66     30 if ( $self->is_empty or $self->is_universal ) {
838              
839             # empty set and universal set have no holes
840             }
841             else {
842 13         22 my $c_set = $self->complement;
843 13         21 my @ranges = $c_set->ranges;
844              
845             # Remove infinite arms of complement set
846 13 50       21 if ( $c_set->is_neg_inf ) {
847 13         11 shift @ranges;
848 13         14 shift @ranges;
849             }
850 13 50       21 if ( $c_set->is_pos_inf ) {
851 13         14 pop @ranges;
852 13         11 pop @ranges;
853             }
854 13         22 $holes->add_range(@ranges);
855             }
856              
857 14         32 return $holes;
858             }
859              
860             #@returns AlignDB::IntSpan
861             sub inset {
862 18     18 1 45 my $self = shift;
863 18         17 my $n = shift;
864              
865 18         68 my $inset = Scalar::Util::blessed($self)->new;
866 18         30 my @edges = $self->edges;
867 18         36 while (@edges) {
868 38         43 my $lower = shift @edges;
869 38         36 my $upper = shift(@edges) - 1;
870 38 100       57 if ( $lower != $self->NEG_INF ) {
871 34         35 $lower += $n;
872             }
873 38 100       50 if ( $upper != $self->POS_INF ) {
874 34         78 $upper -= $n;
875             }
876 38 100       85 $inset->add_pair( $lower, $upper )
877             if $lower <= $upper;
878             }
879              
880 18         35 return $inset;
881             }
882              
883             #@returns AlignDB::IntSpan
884             sub trim {
885 1     1 1 2 my $self = shift;
886 1         2 my $n = shift;
887 1         4 return $self->inset($n);
888             }
889              
890             #@returns AlignDB::IntSpan
891             sub pad {
892 1     1 1 2 my $self = shift;
893 1         3 my $n = shift;
894 1         4 return $self->inset( -$n );
895             }
896              
897             #@returns AlignDB::IntSpan
898             sub excise {
899 7     7 1 19 my $self = shift;
900 7         8 my $minlength = shift;
901              
902 7         24 my $set = Scalar::Util::blessed($self)->new;
903 7         14 map { $set->merge($_) } grep { $_->size >= $minlength } $self->sets;
  10         17  
  14         20  
904              
905 7         19 return $set;
906             }
907              
908             #@returns AlignDB::IntSpan
909             sub fill {
910 8     8 1 21 my $self = shift;
911 8         9 my $maxlength = shift;
912              
913 8         15 my $set = $self->copy;
914 8 50       17 if ( $maxlength > 0 ) {
915 8         13 for my $hole ( $set->holes->sets ) {
916 11 100       21 if ( $hole->size <= $maxlength ) {
917 9         14 $set->merge($hole);
918             }
919             }
920             }
921 8         33 return $set;
922             }
923              
924             sub overlap {
925 63     63 1 65 my $self = shift;
926 63         51 my $supplied = shift;
927 63         92 return $self->intersect($supplied)->size;
928             }
929              
930             sub distance {
931 28     28 1 42 my $self = shift;
932 28         25 my $supplied = shift;
933              
934 28 50 33     35 return unless $self->size and $supplied->size;
935              
936 28         42 my $overlap = $self->overlap($supplied);
937 28 100       70 return -$overlap if $overlap;
938              
939 24         25 my $min_d;
940 24         35 for my $span1 ( $self->sets ) {
941 29         46 for my $span2 ( $supplied->sets ) {
942 29         71 my $d1 = abs( $span1->min - $span2->max );
943 29         53 my $d2 = abs( $span1->max - $span2->min );
944 29 100       58 my $d = $d1 < $d2 ? $d1 : $d2;
945 29 100 100     86 if ( !defined $min_d or $d < $min_d ) {
946 27         64 $min_d = $d;
947             }
948             }
949             }
950              
951 24         45 return $min_d;
952             }
953              
954             #@returns AlignDB::IntSpan
955             sub find_islands {
956 11     11 1 63 my $self = shift;
957 11         10 my $supplied = shift;
958              
959 11         13 my $island;
960 11 100       31 if ( ref $supplied eq __PACKAGE__ ) {
    50          
961 4         12 $island = $self->_find_islands_set($supplied);
962             }
963             elsif ( Scalar::Util::Numeric::isint($supplied) ) {
964 7         10 $island = $self->_find_islands_int($supplied);
965             }
966             else {
967 0         0 Carp::confess "Don't know how to deal with input to find_island\n";
968             }
969              
970 11         18 return $island;
971             }
972              
973             sub _find_islands_int {
974 7     7   7 my $self = shift;
975 7         6 my $number = shift;
976              
977 7         30 my $island = Scalar::Util::blessed($self)->new;
978              
979             # if $pos & 1, i.e. $pos is odd number, $val is in the set
980 7         14 my $pos = $self->_find_pos( $number + 1, 0 );
981 7 100       16 if ( $pos & 1 ) {
982 5         9 my @ranges = $self->ranges;
983 5         12 $island->add_range( $ranges[ $pos - 1 ], $ranges[$pos] );
984             }
985              
986 7         10 return $island;
987             }
988              
989             sub _find_islands_set {
990 4     4   5 my $self = shift;
991 4         2 my $supplied = shift;
992              
993 4         13 my $islands = Scalar::Util::blessed($self)->new;
994              
995 4 50       11 if ( $self->overlap($supplied) ) {
996 4         8 for my $subset ( $self->sets ) {
997 8 100       11 $islands->merge($subset) if $subset->overlap($supplied);
998             }
999             }
1000              
1001 4         11 return $islands;
1002             }
1003              
1004             #@returns AlignDB::IntSpan
1005             sub nearest_island {
1006 10     10 1 54 my $self = shift;
1007 10         10 my $supplied = shift;
1008              
1009 10 100       31 if ( ref $supplied eq __PACKAGE__ ) { # just OK
    50          
1010             }
1011             elsif ( Scalar::Util::Numeric::isint($supplied) ) {
1012 7         23 $supplied = Scalar::Util::blessed($self)->new($supplied);
1013             }
1014             else {
1015 0         0 Carp::confess "Don't know how to deal with input to nearest_island\n";
1016             }
1017              
1018 10         31 my $island = Scalar::Util::blessed($self)->new;
1019 10         11 my $min_d;
1020 10         17 for my $s ( $self->sets ) {
1021 19         32 for my $ss ( $supplied->sets ) {
1022 19 100       28 next if $s->overlap($ss);
1023 17         36 my $d = $s->distance($ss);
1024 17 100 100     51 if ( !defined $min_d or $d <= $min_d ) {
1025 14 100 100     38 if ( defined $min_d and $d == $min_d ) {
1026 2         5 $island->merge($s);
1027             }
1028             else {
1029 12         17 $min_d = $d;
1030 12         24 $island = $s->copy;
1031             }
1032             }
1033             }
1034             }
1035              
1036 10         34 return $island;
1037             }
1038              
1039             sub at_island {
1040 13     13 1 49 my $self = shift;
1041 13         11 my $index = shift;
1042              
1043 13 100 100     48 return if $index == 0 or abs($index) > $self->span_size;
1044              
1045 8         17 my @islands = $self->sets;
1046              
1047 8 100       28 return $index < 0 ? $islands[$index] : $islands[ $index - 1 ];
1048             }
1049              
1050             #----------------------------------------------------------#
1051             # Internal methods
1052             #----------------------------------------------------------#
1053             # Converts a list of integers into pairs of ranges
1054             sub _list_to_ranges {
1055 41     41   46 my $self = shift;
1056              
1057 41         122 my @list = sort { $a <=> $b } @_;
  617         664  
1058 41         38 my @ranges;
1059 41         47 my $count = scalar @list;
1060 41         47 my $pos = 0;
1061 41         85 while ( $pos < $count ) {
1062 164         144 my $end = $pos + 1;
1063 164   100     1181 $end++ while $end < $count && $list[$end] <= $list[ $end - 1 ] + 1;
1064 164         247 push @ranges, ( $list[$pos], $list[ $end - 1 ] );
1065 164         281 $pos = $end;
1066             }
1067              
1068 41         184 return @ranges;
1069             }
1070              
1071             # Converts a runlist into pairs of ranges
1072             sub _runlist_to_ranges {
1073 864     864   823 my $self = shift;
1074              
1075 864         824 my $runlist = shift;
1076 864         2711 $runlist =~ s/\s|_//g;
1077 864 100       1393 return if $runlist eq $self->EMPTY_STRING;
1078              
1079 747         769 my @ranges;
1080              
1081 747         2036 for my $run ( split ",", $runlist ) {
1082 1165 100       5296 if ( $run =~ /^ (-?\d+) $/x ) {
    100          
1083 199         492 push @ranges, ( $1, $1 );
1084             }
1085             elsif ( $run =~ /^ (-?\d+) - (-?\d+) $/x ) {
1086 956 100       2993 Carp::confess "Bad order: $runlist\n" if $1 > $2;
1087 954         2380 push @ranges, ( $1, $2 );
1088             }
1089             else {
1090 10         1117 Carp::confess "Bad syntax: $runlist\n";
1091             }
1092             }
1093              
1094 735         2454 return @ranges;
1095             }
1096              
1097             # Converts a set specification into a set
1098             sub _real_set {
1099 692     692   640 my $self = shift;
1100 692         592 my $supplied = shift;
1101              
1102 692 100 66     2856 if ( defined $supplied and ref $supplied eq __PACKAGE__ ) {
1103 688         1272 return $supplied;
1104             }
1105             else {
1106 4         21 return Scalar::Util::blessed($self)->new($supplied);
1107             }
1108             }
1109              
1110             # Return the index of the first element >= the supplied value.
1111             #
1112             # If the supplied value is larger than any element in the list the returned
1113             # value will be equal to the size of the list.
1114             #
1115             # If $pos & 1, i.e. $pos is odd number, $val is in the set
1116             sub _find_pos {
1117 80508     80508   63994 my $self = shift;
1118 80508         61527 my $val = shift;
1119 80508         60926 my $low = shift;
1120              
1121 80508         88028 my $edges_ref = $self->edges_ref;
1122 80508         96720 my $high = $self->edge_size;
1123              
1124 80508         135467 while ( $low < $high ) {
1125 90913         99838 my $mid = int( ( $low + $high ) / 2 );
1126 90913 100       137843 if ( $val < $edges_ref->[$mid] ) {
    100          
1127 33276         52333 $high = $mid;
1128             }
1129             elsif ( $val > $edges_ref->[$mid] ) {
1130 49079         81754 $low = $mid + 1;
1131             }
1132             else {
1133 8558         13062 return $mid;
1134             }
1135             }
1136              
1137 71950         74344 return $low;
1138             }
1139              
1140             #----------------------------------------------------------#
1141             # Aliases
1142             #----------------------------------------------------------#
1143              
1144 298     298 0 1073 sub runlist { shift->as_string(@_); }
1145 78     78 0 173 sub elements { shift->as_array(@_); }
1146 146     146 0 211 sub size { shift->cardinality(@_); }
1147 0     0 0 0 sub count { shift->cardinality(@_); }
1148 184     184 0 529 sub contains { shift->contains_all(@_); }
1149 1     1 0 7 sub intersection { shift->intersect(@_); }
1150 17     17 0 42 sub equals { shift->equal(@_); }
1151              
1152             1; # Magic true value required at end of module
1153              
1154             __END__