Set-IntSpan-1.19/0000755000076400007640000000000012131014154012565 5ustar swmcdswmcdSet-IntSpan-1.19/Makefile.PL0000644000076400007640000000060410051570572014551 0ustar swmcdswmcduse ExtUtils::MakeMaker; WriteMakefile(NAME => 'Set::IntSpan', VERSION_FROM => 'IntSpan.pm', # finds $VERSION DISTNAME => 'Set-IntSpan', ($] >= 5.005 ? (ABSTRACT => 'Manages sets of integers, newsrc style', AUTHOR => 'Steven McDougall (swmcd@world.std.com)') : ()), dist => {COMPRESS => 'gzip', SUFFIX => 'gz'} ); Set-IntSpan-1.19/README0000644000076400007640000000147712126715346013475 0ustar swmcdswmcdSet::IntSpan - manage sets of integers DESCRIPTION Set::IntSpan manages sets of integers. It is optimized for sets that have long runs of consecutive integers. These arise, for example, in .newsrc files, which maintain lists of articles: alt.foo: 1-21,28,31 alt.bar: 1-14192,14194,14196-14221 Sets are stored internally in a run-length coded form. This provides for both compact storage and efficient computation. In particular, set operations can be performed directly on the encoded representation. HOW TO BUILD AND INSTALL perl Makefile.PL make make test make install TODO Nothing planned. Send suggestions, bugs, etc. to swmcd@world.std.com COPYRIGHT Copyright (c) 1996-2013 by Steven McDougall. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Set-IntSpan-1.19/t/0000755000076400007640000000000012131014154013030 5ustar swmcdswmcdSet-IntSpan-1.19/t/ord.t0000644000076400007640000000237512126715346014027 0ustar swmcdswmcd# -*- perl -*- use strict; use Set::IntSpan 1.17; my $N = 1; sub Not { print "not " } sub OK { my($function, $test) = @_; $test ||= []; for (@$test) { defined $_ or $_ = '' } my $expected = pop @$test; print "ok $N $function: @$test\t-> $expected\n"; $N++; } my @Ord_die = ( [ '(-0', 42, '' ], ); my @Ord_test = ( [ '-' , 0, undef ], [ '0' , 0, 0 ], [ '1' , 0, undef ], [ '1' , 2, undef ], [ '1,3-5' , 0, undef ], [ '1,3-5' , 1, 0 ], [ '1,3-5' , 2, undef ], [ '1,3-5' , 3, 1 ], [ '1,3-5' , 4, 2 ], [ '1,3-5' , 5, 3 ], [ '1,3-5' , 6, undef ], [ '1-)' , 0, undef ], [ '1-)' , 1, 0 ], [ '1-)' , 8, 7 ], [ '1-5,11-15,21-25', 21, 10 ], ); print "1..", @Ord_die + @Ord_test, "\n"; for my $test (@Ord_die) { my($run_list, $n) = @$test; eval { Set::IntSpan->new($run_list)->ord($n) }; $@ or Not; OK("ord", $test); } for my $test (@Ord_test) { my($run_list, $n, $i) = @$test; equal(Set::IntSpan->new($run_list)->ord($n), $i) or Not; OK("ord", $test); } sub equal { my($a, $b) = @_; not defined $a and not defined $b or defined $a and defined $b and $a == $b } Set-IntSpan-1.19/t/cardinal.t0000644000076400007640000000432012126715346015010 0ustar swmcdswmcd# -*- perl -*- use strict; use Set::IntSpan 1.17; my $N = 1; sub Not { print "not " } sub OK { print "ok ", $N++, "\n" } my @Cardinality = # C E F N P I U < > ([' - ', 0, 1, 1, 0, 0, 0, 0, undef, undef ], [' (-) ', -1, 0, 0, 1, 1, 1, 1, undef, undef ], [' (-0 ', -1, 0, 0, 1, 0, 1, 0, undef, 0 ], [' 0-) ', -1, 0, 0, 0, 1, 1, 0, 0 , undef ], [' 1 ', 1, 0, 1, 0, 0, 0, 0, 1 , 1 ], [' 5 ', 1, 0, 1, 0, 0, 0, 0, 5 , 5 ], [' 1,3,5', 3, 0, 1, 0, 0, 0, 0, 1 , 5 ], [' 1,3-5', 4, 0, 1, 0, 0, 0, 0, 1 , 5 ], ['-1-5 ', 7, 0, 1, 0, 0, 0, 0, -1 , 5 ], ); print "1..", 9 * @Cardinality, "\n"; Cardinality(); Empty(); Finite(); Neg_inf(); Pos_inf(); Infinite(); Universal(); Min(); Max(); sub Cardinality { print "#cardinality\n"; for my $t (@Cardinality) { my $operand = $t->[0]; my $set = new Set::IntSpan $operand; my $expected = $t->[1]; my $result = $set->cardinality(); printf "#%-12s %-12s -> %d\n", 'cardinality', $operand, $result; $result == $expected or Not; OK; } } sub Empty { Size("empty" , 2) } sub Finite { Size("finite" , 3) } sub Neg_inf { Size("neg_inf" , 4) } sub Pos_inf { Size("pos_inf" , 5) } sub Infinite { Size("infinite" , 6) } sub Universal { Size("universal", 7) } sub Size { my($method, $column) = @_; print "#$method\n"; for my $t (@Cardinality) { my $operand = $t->[0]; my $set = new Set::IntSpan $operand; my $expected = $t->[$column]; my $result = $set->$method(); printf "#%-12s %-12s -> %d\n", $method, $operand, $result; $result ? $expected : ! $expected or Not; OK; } } sub Min { Extrema("min", 8) } sub Max { Extrema("max", 9) } sub Extrema { my($method, $column) = @_; print "#$method\n"; for my $t (@Cardinality) { my $operand = $t->[0]; my $set = new Set::IntSpan $operand; my $expected = $t->[$column]; my $result = $set->$method(); printf "#%-12s %-12s -> %s\n", $method, $operand, defined $result ? $result : 'undef'; not defined $result and not defined $expected or defined $result and defined $expected and $result==$expected or Not; OK; } } Set-IntSpan-1.19/t/iterator.t0000644000076400007640000001445712126715346015100 0ustar swmcdswmcd# -*- perl -*- use strict; use Set::IntSpan 1.17 qw(grep_set map_set); my $N = 1; sub Not { print "not " } sub OK { print "ok ", $N++, "\n" } sub Equal { my($a, $b) = @_; @$a==@$b or return 0; while (@$a) { shift @$a == shift @$b or return 0 } 1 } my @Sets = split(' ', q{ - (-) (-0 0-) 1 5 1-5 3-7 1-3,8,10-23 }); my @Greps = qw(1 0 $_==1 $_<5 $_&1); my @Maps = ('', split(' ', q{1 $_ -$_ $_+5 -$_,$_ $_%5})); # - (-) (-0 0-) 1 5 1-5 3-7 1--23 my @First = (undef, undef, undef, 0, 1, 5, 1, 3, 1); my @Last = (undef, undef, 0, undef, 1, 5, 5, 7, 23); my @Start = (undef, 0, 0, 0, undef, undef, undef, undef, undef); print "1..", @Sets * (@Greps + @Maps + 3) + 3*16 + 2*6 + 11 + 12, "\n"; Grep (); Map (); First (); Last (); Start (); StartN (); Next (); Prev (); Current(); Wrap (); sub Grep { print "#grep_set\n"; my @exp4 = ('-', undef, undef, undef); my @expected = ([@exp4, '1', '5', '1-5' , '3-7' , '1-3,8,10-23' ], [@exp4, '-', '-', '-' , '-' , '-' ], [@exp4, '1', '-', '1' , '-' , '1' ], [@exp4, '1', '-', '1-4' , '3-4' , '1-3' ], [@exp4, '1', '5', '1,3,5', '3,5,7', '1,3,11,13,15,17,19,21,23']); for (my $s=0; $s<@Sets; $s++) { for (my $g=0; $g<@Greps; $g++) { my $set = new Set::IntSpan $Sets[$s]; my $result = grep_set { eval $Greps[$g] } $set; my $expected = $expected[$g][$s]; my $pResult = defined $result ? $result->run_list : 'undef'; printf "#%3d: grep_set { %-8s } %-12s -> %s\n", $N, $Greps[$g], $Sets[$s], $pResult; not defined $result and not defined $expected or defined $result and defined $expected and $result->run_list eq $expected or Not; OK; } } } sub Map { print "#map_set\n"; my @exp4 = ('-', undef, undef, undef); my @expected = ([@exp4, '-' , '-' , '-' , '-' , '-' ], [@exp4, '1' , '1' , '1' , '1' , '1' ], [@exp4, '1' , '5' , '1-5' , '3-7' , '1-3,8,10-23' ], [@exp4, '-1' , '-5' , '-5--1' , '-7--3' , '-23--10,-8,-3--1'], [@exp4, '6' , '10' , '6-10' , '8-12' , '6-8,13,15-28' ], [@exp4, '-1,1', '-5,5', '-5--1,1-5', '-7--3,3-7', '-23--10,-8,-3--1,1-3,8,10-23'], [@exp4, '1' , '0' , '0-4' , '0-4' , '0-4' ]); for (my $s=0; $s<@Sets; $s++) { for (my $m=0; $m<@Maps; $m++) { my $set = new Set::IntSpan $Sets[$s]; my $result = map_set { eval $Maps[$m] } $set; my $expected = $expected[$m][$s]; my $pResult = defined $result ? $result->run_list : 'undef'; printf "#%3d: map_set { %-8s } %-12s -> %s\n", $N, $Maps[$m], $Sets[$s], $pResult; not defined $result and not defined $expected or defined $result and defined $expected and $result->run_list eq $expected or Not; OK; } } } sub First { Terminal('first', @First); } sub Last { Terminal('last' , @Last ); } sub Start { Terminal('start', @Start); } sub Terminal { my($method, @expected) = @_; print "#$method\n"; for (my $s=0; $s<@Sets; $s++) { my $set = new Set::IntSpan $Sets[$s]; my $result = $set->$method(0); my $expected = $expected[$s]; my $pResult = defined $result ? $result : 'undef'; printf "#%3d: %-9s { %-12s } -> %s\n", $N, $method, $Sets[$s], $pResult; not defined $result and not defined $expected or defined $result and defined $expected and $result == $expected or Not; OK; } } sub StartN { print "#start()\n"; for my $runList ('2-5,8,10-14', '(-5,8,10-14', '2-5,8,10-)') { my $set = new Set::IntSpan $runList; for my $n (0..15) { my $result = $set->start($n); my $expected = $set->member($n) ? $n : undef; my $pResult = defined $result ? $result : 'undef'; printf "#%3d: start(%2d) { %12s } -> %s\n", $N, $n, $runList, $pResult; not defined $result and not defined $expected or defined $result and defined $expected and $result == $expected or Not; OK; } } } sub Next { print "#next\n"; for my $runList (@Sets) { my $set = new Set::IntSpan $runList; finite $set or next; my @result; for (my $n=$set->first; defined $n; $n=$set->next) { push @result, $n; } my @expected = elements $set; printf "#%3d: next: %12s -> %s\n", $N, $runList, join(',', @expected); Equal(\@result, \@expected) or Not; OK; } } sub Prev { print "#prev\n"; for my $runList (@Sets) { my $set = new Set::IntSpan $runList; finite $set or next; my @result; for (my $n=$set->last; defined $n; $n=$set->prev) { push @result, $n; } my @expected = reverse elements $set; printf "#%3d: prev: %12s -> %s\n", $N, $runList, join(',', @expected); Equal(\@result, \@expected) or Not; OK; } } sub Table { map { [ split(' ', $_) ] } split(/\n/, shift) } sub Current { print "#current\n"; my $set = new Set::IntSpan '(-0, 3-5, 7-)'; $set->start(0); my @walk = Table <$direction(); my $result = $set->current; printf "#%3d: $direction -> $result\n", $N; $result==$expected or Not; OK; } } sub Wrap { print "#wrap\n"; my @forward = (1, 2, undef, 1, 2, undef); my @backward = (2, 1, undef, 2, 1, undef); my $set = new Set::IntSpan '1-2'; for my $i (0..5) { my $result = $set->next; my $expected = $forward[$i]; my $pResult = defined $result ? $result : 'undef'; printf "#%3d: next -> $pResult\n", $N; not defined $result and not defined $expected or defined $result and defined $expected and $result == $expected or Not; OK; } for my $i (0..5) { my $result = $set->prev; my $expected = $backward[$i]; my $pResult = defined $result ? $result : 'undef'; printf "#%3d: next -> $pResult\n", $N; not defined $result and not defined $expected or defined $result and defined $expected and $result == $expected or Not; OK; } } Set-IntSpan-1.19/t/set_spec.t0000644000076400007640000000127412126715346015045 0ustar swmcdswmcd# -*- perl -*- use strict; use Set::IntSpan 1.17; my $N = 1; sub Not { print "not " } sub OK { print "ok ", $N++, "\n" } print "1..3\n"; print "#set specification\n"; my $set = new Set::IntSpan; my $run_list = run_list $set; print "#set spec: new Set::IntSpan -> $run_list\n"; empty $set or Not; OK; my $set_1 = new Set::IntSpan "1-5"; my $set_2 = new Set::IntSpan $set_1; my $set_3 = new Set::IntSpan [1, 2, 3, 4, 5]; my $run_list_1 = run_list $set_1; my $run_list_2 = run_list $set_2; my $run_list_3 = run_list $set_3; print "#set_spec: $run_list_1 -> $run_list_2\n"; $set_1->equal($set_2) or Not; OK; print "#set_spec: [1, 2, 3, 4, 5] -> $run_list_3\n"; $set_1->equal($set_3) or Not; OK; Set-IntSpan-1.19/t/use-int.t0000644000076400007640000000071112130716156014612 0ustar swmcdswmcd# -*- perl -*- use strict; use Config; BEGIN { $Set::IntSpan::integer = 1 } use Set::IntSpan 1.17; my $N = 1; sub Not { print "not " } sub OK { print "ok ", $N++, " @_\n" } print "1..1\n"; my $set = new Set::IntSpan '1_000_000_000_000-1_000_000_000_100'; for my $i (0..100) { insert $set 2e12+$i; } if ($Config{ivsize}==4) { $set eq '1000000000000-1000000000100' or Not; OK 'use integer'; } else { OK '# SKIP not a 32-bit platform'; } Set-IntSpan-1.19/t/real_set.t0000644000076400007640000000151612126715346015035 0ustar swmcdswmcd# -*- perl -*- use strict; use Set::IntSpan 1.17; my $N = 1; sub Not { print "not " } sub OK { print "ok ", $N++, "\n" } print "1..4\n"; print "#real_set\n"; my $set = new Set::IntSpan; my $set_1 = union $set; my $run_list_1 = run_list $set_1; print "#real_set: union set -> $run_list_1\n"; empty $set_1 or Not; OK; my $set_2 = union $set "1-5,8-9"; my $set_3 = union $set $set_2; my $set_4 = union $set +[1, 5, 2, 8, 9, 1, 3, 4, 9]; my $run_list_2 = run_list $set_2; my $run_list_3 = run_list $set_3; my $run_list_4 = run_list $set_4; print "#real_set: $run_list_2 -> $run_list_3\n"; $set_2->equal($set_3) or Not; OK; print "#real_set: $run_list_2 -> $run_list_4\n"; $set_2->equal($set_4) or Not; OK; my $set_5 = union $set "0"; my $run_list_5 = run_list $set_5; print "#real_set: $run_list_5 -> 0\n"; $run_list_5 eq "0" or Not; OK; Set-IntSpan-1.19/t/binary.t0000644000076400007640000000554012126715346014524 0ustar swmcdswmcd# -*- perl -*- use strict; use Set::IntSpan 1.17; my $N = 1; sub Not { print "not " } sub OK { print "ok ", $N++, "\n" } sub Table { map { [ split(' ', $_) ] } split(/\s*\n\s*/, shift) } # A B U I X A-B B-A my @Binaries = Table <[0], $t->[1], $t->[2]); Binary("union", $t->[1], $t->[0], $t->[2]); B ("U" , $t->[0], $t->[1], $t->[2]); B ("U" , $t->[1], $t->[0], $t->[2]); } } sub Intersect { print "#intersect\n"; for my $t (@Binaries) { Binary("intersect", $t->[0], $t->[1], $t->[3]); Binary("intersect", $t->[1], $t->[0], $t->[3]); B ("I" , $t->[0], $t->[1], $t->[3]); B ("I" , $t->[1], $t->[0], $t->[3]); } } sub Xor { print "#xor\n"; for my $t (@Binaries) { Binary("xor", $t->[0], $t->[1], $t->[4]); Binary("xor", $t->[1], $t->[0], $t->[4]); B ("X" , $t->[0], $t->[1], $t->[4]); B ("X" , $t->[1], $t->[0], $t->[4]); } } sub Diff { print "#diff\n"; for my $t (@Binaries) { Binary("diff", $t->[0], $t->[1], $t->[5]); Binary("diff", $t->[1], $t->[0], $t->[6]); B ("D" , $t->[0], $t->[1], $t->[5]); B ("D" , $t->[1], $t->[0], $t->[6]); } } sub Binary { my($method, $op1, $op2, $expected) = @_; my $set1 = new Set::IntSpan $op1; my $set2 = new Set::IntSpan $op2; my $setE = $set1->$method($set2); my $run_list = run_list $setE; printf "#%-12s %-10s %-10s -> %-10s\n", $method, $op1, $op2, $run_list; $run_list eq $expected or Not; OK; } sub B { my($method, $op1, $op2, $expected) = @_; my $set1 = new Set::IntSpan $op1; my $set2 = new Set::IntSpan $op2; $set1->$method($set2); my $run_list = run_list $set1; printf "#%-12s %-10s %-10s -> %-10s\n", $method, $op1, $op2, $run_list; $run_list eq $expected or Not; OK; } Set-IntSpan-1.19/t/bsearch.t0000644000076400007640000001200412126715346014640 0ustar swmcdswmcd# -*- perl -*- use strict; use Set::IntSpan 1.17; my $N = 1; sub Not { print "not " } sub OK { print "ok ", $N++, "\n" } my @tests = ( [ [] , 0, 0 ], [ [ 1 ], 0, 0 ], [ [ 1 ], 1, 0 ], [ [ 1 ], 2, 1 ], [ [ 1, 2 ], 0, 0 ], [ [ 1, 2 ], 1, 0 ], [ [ 1, 2 ], 2, 1 ], [ [ 1, 2 ], 3, 2 ], [ [ 1, 3 ], 0, 0 ], [ [ 1, 3 ], 1, 0 ], [ [ 1, 3 ], 2, 1 ], [ [ 1, 3 ], 3, 1 ], [ [ 1, 3 ], 4, 2 ], [ [ 1, 3, 5 ], 0, 0 ], [ [ 1, 3, 5 ], 1, 0 ], [ [ 1, 3, 5 ], 2, 1 ], [ [ 1, 3, 5 ], 3, 1 ], [ [ 1, 3, 5 ], 4, 2 ], [ [ 1, 3, 5 ], 5, 2 ], [ [ 1, 3, 5 ], 6, 3 ], [ [ 1, 3, 5, 7 ], 0, 0 ], [ [ 1, 3, 5, 7 ], 1, 0 ], [ [ 1, 3, 5, 7 ], 2, 1 ], [ [ 1, 3, 5, 7 ], 3, 1 ], [ [ 1, 3, 5, 7 ], 4, 2 ], [ [ 1, 3, 5, 7 ], 5, 2 ], [ [ 1, 3, 5, 7 ], 6, 3 ], [ [ 1, 3, 5, 7 ], 7, 3 ], [ [ 1, 3, 5, 7 ], 8, 4 ], [ [ 1, 3, 5, 7, 9 ], 0, 0 ], [ [ 1, 3, 5, 7, 9 ], 1, 0 ], [ [ 1, 3, 5, 7, 9 ], 2, 1 ], [ [ 1, 3, 5, 7, 9 ], 3, 1 ], [ [ 1, 3, 5, 7, 9 ], 4, 2 ], [ [ 1, 3, 5, 7, 9 ], 5, 2 ], [ [ 1, 3, 5, 7, 9 ], 6, 3 ], [ [ 1, 3, 5, 7, 9 ], 7, 3 ], [ [ 1, 3, 5, 7, 9 ], 8, 4 ], [ [ 1, 3, 5, 7, 9 ], 9, 4 ], [ [ 1, 3, 5, 7, 9 ], 10, 5 ], [ [ 1, 3, 5, 7, 9, 11 ], 0, 0 ], [ [ 1, 3, 5, 7, 9, 11 ], 1, 0 ], [ [ 1, 3, 5, 7, 9, 11 ], 2, 1 ], [ [ 1, 3, 5, 7, 9, 11 ], 3, 1 ], [ [ 1, 3, 5, 7, 9, 11 ], 4, 2 ], [ [ 1, 3, 5, 7, 9, 11 ], 5, 2 ], [ [ 1, 3, 5, 7, 9, 11 ], 6, 3 ], [ [ 1, 3, 5, 7, 9, 11 ], 7, 3 ], [ [ 1, 3, 5, 7, 9, 11 ], 8, 4 ], [ [ 1, 3, 5, 7, 9, 11 ], 9, 4 ], [ [ 1, 3, 5, 7, 9, 11 ], 10, 5 ], [ [ 1, 3, 5, 7, 9, 11 ], 11, 5 ], [ [ 1, 3, 5, 7, 9, 11 ], 12, 6 ], [ [ 1, 3, 5, 7, 9, 11, 13 ], 0, 0 ], [ [ 1, 3, 5, 7, 9, 11, 13 ], 1, 0 ], [ [ 1, 3, 5, 7, 9, 11, 13 ], 2, 1 ], [ [ 1, 3, 5, 7, 9, 11, 13 ], 3, 1 ], [ [ 1, 3, 5, 7, 9, 11, 13 ], 4, 2 ], [ [ 1, 3, 5, 7, 9, 11, 13 ], 5, 2 ], [ [ 1, 3, 5, 7, 9, 11, 13 ], 6, 3 ], [ [ 1, 3, 5, 7, 9, 11, 13 ], 7, 3 ], [ [ 1, 3, 5, 7, 9, 11, 13 ], 8, 4 ], [ [ 1, 3, 5, 7, 9, 11, 13 ], 9, 4 ], [ [ 1, 3, 5, 7, 9, 11, 13 ], 10, 5 ], [ [ 1, 3, 5, 7, 9, 11, 13 ], 11, 5 ], [ [ 1, 3, 5, 7, 9, 11, 13 ], 12, 6 ], [ [ 1, 3, 5, 7, 9, 11, 13 ], 13, 6 ], [ [ 1, 3, 5, 7, 9, 11, 13 ], 14, 7 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15 ], 0, 0 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15 ], 1, 0 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15 ], 2, 1 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15 ], 3, 1 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15 ], 4, 2 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15 ], 5, 2 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15 ], 6, 3 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15 ], 7, 3 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15 ], 8, 4 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15 ], 9, 4 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15 ], 10, 5 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15 ], 11, 5 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15 ], 12, 6 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15 ], 13, 6 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15 ], 14, 7 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15 ], 15, 7 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15 ], 16, 8 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17 ], 0, 0 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17 ], 1, 0 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17 ], 2, 1 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17 ], 3, 1 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17 ], 4, 2 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17 ], 5, 2 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17 ], 6, 3 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17 ], 7, 3 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17 ], 8, 4 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17 ], 9, 4 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17 ], 10, 5 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17 ], 11, 5 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17 ], 12, 6 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17 ], 13, 6 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17 ], 14, 7 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17 ], 15, 7 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17 ], 16, 8 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17 ], 17, 8 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17 ], 18, 9 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 ], 0, 0 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 ], 1, 0 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 ], 2, 1 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 ], 3, 1 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 ], 4, 2 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 ], 5, 2 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 ], 6, 3 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 ], 7, 3 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 ], 8, 4 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 ], 9, 4 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 ], 10, 5 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 ], 11, 5 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 ], 12, 6 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 ], 13, 6 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 ], 14, 7 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 ], 15, 7 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 ], 16, 8 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 ], 17, 8 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 ], 18, 9 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 ], 19, 9 ], [ [ 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 ], 20, 10 ], ); print "1..", scalar @tests, "\n"; for my $test (@tests) { my($edges, $target, $expected) = @$test; my $actual = Set::IntSpan::_bsearch($edges, $target); $expected==$actual or Not; OK; } Set-IntSpan-1.19/t/member.t0000644000076400007640000000430512126715346014505 0ustar swmcdswmcd# -*- perl -*- use strict; use Set::IntSpan 1.17; my $N = 1; sub Not { print "not " } sub OK { print "ok ", $N++, "\n" } sub Table { [ map { [ split(' ', $_) ] } split(/\s*\n\s*/, shift) ] } my @Sets = split(' ', q{ - (-) (-3 3-) 3 3-5 3-5,7-9 } ); my @Elements = ( 1..7 ); my $Member = Table < %d\n", "member", $run_list, $int, $result; my $expected = $Member->[$s][$i]; $result ? $expected : ! $expected or Not; OK; } } } sub Insert { Delta("insert", $Insert) } sub Remove { Delta("remove", $Remove) } sub Delta { my($method, $expected) = @_; print "#$method\n"; for my $s (0..$#Sets) { for my $i (0..$#Elements) { my $run_list = $Sets[$s]; my $set = new Set::IntSpan $run_list; my $int = $Elements[$i]; $set->$method($int); my $result = run_list $set; printf "#%-12s %-12s %d -> %s\n", $method, $run_list, $int, $result; $result eq $expected->[$s][$i] or Not; OK; } } } Set-IntSpan-1.19/t/island.t0000644000076400007640000000661612126715346014517 0ustar swmcdswmcd# -*- perl -*- use strict; use Set::IntSpan 1.17; my $N = 1; sub Not { print "not " } sub OK { print "ok ", $N++, "\n" } my @Island = # cover holes ([' - ', ' - ', ' - ',], [' (-) ', ' (-) ', ' - ',], [' (-1,9-) ', ' (-) ', ' 2-8 ',], [' (-0 ', ' (-0 ', ' - ',], [' (-0,5-9 ', ' (-9 ', ' 1-4 ',], [' 0-) ', ' 0-) ', ' - ',], [' 0-5,9-) ', ' 0-) ', ' 6-8 ',], [' 1 ', ' 1 ', ' - ',], [' 5 ', ' 5 ', ' - ',], [' 1,3,5 ', ' 1-5 ', ' 2,4 ',], [' 1,3-5 ', ' 1-5 ', ' 2 ',], ['-1-5 ', '-1-5 ', ' - ',], ); my @Inset = ( [ ' - ', -2, ' - ' ], [ ' - ', -1, ' - ' ], [ ' - ', 0, ' - ' ], [ ' - ', 1, ' - ' ], [ ' - ', 2, ' - ' ], [ '(-)', -2, '(-)' ], [ '(-)', -1, '(-)' ], [ '(-)', 0, '(-)' ], [ '(-)', 1, '(-)' ], [ '(-)', 2, '(-)' ], [ '(-0', -2, '(-2 ' ], [ '(-0', -1, '(-1 ' ], [ '(-0', 0, '(-0 ' ], [ '(-0', 1, '(--1' ], [ '(-0', 2, '(--2' ], [ '0-)', -2, '-2-)' ], [ '0-)', -1, '-1-)' ], [ '0-)', 0, ' 0-)' ], [ '0-)', 1, ' 1-)' ], [ '0-)', 2, ' 2-)' ], [ '0,2-3,6-8,12-15,20-24,30-35' , -2, '-2-26,28-37' ], [ '0,2-3,6-8,12-15,20-24,30-35' , -1, '-1-9,11-16,19-25,29-36' ], [ '0,2-3,6-8,12-15,20-24,30-35' , 0, '0,2-3,6-8,12-15,20-24,30-35' ], [ '0,2-3,6-8,12-15,20-24,30-35' , 1, '7,13-14,21-23,31-34' ], [ '0,2-3,6-8,12-15,20-24,30-35' , 2, '22,32-33' ], [ '(-0,2-3,6-8,12-15,20-24,30-35', -2, '(-26,28-37' ], [ '(-0,2-3,6-8,12-15,20-24,30-35', -1, '(-9,11-16,19-25,29-36' ], [ '(-0,2-3,6-8,12-15,20-24,30-35', 0, '(-0,2-3,6-8,12-15,20-24,30-35' ], [ '(-0,2-3,6-8,12-15,20-24,30-35', 1, '(--1,7,13-14,21-23,31-34' ], [ '(-0,2-3,6-8,12-15,20-24,30-35', 2, '(--2,22,32-33' ], [ '0,2-3,6-8,12-15,20-24,30-)' , -2, '-2-26,28-)' ], [ '0,2-3,6-8,12-15,20-24,30-)' , -1, '-1-9,11-16,19-25,29-)' ], [ '0,2-3,6-8,12-15,20-24,30-)' , 0, '0,2-3,6-8,12-15,20-24,30-)' ], [ '0,2-3,6-8,12-15,20-24,30-)' , 1, '7,13-14,21-23,31-)' ], [ '0,2-3,6-8,12-15,20-24,30-)' , 2, '22,32-)' ], ); print "1..", 2 * (@Island+1) + (@Inset+2), "\n"; Cover(); Holes(); Inset(); sub Cover { print "#cover\n"; for my $t (@Island) { my $set = new Set::IntSpan $t->[0]; my $expected = new Set::IntSpan $t->[1]; my $result = $set->cover; printf "#%-12s %-12s -> %s\n", 'cover', $set->run_list, $result->run_list; $result->equal($expected) or Not; OK; } Set::IntSpan->new->extent->empty or Not; OK; } sub Holes { print "#holes\n"; for my $t (@Island) { my $set = new Set::IntSpan $t->[0]; my $expected = new Set::IntSpan $t->[2]; my $result = $set->holes; printf "#%-12s %-12s -> %s\n", 'holes', $set->run_list, $result->run_list; $result->equal($expected) or Not; OK; } Set::IntSpan->new->holes->empty or Not; OK; } sub Inset { print "#inset\n"; for my $t (@Inset) { my $set = new Set::IntSpan $t->[0]; my $n = $t->[1]; my $expected = new Set::IntSpan $t->[2]; my $result = $set->inset($n); printf "#%-12s %-12s %d -> %s\n", 'inset', $set->run_list, $n, $result->run_list; $result->equal($expected) or Not; OK; } Set::IntSpan->new('1-3')->pad (1)->size==5 or Not; OK; Set::IntSpan->new('1-3')->trim(1)->size==1 or Not; OK; } Set-IntSpan-1.19/t/spans.t0000644000076400007640000000771612126715347014374 0ustar swmcdswmcd# -*- perl -*- use strict; use Set::IntSpan 1.17 qw(grep_spans map_spans); my $N = 1; sub Not { print "not " } sub OK { print "ok ", $N++, "\n" } my @Sets = split(' ', q{ - (-) (-0 0-) 1 5 1-3 3-7 1-3,8,10-23 1-3,8,10-23,30-) }); sub long_span { my($l, $u) = @$_; not defined $l or not defined $u or $u-$l > 3 } sub short_span { my($l, $u) = @$_; defined $l and defined $u and $u-$l < 3 } my @Greps = ('0', '1', 'long_span', 'short_span'); sub mirror { my($l, $u) = @$_; if ( defined $l and defined $u) { return [ -$u , -$l ] } elsif (not defined $l and defined $u) { return [ -$u , undef ] } elsif ( defined $l and not defined $u) { return [ undef, -$l ] } else { return [ undef, undef ] } } sub mirror_mirror { my($l, $u) = @$_; if ( defined $l and defined $u) { return [ -$u , -$l ], [ $l , $u ] } elsif (not defined $l and defined $u) { return [ -$u , undef ], [ undef , $u ] } elsif ( defined $l and not defined $u) { return [ undef, -$l ], [ $l , undef] } else { return [ undef, undef ], [ undef, undef ] } } sub double_up { my($l, $u) = @$_; if ( defined $l and defined $u) { return [ 2*$l , 2*$u ] } elsif (not defined $l and defined $u) { return [ undef, 2*$u ] } elsif ( defined $l and not defined $u) { return [ 2*$l, undef ] } else { return [ undef, undef ] } } sub stretch_up { my($l, $u) = @$_; if ( defined $l and defined $u) { return [ $l , $u+5 ] } elsif (not defined $l and defined $u) { return [ undef, $u+5 ] } elsif ( defined $l and not defined $u) { return [ $l , undef ] } else { return [ undef, undef ] } } my @Maps = ('()', '$_', 'mirror', 'mirror_mirror', 'double_up', 'stretch_up'); print "1..", @Sets * (@Greps + @Maps), "\n"; Grep(); Map (); sub Grep { print "#grep_span\n"; my @expected = (['-', ' - ', ' - ', ' - ', '-', '-', ' - ', ' - ', ' - ', ' - '], ['-', '(-)', '(-0', '0-)', '1', '5', '1-3', '3-7', '1-3,8,10-23', '1-3,8,10-23,30-)'], ['-', '(-)', '(-0', '0-)', '-', '-', ' - ', '3-7', ' 10-23', ' 10-23,30-)'], ['-', ' - ', ' - ', ' - ', '1', '5', '1-3', ' - ', '1-3,8 ', '1-3,8, '], ); for (my $g=0; $g<@Greps; $g++) { for (my $s=0; $s<@Sets; $s++) { my $set = new Set::IntSpan $Sets[$s]; my $result = grep_spans { eval $Greps[$g] } $set; my $expected = new Set::IntSpan $expected[$g][$s]; printf "#%3d: grep_span { %-8s } %-20s -> %s\n", $N, $Greps[$g], $Sets[$s], $result->run_list; equal $result $expected or Not; OK; } } } sub Map { print "#map_span\n"; my @expected = (['-', ' - ', ' - ', ' - ', ' -', ' -', ' - ' , ' - ', ' - ', ' - '], ['-', '(-)', '(-0', '0-)', ' 1', ' 5', ' 1-3' , ' 3-7 ', ' 1-3,8,10-23 ', ' 1-3,8,10-23,30-) '], ['-', '(-)', '0-)', '(-0', '-1', '-5', '-3--1', '-7--3', '-23--10,-8,-3--1', '(--30,-23--10,-8,-3--1'], ['-', '(-)', '(-)', '(-)', '-1,1', '-5,5', '-3--1,1-3', '-7--3,3-7 ', '-23--10,-8,-3--1,1-3,8,10-23', '(--30,-23--10,-8,-3--1, 1-3,8,10-23,30-)'], ['-', '(-)', '(-0', '0-)', ' 2', ' 10', '2-6', '6-14', '2-6,16,20-46', '2-6,16,20-46,60-)' ], ['-', '(-)', '(-5', '0-)', ' 1-6', '5-10', ' 1-8', '3-12', '1-28' , '1-28,30-)' ], ); for (my $g=0; $g<@Maps; $g++) { for (my $s=0; $s<@Sets; $s++) { my $set = new Set::IntSpan $Sets[$s]; my $result = map_spans { eval $Maps[$g] } $set; my $expected = new Set::IntSpan $expected[$g][$s]; printf "#%3d: map_span { %-8s } %-20s -> %s\n", $N, $Maps[$g], $Sets[$s], $result->run_list; equal $result $expected or Not; OK; } } } Set-IntSpan-1.19/t/creation.t0000644000076400007640000001357412126715346015052 0ustar swmcdswmcd# -*- perl -*- use strict; use Set::IntSpan 1.17; my $N = 1; sub Not { print "not " } sub OK { print "ok ", $N++, "\n" } sub Table { map { [ split(' ', $_) ] } split(/\s*\n\s*/, shift) } my $Err = "Set::IntSpan::elements: infinite set"; my @New = (['' , '-' , '' , [] ], [' ' , '-' , '' , [] ], [' ( - ) ' , '(-)' , $Err , [[undef, undef]] ], ['-_2 - -1 ', '-2--1' , '-2,-1' , [[-2,-1]] ], ['-' , '-' , '' , [] ], ['0' , '0' , '0' , [[0,0]] ], ['1' , '1' , '1' , [[1,1]] ], ['1-1' , '1' , '1' , [[1,1]] ], ['-1' , '-1' , '-1' , [[-1,-1]] ], ['1-2' , '1-2' , '1,2' , [[1,2]] ], ['-2--1' , '-2--1' , '-2,-1' , [[-2,-1]] ], ['-2-1' , '-2-1' , '-2,-1,0,1' , [[-2,1]] ], ['1,2-4' , '1-4' , '1,2,3,4' , [[1,4]] ], ['1-3,4,5-7' , '1-7' , '1,2,3,4,5,6,7', [[1,7]] ], ['1-3,4' , '1-4' , '1,2,3,4' , [[1,4]] ], ['1,2,4,5,6,7' , '1-2,4-7', '1,2,4,5,6,7' , [[1,2],[4,7]] ], ['1,2-)' , '1-)' , $Err , [[1,undef]] ], ['(-0,1-)' , '(-)' , $Err , [[undef,undef]] ], ['(-)' , '(-)' , $Err , [[undef,undef]] ], ['1-)' , '1-)' , $Err , [[1,undef]] ], ['(-1' , '(-1' , $Err , [[undef,1]] ], ['-3,-1-)' , '-3,-1-)', $Err , [[-3,-3],[-1,undef]]], ['(-1,3' , '(-1,3' , $Err , [[undef,1],[3,3]] ], ); my @New_list = ( ['1', '2', '1-2'], ['1-5', '2', '1-5'], ['1-5', '2-8', '1-8'], ['1-5', '2-8', '10-20', '1-8,10-20'], ['(-5', '2-8', '10-20', '(-8,10-20'], ['(-5', '2-8', '10-)', '(-8,10-)'], ['40-45', '20-25', '10-15', '1', '12-13', '1,10-15,20-25,40-45' ] ); my @New_array = ( [ [ ], "-" ], [ [ 1 ], "1" ], [ [ 1, 1 ], "1" ], [ [ 1, 2 ], "1-2" ], [ [ 1, 2, 2 ], "1-2" ], [ [ 1, 3, 3 ], "1,3" ], [ [ 1, 3 ], "1,3" ], [ [ 1, 3, 3 ], "1,3" ], [ [ 1, 3, 4 ], "1,3,4" ], [ [ 1, 3, 4, 4 ], "1,3,4" ], [ [ 1, 2, 4 ], "1-2,4" ], [ [ 1, 2, 4, 4 ], "1-2,4" ], [ [ 1, 2, 4, 5 ], "1-2,4-5" ], [ [ 1, 2, 4, 5, 5 ], "1-2,4-5" ], [ [ 3, 2, 1 ], "1-3" ], [ [ [ undef, -1 ] ], "(--1" ], [ [ 5, [ undef, 1 ], 3 ], "(-1,3,5" ], [ [ 5, [ undef, 1 ], 3, 4 ], "(-1,3-5" ], [ [ 5, [ undef, 1 ], 3, [ 8, undef ], 4 ], "(-1,3-5,8-)" ], [ [ 5, [ undef, 1 ], 3, [ 6, undef ], 4 ], "(-1,3-)" ], [ [ 5, [ undef, 2 ], 3, [ 4, undef ], 4 ], "(-)" ], [ [ [ 1, 5 ], [ 3, 8 ], 27 ], "1-8,27" ], [ [ 1, [ 5, 8 ], 5, [ 7, 9 ], 2 ], "1-2,5-9" ], ); print "1..", @New * 7 + @New_list + @New_array, "\n"; New (); Elements (); Sets (); Spans (); New_list (); New_array(); sub New { print "#new\n"; for my $test (@New) { my $set = new Set::IntSpan $test->[0]; my $result = $set->run_list(); printf "#new %-14s -> %s\n", $test->[0], $result; $result eq $test->[1] or Not; OK my $copy = new Set::IntSpan $set; $result = $copy->run_list(); printf "#new %-14s -> %s\n", $test->[0], $result; $result eq $test->[1] or Not; OK; } } sub Elements { print "#elements\n"; my($set, $expected, @elements, $elements, $result); for my $t (@New) { $set = new Set::IntSpan $t->[0]; $expected = $t->[2]; eval { @elements = elements $set }; if ($@) { printf "#elements %-14s -> %s\n", $t->[0], $@; $@ =~/$expected/ or Not; OK; } else { $result = join(',', @elements ); printf "#elements %-14s -> %s\n", $t->[0], $result; $result eq $expected or Not; OK; } eval { $elements = elements $set }; if ($@) { printf "#elements %-14s -> %s\n", $t->[0], $@; $@ =~ /$expected/ or Not; OK; } else { $result = join(',', @$elements ); printf "#elements %-14s -> %s\n", $t->[0], $result; $result eq $expected or Not; OK; } } } sub Sets { print "#sets\n"; for my $t (@New) { my $set = new Set::IntSpan $t->[0]; my @sets = sets $set; my @expected = map { $_ eq '-' ? () : new Set::IntSpan $_ } split /,/, $t->[1]; equal_sets(\@sets, \@expected) or Not; OK; } } sub equal_sets { my($a, $b) = @_; @$a == @$b or return 0; while (@$a) { my $a = shift @$a; my $b = shift @$b; ref $a eq 'Set::IntSpan' or return 0; ref $b eq 'Set::IntSpan' or return 0; equal $a $b or return 0; } 1 } sub Spans { print "#spans\n"; for my $t (@New) { my $set1 = new Set::IntSpan $t->[0]; my @spans = spans $set1; my $expected = $t->[3]; equal_lists(\@spans, $expected) or Not; OK; my $set2 = new Set::IntSpan $t->[3]; equal $set1 $set2 or Not; OK; print "set1 $set1, set2 $set2\n"; } } sub equal_lists { my($a, $b) = @_; # print "a <@$a>, b <@$b>\n"; @$a==@$b or return 0; my @a = @$a; my @b = @$b; while (@a) { my $aa = shift @a; my $bb = shift @b; if (ref $aa and ref $bb) { equal_lists($aa, $bb) or return 0 } elsif (defined $aa and defined $bb) { $aa == $bb or return 0 } else { not defined $aa and not defined $bb or return 0 } } 1 } sub New_list { for my $t (@New_list) { my @run_lists = @$t; my $expected = pop @run_lists; my $set = new Set::IntSpan @run_lists; my $actual = $set->run_list; $set->equal($expected) or Not; OK; } } sub New_array { for my $t (@New_array) { my $actual = new Set::IntSpan $t->[0]; my $expected = $t->[1]; $actual eq $expected or Not; OK; } } Set-IntSpan-1.19/t/overload.t0000644000076400007640000000410312126715346015045 0ustar swmcdswmcd# -*- perl -*- use strict; use Set::IntSpan 1.17; my $N = 1; sub Not { print "not " } sub OK { print "ok ", $N++, "\n" } print "1..", 6 + 8 + 1 + 8 + 4 + 12 + 7 + 1 + 12 + 2, "\n"; my $a = new Set::IntSpan "1-5"; my $e = new Set::IntSpan; my $i = new Set::IntSpan "(-)"; # Conversion $a or Not; OK; $e and Not; OK; $i or Not; OK; "$a" eq "1-5" or Not; OK; "$e" eq "-" or Not; OK; "$i" eq "(-)" or Not; OK; # Equality $a eq "1-5" or Not; OK; $a eq "6-9" and Not; OK; "1-5" eq $a or Not; OK; "6-9" eq $a and Not; OK; $a ne "6-9" or Not; OK; $a ne "1-5" and Not; OK; "6-9" ne $a or Not; OK; "1-5" ne $a and Not; OK; # Unary ~$a eq "(-0,6-)" or Not; OK; # Binary my $u1 = $a + "3-8"; my $u2 = "3-8" + $a; $u1 eq "1-8" or Not; OK; $u2 eq "1-8" or Not; OK; my $d1 = $a - "3-8"; my $d2 = "3-8" - $a; $d1 eq "1-2" or Not; OK; $d2 eq "6-8" or Not; OK; my $i1 = $a * "3-8"; my $i2 = "3-8" * $a; $i1 eq "3-5" or Not; OK; $i2 eq "3-5" or Not; OK; # Assignment my $x1 = $a ^ "3-8"; my $x2 = "3-8" ^ $a; $x1 eq "1-2,6-8" or Not; OK; $x2 eq "1-2,6-8" or Not; OK; $a += "3-8"; $a eq "1-8" or Not; OK; $a -= "3-8"; $a eq "1-2" or Not; OK; $a *= "3-8"; $a eq "-" or Not; OK; $a ^= "3-8"; $a eq "3-8" or Not; OK; # Equivalence $a == 6 or Not; OK; $a == 7 and Not; OK; $a != 7 or Not; OK; $a != 6 and Not; OK; $a < 7 or Not; OK; $a < 6 and Not; OK; $a <= 6 or Not; OK; $a <= 5 and Not; OK; $a > 5 or Not; OK; $a > 6 and Not; OK; $a >= 6 or Not; OK; $a >= 7 and Not; OK; ($a <=> 7) == -1 or Not; OK; ($a <=> 6) == 0 or Not; OK; ($a <=> 5) == 1 or Not; OK; ( 5 <=> $a) == -1 or Not; OK; ( 7 <=> $a) == 1 or Not; OK; ($a <=> $i) == -1 or Not; OK; ($i <=> $a) == 1 or Not; OK; my @c = sort($i, $a, $e); $c[0] eq $e and $c[1] eq $a and $c[2] eq $i or Not; OK; $a lt $i or Not; OK; $i lt $a and Not; OK; $a le $i or Not; OK; $i le $a and Not; OK; $i gt $a or Not; OK; $a gt $i and Not; OK; $i ge $a or Not; OK; $a ge $i and Not; OK; $a le $a or Not; OK; $a lt $a and Not; OK; $a ge $a or Not; OK; $a gt $a and Not; OK; "3-8" le $a or Not; OK; "3-8" ge $a or Not; OK; Set-IntSpan-1.19/t/no-int.t0000644000076400007640000000056112126715346014442 0ustar swmcdswmcd# -*- perl -*- use strict; use Set::IntSpan 1.17; my $N = 1; sub Not { print "not " } sub OK { print "ok ", $N++, " @_\n" } print "1..1\n"; my $set = new Set::IntSpan '1_000_000_000_000-1_000_000_000_100'; for my $i (0..100) { insert $set 2e12+$i; } $set eq '1_000_000_000_000-1_000_000_000_100,2_000_000_000_000-2_000_000_000_100' or Not; OK 'no integer'; Set-IntSpan-1.19/t/subclass.t0000644000076400007640000000170112126715347015053 0ustar swmcdswmcd# -*- perl -*- use strict; use Set::IntSpan 1.17; @Foo::Bar::ISA = qw(Set::IntSpan); my $N = 1; sub Not { print "not " } sub OK { print "ok ", $N++, "\n" } print "1..20\n"; my $intspan = new Set::IntSpan '15-25'; my $foobar = new Foo::Bar '1-10, 20-30'; ref $intspan eq 'Set::IntSpan' or Not; OK; ref $foobar eq 'Foo::Bar' or Not; OK; for my $op (qw(union intersect diff xor)) { my $result; $result = $intspan->$op($intspan); ref $result eq 'Set::IntSpan' or Not; OK; $result = $intspan->$op($foobar); ref $result eq 'Set::IntSpan' or Not; OK; $result = $foobar->$op($intspan); ref $result eq 'Foo::Bar' or Not; OK; $result = $foobar->$op($foobar); ref $result eq 'Foo::Bar' or Not; OK; } for my $op (qw(complement)) { my $result; $result = $intspan->$op(); ref $result eq 'Set::IntSpan' or Not; OK; $result = $foobar->$op(); ref $result eq 'Foo::Bar' or Not; OK; } Set-IntSpan-1.19/t/relation.t0000644000076400007640000000443012126715346015052 0ustar swmcdswmcd# -*- perl -*- use strict; use Set::IntSpan 1.17; my $N = 1; sub Not { print "not " } sub OK { print "ok ", $N++, "\n" } my $Sets = [ split(' ', q{ - (-) (-0 0-) 1 5 1-5 3-7 1-3,8,10-23 }) ]; my $Equal = [[qw( 1 0 0 0 0 0 0 0 0 )], [qw( 0 1 0 0 0 0 0 0 0 )], [qw( 0 0 1 0 0 0 0 0 0 )], [qw( 0 0 0 1 0 0 0 0 0 )], [qw( 0 0 0 0 1 0 0 0 0 )], [qw( 0 0 0 0 0 1 0 0 0 )], [qw( 0 0 0 0 0 0 1 0 0 )], [qw( 0 0 0 0 0 0 0 1 0 )], [qw( 0 0 0 0 0 0 0 0 1 )]]; my $Equivalent = [[qw( 1 0 0 0 0 0 0 0 0 )], [qw( 0 1 1 1 0 0 0 0 0 )], [qw( 0 1 1 1 0 0 0 0 0 )], [qw( 0 1 1 1 0 0 0 0 0 )], [qw( 0 0 0 0 1 1 0 0 0 )], [qw( 0 0 0 0 1 1 0 0 0 )], [qw( 0 0 0 0 0 0 1 1 0 )], [qw( 0 0 0 0 0 0 1 1 0 )], [qw( 0 0 0 0 0 0 0 0 1 )]]; my $Superset = [[qw( 1 0 0 0 0 0 0 0 0 )], [qw( 1 1 1 1 1 1 1 1 1 )], [qw( 1 0 1 0 0 0 0 0 0 )], [qw( 1 0 0 1 1 1 1 1 1 )], [qw( 1 0 0 0 1 0 0 0 0 )], [qw( 1 0 0 0 0 1 0 0 0 )], [qw( 1 0 0 0 1 1 1 0 0 )], [qw( 1 0 0 0 0 1 0 1 0 )], [qw( 1 0 0 0 1 0 0 0 1 )]]; my $Subset = [[qw( 1 1 1 1 1 1 1 1 1 )], [qw( 0 1 0 0 0 0 0 0 0 )], [qw( 0 1 1 0 0 0 0 0 0 )], [qw( 0 1 0 1 0 0 0 0 0 )], [qw( 0 1 0 1 1 0 1 0 1 )], [qw( 0 1 0 1 0 1 1 1 0 )], [qw( 0 1 0 1 0 0 1 0 0 )], [qw( 0 1 0 1 0 0 0 1 0 )], [qw( 0 1 0 1 0 0 0 0 1 )]]; print "1..", 4 * @$Sets * @$Sets, "\n"; Equal (); Equivalent(); Superset (); Subset (); sub Equal { Relation("equal" , $Sets, $Equal ) } sub Equivalent { Relation("equivalent", $Sets, $Equivalent) } sub Superset { Relation("superset" , $Sets, $Superset ) } sub Subset { Relation("subset" , $Sets, $Subset ) } sub Relation { my($method, $sets, $expected) = @_; print "#$method\n"; for (my $i=0; $i<@{$sets}; $i++) { for (my $j=0; $j<@{$sets}; $j++) { Relation_1($method, $sets->[$i], $sets->[$j], $expected->[$i][$j]); } } } sub Relation_1 { my($method, $op1, $op2, $expected) = @_; my $result; my $set1 = new Set::IntSpan $op1; my $set2 = new Set::IntSpan $op2; $result = $set1->$method($set2); printf "#%-12s %-12s %-12s -> %d\n", $method, $op1, $op2, $result; $result ? $expected : ! $expected or Not; OK; } Set-IntSpan-1.19/t/span_ord.t0000644000076400007640000000467312126715346015053 0ustar swmcdswmcd# -*- perl -*- use strict; use Set::IntSpan 1.17; my $N = 1; sub Not { print "not " } sub OK_ord { my $test = shift; my($runlist, $n, $ord_exp, $span_exp) = @$test; $ord_exp = '' unless defined $ord_exp; print "ok $N ord : $runlist $n\t-> $ord_exp\n"; $N++; } sub OK_span { my $test = shift; my($runlist, $n, $ord_exp, $span_exp) = @$test; $span_exp = defined $span_exp ? join ', ', map { defined($_) ? $_ : '' } @$span_exp : ''; print "ok $N span: $runlist $n\t-> $span_exp\n"; $N++; } my @Span_ord_test = ( [ '-' , 0, undef, undef ], [ '(-)' , 0, 0 , [undef, undef] ], [ '0' , 0, 0 , [ 0, 0] ], [ '1' , 0, undef, undef ], [ '1' , 1, 0 , [ 1, 1] ], [ '1' , 2, undef, undef ], [ '1,3-5' , 0, undef, undef ], [ '1,3-5' , 1, 0 , [ 1, 1] ], [ '1,3-5' , 2, undef, undef ], [ '1,3-5' , 3, 1 , [ 3, 5] ], [ '1,3-5' , 4, 1 , [ 3, 5] ], [ '1,3-5' , 5, 1 , [ 3, 5] ], [ '1,3-5' , 6, undef, undef ], [ '1-)' , 0, undef, undef ], [ '1-)' , 1, 0 , [ 1, undef] ], [ '1-)' , 2, 0 , [ 1, undef] ], [ '(-1' , 0, 0 , [undef, 1] ], [ '(-1' , 1, 0 , [undef, 1] ], [ '(-1' , 2, undef, undef ], [ '1-5,11-15,21-25' , 21, 2 , [ 21, 25] ], [ '(-5,11-15,21-25' , 21, 2 , [ 21, 25] ], [ '1-5,11-15,21-25,30-40', 21, 2 , [ 21, 25] ], [ '(-5,11-15,21-25,30-)' , 21, 2 , [ 21, 25] ], [ '(-5,11-15,21-25,30-)' , 20, undef, undef ], ); print "1..", 2 * @Span_ord_test, "\n"; for my $test (@Span_ord_test) { my($run_list, $n, $ord_exp, $span_exp) = @$test; my $set = new Set::IntSpan $run_list; my $ord_act = $set->span_ord($n); identical_n($ord_act, $ord_exp) or Not; OK_ord($test); my $span_act = defined $ord_act ? ($set->spans)[$ord_act] : undef; identical_span($span_act, $span_exp) or Not; OK_span($test); } sub identical_n { my($a, $b) = @_; not defined $a and not defined $b or defined $a and defined $b and $a == $b } sub identical_span { my($a, $b) = @_; not defined $a and not defined $b or defined $a and defined $b and identical_n($a->[0], $b->[0]) and identical_n($a->[1], $b->[1]) } Set-IntSpan-1.19/t/unary.t0000644000076400007640000000217012126715347014373 0ustar swmcdswmcd# -*- perl -*- use strict; use Set::IntSpan 1.17; my $N = 1; sub Not { print "not " } sub OK { print "ok ", $N++, "\n" } sub Table { map { [ split(' ', $_) ] } split(/\s*\n\s*/, shift) } my @Unaries = Table <[0], $t->[1]); Unary("complement", $t->[1], $t->[0]); U ("C" , $t->[0], $t->[1]); U ("C" , $t->[1], $t->[0]); } } sub Unary { my($method, $operand, $expected) = @_; my $set = new Set::IntSpan $operand; my $setE = $set->$method(); my $run_list = run_list $setE; printf "#%-12s %-10s -> %-10s\n", $method, $operand, $run_list; $run_list eq $expected or Not; OK; } sub U { my($method, $operand, $expected) = @_; my $set = new Set::IntSpan $operand; $set->$method(); my $run_list = run_list $set; printf "#%-12s %-10s -> %-10s\n", $method, $operand, $run_list; $run_list eq $expected or Not; OK; } Set-IntSpan-1.19/t/error.t0000644000076400007640000000156012126715346014367 0ustar swmcdswmcd# -*- perl -*- use strict; use Set::IntSpan 1.17; my $N = 1; sub Not { print "not " } sub OK { print "ok ", $N++, "\n" } sub Table { map { [ split(' ', $_) ] } split(/\s*\n\s*/, shift) } my @Errors = Table < %s", "new Set::Intspan", $run_list, $@; $@ =~ /$expected/ or Not; OK; my $valid = valid Set::IntSpan $run_list; printf "#%-20s %-12s -> %s", "valid Set::Intspan", $run_list, $@; ($valid or $@ !~ /$expected/) and Not; OK; } } Set-IntSpan-1.19/t/index.t0000644000076400007640000003502312126715346014346 0ustar swmcdswmcd# -*- perl -*- use strict; use Set::IntSpan 1.17; my $N = 1; sub Not { print "not " } sub OK { my($function, $test) = @_; $test ||= []; for (@$test) { defined $_ or $_ = '' } my $expected = pop @$test; print "ok $N $function: @$test\t-> $expected\n"; $N++; } my @At_die = ( [ "(-0", 42, "" ], [ "0-)", -42, "" ], ); my @At_test = ( [ "-" , 0, undef ], [ "-" , -1, undef ], [ "1-10,20-30" , 25, undef ], [ "1-10,20-30" , -25, undef ], [ "0-)" , 0, 0 ], [ "0-)" , 42, 42 ], [ "(--1" , -1, -1 ], [ "(--1" , -42, -42 ], [ "1-10,20-)" , 15, 25 ], [ "(--21,-10--1" , -15, -25 ], [ "0-9" , 0, 0 ], [ "0-9" , 5, 5 ], [ "0-9" , 9, 9 ], [ "0-9" , 10, undef ], [ "0-9" , -1, 9 ], [ "0-9" , -5, 5 ], [ "0-9" , -10, 0 ], [ "0-9" , -11, undef ], [ "1-10,21-30,41-50", 5, 6 ], [ "1-10,21-30,41-50", 15, 26 ], [ "1-10,21-30,41-50", 25, 46 ], [ "1-10,21-30,41-50", 30, undef ], [ "1-10,21-30,41-50", -1, 50 ], [ "1-10,21-30,41-50", -11, 30 ], [ "1-10,21-30,41-50", -21, 10 ], [ "1-10,21-30,41-50", -30, 1 ], [ "1-10,21-30,41-50", -31, undef ], ); my @Splice_die = ( [ "(-0" , 0, 1, "" ], [ "0-)" , -1, 1, "" ], [ "0-)" , -2, -1, "" ], [ "0-)" , 0, -1, "" ], ); my @Splice_test = ( # empty sets [ "-" , 0, undef, "-" ], [ "-" , 0, 0, "-" ], [ "-" , 0, 1, "-" ], [ "-" , 0, -1, "-" ], # infinite sets [ "0-)" , 0, 0, "-" ], [ "0-)" , 0, 1, "0" ], [ "0-)" , 0, 10, "0-9" ], [ "0-)" , 5, 0, "-" ], [ "0-)" , 5, 1, "5" ], [ "0-)" , 5, 10, "5-14" ], [ "1-10,21-30,41-)" , 5, 20, "6-10,21-30,41-45" ], [ "1-10,21-30,41-)" , 15, 10, "26-30,41-45" ], [ "(-0" , -1, 0, "-" ], [ "(-0" , -1, 1, "0" ], [ "(-0" , -10, 5, "-9--5" ], [ "(-0" , -10, -3, "-9--3" ], [ "(-10,21-30,41-50", -15, 10, "26-30,41-45" ], [ "(-10,21-30,41-50", -15, -10, "26-30" ], [ "(-10,21-30,41-50", -15, undef, "26-30,41-50" ], # empty slices [ "1-10" , 10, 1, "-" ], [ "1-10" , 5, 0, "-" ], [ "1-10" , -5, 0, "-" ], [ "1-10" , -10, 0, "-" ], # positive offset, no length [ "1-10" , 0, undef, "1-10" ], [ "1-10" , 1, undef, "2-10" ], [ "1-10" , 5, undef, "6-10" ], [ "1-10" , 9, undef, "10" ], [ "1-10" , 10, undef, "-" ], # positive offset, positive length [ "1-10" , 0, 3, "1-3" ], [ "1-10" , 5, 3, "6-8" ], [ "1-10" , 7, 3, "8-10" ], [ "1-10" , 9, 1, "10" ], [ "1-10" , 10, 1, "-" ], [ "1-10" , 0, 10, "1-10" ], [ "1-10" , 0, 20, "1-10" ], # positive offset, negative length [ "1-10" , 0, -3, "1-7" ], [ "1-10" , 5, -3, "6-7" ], [ "1-10" , 6, -3, "7" ], [ "1-10" , 7, -3, "-" ], [ "1-10" , 8, -3, "-" ], [ "1-10" , 9, -3, "-" ], # negative offset, no length [ "1-10" , -1, undef, "10" ], [ "1-10" , -2, undef, "9-10" ], [ "1-10" , -5, undef, "6-10" ], [ "1-10" , -9, undef, "2-10" ], [ "1-10" , -10, undef, "1-10" ], # negative offset, positive length [ "1-10" , -2, 2, "9-10" ], [ "1-10" , -5, 2, "6-7" ], [ "1-10" , -10, 3, "1-3" ], [ "1-10" , -10, 10, "1-10" ], [ "1-10" , -10, 20, "1-10" ], [ "1-10" , -20, 20, "1-10" ], # negative offset, negative length [ "1-10" , -10, -3, "1-7" ], [ "1-10" , -5, -3, "6-7" ], [ "1-10" , -5, -1, "6-9" ], [ "1-10" , -3, -3, "-" ], [ "1-10" , -10, -10, "-" ], [ "1-10" , -11, -10, "-" ], [ "1-10" , -20, -9, "1" ], [ "1-10" , -20, -1, "1-9" ], [ "1-10,21-30,41-50", 0, 0, "-" ], # positive offset, no length [ "1-10,21-30,41-50", 0, undef, "1-10,21-30,41-50" ], [ "1-10,21-30,41-50", 9, undef, "10,21-30,41-50" ], [ "1-10,21-30,41-50", 10, undef, "21-30,41-50" ], [ "1-10,21-30,41-50", 19, undef, "30,41-50" ], [ "1-10,21-30,41-50", 20, undef, "41-50" ], [ "1-10,21-30,41-50", 29, undef, "50" ], [ "1-10,21-30,41-50", 30, undef, "-" ], # positive offset, positive length [ "1-10,21-30,41-50", 0, 1, "1" ], [ "1-10,21-30,41-50", 9, 1, "10" ], [ "1-10,21-30,41-50", 10, 1, "21" ], [ "1-10,21-30,41-50", 19, 1, "30" ], [ "1-10,21-30,41-50", 20, 1, "41" ], [ "1-10,21-30,41-50", 29, 1, "50" ], [ "1-10,21-30,41-50", 0, 10, "1-10" ], [ "1-10,21-30,41-50", 0, 11, "1-10,21" ], [ "1-10,21-30,41-50", 0, 20, "1-10,21-30" ], [ "1-10,21-30,41-50", 0, 21, "1-10,21-30,41" ], [ "1-10,21-30,41-50", 0, 30, "1-10,21-30,41-50" ], [ "1-10,21-30,41-50", 5, 10, "6-10,21-25" ], [ "1-10,21-30,41-50", 5, 11, "6-10,21-26" ], [ "1-10,21-30,41-50", 5, 20, "6-10,21-30,41-45" ], [ "1-10,21-30,41-50", 5, 21, "6-10,21-30,41-46" ], [ "1-10,21-30,41-50", 5, 30, "6-10,21-30,41-50" ], [ "1-10,21-30,41-50", 15, 10, "26-30,41-45" ], [ "1-10,21-30,41-50", 15, 11, "26-30,41-46" ], [ "1-10,21-30,41-50", 15, 20, "26-30,41-50" ], [ "1-10,21-30,41-50", 15, 21, "26-30,41-50" ], [ "1-10,21-30,41-50", 15, 30, "26-30,41-50" ], [ "1-10,21-30,41-50", 25, 1, "46" ], [ "1-10,21-30,41-50", 25, 2, "46-47" ], [ "1-10,21-30,41-50", 25, 3, "46-48" ], [ "1-10,21-30,41-50", 25, 5, "46-50" ], [ "1-10,21-30,41-50", 25, 6, "46-50" ], [ "1-10,21-30,41-50", 25, 10, "46-50" ], # positive offset, negative length [ "1-10,21-30,41-50", 0, -1, "1-10,21-30,41-49" ], [ "1-10,21-30,41-50", 9, -1, "10,21-30,41-49" ], [ "1-10,21-30,41-50", 10, -1, "21-30,41-49" ], [ "1-10,21-30,41-50", 19, -1, "30,41-49" ], [ "1-10,21-30,41-50", 20, -1, "41-49" ], [ "1-10,21-30,41-50", 29, -1, "-" ], [ "1-10,21-30,41-50", 0, -10, "1-10,21-30" ], [ "1-10,21-30,41-50", 0, -11, "1-10,21-29" ], [ "1-10,21-30,41-50", 0, -20, "1-10" ], [ "1-10,21-30,41-50", 0, -21, "1-9" ], [ "1-10,21-30,41-50", 0, -30, "-" ], [ "1-10,21-30,41-50", 5, -10, "6-10,21-30" ], [ "1-10,21-30,41-50", 5, -11, "6-10,21-29" ], [ "1-10,21-30,41-50", 5, -20, "6-10" ], [ "1-10,21-30,41-50", 5, -21, "6-9" ], [ "1-10,21-30,41-50", 5, -30, "-" ], [ "1-10,21-30,41-50", 15, -10, "26-30" ], [ "1-10,21-30,41-50", 15, -11, "26-29" ], [ "1-10,21-30,41-50", 15, -20, "-" ], [ "1-10,21-30,41-50", 15, -21, "-" ], [ "1-10,21-30,41-50", 15, -30, "-" ], [ "1-10,21-30,41-50", 25, -1, "46-49" ], [ "1-10,21-30,41-50", 25, -2, "46-48" ], [ "1-10,21-30,41-50", 25, -3, "46-47" ], [ "1-10,21-30,41-50", 25, -5, "-" ], [ "1-10,21-30,41-50", 25, -6, "-" ], [ "1-10,21-30,41-50", 25, -10, "-" ], # negative offset, no length [ "1-10,21-30,41-50", -1, undef, "50" ], [ "1-10,21-30,41-50", -10, undef, "41-50" ], [ "1-10,21-30,41-50", -11, undef, "30,41-50" ], [ "1-10,21-30,41-50", -20, undef, "21-30,41-50" ], [ "1-10,21-30,41-50", -21, undef, "10,21-30,41-50" ], [ "1-10,21-30,41-50", -29, undef, "2-10,21-30,41-50" ], [ "1-10,21-30,41-50", -30, undef, "1-10,21-30,41-50" ], # negative offset, positive length [ "1-10,21-30,41-50", -1, 1, "50" ], [ "1-10,21-30,41-50", -9, 1, "42" ], [ "1-10,21-30,41-50", -10, 1, "41" ], [ "1-10,21-30,41-50", -19, 1, "22" ], [ "1-10,21-30,41-50", -20, 1, "21" ], [ "1-10,21-30,41-50", -29, 1, "2" ], [ "1-10,21-30,41-50", -30, 1, "1" ], [ "1-10,21-30,41-50", -40, 1, "1" ], [ "1-10,21-30,41-50", -1, 10, "50" ], [ "1-10,21-30,41-50", -9, 10, "42-50" ], [ "1-10,21-30,41-50", -10, 10, "41-50" ], [ "1-10,21-30,41-50", -19, 10, "22-30,41" ], [ "1-10,21-30,41-50", -30, 10, "1-10" ], [ "1-10,21-30,41-50", -40, 10, "1-10" ], [ "1-10,21-30,41-50", -5, 1, "46" ], [ "1-10,21-30,41-50", -5, 2, "46-47" ], [ "1-10,21-30,41-50", -5, 3, "46-48" ], [ "1-10,21-30,41-50", -5, 5, "46-50" ], [ "1-10,21-30,41-50", -5, 6, "46-50" ], [ "1-10,21-30,41-50", -5, 10, "46-50" ], [ "1-10,21-30,41-50", -15, 10, "26-30,41-45" ], [ "1-10,21-30,41-50", -15, 11, "26-30,41-46" ], [ "1-10,21-30,41-50", -15, 20, "26-30,41-50" ], [ "1-10,21-30,41-50", -15, 21, "26-30,41-50" ], [ "1-10,21-30,41-50", -15, 30, "26-30,41-50" ], [ "1-10,21-30,41-50", -25, 1, "6" ], [ "1-10,21-30,41-50", -25, 2, "6-7" ], [ "1-10,21-30,41-50", -25, 3, "6-8" ], [ "1-10,21-30,41-50", -25, 5, "6-10" ], [ "1-10,21-30,41-50", -25, 6, "6-10,21" ], [ "1-10,21-30,41-50", -25, 10, "6-10,21-25" ], # negative offset, negative length [ "1-10,21-30,41-50", -1, -1, "-" ], [ "1-10,21-30,41-50", -9, -1, "42-49" ], [ "1-10,21-30,41-50", -10, -1, "41-49" ], [ "1-10,21-30,41-50", -19, -1, "22-30,41-49" ], [ "1-10,21-30,41-50", -20, -1, "21-30,41-49" ], [ "1-10,21-30,41-50", -29, -1, "2-10,21-30,41-49" ], [ "1-10,21-30,41-50", -31, -1, "1-10,21-30,41-49" ], [ "1-10,21-30,41-50", -5, -1, "46-49" ], [ "1-10,21-30,41-50", -5, -2, "46-48" ], [ "1-10,21-30,41-50", -5, -4, "46" ], [ "1-10,21-30,41-50", -5, -5, "-" ], [ "1-10,21-30,41-50", -5, -7, "-" ], [ "1-10,21-30,41-50", -15, -10, "26-30" ], [ "1-10,21-30,41-50", -15, -11, "26-29" ], [ "1-10,21-30,41-50", -15, -20, "-" ], [ "1-10,21-30,41-50", -15, -21, "-" ], [ "1-10,21-30,41-50", -15, -30, "-" ], [ "1-10,21-30,41-50", -25, -1, "6-10,21-30,41-49" ], [ "1-10,21-30,41-50", -25, -2, "6-10,21-30,41-48" ], [ "1-10,21-30,41-50", -25, -9, "6-10,21-30,41" ], [ "1-10,21-30,41-50", -25, -10, "6-10,21-30" ], [ "1-10,21-30,41-50", -25, -11, "6-10,21-29" ], [ "1-10,21-30,41-50", -25, -24, "6" ], [ "1-10,21-30,41-50", -25, -25, "-" ], [ "1-10,21-30,41-50", -30, -10, "1-10,21-30" ], [ "1-10,21-30,41-50", -30, -11, "1-10,21-29" ], [ "1-10,21-30,41-50", -30, -20, "1-10" ], [ "1-10,21-30,41-50", -30, -21, "1-9" ], [ "1-10,21-30,41-50", -30, -30, "-" ], [ "1-10,21-30,41-50", -35, -10, "1-10,21-30" ], [ "1-10,21-30,41-50", -35, -11, "1-10,21-29" ], [ "1-10,21-30,41-50", -35, -20, "1-10" ], [ "1-10,21-30,41-50", -35, -21, "1-9" ], [ "1-10,21-30,41-50", -35, -30, "-" ], ); my @Slice_die = ( [ "(-0" , 0, 1, "" ], [ "0-)" , -2, -1, "" ], ); my @Slice_test = ( # empty sets [ "-" , 0, 0, "-" ], [ "-" , 0, 1, "-" ], [ "-" , -2, -1, "-" ], # infinite sets [ "0-)" , 0, 0, "0" ], [ "0-)" , 0, 1, "0-1" ], [ "0-)" , 0, 9, "0-9" ], [ "0-)" , 5, 4, "-" ], [ "0-)" , 5, 5, "5" ], [ "0-)" , 5, 14, "5-14" ], [ "1-10,21-30,41-)" , 5, 24, "6-10,21-30,41-45" ], [ "1-10,21-30,41-)" , 15, 24, "26-30,41-45" ], [ "(-0" , -1, 0, "0" ], [ "(-0" , -2, -1, "-1-0" ], [ "(-0" , -10, -6, "-9--5" ], [ "(-0" , -10, -4, "-9--3" ], [ "(-10,21-30,41-50", -15, -6, "26-30,41-45" ], [ "(-10,21-30,41-50", -15, -11, "26-30" ], # empty slices [ "1-10" , 10, 11, "-" ], [ "1-10" , 5, 4, "-" ], [ "1-10" , -5, -6, "-" ], [ "1-10" , -12, -11, "-" ], # positive indices [ "1-10" , 0, 2, "1-3" ], [ "1-10" , 5, 7, "6-8" ], [ "1-10" , 7, 9, "8-10" ], [ "1-10" , 9, 9, "10" ], [ "1-10" , 10, 10, "-" ], [ "1-10" , 0, 9, "1-10" ], [ "1-10" , 0, 20, "1-10" ], # negative indices [ "1-10" , -2, -1, "9-10" ], [ "1-10" , -5, -4, "6-7" ], [ "1-10" , -10, -8, "1-3" ], [ "1-10" , -10, -1, "1-10" ], [ "1-10" , -10, 20, "1-10" ], ); print "1..", @At_die + @At_test + @Splice_die + @Splice_test + @Slice_die + @Slice_test, "\n"; for my $test (@At_die) { my($run_list, $i) = @$test; eval { Set::IntSpan->new($run_list)->at($i) }; $@ or Not; OK("at", $test); } for my $test (@At_test) { my($run_list, $i, $n) = @$test; equal(Set::IntSpan->new($run_list)->at($i), $n) or Not; OK("at", $test); } sub equal { my($a, $b) = @_; not defined $a and not defined $b or defined $a and defined $b and $a == $b } for my $test (@Splice_die) { my($run_list, $offset, $length) = @$test; eval { Set::IntSpan->new($run_list)->_splice($offset, $length) }; $@ or Not; OK("splice", $test); } for my $test (@Splice_test) { my($run_list, $offset, $length, $expected) = @$test; my $actual = Set::IntSpan->new($run_list)->_splice($offset, $length)->run_list; $actual eq $expected or Not; OK("splice", $test); # $actual eq $expected or print "\t$actual\n"; } for my $test (@Slice_die) { my($run_list, $offset, $length) = @$test; eval { Set::IntSpan->new($run_list)->slice($offset, $length) }; $@ or Not; OK("slice", $test); } for my $test (@Slice_test) { my($run_list, $offset, $length, $expected) = @$test; my $actual = Set::IntSpan->new($run_list)->slice($offset, $length)->run_list; $actual eq $expected or Not; OK("slice", $test); # $actual eq $expected or print "\t$actual\n"; } Set-IntSpan-1.19/MANIFEST0000644000076400007640000000054612126715346013742 0ustar swmcdswmcdChanges IntSpan.pm MANIFEST Makefile.PL README t/binary.t t/bsearch.t t/cardinal.t t/creation.t t/error.t t/index.t t/island.t t/iterator.t t/member.t t/no-int.t t/ord.t t/overload.t t/real_set.t t/relation.t t/set_spec.t t/span_ord.t t/spans.t t/subclass.t t/unary.t t/use-int.t META.yml Module meta-data (added by MakeMaker) Set-IntSpan-1.19/IntSpan.pm0000644000076400007640000014535512131013761014517 0ustar swmcdswmcdpackage Set::IntSpan; use 5; use if $Set::IntSpan::integer, qw(integer); use strict; use base qw(Exporter); use Carp; our $VERSION = '1.19'; our @EXPORT_OK = qw(grep_set map_set grep_spans map_spans); use overload '+' => 'union' , '-' => 'diff' , '*' => 'intersect' , '^' => 'xor' , '~' => 'complement', '+=' => 'U' , '-=' => 'D' , '*=' => 'I' , '^=' => 'X' , 'eq' => 'set_eq' , 'ne' => 'set_ne' , 'lt' => 'set_lt' , 'le' => 'set_le' , 'gt' => 'set_gt' , 'ge' => 'set_ge' , '<=>' => 'spaceship' , 'cmp' => 'spaceship' , '""' => 'run_list' , 'bool' => sub { not shift->empty }; sub _reorder # restore the order of args that are reversed by operator overloads { if ($_[2]) { my $temp = $_[0]; $_[0] = $_[1]; $_[1] = $temp; } } sub set_eq { my($a, $set_spec) = @_; my $b = $a->_real_set($set_spec); $a->equal($b) } sub set_le { my($a, $set_spec, $reverse) = @_; my $b = $a->_real_set($set_spec); _reorder($a, $b, $reverse); $a->subset($b) } sub set_ge { my($a, $set_spec, $reverse) = @_; my $b = $a->_real_set($set_spec); _reorder($a, $b, $reverse); $a->superset($b) } sub set_ne { not &set_eq } sub set_lt { &set_le and not &set_eq } sub set_gt { &set_ge and not &set_eq } sub set_cmp { my($a, $b, $reverse) = @_; $b = $a->_real_set($b); _reorder($a, $b, $reverse); $a->equal($b) ? 0 : 1; } sub spaceship { my($a, $b, $reverse) = @_; ref $a and $a = $a->size; ref $b and $b = $b->size; _reorder($a, $b, $reverse); $a == $b and return 0; $a < 0 and return 1; $b < 0 and return -1; $a <=> $b } $Set::IntSpan::Empty_String = '-'; sub new { my($this, $set_spec, @set_specs) = @_; my $class = ref($this) || $this; my $set = bless { }, $class; $set->{empty_string} = \$Set::IntSpan::Empty_String; $set->copy($set_spec); while (@set_specs) { $set = $set->union(shift @set_specs); } $set } sub valid { my($this, $run_list) = @_; my $class = ref($this) || $this; my $set = new $class; eval { $set->_copy_run_list($run_list) }; $@ ? 0 : 1 } sub copy { my($set, $set_spec) = @_; SWITCH: { defined $set_spec or $set->_copy_empty ( ), last; ref $set_spec or $set->_copy_run_list($set_spec), last; ref $set_spec eq 'ARRAY' and $set->_copy_array ($set_spec), last; $set->_copy_set ($set_spec) ; } $set } sub _copy_empty # makes $set the empty set { my $set = shift; $set->{negInf} = 0; $set->{posInf} = 0; $set->{edges } = []; } sub _copy_array # copies an array into a set { my($set, $array) = @_; my @spans = grep { ref } @$array; my @elements = sort { $a <=> $b } grep { not ref } @$array; my @span; for my $e (@elements) { if (@span==0) { push @span, $e; } elsif (@span==1 and $e==$span[0]+1) { push @span, $e; } elsif (@span==1 and $e >$span[0]+1) { push @spans, [ $span[0], $span[0] ]; @span = ($e); } elsif (@span==2 and $e==$span[1]+1) { $span[1] = $e; } elsif (@span==2 and $e >$span[1]+1) { push @spans, [ @span ]; @span = ($e); } } @span==1 and push @spans, [ $span[0], $span[0] ]; @span==2 and push @spans, [ @span ]; $set->_insert_spans(\@spans) } sub bySpan { my($al, $au) = @$a; my($bl, $bu) = @$b; if (defined $al && defined $bl) { return $al <=> $bl; } elsif (defined $al ) { return 1; } elsif ( defined $bl) { return -1; } elsif (defined $au ) { return -1; } elsif ( defined $bu) { return 1; } else { return 0; } } sub _insert_spans { my($set, $spans) = @_; my @edges; $set->{negInf} = 0; $set->{posInf} = 0; $set->{edges } = \@edges; my @spans = sort bySpan @$spans; if (@spans and not defined $spans[0][0]) { $set->{negInf} = 1; my $span = shift @spans; if (not defined $span->[1]) { $set->{posInf} = 1; return $set; } push @edges, $span->[1]; while (@spans and not defined $spans[0][0]) { my $span = shift @spans; $edges[0] = $span->[1] if $edges[0] < $span->[1]; } } for (@spans) { $_->[0]--; } if (@spans and not @edges) { my $span = shift @spans; if (defined $span->[1]) { push @edges, @$span; } else { push @edges, $span->[0]; $set->{posInf} = 1; return $set; } } while (@spans and defined $spans[0][1]) { my $span = shift @spans; if ($edges[-1] < $span->[0]) { push @edges, @$span; } else { $edges[-1] = $span->[1] if $edges[-1] < $span->[1]; } } if (@spans) { $set->{posInf} = 1; my $span = shift @spans; if ($edges[-1] < $span->[0]) { push @edges, $span->[0]; } else { pop @edges; } } return $set } sub _copy_set # copies one set to another { my($dest, $src) = @_; $dest->{negInf} = $src->{negInf}; $dest->{posInf} = $src->{posInf}; $dest->{edges } = [ @{$src->{edges }} ]; } sub _copy_run_list # parses a run list { my($set, $runList) = @_; $set->_copy_empty; $runList =~ s/\s|_//g; return if $runList eq '-'; # empty set my($first, $last) = (1, 0); # verifies order of infinite runs my @edges; for my $run (split(/,/ , $runList)) { croak "Set::IntSpan::_copy_run_list: Bad order 1: $runList\n" if $last; RUN: { $run =~ /^ (-?\d+) $/x and do { push(@edges, $1-1, $1); last RUN; }; $run =~ /^ (-?\d+) - (-?\d+) $/x and do { croak "Set::IntSpan::_copy_run_list: Bad order 2: $runList\n" if $1 > $2; push(@edges, $1-1, $2); last RUN; }; $run =~ /^ \( - (-?\d+) $/x and do { croak "Set::IntSpan::_copy_run_list: Bad order 3: $runList\n" unless $first; $set->{negInf} = 1; push @edges, $1; last RUN; }; $run =~ /^ (-?\d+) - \) $/x and do { push @edges, $1-1; $set->{posInf} = 1; $last = 1; last RUN; }; $run =~ /^ \( - \) $/x and do { croak "Set::IntSpan::_copy_run_list: Bad order 4: $runList\n" unless $first; $last = 1; $set->{negInf} = 1; $set->{posInf} = 1; last RUN; }; croak "Set::IntSpan::_copy_run_list: Bad syntax: $runList\n"; } $first = 0; } $set->{edges} = [ @edges ]; $set->_cleanup or croak "Set::IntSpan::_copy_run_list: Bad order 5: $runList\n"; } # check for overlapping runs # delete duplicate edges sub _cleanup { my $set = shift; my $edges = $set->{edges}; my $i=0; while ($i < $#$edges) { my $cmp = $$edges[$i] <=> $$edges[$i+1]; { $cmp == -1 and $i++ , last; $cmp == 0 and splice(@$edges, $i, 2), last; $cmp == 1 and return 0; } } 1 } sub run_list { my $set = shift; $set->empty and return ${$set->{empty_string}}; my @edges = @{$set->{edges}}; my @runs; $set->{negInf} and unshift @edges, '('; $set->{posInf} and push @edges, ')'; while(@edges) { my($lower, $upper) = splice @edges, 0, 2; if ($lower ne '(' and $upper ne ')' and $lower+1==$upper) { push @runs, $upper; } else { $lower ne '(' and $lower++; push @runs, "$lower-$upper"; } } join(',', @runs) } sub dump { my $set = shift; ($set->{negInf} ? '(' : '') . join ',', @{$set->{edges}} . ($set->{posInf} ? ')' : '') } sub elements { my $set = shift; ($set->{negInf} or $set->{posInf}) and croak "Set::IntSpan::elements: infinite set\n"; my @elements; my @edges = @{$set->{edges}}; while (@edges) { my($lower, $upper) = splice(@edges, 0, 2); push @elements, $lower+1 .. $upper; } wantarray ? @elements : \@elements } sub sets { my $set = shift; my @edges = @{$set->{edges}}; unshift @edges, undef if $set->{negInf}; push @edges, undef if $set->{posInf}; my @sets; while (@edges) { my($lower, $upper) = splice(@edges, 0, 2); $lower = defined $lower ? $lower+1 : '('; $upper = defined $upper ? $upper : ')'; push @sets, Set::IntSpan->new("$lower-$upper"); } @sets } sub spans { my $set = shift; my @edges = @{$set->{edges}}; unshift @edges, undef if $set->{negInf}; push @edges, undef if $set->{posInf}; my @spans; while (@edges) { my($lower, $upper) = splice(@edges, 0, 2); $lower++ if defined $lower; push @spans, [$lower, $upper]; } @spans } sub _real_set # converts a set specification into a set { my($set, $set_spec) = @_; (defined $set_spec and ref $set_spec and ref $set_spec ne 'ARRAY') ? $set_spec : $set->new($set_spec) } sub U { my($a, $set_spec) = @_; my $s = $a->union($set_spec); $a->{negInf} = $s->{negInf}; $a->{posInf} = $s->{posInf}; $a->{edges } = $s->{edges }; $a } sub union { my($a, $set_spec) = @_; my $b = $a->_real_set($set_spec); my $s = $a->new; $s->{negInf} = $a->{negInf} || $b->{negInf}; my $eA = $a->{edges}; my $eB = $b->{edges}; my $eS = $s->{edges}; my $inA = $a->{negInf}; my $inB = $b->{negInf}; my $iA = 0; my $iB = 0; while ($iA<@$eA and $iB<@$eB) { my $xA = $$eA[$iA]; my $xB = $$eB[$iB]; if ($xA < $xB) { $iA++; $inA = ! $inA; not $inB and push(@$eS, $xA); } elsif ($xB < $xA) { $iB++; $inB = ! $inB; not $inA and push(@$eS, $xB); } else { $iA++; $iB++; $inA = ! $inA; $inB = ! $inB; $inA == $inB and push(@$eS, $xA); } } $iA < @$eA and ! $inB and push(@$eS, @$eA[$iA..$#$eA]); $iB < @$eB and ! $inA and push(@$eS, @$eB[$iB..$#$eB]); $s->{posInf} = $a->{posInf} || $b->{posInf}; $s } sub I { my($a, $set_spec) = @_; my $s = $a->intersect($set_spec); $a->{negInf} = $s->{negInf}; $a->{posInf} = $s->{posInf}; $a->{edges } = $s->{edges }; $a } sub intersect { my($a, $set_spec) = @_; my $b = $a->_real_set($set_spec); my $s = $a->new; $s->{negInf} = $a->{negInf} && $b->{negInf}; my $eA = $a->{edges}; my $eB = $b->{edges}; my $eS = $s->{edges}; my $inA = $a->{negInf}; my $inB = $b->{negInf}; my $iA = 0; my $iB = 0; while ($iA<@$eA and $iB<@$eB) { my $xA = $$eA[$iA]; my $xB = $$eB[$iB]; if ($xA < $xB) { $iA++; $inA = ! $inA; $inB and push(@$eS, $xA); } elsif ($xB < $xA) { $iB++; $inB = ! $inB; $inA and push(@$eS, $xB); } else { $iA++; $iB++; $inA = ! $inA; $inB = ! $inB; $inA == $inB and push(@$eS, $xA); } } $iA < @$eA and $inB and push(@$eS, @$eA[$iA..$#$eA]); $iB < @$eB and $inA and push(@$eS, @$eB[$iB..$#$eB]); $s->{posInf} = $a->{posInf} && $b->{posInf}; $s } sub D { my($a, $set_spec) = @_; my $s = $a->diff($set_spec); $a->{negInf} = $s->{negInf}; $a->{posInf} = $s->{posInf}; $a->{edges } = $s->{edges }; $a } sub diff { my($a, $set_spec, $reverse) = @_; my $b = $a->_real_set($set_spec); _reorder($a, $b, $reverse); my $s = $a->new; $s->{negInf} = $a->{negInf} && ! $b->{negInf}; my $eA = $a->{edges}; my $eB = $b->{edges}; my $eS = $s->{edges}; my $inA = $a->{negInf}; my $inB = $b->{negInf}; my $iA = 0; my $iB = 0; while ($iA<@$eA and $iB<@$eB) { my $xA = $$eA[$iA]; my $xB = $$eB[$iB]; if ($xA < $xB) { $iA++; $inA = ! $inA; not $inB and push(@$eS, $xA); } elsif ($xB < $xA) { $iB++; $inB = ! $inB; $inA and push(@$eS, $xB); } else { $iA++; $iB++; $inA = ! $inA; $inB = ! $inB; $inA != $inB and push(@$eS, $xA); } } $iA < @$eA and not $inB and push(@$eS, @$eA[$iA..$#$eA]); $iB < @$eB and $inA and push(@$eS, @$eB[$iB..$#$eB]); $s->{posInf} = $a->{posInf} && ! $b->{posInf}; $s } sub X { my($a, $set_spec) = @_; my $s = $a->xor($set_spec); $a->{negInf} = $s->{negInf}; $a->{posInf} = $s->{posInf}; $a->{edges } = $s->{edges }; $a } sub xor { my($a, $set_spec) = @_; my $b = $a->_real_set($set_spec); my $s = $a->new; $s->{negInf} = $a->{negInf} ^ $b->{negInf}; my $eA = $a->{edges}; my $eB = $b->{edges}; my $eS = $s->{edges}; my $iA = 0; my $iB = 0; while ($iA<@$eA and $iB<@$eB) { my $xA = $$eA[$iA]; my $xB = $$eB[$iB]; if ($xA < $xB) { $iA++; push(@$eS, $xA); } elsif ($xB < $xA) { $iB++; push(@$eS, $xB); } else { $iA++; $iB++; } } $iA < @$eA and push(@$eS, @$eA[$iA..$#$eA]); $iB < @$eB and push(@$eS, @$eB[$iB..$#$eB]); $s->{posInf} = $a->{posInf} ^ $b->{posInf}; $s } sub complement { my $set = shift; $set->new($set)->C } sub C { my $set = shift; $set->{negInf} = ! $set->{negInf}; $set->{posInf} = ! $set->{posInf}; $set } sub superset { my($a, $set_spec) = @_; my $b = $a->_real_set($set_spec); $b->diff($a)->empty } sub subset { my($a, $b) = @_; $a->diff($b)->empty } sub equal { my($a, $set_spec) = @_; my $b = $a->_real_set($set_spec); $a->{negInf} == $b->{negInf} or return 0; $a->{posInf} == $b->{posInf} or return 0; my $aEdge = $a->{edges}; my $bEdge = $b->{edges}; @$aEdge == @$bEdge or return 0; for (my $i=0; $i<@$aEdge; $i++) { $$aEdge[$i] == $$bEdge[$i] or return 0; } 1 } sub equivalent { my($a, $set_spec) = @_; my $b = $a->_real_set($set_spec); $a->cardinality == $b->cardinality } sub cardinality { my $set = shift; ($set->{negInf} or $set->{posInf}) and return -1; my $cardinality = 0; my @edges = @{$set->{edges}}; while (@edges) { my $lower = shift @edges; my $upper = shift @edges; $cardinality += $upper - $lower; } $cardinality } *size = \&cardinality; sub empty { my $set = shift; not $set->{negInf} and not @{$set->{edges}} and not $set->{posInf} } sub finite { my $set = shift; not $set->{negInf} and not $set->{posInf} } sub neg_inf { shift->{negInf} } sub pos_inf { shift->{posInf} } sub infinite { my $set = shift; $set->{negInf} or $set->{posInf} } sub universal { my $set = shift; $set->{negInf} and not @{$set->{edges}} and $set->{posInf} } sub member { my($set, $n) = @_; my $i = _bsearch($set->{edges}, $n); $set->{negInf} xor $i & 1 } use constant INSERT => 0; use constant REMOVE => 1; sub insert { _indel(@_, INSERT); } sub remove { _indel(@_, REMOVE); } sub _indel # INsertion/DELetion { my($set, $n, $indel) = @_; defined $n or return; my $edge = $set->{edges}; my $i = _bsearch($edge, $n); return if $set->{negInf} xor $i & 1 xor $indel; my $lGap = $i==0 || $edge->[$i-1] < $n-1; my $rGap = $i==@$edge || $n < $edge->[$i]; if ( $lGap and $rGap) { splice @$edge, $i, 0, $n-1, $n } elsif (not $lGap and $rGap) { $edge->[$i-1]++ } elsif ( $lGap and not $rGap) { $edge->[$i ]-- } else { splice @$edge, $i-1, 2 } } # Returns the index of the first edge that satisifies target <= edge. # Returns $#$edges+1 if target > the last edge. # Returns 0 if edges is empty. sub _bsearch { my($edges, $target) = @_; @$edges or return 0; my $lower = 0; my $upper = $#$edges; while ($lower+1 < $upper) { my $mid = int(($lower + $upper) / 2); if ($target <= $edges->[$mid]) { $upper = $mid; } else { $lower = $mid+1; } } $target <= $edges->[$lower] and return $lower; $target <= $edges->[$upper] and return $upper; $upper + 1 } sub span_ord { my($set, $n) = @_; my $i = _bsearch($set->{edges}, $n); ($set->{negInf} xor $i & 1) ? $i >> 1 : undef } sub min { my $set = shift; $set->empty and return undef; $set->neg_inf and return undef; $set->{edges}->[0]+1 } sub max { my $set = shift; $set->empty and return undef; $set->pos_inf and return undef; $set->{edges}->[-1] } sub cover { my $set = shift; my $cover = $set->new(); my $edges = $set->{edges}; my $negInf = $set->{negInf}; my $posInf = $set->{posInf}; if ($negInf and $posInf) { $cover->{negInf} = 1; $cover->{posInf} = 1; } elsif ($negInf and not $posInf) { $cover->{negInf} = 1; $cover->{edges}[0] = $set->{edges}[-1]; } elsif (not $negInf and $posInf) { $cover->{edges}[0] = $set->{edges}[0]; $cover->{posInf} = 1; } elsif (@$edges) { $cover->{edges}[0] = $set->{edges}[ 0]; $cover->{edges}[1] = $set->{edges}[-1]; } $cover } *extent = \&cover; sub holes { my $set = shift; my $holes = $set->new($set); my $edges = $holes->{edges}; my $negInf = $holes->{negInf}; my $posInf = $holes->{posInf}; if ($negInf and $posInf) { $holes->{negInf} = 0; $holes->{posInf} = 0; } elsif ($negInf and not $posInf) { $holes->{negInf} = 0; pop @$edges; } elsif (not $negInf and $posInf) { shift @$edges; $holes->{posInf} = 0; } elsif (@$edges) { shift @$edges; pop @$edges; } $holes } sub inset { my($set, $n) = @_; my $edges = $set->{edges}; my @edges = @$edges; my $inset = $set->new(); $inset->{negInf} = $set->{negInf}; $inset->{posInf} = $set->{posInf}; my @inset; my $nAbs = abs $n; if (@edges and ($inset->{negInf} xor $n < 0)) { my $edge = shift @edges; push @inset, $edge - $nAbs; } while (@edges > 1) { my($lower, $upper) = splice(@edges, 0, 2); $lower += $nAbs; $upper -= $nAbs; push @inset, $lower, $upper if $lower < $upper; } if (@edges) { my $edge = shift @edges; push @inset, $edge + $nAbs; } $inset->{edges} = \@inset; $inset } *trim = \&inset; sub pad { my($set, $n) = @_; $set->inset(-$n) } sub grep_set(&$) { my($block, $set) = @_; return undef if $set->{negInf} or $set->{posInf}; my @edges = @{$set->{edges}}; my @sub_edges = (); while (@edges) { my($lower, $upper) = splice(@edges, 0, 2); for (my $i=$lower+1; $i<=$upper; $i++) { local $_ = $i; &$block() or next; if (@sub_edges and $sub_edges[-1] == $i-1) { $sub_edges[-1] = $i; } else { push @sub_edges, $i-1, $i; } } } my $sub_set = $set->new; $sub_set->{edges} = \@sub_edges; $sub_set } sub map_set(&$) { my($block, $set) = @_; return undef if $set->{negInf} or $set->{posInf}; my $map_set = $set->new; my @edges = @{$set->{edges}}; while (@edges) { my($lower, $upper) = splice(@edges, 0, 2); my $domain; for ($domain=$lower+1; $domain<=$upper; $domain++) { local $_ = $domain; my $range; for $range (&$block()) { $map_set->insert($range); } } } $map_set } sub grep_spans(&$) { my($block, $set) = @_; my @edges = @{$set->{edges}}; my $sub_set = $set->new; my @sub_edges = (); if ($set->{negInf} and $set->{posInf}) { local $_ = [ undef, undef ]; if (&$block()) { $sub_set->{negInf} = 1; $sub_set->{posInf} = 1; } } elsif ($set->{negInf}) { my $upper = shift @edges; local $_ = [ undef, $upper ]; if (&$block()) { $sub_set->{negInf} = 1; push @sub_edges, $upper; } } while (@edges > 1) { my($lower, $upper) = splice(@edges, 0, 2); local $_ = [ $lower+1, $upper ]; &$block() and push @sub_edges, $lower, $upper; } if (@edges) { my $lower = shift @edges; local $_ = [ $lower+1, undef ]; if (&$block()) { $sub_set->{posInf} = 1; push @sub_edges, $lower; } } $sub_set->{edges} = \@sub_edges; $sub_set } sub map_spans(&$) { my($block, $set) = @_; my @edges = @{$set->{edges}}; my @spans; if ($set->{negInf} and $set->{posInf}) { local $_ = [ undef, undef ]; push @spans, &$block(); } elsif ($set->{negInf}) { my $upper = shift @edges; local $_ = [ undef, $upper ]; push @spans, &$block(); } while (@edges > 1) { my($lower, $upper) = splice(@edges, 0, 2); local $_ = [ $lower+1, $upper ]; push @spans, &$block(); } if (@edges) { my $lower = shift @edges; local $_ = [ $lower+1, undef ]; push @spans, &$block(); } $set->new->_insert_spans(\@spans) } sub first($) { my $set = shift; $set->{iterator} = $set->min; $set->{run}[0] = 0; $set->{run}[1] = $#{$set->{edges}} ? 1 : undef; $set->{iterator} } sub last($) { my $set = shift; my $lastEdge = $#{$set->{edges}}; $set->{iterator} = $set->max; $set->{run}[0] = $lastEdge ? $lastEdge-1 : undef; $set->{run}[1] = $lastEdge; $set->{iterator} } sub start($$) { my($set, $start) = @_; $set->{iterator} = undef; defined $start or return undef; my $inSet = $set->{negInf}; my $edges = $set->{edges}; for (my $i=0; $i<@$edges; $i++) { if ($inSet) { if ($start <= $$edges[$i]) { $set->{iterator} = $start; $set->{run}[0] = $i ? $i-1 : undef; $set->{run}[1] = $i; return $start; } $inSet = 0; } else { if ($start <= $$edges[$i]) { return undef; } $inSet = 1; } } if ($inSet) { $set->{iterator} = $start; $set->{run}[0] = @$edges? $#$edges: undef; $set->{run}[1] = undef; } $set->{iterator} } sub current($) { shift->{iterator} } sub next($) { my $set = shift; defined $set->{iterator} or return $set->first; my $run1 = $set->{run}[1]; defined $run1 or return ++$set->{iterator}; my $edges = $set->{edges}; $set->{iterator} < $edges->[$run1] and return ++$set->{iterator}; if ($run1 < $#$edges-1) { my $run0 = $run1 + 1; $set->{run} = [$run0, $run0+1]; $set->{iterator} = $edges->[$run0]+1; } elsif ($run1 < $#$edges) { my $run0 = $run1 + 1; $set->{run} = [$run0, undef]; $set->{iterator} = $edges->[$run0]+1; } else { $set->{iterator} = undef; } $set->{iterator} } sub prev($) { my $set = shift; defined $set->{iterator} or return $set->last; my $run0 = $set->{run}[0]; defined $run0 or return --$set->{iterator}; my $edges = $set->{edges}; $set->{iterator} > $edges->[$run0]+1 and return --$set->{iterator}; if ($run0 > 1) { my $run1 = $run0 - 1; $set->{run} = [$run1-1, $run1]; $set->{iterator} = $edges->[$run1]; } elsif ($run0 > 0) { my $run1 = $run0 - 1; $set->{run} = [undef, $run1]; $set->{iterator} = $edges->[$run1]; } else { $set->{iterator} = undef; } $set->{iterator} } sub at { my($set, $i) = @_; $i < 0 ? $set->_at_neg($i) : $set->_at_pos($i) } sub _at_pos { my($set, $i) = @_; $set->neg_inf and croak "Set::IntSpan::at: negative infinite set\n"; my @edges = @{$set->{edges}}; while (@edges > 1) { my($lower, $upper) = splice(@edges, 0, 2); my $size = $upper - $lower; $i < $size and return $lower + 1 + $i; $i -= $size; } @edges ? $edges[0] + 1 + $i : undef } sub _at_neg { my($set, $i) = @_; $set->pos_inf and croak "Set::IntSpan::at: positive infinite set\n"; my @edges = @{$set->{edges}}; $i++; while (@edges > 1) { my($lower, $upper) = splice(@edges, -2, 2); my $size = $upper - $lower; -$i < $size and return $upper + $i; $i += $size; } @edges ? $edges[0] + $i : undef } sub ord { my($set, $n) = @_; $set->{negInf} and croak "Set::IntSpan::ord: negative infinite set\n"; defined $n or return undef; my $i = 0; my @edges = @{$set->{edges}}; while (@edges) { my($lower, $upper) = splice(@edges, 0, 2); $n <= $lower and return undef; if (defined $upper and $upper < $n) { $i += $upper - $lower; next; } return $i + $n - $lower - 1; } undef } sub slice { my($set, $from, $to) = @_; $set->{slicing} = 1; my $slice = $set->_splice($from, $to - $from + 1); $set->{slicing} = 0; $slice } sub _splice { my($set, $offset, $length) = @_; $offset < 0 ? $set->_splice_neg($offset, $length) : $set->_splice_pos($offset, $length) } sub _splice_pos { my($set, $offset, $length) = @_; $set->neg_inf and croak "Set::IntSpan::slice: negative infinite set\n"; my @edges = @{$set->{edges}}; my $slice = new Set::IntSpan; while (@edges > 1) { my ($lower, $upper) = @edges[0,1]; my $size = $upper - $lower; $offset < $size and last; splice(@edges, 0, 2); $offset -= $size; } @edges or return $slice; # empty set $edges[0] += $offset; $slice->{edges} = $set->_splice_length(\@edges, $length); $slice } sub _splice_neg { my($set, $offset, $length) = @_; $set->pos_inf and croak "Set::IntSpan::slice: positive infinite set\n"; my @edges = @{$set->{edges}}; my $slice = new Set::IntSpan; my @slice; $offset++; while (@edges > 1) { my ($lower, $upper) = @edges[-2,-1]; my $size = $upper - $lower; -$offset < $size and last; unshift @slice, splice(@edges, -2, 2); $offset += $size; } if (@edges) { my $upper = pop @edges; unshift @slice, $upper+$offset-1, $upper; } elsif ($set->{slicing}) { $length += $offset-1; } $slice->{edges} = $set->_splice_length(\@slice, $length); $slice } sub _splice_length { my($set, $edges, $length) = @_; not defined $length and return $edges; # everything $length<0 and return $set->_splice_length_neg($edges, -$length); $length>0 and return $set->_splice_length_pos($edges, $length); [] # $length==0 } sub _splice_length_pos { my($set, $edges, $length) = @_; my @slice; while (@$edges > 1) { my ($lower, $upper) = @$edges[0,1]; my $size = $upper - $lower; $length <= $size and last; push @slice, splice(@$edges, 0, 2); $length -= $size; } if (@$edges) { my $lower = shift @$edges; push @slice, $lower, $lower+$length; } \@slice } sub _splice_length_neg { my($set, $edges, $length) = @_; $set->pos_inf and croak "Set::IntSpan::slice: positive infinite set\n"; while (@$edges > 1) { my($lower, $upper) = @$edges[-2,-1]; my $size = $upper - $lower; $length < $size and last; splice(@$edges, -2, 2); $length -= $size; } if (@$edges) { $edges->[-1] -= $length; } $edges } 1 __END__ =head1 NAME Set::IntSpan - Manages sets of integers =head1 SYNOPSIS # BEGIN { $Set::IntSpan::integer = 1 } use Set::IntSpan qw(grep_set map_set grep_spans map_spans); # $Set::IntSpan::Empty_String = '-'; # or ''; $set = new Set::IntSpan $set_spec; $set = new Set::IntSpan @set_specs; $valid = valid Set::IntSpan $run_list; $set = copy $set $set_spec; $run_list = run_list $set; @elements = elements $set; @sets = sets $set; @spans = spans $set; $u_set = union $set $set_spec; $i_set = intersect $set $set_spec; $x_set = xor $set $set_spec; $d_set = diff $set $set_spec; $c_set = complement $set; $set->U($set_spec); # Union $set->I($set_spec); # Intersect $set->X($set_spec); # Xor $set->D($set_spec); # Diff $set->C; # Complement equal $set $set_spec equivalent $set $set_spec superset $set $set_spec subset $set $set_spec $n = cardinality $set; $n = size $set; empty $set finite $set neg_inf $set pos_inf $set infinite $set universal $set member $set $n; insert $set $n; remove $set $n; $min = min $set; $max = max $set; $holes = holes $set; $cover = cover $set; $inset = inset $set $n; $smaller = trim $set $n; $bigger = pad $set $n; $subset = grep_set { ... } $set; $mapset = map_set { ... } $set; $subset = grep_spans { ... } $set; $mapset = map_spans { ... } $set; for ($element=$set->first; defined $element; $element=$set->next) { ... } for ($element=$set->last ; defined $element; $element=$set->prev) { ... } $element = $set->start($n); $element = $set->current; $n = $set->at($i); $slice = $set->slice($from, $to); $i = $set->ord($n); $i = $set->span_ord($n); =head2 Operator overloads $u_set = $set + $set_spec; # union $i_set = $set * $set_spec; # intersect $x_set = $set ^ $set_spec; # xor $d_set = $set - $set_spec; # diff $c_set = ~$set; # complement $set += $set_spec; # union $set *= $set_spec; # intersect $set ^= $set_spec; # xor $set -= $set_spec; # diff $set eq $set_spec # equal $set ne $set_spec # not equal $set le $set_spec # subset $set lt $set_spec # proper subset $set ge $set_spec # superset $set gt $set_spec # proper superset # compare sets by cardinality $set1 == $set2 $set1 != $set2 $set1 <= $set2 $set1 < $set2 $set1 >= $set2 $set1 > $set2 $set1 <=> $set2 # compare cardinality of set to an integer $set1 == $n $set1 != $n $set1 <= $n $set1 < $n $set1 >= $n $set1 > $n $set1 <=> $n @sorted = sort @sets; # sort sets by cardinality if ($set) { ... } # true if $set is not empty print "$set\n"; # stringizes to the run list =head1 EXPORTS =head2 C<@EXPORT> Nothing =head2 C<@EXPORT_OK> C, C, C, C =head1 DESCRIPTION C manages sets of integers. It is optimized for sets that have long runs of consecutive integers. These arise, for example, in .newsrc files, which maintain lists of articles: alt.foo: 1-21,28,31 alt.bar: 1-14192,14194,14196-14221 A run of consecutive integers is also called a I. Sets are stored internally in a run-length coded form. This provides for both compact storage and efficient computation. In particular, set operations can be performed directly on the encoded representation. C is designed to manage finite sets. However, it can also represent some simple infinite sets, such as { x | x>n }. This allows operations involving complements to be carried out consistently, without having to worry about the actual value of INT_MAX on your machine. =head1 SPANS A I is a run of consecutive integers. A span may be represented by an array reference, in any of 5 forms: =head2 Finite forms Span Set [ $n, $n ] { n } [ $a, $b ] { x | a<=x && x<=b} =head2 Infinite forms Span Set [ undef, $b ] { x | x<=b } [ $a , undef ] { x | x>=a } [ undef, undef ] The set of all integers Some methods operate directly on spans. =head1 SET SPECIFICATIONS Many of the methods take a I. There are four kinds of set specifications. =head2 Empty If a set specification is omitted, then the empty set is assumed. Thus, $set = new Set::IntSpan; creates a new, empty set. Similarly, copy $set; removes all elements from $set. =head2 Object reference If an object reference is given, it is taken to be a C object. =head2 Run list If a string is given, it is taken to be a I. A run list specifies a set using a syntax similar to that in newsrc files. A run list is a comma-separated list of I. Each run specifies a set of consecutive integers. The set is the union of all the runs. Runs may be written in any of 5 forms. =head3 Finite forms =over 8 =item n { n } =item a-b { x | a<=x && x<=b } =back =head3 Infinite forms =over 8 =item (-n { x | x<=n } =item n-) { x | x>=n } =item (-) The set of all integers =back =head3 Empty forms The empty set is consistently written as '' (the null string). It is also denoted by the special form '-' (a single dash). =head3 Restrictions The runs in a run list must be disjoint, and must be listed in increasing order. Valid characters in a run list are 0-9, '(', ')', '-' and ','. White space and underscore (_) are ignored. Other characters are not allowed. =head3 Examples Run list Set "-" { } "1" { 1 } "1-2" { 1, 2 } "-5--1" { -5, -4, -3, -2, -1 } "(-)" the integers "(--1" the negative integers "1-3, 4, 18-21" { 1, 2, 3, 4, 18, 19, 20, 21 } =head2 Array reference If an array reference is given, then the elements of the array specify the elements of the set. The array may contain =over 4 =item * integers =item * L =back The set is the union of all the integers and spans in the array. The integers and spans need not be disjoint. The integers and spans may be in any order. =head3 Examples Array ref Set [ ] { } [ 1, 1 ] { 1 } [ 1, 3, 2 ] { 1, 2, 3 } [ 1, [ 5, 8 ], 5, [ 7, 9 ], 2 ] { 1, 2, 5, 6, 7, 8, 9 } [ undef, undef ] the integers [ undef, -1 ] the negative integers =head1 ITERATORS Each set has a single I, which is shared by all calls to C, C, C, C, C, and C. At all times, the iterator is either an element of the set, or C. C, C, and C set the iterator; C, and C move it; and C returns it. Calls to these methods may be freely intermixed. Using C and C, a single loop can move both forwards and backwards through a set. Using C, a loop can iterate over portions of an infinite set. =head1 METHODS =head2 Creation =over 4 =item I<$set> = C C I<$set_spec> =item I<$set> = C C I<@set_specs> Creates and returns a C object. The initial contents of the set are given by I<$set_spec>, or by the union of all the I<@set_specs>. =item I<$ok> = C C I<$run_list> Returns true if I<$run_list> is a valid run list. Otherwise, returns false and leaves an error message in $@. =item I<$set> = C I<$set> I<$set_spec> Copies I<$set_spec> into I<$set>. The previous contents of I<$set> are lost. For convenience, C returns I<$set>. =item I<$run_list> = C I<$set> Returns a run list that represents I<$set>. The run list will not contain white space. I<$set> is not affected. By default, the empty set is formatted as '-'; a different string may be specified in C<$Set::IntSpan::Empty_String>. =item I<@elements> = C I<$set> Returns an array containing the elements of I<$set>. The elements will be sorted in numerical order. In scalar context, returns an array reference. I<$set> is not affected. =item I<@sets> = C I<$set> Returns the runs in I<$set>, as a list of C objects. The sets in the list are in order. =item I<@spans> = C I<$set> Returns the runs in I<$set>, as a list of the form ([$a1, $b1], [$a2, $b2], ... [$aN, $bN]) If a run contains only a single integer, then the upper and lower bounds of the corresponding span will be equal. If the set has no lower bound, then $a1 will be C. Similarly, if the set has no upper bound, then $bN will be C. The runs in the list are in order. =back =head2 Set operations For these operations, a new C object is created and returned. The operands are not affected. =over 4 =item I<$u_set> = C I<$set> I<$set_spec> Returns the set of integers in either I<$set> or I<$set_spec>. =item I<$i_set> = C I<$set> I<$set_spec> Returns the set of integers in both I<$set> and I<$set_spec>. =item I<$x_set> = C I<$set> I<$set_spec> Returns the set of integers in I<$set> or I<$set_spec>, but not both. =item I<$d_set> = C I<$set> I<$set_spec> Returns the set of integers in I<$set> but not in I<$set_spec>. =item I<$c_set> = C I<$set> Returns the set of integers that are not in I<$set>. =back =head2 Mutators By popular demand, C now has mutating forms of the binary set operations. These methods alter the object on which they are called. =over 4 =item I<$set>->C(I<$set_spec>) Makes I<$set> the union of I<$set> and I<$set_spec>. Returns I<$set>. =item I<$set>->C(I<$set_spec>) Makes I<$set> the intersection of I<$set> and I<$set_spec>. Returns I<$set>. =item I<$set>->C(I<$set_spec>) Makes I<$set> the symmetric difference of I<$set> and I<$set_spec>. Returns I<$set>. =item I<$set>->C(I<$set_spec>) Makes I<$set> the difference of I<$set> and I<$set_spec>. Returns I<$set>. =item I<$set>->C Converts I<$set> to its own complement. Returns I<$set>. =back =head2 Comparison =over 4 =item C I<$set> I<$set_spec> Returns true iff I<$set> and I<$set_spec> contain the same elements. =item C I<$set> I<$set_spec> Returns true iff I<$set> and I<$set_spec> contain the same number of elements. All infinite sets are equivalent. =item C I<$set> I<$set_spec> Returns true iff I<$set> is a superset of I<$set_spec>. =item C I<$set> I<$set_spec> Returns true iff I<$set> is a subset of I<$set_spec>. =back =head2 Cardinality =over 4 =item I<$n> = C I<$set> =item I<$n> = C I<$set> Returns the number of elements in I<$set>. Returns -1 for infinite sets. C is provided as an alias for C. =item C I<$set> Returns true iff I<$set> is empty. =item C I<$set> Returns true iff I<$set> is finite. =item C I<$set> Returns true iff I<$set> contains {x | x I<$set> Returns true iff I<$set> contains {x | x>n} for some n. =item C I<$set> Returns true iff I<$set> is infinite. =item C I<$set> Returns true iff I<$set> contains all integers. =back =head2 Membership =over 4 =item C I<$set> I<$n> Returns true iff the integer I<$n> is a member of I<$set>. =item C I<$set> I<$n> Inserts the integer I<$n> into I<$set>. Does nothing if I<$n> is already a member of I<$set>. =item C I<$set> I<$n> Removes the integer I<$n> from I<$set>. Does nothing if I<$n> is not a member of I<$set>. =back =head2 Extrema =over 4 =item C I<$set> Returns the smallest element of I<$set>, or C if there is none. =item C I<$set> Returns the largest element of I<$set>, or C if there is none. =back =head2 Spans =over 4 =item I<$holes> = C I<$set> Returns a set containing all the holes in I<$set>, that is, all the integers that are in-between spans of I<$set>. C is always a finite set. =item I<$cover> = C I<$set> Returns a set consisting of a single span from I<$set>->C to I<$set>->C. This is the same as union $set $set->holes =item I<$inset> = C I<$set> I<$n> =item I<$smaller> = C I<$set> I<$n> =item I<$bigger> = C I<$set> I<$n> C returns a set constructed by removing I<$n> integers from each end of each span of I<$set>. If I<$n> is negative, then -I<$n> integers are added to each end of each span. In the first case, spans may vanish from the set; in the second case, holes may vanish. C is provided as a synonym for C. C I<$set> I<$n> is the same as C I<$set> -I<$n>. =back =head2 Iterators =over 4 =item I<$set>->C Sets the iterator for I<$set> to the smallest element of I<$set>. If there is no smallest element, sets the iterator to C. Returns the iterator. =item I<$set>->C Sets the iterator for I<$set> to the largest element of I<$set>. If there is no largest element, sets the iterator to C. Returns the iterator. =item I<$set>->C(I<$n>) Sets the iterator for I<$set> to I<$n>. If I<$n> is not an element of I<$set>, sets the iterator to C. Returns the iterator. =item I<$set>->C Sets the iterator for I<$set> to the next element of I<$set>. If there is no next element, sets the iterator to C. Returns the iterator. C will return C only once; the next call to C will reset the iterator to the smallest element of I<$set>. =item I<$set>->C Sets the iterator for I<$set> to the previous element of I<$set>. If there is no previous element, sets the iterator to C. Returns the iterator. C will return C only once; the next call to C will reset the iterator to the largest element of I<$set>. =item I<$set>->C Returns the iterator for I<$set>. =back =head2 Indexing The elements of a set are kept in numerical order. These methods index into the set based on this ordering. =over 4 =item I<$n> = I<$set>->C($i) Returns the I<$i>th element of I<$set>, or C if there is no I<$i>th element. Negative indices count backwards from the end of the set. Dies if =over 4 =item * I<$i> is non-negative and I<$set> is C =item * I<$i> is negative and I<$set> is C =back =item I<$slice> = I<$set>->C(I<$from>, I<$to>) Returns a C object containing the elements of I<$set> at indices I<$from>..I<$to>. Negative indices count backwards from the end of the set. Dies if =over 4 =item * I<$from> is non-negative and I<$set> is C =item * I<$from> is negative and I<$set> is C =back =item I<$i> = I<$set>->C($n) The inverse of C. Returns the index I<$i> of the integer I<$n> in I<$set>, or C if I<$n> if not an element of I<$set>. Dies if I<$set> is C. =item I<$i> = I<$set>->C($n) Returns the index I<$i> of the span containing the integer I<$n>, or C if I<$n> if not an element of I<$set>. To recover the span containing I<$n>, write ($set->spans)[$i] =back =head1 OPERATOR OVERLOADS For convenience, some operators are overloaded on C objects. =head2 set operations One operand must be a C object. The other operand may be a C object or a set specification. $u_set = $set + $set_spec; # union $i_set = $set * $set_spec; # intersect $x_set = $set ^ $set_spec; # xor $d_set = $set - $set_spec; # diff $c_set = ~$set; # complement $set += $set_spec; # union $set *= $set_spec; # intersect $set ^= $set_spec; # xor $set -= $set_spec; # diff =head2 equality The string comparison operations are overloaded to compare sets for equality and containment. One operand must be a C object. The other operand may be a C object or a set specification. $set eq $set_spec # equal $set ne $set_spec # not equal $set le $set_spec # subset $set lt $set_spec # proper subset $set ge $set_spec # superset $set gt $set_spec # proper superset =head2 equivalence The numerical comparison operations are overloaded to compare sets by cardinality. One operand must be a C object. The other operand may be a C object or an integer. $set1 == $set2 $set1 != $set2 $set1 <= $set2 $set1 < $set2 $set1 >= $set2 $set1 > $set2 $set1 <=> $set2 $set1 cmp $set2 $set1 == $n $set1 != $n $set1 <= $n $set1 < $n $set1 >= $n $set1 > $n $set1 <=> $n $set1 cmp $n N.B. The C operator is overloaded to compare sets by cardinality, not containment. This is done so that sort @sets will sort a list of sets by cardinality. =head2 conversion In boolean context, a C object evaluates to true if it is not empty. A C object stringizes to its run list. =head1 FUNCTIONS =over 4 =item I<$sub_set> = C { ... } I<$set> Evaluates the BLOCK for each integer in I<$set> (locally setting C<$_> to each integer) and returns a C object containing those integers for which the BLOCK returns TRUE. Returns C if I<$set> is infinite. =item I<$map_set> = C { ... } I<$set> Evaluates the BLOCK for each integer in I<$set> (locally setting C<$_> to each integer) and returns a C object containing all the integers returned as results of all those evaluations. Evaluates the BLOCK in list context, so each element of I<$set> may produce zero, one, or more elements in the returned set. The elements may be returned in any order, and need not be disjoint. Returns C if I<$set> is infinite. =item I<$sub_set> = C { ... } I<$set> Evaluates the BLOCK for each span in I<$set> and returns a C object containing those spans for which the BLOCK returns TRUE. Within BLOCK, C<$_> is locally set to an array ref of the form [ $lower, $upper ] where I<$lower> and I<$upper> are the bounds of the span. If the span contains only one integer, then I<$lower> and I<$upper> will be equal. If the span is unbounded, then the corresponding element(s) of the array will be C. =item I<$map_set> = C { ... } I<$set> Evaluates the BLOCK for each span in I<$set>, and returns a C object consisting of the union of all the spans returned as results of all those evaluations. Within BLOCK, C<$_> is locally set to an array ref of the form [ $lower, $upper ] as described above for C. Each evaluation of BLOCK must return a list of L. Each returned list may contain zero, one, or more spans. Spans may be returned in any order, and need not be disjoint. However, for each bounded span, the constraint $lower <= $upper must hold. =back =head1 CLASS VARIABLES =over 4 =item C<$Set::IntSpan::Empty_String> C<$Set::IntSpan::Empty_String> contains the string that is returned when C is called on the empty set. C<$Empty_String> is initially '-'; alternatively, it may be set to ''. Other values should be avoided, to ensure that C always returns a valid run list. C accesses C<$Empty_String> through a reference stored in I<$set>->{C}. Subclasses that wish to override the value of C<$Empty_String> can reassign this reference. =item C<$Set::IntSpan::integer> Up until version 1.16, C specified C, because they were sets of...you know...integers. As of 2012, users are reporting newsgroups with article numbers above 0x7fffffff, which break C on 32-bit processors. Version 1.17 removes C by default. This extends the usable range of C to the number of bits in the mantissa of your floating point representation. For IEEE 754 doubles, this is 53 bits, or around 9e15. I benchmarked C on a Pentium 4, and it looks like C provides a 2% to 4% speedup, depending on the application. If you want C back, either for performance, or because you are somehow dependent on its semantics, write BEGIN { $Set::IntSpan::integer = 1 } use Set::IntSpan; =back =head1 DIAGNOSTICS Any method (except C) will C if it is passed an invalid run list. =over 4 =item C I<$runList> (F) I<$run_list> has bad syntax =item C I<$runList> (F) I<$run_list> has overlapping runs or runs that are out of order. =item C (F) An infinite set was passed to C. =item C (F) C was called with a non-negative index on a negative infinite set. =item C (F) C was called with a negative index on a positive infinite set. =item C (F) C was called with I<$from> non-negative on a negative infinite set. =item C (F) C was called with I<$from> negative on a positive infinite set. =item C (F) C was called on a negative infinite set. =item Out of memory! (X) C I<$set> can generate an "Out of memory!" message on sufficiently large finite sets. =back =head1 NOTES =head2 Traps Beware of forms like union $set [1..5]; This passes an element of @set to union, which is probably not what you want. To force interpretation of $set and [1..5] as separate arguments, use forms like union $set +[1..5]; or $set->union([1..5]); =head2 grep_set and map_set C and C make it easy to construct sets for which the internal representation used by C is I small. Consider: $billion = new Set::IntSpan '0-1_000_000_000'; # OK $odd = grep_set { $_ & 1 } $billion; # trouble $even = map_set { $_ * 2 } $billion; # double trouble =head2 Error handling There are two common approaches to error handling: exceptions and return codes. There seems to be some religion on the topic, so C provides support for both. To catch exceptions, protect method calls with an eval: $run_list = ; eval { $set = new Set::IntSpan $run_list }; $@ and print "$@: try again\n"; To check return codes, use an appropriate method call to validate arguments: $run_list = ; if (valid Set::IntSpan $run_list) { $set = new Set::IntSpan $run_list } else { print "$@ try again\n" } Similarly, use C to protect calls to C: finite $set and @elements = elements $set; Calling C on a large, finite set can generate an "Out of memory!" message, which cannot (easily) be trapped. Applications that must retain control after an error can use C to protect calls to C: @elements = elements { intersect $set "-1_000_000 - 1_000_000" }; or check the size of $set first: finite $set and cardinality $set < 2_000_000 and @elements = elements $set; =head2 Limitations Although C can represent some infinite sets, it does I perform infinite-precision arithmetic. Therefore, finite elements are restricted to the range of integers on your machine. =head2 Extensions Users report that you can construct Set::IntSpan objects on anything that behaves like an integer. For example: $x = new Math::BigInt ...; $set = new Set::Intspan [ [ $x, $x+5 ] ]; I'm not documenting this as supported behavior, because I don't have the resources to test it, but I'll try not to break it. If anyone finds problems with it, let me know. =head2 Roots The sets implemented here are based on a Macintosh data structure called a I. See Inside Macintosh for more information. C was originally written to manage run lists for the L> module. =head1 AUTHOR Steven McDougall =head1 ACKNOWLEDGMENTS =over 4 =item * Malcolm Cook =item * David Hawthorne =item * Martin Krzywinski =item * Marc Lehmann =item * Andrew Olson =item * Nicholas Redgrave =back =head1 COPYRIGHT Copyright (c) 1996-2013 by Steven McDougall. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Set-IntSpan-1.19/Changes0000644000076400007640000000362212131014014014056 0ustar swmcdswmcdRevision history for Perl extension Set::IntSpan 1.19 2014 Apr 09 - unit test fix 1.18 2013 Apr 03 - POD 1.17 2013 Apr 02 - no use integer - optimize _copy_array 1.16 2010 Nov 10 - unit test fix for Perl 5.6.2 on x86_64 1.15 2010 Nov 04 - added span_ord() method 1.14 2010 Jun 22 - added ord() method 1.13 2007 Oct 27 - recoded member(), insert(), and remove() to use a binary search 1.12 2007 Sep 08 - added support for spans in constructors 1.11 2007 Mar 17 - added mutating set operations - added operator overloads 1.10 2007 Mar 04 - extened new to take list of set_specs - added size as an alias for cardinality - added sets method - added cover (extent), and holes methods - added inset, pad, and trim methods - added grep_spans and map_spans functions 1.09 2005 Dec 13 - added indexing methods - 'die' instead of 'croak' on fatal errors 1.08 2004 May 07 - added the spans method - cleaned up some warnings 1.07 1988 Dec 03 - fixes to facilitate subclassing o use ref $this instead of hardcoded "Set::IntSpan" o made internal functions into methods o use method call syntax on all internal method calls, not function call syntax o use direct object syntax on all internal method calls, because indirect object syntax sometimes parses as a function call - added ABSTRACT and AUTHOR keys in Makefile.PL 1.06 Mar 3 1998 - fixed real_set "0" bug 1.05 Dec 19 1997 - fixed new Set::IntSpan "0" bug 1.04 Jun 12 1997 - runs clean under Perl 5.004 - added iterators 1.03 Jun 7 1996 - runs clean under -w - moved test code to t/*.t - added valid(), min() and max() - documentation fixes 1.01 Feb 22 1996 - added $Set::IntSpan::Empty_String - made Set::IntSpan an Exporter - documentation fixes 1.00 Jan 2 1996 - original version Set-IntSpan-1.19/META.yml0000644000076400007640000000104612131014154014037 0ustar swmcdswmcd--- #YAML:1.0 name: Set-IntSpan version: 1.19 abstract: Manages sets of integers, newsrc style author: - Steven McDougall (swmcd@world.std.com) license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: {} no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.57_05 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4