From 7fa252fe32a34065852e73aebc00272833f5537a Mon Sep 17 00:00:00 2001 From: Tom Ryder Date: Fri, 6 Oct 2017 11:09:24 +1300 Subject: Add numeric ranges checking --- MANIFEST | 1 + README | 4 +-- lib/List/Breakdown.pm | 74 ++++++++++++++++++++++++++++++++++++++++++++++++--- t/errors.t | 9 ++++--- t/intervals.t | 34 +++++++++++++++++++++++ 5 files changed, 113 insertions(+), 9 deletions(-) create mode 100644 t/intervals.t diff --git a/MANIFEST b/MANIFEST index 8bab15f..968459f 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4,6 +4,7 @@ Makefile.PL MANIFEST README t/errors.t +t/intervals.t t/monitoring.t t/records.t t/words.t diff --git a/README b/README index 7fbcbbd..c4bd319 100644 --- a/README +++ b/README @@ -1,8 +1,8 @@ List-Breakdown Filter elements from a list non-uniquely into a specified hash -structure, which can be nested, that pass subroutines or match regular -expressions. +structure, which can be nested, that pass subroutines, match regular +expressions, or fall within intervals. INSTALLATION diff --git a/lib/List/Breakdown.pm b/lib/List/Breakdown.pm index 8feafac..766098f 100644 --- a/lib/List/Breakdown.pm +++ b/lib/List/Breakdown.pm @@ -30,6 +30,16 @@ my %types = ( return { breakdown( $spec, @_ ) }; }, + # If it's an array, we're doing numeric bounds checking [a,b) + ARRAY => sub { + my $bounds = shift; + @{$bounds} == 2 + or croak 'ARRAY ref for bounds needs two items'; + my $l = defined $bounds->[0] ? $bounds->[0] : '-Inf'; + my $u = defined $bounds->[1] ? $bounds->[1] : 'Inf'; + return [ grep { $_ >= $l and $_ < $u } @_ ]; + }, + # If it's a subroutine, return a arrayref of all elements for which it # returns true CODE => sub { @@ -52,7 +62,7 @@ sub breakdown { # Check the spec is a hashref ref $spec eq 'HASH' - or croak 'HASH reference expected for first argument'; + or croak 'HASH ref expected for first argument'; # Start building a results hash my %results; @@ -60,7 +70,7 @@ sub breakdown { # Check that the value for this key is a reference my $ref = ref $spec->{$key} - or croak "Reference expected for '$key'"; + or croak "Ref expected for '$key'"; # Check it's a reference we understand exists $types{$ref} @@ -83,6 +93,7 @@ __END__ =for stopwords sublists Unhandled tradename licensable MERCHANTABILITY hashrefs CPAN AnnoCPAN +syntaxes =head1 NAME @@ -142,8 +153,24 @@ This puts the following structure in C<%filtered>: Given a hash reference structure and a list of items, apply each of the subroutines or regular expressions given as values of the hash reference, returning a new hash in the same structure with the tests replaced with the -items for which the subroutine returns true, in the same way as C, or (as -a shortcut) for which the regular expression matched. +items for which the subroutine returns true, in the same way as C. + +There are two shortcut syntaxes: + +=over 4 + +=item * + +If a value in the C structure is an C reference with two items, it +will be interpreted as defining bounds C<[lower,upper)> for matched values. +`undef` can be used to denote negative or positive infinity. + +=item * + +If it's a C reference, it will be interpreted as a pattern to match +against all of the items, and will return the items that match. + +=back =head1 EXAMPLES @@ -274,6 +301,45 @@ C<%results>: Note the extra level of hash referencing beneath the C key. +=head2 Grouping numbers by size + +Suppose you have a list of stray numbers from your volcanic activity reporting +system, some of which might be merely worrisome and some an emergency, and they +need to be filtered to know where to send them: + + my @numbers = ( 1, 32, 3718.4, 0x56, 0777, 3.14, -5, 1.2e5 ); + +You could filter them into buckets like this, using the interval syntax; an +array reference with exactly two elements; lower bound (inclusive) first, upper +bound (exclusive) second: + + my $filters = { + negative => [ undef, 0 ], + positive => { + small => [ 0, 10 ], + medium => [ 10, 100 ], + large => [ 100, undef ], + }, + }; + +Applying the bucket structure like so: + + my %filtered = breakdown $filters, @numbers; + +The result set would look like this: + + my %expected = ( + negative => [ -5 ] + positive => { + small => [ 1, 3.14 ], + medium => [ 32, 86 ], + large => [ 3_718.4, 511, 120_000 ] + }, + ); + +Notice that you can express infinity or negative infinity as C. Note +also this is a numeric comparison only. + =head1 AUTHOR Tom Ryder C<< >> diff --git a/t/errors.t b/t/errors.t index 44cf190..499310e 100644 --- a/t/errors.t +++ b/t/errors.t @@ -4,7 +4,7 @@ use strict; use warnings; use utf8; -use Test::More tests => 5; +use Test::More tests => 7; use List::Breakdown 'breakdown'; @@ -23,8 +23,11 @@ is( eval { breakdown { a => undef }, @t } || undef, # A non-reference value in spec hashref is fatal is( eval { breakdown { a => 'a' }, @t } || undef, undef, 'error_notref_def' ); -# The wrong kind of reference as a value in spec hashref is fatal -is( eval { breakdown { a => [] }, @t } || undef, undef, 'error_badref_array' ); +# Any number of items in the numeric range shortcut besides 2 is fatal +is( eval { breakdown { a => [] }, @t } || undef, undef, 'error_badref_array' ); +is( eval { breakdown { a => [1] }, @t } || undef, undef, 'error_badref_array' ); +is( eval { breakdown { a => [ 1, 2, 3 ] }, @t } || undef, + undef, 'error_badref_array' ); # A double reference as a value in a spec hashref is fatal is( eval { breakdown { a => \{} }, @t } || undef, undef, diff --git a/t/intervals.t b/t/intervals.t new file mode 100644 index 0000000..53f4724 --- /dev/null +++ b/t/intervals.t @@ -0,0 +1,34 @@ +#!perl -T + +use strict; +use warnings; +use utf8; + +use Test::More tests => 1; + +use List::Breakdown 'breakdown'; + +our $VERSION = '0.14'; + +## no critic (ProhibitMagicNumbers,ProhibitLeadingZeros) +my @numbers = ( 1, 32, 3718.4, 0x56, 0777, 3.14, -5, 1.2e5 ); +my $filters = { + negative => [ undef, 0 ], + positive => { + small => [ 0, 10 ], + medium => [ 10, 100 ], + large => [ 100, undef ], + }, +}; +my %filtered = breakdown $filters, @numbers; + +my %expected = ( + negative => [ -5, ], + positive => { + large => [ 3_718.4, 511, 120_000, ], + medium => [ 32, 86, ], + small => [ 1, 3.14, ], + }, +); + +is_deeply( \%filtered, \%expected, 'words' ); -- cgit v1.2.3