Skip to content
This repository
Browse code

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

  • Loading branch information...
commit b57203407b6c56e00349676d203f4ffa2958d2d5 2 parents 9926aef + 96b9b05
Michael G. Schwern authored

Showing 3 changed files with 162 additions and 0 deletions. Show diff stats Hide diff stats

  1. +24 0 lib/perl5i.pm
  2. +38 0 lib/perl5i/2/ARRAY.pm
  3. +100 0 t/pick.t
24 lib/perl5i.pm
@@ -635,6 +635,30 @@ Example usage:
635 635 my %hash = @array->as_hash;
636 636 say q[@array contains 'a'] if $hash{"a"};
637 637
  638 +=head3 pick
  639 +
  640 + my @rand = @array->pick($number);
  641 +
  642 +The pick() method returns a list of $number elements in @array.
  643 +If $number is larger than the size of the list, it returns the entire list shuffled.
  644 +
  645 +Example usage:
  646 +
  647 + my @array = (1, 2, 3, 4);
  648 + my @rand = @array->pick(2);
  649 +
  650 +=head3 pick_one
  651 +
  652 + my $rand = @array->pick_one;
  653 +
  654 +The pick_one() method returns a random element in @array.
  655 +It is similar to @array->pick(1), except that it does not return a list.
  656 +
  657 +Example usage:
  658 +
  659 + my @array = (1,2,3,4);
  660 + my $rand = @array->pick_one;
  661 +
638 662 =head3 diff
639 663
640 664 Calculate the difference between two (or more) arrays:
38 lib/perl5i/2/ARRAY.pm
@@ -49,6 +49,44 @@ method as_hash{
49 49 return wantarray ? %result : \%result;
50 50 }
51 51
  52 +
  53 +method pick ( $num ){
  54 + Carp::croak("pick() takes the number of elements to pick")
  55 + unless defined $num;
  56 + Carp::croak("pick() takes a positive integer or zero, not '$num'")
  57 + unless $num->is_integer && ($num->is_positive or $num == 0);
  58 +
  59 + if($num >= @$self){
  60 + my @result = List::Util::shuffle(@$self);
  61 + return wantarray ? @result : \@result;
  62 + }
  63 +
  64 + # for the first position in the array, generate a random number that gives
  65 + # 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);
  66 + # repeat for the rest of the array, each time altering the probability of
  67 + # the element being picked to reflect the number of elements picked so far and the number left.
  68 + my $num_left = @$self;
  69 + my @result;
  70 + my $i=0;
  71 + while($num > 0){
  72 + my $rand = int(rand($num_left));
  73 + if($rand < $num){
  74 + push(@result, $self->[$i]);
  75 + $num--;
  76 + }
  77 + $num_left--;
  78 + $i++;
  79 + }
  80 +
  81 + return wantarray ? @result : \@result;
  82 +}
  83 +
  84 +
  85 +method pick_one() {
  86 + return @$self[int rand @$self];
  87 +}
  88 +
  89 +
52 90 method grep($filter) {
53 91 my @result = CORE::grep { $_ ~~ $filter } @$self;
54 92
100 t/pick.t
... ... @@ -0,0 +1,100 @@
  1 + #!/usr/bin/perl
  2 +
  3 +use lib 't/lib';
  4 +use perl5i::latest;
  5 +use Test::More;
  6 +use Test::perl5i;
  7 +
  8 +func pick_ok($array, $num) {
  9 + local $Test::Builder::Level = $Test::Builder::Level +1;
  10 + my @rand = $array->pick($num);
  11 + if($num <= @$array){
  12 + is @rand, $num;
  13 + }
  14 + else{
  15 + is @rand, @$array;
  16 + }
  17 + ok (is_subset($array, \@rand)) or diag sprintf <<END, explain $array, explain \@rand;
  18 +set: %s
  19 +subset: %s
  20 +END
  21 +}
  22 +
  23 +func is_subset($array, $sub){
  24 + my %arr_hash;
  25 + for my $val (@$array){
  26 + $val = safe_key($val);
  27 + $arr_hash{$val}++;
  28 + }
  29 + for my $val (@$sub){
  30 + $val = safe_key($val);
  31 + $arr_hash{$val}--;
  32 + return 0 if $arr_hash{$val} < 0;
  33 + }
  34 + return 1;
  35 +}
  36 +
  37 +func pick_one_ok($array){
  38 + local $Test::Builder::Level = $Test::Builder::Level +1;
  39 + my $elem = @$array->pick_one;
  40 + ok grep safe_key($_) eq safe_key($elem), @$array;
  41 +}
  42 +
  43 +func safe_key($val){
  44 + return defined $val ? $val : "__UNDEFINED__";
  45 +}
  46 +
  47 +note 'is_subset';{
  48 + ok !(is_subset([1,2,3,4] , [1,1,1]));
  49 +
  50 + ok !(is_subset([1,1,1,1] , [1,2]));
  51 +
  52 + ok is_subset([1,2,3,4] , [1,2]);
  53 +}
  54 +note 'pick()'; {
  55 + my @arr = qw(a b c d e f g h i);
  56 + pick_ok(\@arr, 5);
  57 +
  58 + pick_ok(\@arr, 9);
  59 +
  60 + pick_ok(\@arr, 100);
  61 +
  62 + pick_ok(\@arr, 0);
  63 +}
  64 +
  65 +note 'pick with undefined elements';{
  66 + pick_ok([undef,undef,undef] => 2);
  67 +
  68 +}
  69 +
  70 +note 'pick method with duplicate elements';{
  71 + pick_ok([1,1,2,2,3,3] => 6);
  72 +}
  73 +
  74 +note "pick with no args"; {
  75 + my @array = (1, 2, 3);
  76 + throws_ok { @array->pick(); }
  77 + qr{^\Qpick() takes the number of elements to pick at $0 line };
  78 +}
  79 +
  80 +note "pick with negative arg"; {
  81 + my @array = (1, 2, 3);
  82 + throws_ok { @array->pick(-20); }
  83 + qr{^\Qpick() takes a positive integer or zero, not '-20' at $0 line };
  84 +}
  85 +
  86 +note "pick with non-numerical argument"; {
  87 + my @array = (1, 2, 3);
  88 + throws_ok { @array->pick("rawr"); }
  89 + qr{^\Qpick() takes a positive integer or zero, not 'rawr' at $0 line };
  90 +}
  91 +
  92 +note "pick_one method";{
  93 + pick_one_ok([1,2,3,4,4]);
  94 +
  95 + pick_one_ok(["a","b","c","d","e"]);
  96 +
  97 + pick_one_ok([undef, undef, undef, undef]);
  98 +}
  99 +
  100 +done_testing;

0 comments on commit b572034

Please sign in to comment.
Something went wrong with that request. Please try again.