Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

298 lines (223 sloc) 7.569 kb
# vi: set ts=4 sw=4 ht=4 et :
package perl5i::2::ARRAY;
use 5.010;
use strict;
use warnings;
no if $] >= 5.018000, warnings => 'experimental::smartmatch';
# Don't accidentally turn carp/croak into methods.
require Carp::Fix::1_25;
use perl5i::2::Signatures;
use perl5i::2::autobox;
# A foreach which honors the number of parameters in the signature
method foreach($code) {
my $n = 1;
if( my $sig = $code->signature ) {
$n = $sig->num_positional_params;
Carp::Fix::1_25::croak("Function passed to foreach takes no arguments") unless $n;
}
my $idx = 0;
while ( $idx <= $#{$self} ) {
$code->(@{$self}[$idx..($idx+$n-1)]);
$idx += $n;
}
return;
}
method first($filter) {
# Deep recursion and segfault (lines 90 and 91 in first.t) if we use
# the same elegant approach as in grep().
if ( ref $filter eq 'Regexp' ) {
return List::Util::first( sub { $_ ~~ $filter }, @$self );
}
return List::Util::first( sub { $filter->() }, @$self );
}
method map( $code ) {
my @result = CORE::map { $code->($_) } @$self;
return wantarray ? @result : \@result;
}
method as_hash{
my %result = CORE::map { $_ => 1 } @$self;
return wantarray ? %result : \%result;
}
method pick ( $num ){
Carp::Fix::1_25::croak("pick() takes the number of elements to pick")
unless defined $num;
Carp::Fix::1_25::croak("pick() takes a positive integer or zero, not '$num'")
unless $num->is_integer && ($num->is_positive or $num == 0);
if($num >= @$self){
my @result = List::Util::shuffle(@$self);
return wantarray ? @result : \@result;
}
# for the first position in the array, generate a random number that gives
# that element an n/N chance of being picked (where n is the number of elements to pick and N is the total array size);
# repeat for the rest of the array, each time altering the probability of
# the element being picked to reflect the number of elements picked so far and the number left.
my $num_left = @$self;
my @result;
my $i=0;
while($num > 0){
my $rand = int(rand($num_left));
if($rand < $num){
push(@result, $self->[$i]);
$num--;
}
$num_left--;
$i++;
}
# Don't return the picks in the same order as the original array
# Simulates what would happen if you shuffled first
@result = @result->shuffle;
return wantarray ? @result : \@result;
}
method pick_one() {
return @$self[int rand @$self];
}
method grep($filter) {
my @result = CORE::grep { $_ ~~ $filter } @$self;
return wantarray ? @result : \@result;
}
method popn($times) {
Carp::Fix::1_25::croak("popn() takes the number of elements to pop")
unless defined $times;
Carp::Fix::1_25::croak("popn() takes a positive integer or zero, not '$times'")
unless $times->is_integer && ($times->is_positive or $times == 0);
# splice() will choke if you walk off the array, so rein it in
$times = scalar(@$self) if ($times > scalar(@$self));
my @result = splice(@$self, -$times, $times);
return wantarray ? @result : \@result;
}
method shiftn($times) {
Carp::Fix::1_25::croak("shiftn() takes the number of elements to shift")
unless defined $times;
Carp::Fix::1_25::croak("shiftn() takes a positive integer or zero, not '$times'")
unless $times->is_integer && ($times->is_positive or $times == 0);
# splice() will choke if you walk off the array, so rein it in
$times = scalar(@$self) if ($times > scalar(@$self));
my @result = splice(@$self, 0, $times);
return wantarray ? @result : \@result;
}
sub all {
require List::MoreUtils;
return &List::MoreUtils::all($_[1], @{$_[0]});
}
sub any {
require List::MoreUtils;
return &List::MoreUtils::any($_[1], @{$_[0]});
}
sub none {
require List::MoreUtils;
return &List::MoreUtils::none($_[1], @{$_[0]});
}
sub true {
require List::MoreUtils;
return &List::MoreUtils::true($_[1], @{$_[0]});
}
sub false {
require List::MoreUtils;
return &List::MoreUtils::false($_[1], @{$_[0]});
}
sub uniq {
require List::MoreUtils;
my @uniq = List::MoreUtils::uniq(@{$_[0]});
return wantarray ? @uniq : \@uniq;
}
sub minmax {
require List::MoreUtils;
my @minmax = List::MoreUtils::minmax(@{$_[0]});
return wantarray ? @minmax : \@minmax;
}
sub mesh {
require List::MoreUtils;
my @mesh = &List::MoreUtils::zip(@_);
return wantarray ? @mesh : \@mesh;
}
# Compare differences between two arrays.
my $diff_two_deeply = func($c, $d) {
my $diff = [];
# For each element of $c, try to find if it is equal to any of the
# elements of $d. If not, it's unique, and has to be pushed into
# $diff.
require perl5i::2::equal;
require List::MoreUtils;
foreach my $item (@$c) {
unless (
List::MoreUtils::any( sub { perl5i::2::equal::are_equal( $item, $_ ) }, @$d )
)
{
push @$diff, $item;
}
}
return $diff;
};
my $diff_two_simply = func($c, $d) {
no warnings 'uninitialized';
my %seen = map { $_ => 1 } @$d;
my @diff = grep { not $seen{$_} } @$c;
return \@diff;
};
method diff(@rest) {
unless (@rest) {
return wantarray ? @$self : $self;
}
require List::MoreUtils;
my $has_refs = List::MoreUtils::any(sub { ref $_ }, @$self);
my $diff_two = $has_refs ? $diff_two_deeply : $diff_two_simply;
# XXX If I use carp here, the exception is "bizarre copy of ARRAY in
# ssasign ... "
die "Arguments must be array references" if grep { ref $_ ne 'ARRAY' } @rest;
foreach my $array (@rest) {
$self = $diff_two->($self, $array);
}
return wantarray ? @$self : $self;
}
my $intersect_two_simply = func($c, $d) {
no warnings 'uninitialized';
my %seen = map { $_ => 1 } @$d;
my @intersect = grep { $seen{$_} } @$c;
return \@intersect;
};
# Compare differences between two arrays.
my $intersect_two_deeply = func($c, $d) {
require perl5i::2::equal;
my $intersect = [];
# For each element of $c, try to find if it is equal to any of the
# elements of $d. If it is, it's shared, and has to be pushed into
# $intersect.
require List::MoreUtils;
foreach my $item (@$c) {
if (
List::MoreUtils::any( sub { perl5i::2::equal::are_equal( $item, $_ ) }, @$d )
)
{
push @$intersect, $item;
}
}
return $intersect;
};
method intersect(@rest) {
unless (@rest) {
return wantarray ? @$self : $self;
}
require List::MoreUtils;
my $has_refs = List::MoreUtils::any(sub { ref $_ }, @$self);
my $intersect_two = $has_refs ? $intersect_two_deeply : $intersect_two_simply;
# XXX If I use carp here, the exception is "bizarre copy of ARRAY in
# ssasign ... "
die "Arguments must be array references" if grep { ref $_ ne 'ARRAY' } @rest;
foreach my $array (@rest) {
$self = $intersect_two->($self, $array);
}
return wantarray ? @$self : $self;
}
method ltrim($charset) {
my @result = CORE::map { $_->ltrim($charset) } @$self;
return wantarray ? @result : \@result;
}
method rtrim($charset) {
my @result = CORE::map { $_->rtrim($charset) } @$self;
return wantarray ? @result : \@result;
}
method trim($charset) {
my @result = CORE::map { $_->trim($charset) } @$self;
return wantarray ? @result : \@result;
}
1;
Jump to Line
Something went wrong with that request. Please try again.