List-UtilsBy
2 results

 view release on metacpan or  search on metacpan

lib/List/UtilsBy.pm  view on Meta::CPAN 

99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
them "naturally", rather than lexically.
 
   sort_by { s/(\d+)/sprintf "%09d", $1/eg; $_ } @strings
 
This sorts strings by generating sort keys which zero-pad the embedded numbers
to some level (9 digits in this case), helping to ensure the lexical sort puts
them in the correct order.
 
=cut
 
sub sort_by(&@)
{
   my $keygen = shift;
 
   my @keys = map { local $_ = $_; scalar $keygen->( $_ ) } @_;
   return @_[ sort { $keys[$a] cmp $keys[$b] } 0 .. $#_ ];
}
 
=head2 nsort_by
 
   @vals = nsort_by { KEYFUNC } @vals
 
Similar to L</sort_by> but compares its key values numerically.
 
=cut
 
sub nsort_by(&@)
{
   my $keygen = shift;
 
   my @keys = map { local $_ = $_; scalar $keygen->( $_ ) } @_;
   return @_[ sort { $keys[$a] <=> $keys[$b] } 0 .. $#_ ];
}
 
=head2 rev_sort_by
 
=head2 rev_nsort_by

lib/List/UtilsBy.pm  view on Meta::CPAN 

143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
Similar to L</sort_by> and L</nsort_by> but returns the list in the reverse
order. Equivalent to
 
   @vals = reverse sort_by { KEYFUNC } @vals
 
except that these functions are slightly more efficient because they avoid
the final C<reverse> operation.
 
=cut
 
sub rev_sort_by(&@)
{
   my $keygen = shift;
 
   my @keys = map { local $_ = $_; scalar $keygen->( $_ ) } @_;
   return @_[ sort { $keys[$b] cmp $keys[$a] } 0 .. $#_ ];
}
 
sub rev_nsort_by(&@)
{
   my $keygen = shift;
 
   my @keys = map { local $_ = $_; scalar $keygen->( $_ ) } @_;
   return @_[ sort { $keys[$b] <=> $keys[$a] } 0 .. $#_ ];
}
 
=head2 max_by
 
   $optimal = max_by { KEYFUNC } @vals

lib/List/UtilsBy.pm  view on Meta::CPAN 

184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
list of all the maximal values is returned. This may be used to obtain
positions other than the first, if order is significant.
 
If called on an empty list, an empty list is returned.
 
For symmetry with the L</nsort_by> function, this is also provided under the
name C<nmax_by> since it behaves numerically.
 
=cut
 
sub max_by(&@)
{
   my $code = shift;
 
   return unless @_;
 
   local $_;
 
   my @maximal = $_ = shift @_;
   my $max     = $code->( $_ );

lib/List/UtilsBy.pm  view on Meta::CPAN 

222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
 
   $optimal = min_by { KEYFUNC } @vals
 
   @optimal = min_by { KEYFUNC } @vals
 
Similar to L</max_by> but returns values which give the numerically smallest
result from the key function. Also provided as C<nmin_by>
 
=cut
 
sub min_by(&@)
{
   my $code = shift;
 
   return unless @_;
 
   local $_;
 
   my @minimal = $_ = shift @_;
   my $min     = $code->( $_ );

lib/List/UtilsBy.pm  view on Meta::CPAN 

263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
I<Since version 0.11.>
 
Similar to calling both L</min_by> and L</max_by> with the same key function
on the same list. This version is more efficient than calling the two other
functions individually, as it has less work to perform overall. In the case of
ties, only the first optimal element found in each case is returned. Also
provided as C<nminmax_by>.
 
=cut
 
sub minmax_by(&@)
{
   my $code = shift;
 
   return unless @_;
 
   my $minimal = $_ = shift @_;
   my $min     = $code->( $_ );
 
   return ( $minimal, $minimal ) unless @_;

lib/List/UtilsBy.pm  view on Meta::CPAN 

337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
 
   my @some_fruit = reverse uniq_by { $_->colour } reverse @fruit;
 
Because the values returned by the key function are used as hash keys, they
ought to either be strings, or at least well-behaved as strings (such as
numbers, or object references which overload stringification in a suitable
manner).
 
=cut
 
sub uniq_by(&@)
{
   my $code = shift;
 
   my %present;
   return grep {
      my $key = $code->( local $_ = $_ );
      !$present{$key}++
   } @_;
}

lib/List/UtilsBy.pm  view on Meta::CPAN 

366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
 
   my %balls_by_colour = partition_by { $_->colour } @balls;
 
Because the values returned by the key function are used as hash keys, they
ought to either be strings, or at least well-behaved as strings (such as
numbers, or object references which overload stringification in a suitable
manner).
 
=cut
 
sub partition_by(&@)
{
   my $code = shift;
 
   my %parts;
   push @{ $parts{ $code->( local $_ = $_ ) } }, $_ for @_;
 
   return %parts;
}
 
=head2 count_by

lib/List/UtilsBy.pm  view on Meta::CPAN 

394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
 
   my %count_of_balls = count_by { $_->colour } @balls;
 
Because the values returned by the key function are used as hash keys, they
ought to either be strings, or at least well-behaved as strings (such as
numbers, or object references which overload stringification in a suitable
manner).
 
=cut
 
sub count_by(&@)
{
   my $code = shift;
 
   my %counts;
   $counts{ $code->( local $_ = $_ ) }++ for @_;
 
   return %counts;
}
 
=head2 zip_by

lib/List/UtilsBy.pm  view on Meta::CPAN 

438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
a hash from two separate lists of keys and values
 
   my %nums = zip_by { @_ } [qw( one two three )], [ 1, 2, 3 ];
   # %nums = ( one => 1, two => 2, three => 3 )
 
(A function having this behaviour is sometimes called C<zipWith>, e.g. in
Haskell, but that name would not fit the naming scheme used by this module).
 
=cut
 
sub zip_by(&@)
{
   my $code = shift;
 
   @_ or return;
 
   my $len = 0;
   scalar @$_ > $len and $len = scalar @$_ for @_;
 
   return map {
      my $idx = $_;

lib/List/UtilsBy.pm  view on Meta::CPAN 

477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
   my ( $firstnames, $lastnames ) = unzip_by { m/^(.*?) (.*)$/ } @names;
 
If the function returns lists of differing lengths, the result will be padded
with C<undef> in the missing elements.
 
This function is an inverse of L</zip_by>, if given a corresponding inverse
function.
 
=cut
 
sub unzip_by(&@)
{
   my $code = shift;
 
   my @ret;
   foreach my $idx ( 0 .. $#_ ) {
      my @slice = $code->( local $_ = $_[$idx] );
      $#slice = $#ret if @slice < @ret;
      $ret[$_][$idx] = $slice[$_] for 0 .. $#slice;
   }

lib/List/UtilsBy.pm  view on Meta::CPAN 

523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
   extract_by { !defined $_ } @refs;
 
will leave weak references weakened in the C<@refs> array, whereas
 
   @refs = grep { defined $_ } @refs;
 
will strengthen them all again.
 
=cut
 
sub extract_by(&\@)
{
   my $code = shift;
   my ( $arrref ) = @_;
 
   my @ret;
   for( my $idx = 0; ; $idx++ ) {
      last if $idx > $#$arrref;
      next unless $code->( local $_ = $arrref->[$idx] );
 
      push @ret, splice @$arrref, $idx, 1, ();

lib/List/UtilsBy.pm  view on Meta::CPAN 

560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
As with L</extract_by>, this function requires a real array and not just a
list, and is also implemented using C<splice> so that weak references are
not disturbed.
 
If this function fails to find a matching element, it will return an empty
list in list context. This allows a caller to distinguish the case between
no matching element, and the first matching element being C<undef>.
 
=cut
 
sub extract_first_by(&\@)
{
   my $code = shift;
   my ( $arrref ) = @_;
 
   foreach my $idx ( 0 .. $#$arrref ) {
      next unless $code->( local $_ = $arrref->[$idx] );
 
      return splice @$arrref, $idx, 1, ();
   }

lib/List/UtilsBy.pm  view on Meta::CPAN 

587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
 
I<Since version 0.07.>
 
Returns the list of values shuffled into a random order. The randomisation is
not uniform, but weighted by the value returned by the C<WEIGHTFUNC>. The
probability of each item being returned first will be distributed with the
distribution of the weights, and so on recursively for the remaining items.
 
=cut
 
sub weighted_shuffle_by(&@)
{
   my $code = shift;
   my @vals = @_;
 
   my @weights = map { $code->( local $_ = $_ ) } @vals;
 
   my @ret;
   while( @vals > 1 ) {
      my $total = 0; $total += $_ for @weights;
      my $select = int rand $total;

lib/List/UtilsBy.pm  view on Meta::CPAN 

627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
 
Similar to a regular C<map> functional, returns a list of the values returned
by C<BLOCKFUNC>. Values from the input list are given to the block function in
bundles of C<$number>.
 
If given a list of values whose length does not evenly divide by C<$number>,
the final call will be passed fewer elements than the others.
 
=cut
 
sub bundle_by(&@)
{
   my $code = shift;
   my $n = shift;
 
   my @ret;
   for( my ( $pos, $next ) = ( 0, $n ); $pos < @_; $pos = $next, $next += $n ) {
      $next = @_ if $next > @_;
      push @ret, $code->( @_[$pos .. $next-1] );
   }
   return @ret;

t/Unrandom.pm  view on Meta::CPAN 

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 
use Exporter 'import';
our @EXPORT = qw( unrandomly );
 
our $randhook;
*CORE::GLOBAL::rand = sub { $randhook ? $randhook->( $_[0] ) : rand $_[0] };
 
use constant VALUE => 0;
use constant BELOW => 1;
 
sub unrandomly(&)
{
   my $code = shift;
 
   my @rands;
   my $randidx;
   local $randhook = sub {
      my ( $below ) = @_;
      if( $randidx > $#rands ) {
         push @rands, [ 0, $below ];
         $randidx++;



( run in 0.251 second using v1.01-cache-2.11-cpan-bb97c1e446a )