File Coverage

blib/lib/Array/Pick/Scan.pm

Criterion	Covered	Total	%
statement	37	47	78.7
branch	14	26	53.8
condition	3	4	75.0
subroutine	6	6	100.0
pod	1	1	100.0
total	61	84	72.6

package Array::Pick::Scan;

use 5.010001;
use strict;
use warnings;

use Exporter qw(import);

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2022-05-21'; # DATE
our $DIST = 'Array-Pick-Scan'; # DIST
our $VERSION = '0.005'; # VERSION

our @EXPORT_OK = qw(random_item pick);

sub random_item {
    my ($src, $num_items, $opts) = @_;
    my $ref = ref $src;

    $num_items //= 1;
    $opts //= {};

    if ($ref eq 'ARRAY') {
        my $ary = $src;
        my $ary_size = @$ary;

        if (!$ary_size) {
            return ();
        } elsif ($num_items == 1) {
            my $idx = int(rand() * $ary_size);
            return $opts->{pos} ? $idx : $ary->[$idx];
        } else {
            my @items;
            for my $i (0..$ary_size-1) {
                if (@items < $num_items) {
                    # we haven't reached $num_items, insert item to array in a
                    # random position
                    my $idx = int(rand(@items+1));
                    splice @items, $idx, 0, ($opts->{pos} ? $i : $ary->[$i]);
                } else {
                    # we have reached $num_items, just replace an item randomly,
                    # using algorithm from Learning Perl, slightly modified
                    if (rand($i+1) < @items) {
                        my $idx = int(rand(@items));
                        splice @items, $idx, 1, ($opts->{pos} ? $i : $ary->[$i]);
                    }
                }
            }
            return @items;
        }
    } elsif ($ref eq 'CODE') {
        my $iter = $src;
        my @items;
        my $i = -1;
        while (defined(my $item = $iter->())) {
            $i++;
            if (@items < $num_items) {
                # we haven't reached $num_items, insert item to array in a
                # random position
                    my $idx = int(rand(@items+1));
                splice @items, $idx, 0, ($opts->{pos} ? $i : $item);
            } else {
                # we have reached $num_items, just replace an item randomly,
                # using algorithm from Learning Perl, slightly modified
                if (rand($i+1) < @items) {
                    my $idx = int(rand(@items));
                    splice @items, $idx, 1, $opts->{pos} ? $i : $item;
                }
            }
        }
        return @items;
    } else {
        die "Please specify arrayref or coderef iterator as source of items";
    }
}

{
    no strict 'refs'; ## no critic: TestingAndDebugging::ProhibitNoStrict
    *pick = \&random_item;
}

1;
# ABSTRACT: Pick random items from an array (or iterator), without duplicates

__END__