From b9c565b77b8ac8f8856c6af118a1e1af5b917c24 Mon Sep 17 00:00:00 2001 From: Mischa POSLAWSKY Date: Sun, 15 Nov 2009 05:10:42 +0100 Subject: [PATCH] rethink method parameters: options to new(), data to ranges() With normal usage, calling multiple ranges for the same data seems unlikely. More useful would be to reuse the same options for different lists, so make that the object variable. Tests are a clear exception because the same input is reused often. Doesn't suffer too much though, as options can now be kept instead. --- lib/List/Index.pm | 34 ++++++------ t/10-ranges.t | 135 ++++++++++++++++++++++++++++------------------ t/25-apply.t | 5 +- 3 files changed, 103 insertions(+), 71 deletions(-) diff --git a/lib/List/Index.pm b/lib/List/Index.pm index 719aca7..daeb707 100644 --- a/lib/List/Index.pm +++ b/lib/List/Index.pm @@ -6,36 +6,40 @@ use warnings; use Exporter 'import'; -our $VERSION = '1.01'; +our $VERSION = '1.02'; our @EXPORT_OK = qw(rangematch); sub new { - my ($class, $values) = @_; - bless [sort map { s/[^a-z]/./g; $_ } @$values], $class; + my ($class, $options) = @_; + $options ||= {}; + bless $options, $class; } sub ranges { my $self = shift; + my @rows = sort map { s/[^a-z]/./g; $_ } @{ shift() }; my $options = shift || {}; + $options->{$_} //= $self->{$_} for keys %$self; + my $pagesize = $options->{pagesize} || 50; my $context = $options->{context } // 1 + ($pagesize >> 4); my $length = $options->{length } || 4; - my $pages = $options->{pages } || 1 + int $#$self / $pagesize; + my $pages = $options->{pages } || 1 + int $#rows / $pagesize; - $pagesize = $pages >= $#$self ? 1 : @$self / $pages; + $pagesize = $pages >= $#rows ? 1 : @rows / $pages; my $lookbehind = -$context; my $lookahead = $context; my @links = (''); - for (my $offset = $pagesize + .5; $offset < @$self; $offset += $pagesize) { - my $link = substr $self->[$offset], 0, $length; + for (my $offset = $pagesize + .5; $offset < @rows; $offset += $pagesize) { + my $link = substr $rows[$offset], 0, $length; if ($context) { my $penalty = 0; # take a value slightly before the current offset if ((my $before = $offset + $lookbehind) > 0) { # see how much of it matches the current link my $trim = 1; - for my $match (split //, $self->[$before - 1]) { + for my $match (split //, $rows[$before - 1]) { scalar $link =~ /\G\Q$match/g or last; $trim++; } @@ -43,7 +47,7 @@ sub ranges { if ($trim < length $link) { substr($link, $trim) = ''; for (reverse $before .. $offset) { - $self->[$offset - $penalty] =~ /^\Q$link/ or last; + $rows[$offset - $penalty] =~ /^\Q$link/ or last; $penalty++; } } @@ -52,20 +56,20 @@ sub ranges { $lookbehind = -$context; # take a value after the current offset - if ((my $after = $offset + $lookahead) < $#$self) { + if ((my $after = $offset + $lookahead) < $#rows) { # see how much of it matches the current link my $trim = 1; - for my $match (split //, $self->[$after]) { + for my $match (split //, $rows[$after]) { scalar $link =~ /\G\Q$match/g or last; $trim++; } # use this link if it's shorter if ($trim < length $link) { - $link = substr $self->[$after], 0, $trim; + $link = substr $rows[$after], 0, $trim; # advance lookbehind offset on the next page $penalty = 0; for ($offset .. $after) { - last if $self->[$_] =~ /^\Q$link/; + last if $rows[$_] =~ /^\Q$link/; $lookbehind++; } } @@ -186,8 +190,8 @@ List::Index - Find and apply prefix ranges to paginate keywords =head1 SYNOPSIS use List::Index; - my $index = List::Index->new(\@values); - my @pages = $index->ranges({pagesize => 50}); + my $index = List::Index->new({ pagesize => 50 }); + my @pages = $index->ranges(\@values); say "$_" for @pages; use List::Index 'rangematch'; diff --git a/t/10-ranges.t b/t/10-ranges.t index 01971c8..efe64b3 100644 --- a/t/10-ranges.t +++ b/t/10-ranges.t @@ -11,49 +11,70 @@ ok(eval { List::Index->VERSION(1) }, 'version 1.00 compatibility'); subtest 'single-char alphabet' => sub { plan tests => 5; - my @uniform = 'a'..'z'; - my $index = List::Index->new(\@uniform) or return; - is_deeply(\@uniform, ['a'..'z'], 'original data unaltered'); - is_deeply($index->ranges, ['-'], 'single page'); - is_deeply($index->ranges({pages => 3}), [qw(-i j-q r-)], 'given pages'); - is_deeply($index->ranges({pagesize => @uniform / 2.1}), [qw( - -i j-q r- - )], 'equivalent pagesize'); - is_deeply($index->ranges({ pages => 500 }), ['-a', 'b'..'y', 'z-'], 'max pages'); + my @data = ('a'..'z'); + + is_deeply(List::Index->new->ranges(\@data), ['-'], 'single page'); + is_deeply(\@data, ['a'..'z'], 'original data unaltered'); + is_deeply( + List::Index->new({ pages => 3 })->ranges(\@data), + [qw(-i j-q r-)], + 'given pages' + ); + is_deeply( + List::Index->new({ pagesize => @data / 2.1 })->ranges(\@data), + [qw(-i j-q r-)], + 'equivalent pagesize' + ); + is_deeply( + List::Index->new({ pages => 500 })->ranges(\@data), + ['-a', 'b'..'y', 'z-'], + 'max pages' + ); }; subtest 'uniform alphanumeric' => sub { plan tests => 2; - my $index = List::Index->new(['aa'..'zz', 1..202]) or return; - is_deeply($index->ranges, [qw( - -. - .-bp bq-dm dn-fi fj-hf hg-i j-k l-m n-os ot-qp qq-sm sn-uj uk-wf wg-x y- + my @data = ('aa'..'zz', 1..202); + my $index = List::Index->new or return; - )], 'default ranges'); - is_deeply($index->ranges({pagesize => 300}), [qw(-c d-n o-)], 'large pagesize'); + is_deeply( + $index->ranges(\@data), + [qw( + -. + .-bp bq-dm dn-fi fj-hf hg-i j-k l-m n-os ot-qp qq-sm sn-uj uk-wf wg-x y- + )], + 'default ranges' + ); + is_deeply( + $index->ranges(\@data, { pagesize => 300 }), + [qw(-c d-n o-)], + 'large pagesize' + ); }; subtest 'context' => sub { plan tests => 9; - my $index = List::Index->new([qw( + my @data = qw( kkeg kl km kmlu knsy koxb kpeo kuaa kuab kuac kuapa kuq kur kux kzb lc lg lgu lgua lguc lguq lgur lgws lgx lka lkq lks lln llq llx - )]) or return; + ); + my $index = List::Index->new({ pagesize => 10 }) or return; + is_deeply( - $index->ranges({ pagesize=>10, context=>0, length=>5 }), + $index->ranges(\@data, { context => 0, length => 5 }), # ranges should match offsets exactly [qw(-kuap. kuapa-lgup lguq-)], 'no context' ); is_deeply( - $index->ranges({ pagesize=>10, context=>0 }), + $index->ranges(\@data, { context => 0 }), # default length limits to 4 chars [qw(-kuao kuap-lgup lguq-)], 'default length' ); is_deeply( - $index->ranges({ pagesize=>10, context=>1 }), + $index->ranges(\@data, { context => 1 }), # lookbehinds aren't shorter (kuac sub { TODO: { local $TODO = 'backtrack'; is_deeply( - $index->ranges({ pagesize=>10, context=>2 }), + $index->ranges(\@data, { context => 2 }), # allowed to advance to 'kur', but provides no benefits over 'kuq' [qw(-kup kuq-lgup lguq-)], 'minimal lookahead' ); } is_deeply( - $index->ranges({ pagesize=>10, context=>3 }), + $index->ranges(\@data, { context => 3 }), # shorten 'kuap' to 'ku' because lookbehind is 'kp...' # 'lguq' matches 'lg', but may only backtrack to 'lgu' [qw(-kt ku-lgt lgu-)], 'lookbehind' ); is_deeply( - $index->ranges({ pagesize=>10, context=>4 }), + $index->ranges(\@data, { context => 4 }), [qw(-kt ku-lf lg-)], 'maximal lookahead' ); is_deeply( - $index->ranges({ pagesize=>10, context=>5 }), + $index->ranges(\@data, { context => 5 }), # after forwarding 'kuap' to 'lc' # disallow backtracking of 'lguq' to 'lc' to prevent qw[-k l-] # so only lookahead (to 'lkq') remains @@ -89,13 +110,13 @@ TODO: { 'lookbehind forbidden' ); is_deeply( - $index->ranges({ pagesize=>10, context=>9 }), + $index->ranges(\@data, { context => 9 }), # allow a single (10-9) entry (l-lf = lc) to remain [qw(-k l-lf lg-)], 'lookbehind penalty' ); is_deeply( - $index->ranges({ pagesize=>10, context=>10 }), + $index->ranges(\@data, { context => 10 }), # allow the last page to go back upto 'lc', replacing the 2nd page [qw(-k l-)], 'full overlap' @@ -104,18 +125,20 @@ TODO: { subtest 'distribution' => sub { plan tests => 2; - my $index = List::Index->new([qw( + my @data = qw( gnihka gniub go gsearnrqns gtdvcxyt gw gwoufolwcvmtueyg gysgphci h habkdgifjfxoh hbbvjf hbqleexnqts hccg hd hdoeqwdmgqwaoya hfbegicieuxz hfm hj hkoysmws hmylu hnvtvpievbdlkrmb hs hvdvcqn hvn hyrybeur iaiaab ib ibavqyar idfniqvxpohbk idh - )]) or return; + ); + my $index = List::Index->new({ pagesize => 10 }) or return; + is_deeply( - $index->ranges({ pagesize=>10, context=>8 }), + $index->ranges(\@data, { context => 8 }), [qw(-g h i-)], 'large context' ); is_deeply( - $index->ranges({ pagesize=>10, context=>7 }), + $index->ranges(\@data, { context => 7 }), # after 2nd page is enlarged by lookbehind to 'h', limit subsequent lookahead # to prevent the page from getting too large (17 entries if forwarded to 'i') [qw(-g h-hm hn-)], @@ -128,20 +151,19 @@ subtest 'distribution' => sub { subtest 'modulo' => sub { plan tests => 2; - my $index = List::Index->new([qw( - a b ccb ccd cce gf gg gh i j - )]) or return; + my @data = qw( a b ccb ccd cce gf gg gh i j ); + my $index = List::Index->new({ pagesize => 4, context => 0 }) or return; # 10 entries at 4 per page requires 3 pages # so actual target page sizes should be 3,4,3 (not 4,4,2) is_deeply( - $index->ranges({ pagesize=>4, context=>0 }), + $index->ranges(\@data), [qw(-ccc ccd-gg gh-)], 'uniform page sizes' ); { local $TODO = 'early lookbehind causing [c-gg]'; is_deeply( - $index->ranges({ pagesize=>4, context=>1 }), + $index->ranges(\@data, { context => 1 }), [qw(-b c-h i-)], 'context at new intervals' ); @@ -150,22 +172,31 @@ subtest 'modulo' => sub { subtest 'context' => sub { plan tests => 4; - my $index = List::Index->new([qw( - baa1 baa2 baa3 baaa bbc cbc daaa ea eaaa zed - )]) or return; - is_deeply($index->ranges({pagesize => 2, context => 0}), [ - qw(-baa. baa.-bbb bbc-daa. daaa-eaa. eaaa-) - ], 'no context'); - is_deeply($index->ranges({pagesize => 2}), [ - qw(-a b c d e-) - ], 'default context'); # context should be 1 - is_deeply($index->ranges({pagesize => 2, context => 2}), [ - qw(-a b-c d e-) - ], 'overlap'); # first item equals second due to large context - is_deeply($index->ranges({pagesize => 2, context => 0, length => 1}), [ - qw(-a b-c d e-) - ], 'single char'); - - #pp($index->ranges({pagesize => 2, context => 2, length => 1})); + my @data = qw( baa1 baa2 baa3 baaa bbc cbc daaa ea eaaa zed ); + my $index = List::Index->new({ pagesize => 2 }) or return; + + is_deeply( + $index->ranges(\@data, { context => 0 }), + [qw(-baa. baa.-bbb bbc-daa. daaa-eaa. eaaa-)], + 'no context' + ); + is_deeply( + $index->ranges(\@data, { context => undef }), + [qw(-a b c d e-)], #TODO + 'default context' # context should be 1 + ); + is_deeply( + $index->ranges(\@data, { context => 2 }), + # first item equals second due to large context + [qw(-a b-c d e-)], + 'overlap' + ); + is_deeply( + $index->ranges(\@data, { context => 0, length => 1 }), + [qw(-a b-c d e-)], + 'single char' + ); + + #pp(List::Index->new({pagesize => 2, context => 2, length => 1}))->ranges(\@data); }; diff --git a/t/25-apply.t b/t/25-apply.t index 92467c3..c06ae06 100644 --- a/t/25-apply.t +++ b/t/25-apply.t @@ -26,10 +26,7 @@ BEGIN { use_ok('List::Index' => 'rangematch'); } @values = uniq @values; # find ranges for generated values - my $ranges = eval { - my $index = List::Index->new(\@values); - $index->ranges(\%options); - }; + my $ranges = eval { List::Index->new(\%options)->ranges(\@values) }; my $failure = $@ || ref $ranges ne 'ARRAY' && ( $ranges ? 'returned ranges not an array ref' : 'no ranges returned' ); -- 2.30.0