| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Array::Pick::Scan; | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY | 
| 4 |  |  |  |  |  |  | our $DATE = '2020-05-18'; # DATE | 
| 5 |  |  |  |  |  |  | our $DIST = 'Array-Pick-Scan'; # DIST | 
| 6 |  |  |  |  |  |  | our $VERSION = '0.002'; # VERSION | 
| 7 |  |  |  |  |  |  |  | 
| 8 | 1 |  |  | 1 |  | 67810 | use 5.010001; | 
|  | 1 |  |  |  |  | 11 |  | 
| 9 | 1 |  |  | 1 |  | 5 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 29 |  | 
| 10 | 1 |  |  | 1 |  | 6 | use warnings; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 27 |  | 
| 11 |  |  |  |  |  |  |  | 
| 12 | 1 |  |  | 1 |  | 4 | use Exporter qw(import); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 287 |  | 
| 13 |  |  |  |  |  |  | our @EXPORT_OK = qw(random_item); | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | sub random_item { | 
| 16 | 200 |  |  | 200 | 1 | 2583 | my ($src, $num_items) = @_; | 
| 17 | 200 |  |  |  |  | 286 | my $ref = ref $src; | 
| 18 |  |  |  |  |  |  |  | 
| 19 | 200 |  | 50 |  |  | 326 | $num_items //= 1; | 
| 20 |  |  |  |  |  |  |  | 
| 21 | 200 | 100 |  |  |  | 335 | if ($ref eq 'ARRAY') { | 
|  |  | 50 |  |  |  |  |  | 
| 22 | 100 |  |  |  |  | 124 | my $ary = $src; | 
| 23 | 100 |  |  |  |  | 127 | my $ary_size = @$ary; | 
| 24 |  |  |  |  |  |  |  | 
| 25 | 100 | 50 |  |  |  | 142 | if ($num_items == 1) { | 
| 26 | 100 |  |  |  |  | 303 | return $ary->[rand() * $ary_size]; | 
| 27 |  |  |  |  |  |  | } else { | 
| 28 | 0 |  |  |  |  | 0 | my @items; | 
| 29 | 0 |  |  |  |  | 0 | for my $i (0..$ary_size-1) { | 
| 30 | 0 | 0 |  |  |  | 0 | if (@items < $num_items) { | 
| 31 |  |  |  |  |  |  | # we haven't reached $num_items, insert item to array in a | 
| 32 |  |  |  |  |  |  | # random position | 
| 33 | 0 |  |  |  |  | 0 | splice @items, rand(@items+1), 0, $ary->[$i]; | 
| 34 |  |  |  |  |  |  | } else { | 
| 35 |  |  |  |  |  |  | # we have reached $num_items, just replace an item randomly, | 
| 36 |  |  |  |  |  |  | # using algorithm from Learning Perl, slightly modified | 
| 37 | 0 | 0 |  |  |  | 0 | rand($i+1) < @items and | 
| 38 |  |  |  |  |  |  | splice @items, rand(@items), 1, $ary->[$i]; | 
| 39 |  |  |  |  |  |  | } | 
| 40 |  |  |  |  |  |  | } | 
| 41 | 0 |  |  |  |  | 0 | return @items; | 
| 42 |  |  |  |  |  |  | } | 
| 43 |  |  |  |  |  |  | } elsif ($ref eq 'CODE') { | 
| 44 | 100 |  |  |  |  | 118 | my $iter = $src; | 
| 45 | 100 |  |  |  |  | 127 | my @items; | 
| 46 | 100 |  |  |  |  | 114 | my $i = -1; | 
| 47 | 100 |  |  |  |  | 159 | while (defined(my $item = $iter->())) { | 
| 48 | 1000 |  |  |  |  | 4308 | $i++; | 
| 49 | 1000 | 100 |  |  |  | 1485 | if (@items < $num_items) { | 
| 50 |  |  |  |  |  |  | # we haven't reached $num_items, insert item to array in a | 
| 51 |  |  |  |  |  |  | # random position | 
| 52 | 100 |  |  |  |  | 242 | splice @items, rand(@items+1), 0, $item; | 
| 53 |  |  |  |  |  |  | } else { | 
| 54 |  |  |  |  |  |  | # we have reached $num_items, just replace an item randomly, | 
| 55 |  |  |  |  |  |  | # using algorithm from Learning Perl, slightly modified | 
| 56 | 900 | 100 |  |  |  | 2182 | rand($i+1) < @items and splice @items, rand(@items), 1, $item; | 
| 57 |  |  |  |  |  |  | } | 
| 58 |  |  |  |  |  |  | } | 
| 59 | 100 |  |  |  |  | 631 | return @items; | 
| 60 |  |  |  |  |  |  | } else { | 
| 61 | 0 |  |  |  |  |  | die "Please specify arrayref or coderef iterator as source of items"; | 
| 62 |  |  |  |  |  |  | } | 
| 63 |  |  |  |  |  |  | } | 
| 64 |  |  |  |  |  |  |  | 
| 65 |  |  |  |  |  |  | 1; | 
| 66 |  |  |  |  |  |  | # ABSTRACT: Pick random items from an array (or iterator), without duplicates | 
| 67 |  |  |  |  |  |  |  | 
| 68 |  |  |  |  |  |  | __END__ |