our $VERSION = '1.500013';
$VERSION =~ tr/_//d;
our @EXPORT_OK;
BEGIN {
@EXPORT_OK = qw(
all any first none notall
min max minstr maxstr
product reductions reduce sum sum0
sample shuffle
uniq uniqnum uniqint uniqstr
pairs unpairs pairkeys pairvalues pairmap pairgrep pairfirst
head tail
zip zip_longest zip_shortest
mesh mesh_longest mesh_shortest
);
}
my $rand = do { our $RAND };
*RAND = *List::Util::RAND;
our $RAND;
$RAND = $rand
if !defined $RAND;
sub import {
my $pkg = caller;
no strict 'refs';
${"${pkg}::a"} = ${"${pkg}::a"};
${"${pkg}::b"} = ${"${pkg}::b"};
if ($pkg eq 'List::Util' && @_ < 2) {
package
List::Util;
return __PACKAGE__->import(qw(first min max minstr maxstr reduce sum shuffle));
}
goto &Exporter::import;
}
sub reduce (&@) {
my $f = shift;
unless ( length ref $f && eval { $f = \&$f; 1 } ) {
Carp::croak("Not a subroutine reference");
}
return shift unless @_ > 1;
my $pkg = caller;
my $a = shift;
no strict 'refs';
local *{"${pkg}::a"} = \$a;
my $glob_b = \*{"${pkg}::b"};
foreach my $b (@_) {
local *$glob_b = \$b;
$a = $f->();
}
$a;
}
sub reductions (&@) {
my $f = shift;
unless ( length ref $f && eval { $f = \&$f; 1 } ) {
Carp::croak("Not a subroutine reference");
}
return unless @_;
return shift unless @_ > 1;
my $pkg = caller;
my $a = shift;
no strict 'refs';
local *{"${pkg}::a"} = \$a;
my $glob_b = \*{"${pkg}::b"};
my @o = $a;
foreach my $b (@_) {
local *$glob_b = \$b;
$a = $f->();
push @o, $a;
}
@o;
}
sub first (&@) {
my $f = shift;
unless ( length ref $f && eval { $f = \&$f; 1 } ) {
Carp::croak("Not a subroutine reference");
}
$f->() and return $_
foreach @_;
undef;
}
sub sum (@) {
return undef unless @_;
my $s = 0;
$s += $_ foreach @_;
return $s;
}
sub min (@) {
return undef unless @_;
my $min = shift;
$_ < $min and $min = $_
foreach @_;
return $min;
}
sub max (@) {
return undef unless @_;
my $max = shift;
$_ > $max and $max = $_
foreach @_;
return $max;
}
sub minstr (@) {
return undef unless @_;
my $min = shift;
$_ lt $min and $min = $_
foreach @_;
return $min;
}
sub maxstr (@) {
return undef unless @_;
my $max = shift;
$_ gt $max and $max = $_
foreach @_;
return $max;
}
sub shuffle (@) {
sample(scalar @_, @_);
}
sub sample ($@) {
my $num = shift;
my @i = (0 .. $#_);
$num = @_ if $num > @_;
my @o = defined $RAND ? (map +(splice @i, $RAND->($#i), 1), 1 .. $num)
: (map +(splice @i, rand($#i), 1), 1 .. $num);
@_[@o];
}
sub all (&@) {
my $f = shift;
unless ( length ref $f && eval { $f = \&$f; 1 } ) {
Carp::croak("Not a subroutine reference");
}
$f->() or return !!0
foreach @_;
return !!1;
}
sub any (&@) {
my $f = shift;
unless ( length ref $f && eval { $f = \&$f; 1 } ) {
Carp::croak("Not a subroutine reference");
}
$f->() and return !!1
foreach @_;
return !!0;
}
sub none (&@) {
my $f = shift;
unless ( length ref $f && eval { $f = \&$f; 1 } ) {
Carp::croak("Not a subroutine reference");
}
$f->() and return !!0
foreach @_;
return !!1;
}
sub notall (&@) {
my $f = shift;
unless ( length ref $f && eval { $f = \&$f; 1 } ) {
Carp::croak("Not a subroutine reference");
}
$f->() or return !!1
foreach @_;
return !!0;
}
sub product (@) {
my $p = 1;
$p *= $_ foreach @_;
return $p;
}
sub sum0 (@) {
my $s = 0;
$s += $_ foreach @_;
return $s;
}
sub pairs (@) {
if (@_ % 2) {
warnings::warnif('misc', 'Odd number of elements in pairs');
}
return
map { bless [ @_[$_, $_ + 1] ], 'List::Util::PP::_Pair' }
map $_*2,
0 .. int($#_/2);
}
sub unpairs (@) {
map @{$_}[0,1], @_;
}
sub pairkeys (@) {
if (@_ % 2) {
warnings::warnif('misc', 'Odd number of elements in pairkeys');
}
return
map $_[$_*2],
0 .. int($#_/2);
}
sub pairvalues (@) {
if (@_ % 2) {
warnings::warnif('misc', 'Odd number of elements in pairvalues');
}
return
map $_[$_*2 + 1],
0 .. int($#_/2);
}
sub pairmap (&@) {
my $f = shift;
unless ( length ref $f && eval { $f = \&$f; 1 } ) {
Carp::croak("Not a subroutine reference");
}
if (@_ % 2) {
warnings::warnif('misc', 'Odd number of elements in pairmap');
}
my $pkg = caller;
no strict 'refs';
my $glob_a = \*{"${pkg}::a"};
my $glob_b = \*{"${pkg}::b"};
return
map {
local (*$glob_a, *$glob_b) = \( @_[$_,$_+1] );
$f->();
}
map $_*2,
0 .. int($#_/2);
}
sub pairgrep (&@) {
my $f = shift;
unless ( length ref $f && eval { $f = \&$f; 1 } ) {
Carp::croak("Not a subroutine reference");
}
if (@_ % 2) {
warnings::warnif('misc', 'Odd number of elements in pairgrep');
}
my $pkg = caller;
no strict 'refs';
my $glob_a = \*{"${pkg}::a"};
my $glob_b = \*{"${pkg}::b"};
return
map {
local (*$glob_a, *$glob_b) = \( @_[$_,$_+1] );
$f->() ? (wantarray ? @_[$_,$_+1] : 1) : ();
}
map $_*2,
0 .. int ($#_/2);
}
sub pairfirst (&@) {
my $f = shift;
unless ( length ref $f && eval { $f = \&$f; 1 } ) {
Carp::croak("Not a subroutine reference");
}
if (@_ % 2) {
warnings::warnif('misc', 'Odd number of elements in pairfirst');
}
my $pkg = caller;
no strict 'refs';
my $glob_a = \*{"${pkg}::a"};
my $glob_b = \*{"${pkg}::b"};
foreach my $i (map $_*2, 0 .. int($#_/2)) {
local (*$glob_a, *$glob_b) = \( @_[$i,$i+1] );
return wantarray ? @_[$i,$i+1] : 1
if $f->();
}
return ();
}
sub List::Util::PP::_Pair::key { $_[0][0] }
sub List::Util::PP::_Pair::value { $_[0][1] }
sub List::Util::PP::_Pair::TO_JSON { [ @{$_[0]} ] }
sub uniq (@) {
my %seen;
my $undef;
my @uniq = grep defined($_) ? !$seen{$_}++ : !$undef++, @_;
@uniq;
}
sub uniqnum (@) {
my %seen;
my $sv;
my $b = B::svref_2object(\$sv);
my @uniq =
grep {
my $nv = $_;
my $k;
if (ref $nv && defined &overload::ov_method && defined &overload::mycan) {
my $package = ref $nv;
if (UNIVERSAL::isa($nv, 'Math::BigInt')) {
$k = $nv->bstr;
}
elsif(my $method
= overload::ov_method(overload::mycan($package, '(0+'), $package)
|| overload::ov_method(overload::mycan($package, '""'), $package)
|| overload::ov_method(overload::mycan($package, 'bool'), $package)
) {
$nv = $nv->$method(undef, !!0);
}
elsif (
my $nomethod = overload::ov_method(overload::mycan($package, '(nomethod'), $package)
) {
$nv = $nv->$nomethod(undef, undef, '0+');
}
}
if (defined $k) {
}
elsif (ref $nv) {
$k = 'R' . 0+$nv;
}
elsif ($nv == 0) {
$k = '0';
}
elsif ($nv*0 != $nv*0) {
$k = sprintf '%f', $nv;
}
elsif (int($nv) != $nv) {
$k = 'N' . pack('F', $nv);
}
else {
$sv = $nv + 0;
my $flags = $b->FLAGS;
if ($flags & B::SVf_IVisUV()) {
$k = sprintf '%u', $nv;
}
elsif ($flags & B::SVf_IOK()) {
$k = sprintf '%d', $nv;
}
elsif ($flags & B::SVf_NOK()) {
$k = sprintf '%.0f', $nv;
}
else {
$k = $nv;
}
}
!$seen{$k}++;
}
map +(defined($_) ? $_
: do { warnings::warnif('uninitialized', 'Use of uninitialized value in subroutine entry'); 0 }),
@_;
@uniq;
}
sub uniqint (@) {
my %seen;
my @uniq =
map +(
ref $_ ? $_ : int($_)
),
grep {
!$seen{
/\A[0-9]+\z/ ? $_
: $_ > 0 ? sprintf '%u', $_
: sprintf '%d', $_
}++;
}
map +(defined($_) ? $_
: do { warnings::warnif('uninitialized', 'Use of uninitialized value in subroutine entry'); 0 }),
@_;
@uniq;
}
sub uniqstr (@) {
my %seen;
my @uniq =
grep !$seen{$_}++,
map +(defined($_) ? $_
: do { warnings::warnif('uninitialized', 'Use of uninitialized value in subroutine entry'); '' }),
@_;
@uniq;
}
sub head ($@) {
my $size = shift;
return @_
if $size > @_;
@_[ 0 .. ( $size >= 0 ? $size - 1 : $#_ + $size ) ];
}
sub tail ($@) {
my $size = shift;
return @_
if $size > @_;
@_[ ( $size >= 0 ? ($#_ - ($size-1) ) : 0 - $size ) .. $#_ ];
}
sub zip_longest {
map {
my $idx = $_;
[ map $_->[$idx], @_ ];
} ( 0 .. max(map $#$_, @_) || -1 )
}
sub zip_shortest {
map {
my $idx = $_;
[ map $_->[$idx], @_ ];
} ( 0 .. min(map $#$_, @_) || -1 )
}
*zip = \&zip_longest;
sub mesh_longest {
map {
my $idx = $_;
map $_->[$idx], @_;
} ( 0 .. max(map $#$_, @_) || -1 )
}
sub mesh_shortest {
map {
my $idx = $_;
map $_->[$idx], @_;
} ( 0 .. min(map $#$_, @_) || -1 )
}
*mesh = \&mesh_longest;
1;