Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge remote-tracking branch 'qrazhan/issue/145'

  • Loading branch information...
commit b57203407b6c56e00349676d203f4ffa2958d2d5 2 parents 9926aef + 96b9b05
@schwern schwern authored
Showing with 162 additions and 0 deletions.
  1. +24 −0 lib/perl5i.pm
  2. +38 −0 lib/perl5i/2/ARRAY.pm
  3. +100 −0 t/pick.t
View
24 lib/perl5i.pm
@@ -635,6 +635,30 @@ Example usage:
my %hash = @array->as_hash;
say q[@array contains 'a'] if $hash{"a"};
+=head3 pick
+
+ my @rand = @array->pick($number);
+
+The pick() method returns a list of $number elements in @array.
+If $number is larger than the size of the list, it returns the entire list shuffled.
+
+Example usage:
+
+ my @array = (1, 2, 3, 4);
+ my @rand = @array->pick(2);
+
+=head3 pick_one
+
+ my $rand = @array->pick_one;
+
+The pick_one() method returns a random element in @array.
+It is similar to @array->pick(1), except that it does not return a list.
+
+Example usage:
+
+ my @array = (1,2,3,4);
+ my $rand = @array->pick_one;
+
=head3 diff
Calculate the difference between two (or more) arrays:
View
38 lib/perl5i/2/ARRAY.pm
@@ -49,6 +49,44 @@ method as_hash{
return wantarray ? %result : \%result;
}
+
+method pick ( $num ){
+ Carp::croak("pick() takes the number of elements to pick")
+ unless defined $num;
+ Carp::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++;
+ }
+
+ return wantarray ? @result : \@result;
+}
+
+
+method pick_one() {
+ return @$self[int rand @$self];
+}
+
+
method grep($filter) {
my @result = CORE::grep { $_ ~~ $filter } @$self;
View
100 t/pick.t
@@ -0,0 +1,100 @@
+ #!/usr/bin/perl
+
+use lib 't/lib';
+use perl5i::latest;
+use Test::More;
+use Test::perl5i;
+
+func pick_ok($array, $num) {
+ local $Test::Builder::Level = $Test::Builder::Level +1;
+ my @rand = $array->pick($num);
+ if($num <= @$array){
+ is @rand, $num;
+ }
+ else{
+ is @rand, @$array;
+ }
+ ok (is_subset($array, \@rand)) or diag sprintf <<END, explain $array, explain \@rand;
+set: %s
+subset: %s
+END
+}
+
+func is_subset($array, $sub){
+ my %arr_hash;
+ for my $val (@$array){
+ $val = safe_key($val);
+ $arr_hash{$val}++;
+ }
+ for my $val (@$sub){
+ $val = safe_key($val);
+ $arr_hash{$val}--;
+ return 0 if $arr_hash{$val} < 0;
+ }
+ return 1;
+}
+
+func pick_one_ok($array){
+ local $Test::Builder::Level = $Test::Builder::Level +1;
+ my $elem = @$array->pick_one;
+ ok grep safe_key($_) eq safe_key($elem), @$array;
+}
+
+func safe_key($val){
+ return defined $val ? $val : "__UNDEFINED__";
+}
+
+note 'is_subset';{
+ ok !(is_subset([1,2,3,4] , [1,1,1]));
+
+ ok !(is_subset([1,1,1,1] , [1,2]));
+
+ ok is_subset([1,2,3,4] , [1,2]);
+}
+note 'pick()'; {
+ my @arr = qw(a b c d e f g h i);
+ pick_ok(\@arr, 5);
+
+ pick_ok(\@arr, 9);
+
+ pick_ok(\@arr, 100);
+
+ pick_ok(\@arr, 0);
+}
+
+note 'pick with undefined elements';{
+ pick_ok([undef,undef,undef] => 2);
+
+}
+
+note 'pick method with duplicate elements';{
+ pick_ok([1,1,2,2,3,3] => 6);
+}
+
+note "pick with no args"; {
+ my @array = (1, 2, 3);
+ throws_ok { @array->pick(); }
+ qr{^\Qpick() takes the number of elements to pick at $0 line };
+}
+
+note "pick with negative arg"; {
+ my @array = (1, 2, 3);
+ throws_ok { @array->pick(-20); }
+ qr{^\Qpick() takes a positive integer or zero, not '-20' at $0 line };
+}
+
+note "pick with non-numerical argument"; {
+ my @array = (1, 2, 3);
+ throws_ok { @array->pick("rawr"); }
+ qr{^\Qpick() takes a positive integer or zero, not 'rawr' at $0 line };
+}
+
+note "pick_one method";{
+ pick_one_ok([1,2,3,4,4]);
+
+ pick_one_ok(["a","b","c","d","e"]);
+
+ pick_one_ok([undef, undef, undef, undef]);
+}
+
+done_testing;
Please sign in to comment.
Something went wrong with that request. Please try again.