List-UtilsBy

 view release on metacpan or  search on metacpan

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

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

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

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

   $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

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

   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

   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

   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

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

   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

   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

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

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

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

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++;