#! perl -slw
use strict;

our $ITERS ||= 1000;
our $PICKS ||= 4;

sub genPicker {
    my $n = shift;
    my @indices = 0 .. $n - 1;
    return sub {
        return unless @indices;
        my $index = int rand @indices;
        my $choice = $indices[ $index ];
        $indices[ $index ] = $indices[ $#indices ];
        --$#indices;
        return $choice;
    };
}

my $n = 1;
my @data = map{ ( $_ ) x ( $n *=2 ) } 'A' .. 'F';

print "Required frequencies";
for my $value ( 'A' .. 'F' ) {
    printf "$value : %.1f\n", grep( { $_ eq $value } @data ) / @data * 100;
}


my %chosen;
for ( 1 .. $ITERS ) {
    my $picker = genPicker ( scalar @data );
    my %picks;

    while( keys %picks < $PICKS ) {
        my $pick = $picker->();
        my $value = $data[ $pick ];
        $picks{ $value }++ ;
    }
    $chosen{ $_ }++ for keys %picks;
}

print "\nActual frequencies:";
printf "$_ : %.1f\n", $chosen{ $_ } / ($ITERS * $PICKS) * 100
    for sort{ $chosen{ $a } <=> $chosen{ $b } } keys %chosen;

##</code><code>##

C:\test>618798 -ITERS=1e4 -PICKS=1
Required frequencies
A : 1.6
B : 3.2
C : 6.3
D : 12.7
E : 25.4
F : 50.8

Actual frequencies:
A : 1.7
B : 3.1
C : 6.4
D : 12.4
E : 25.3
F : 51.1

##</code><code>##

C:\test>618798 -ITERS=1e4 -PICKS=2
Required frequencies
A : 1.6
B : 3.2
C : 6.3
D : 12.7
E : 25.4
F : 50.8

Actual frequencies:
A : 2.1
B : 4.2
C : 8.1
D : 15.4
E : 29.5
F : 40.8

##</code><code>##

C:\test>618798 -ITERS=1e4 -PICKS=3
Required frequencies
A : 1.6
B : 3.2
C : 6.3
D : 12.7
E : 25.4
F : 50.8

Actual frequencies:
A : 3.0
B : 5.7
C : 11.3
D : 20.2
E : 28.0
F : 31.7

C:\test>618798 -ITERS=1e4 -PICKS=4
Required frequencies
A : 1.6
B : 3.2
C : 6.3
D : 12.7
E : 25.4
F : 50.8

Actual frequencies:
A : 4.5
B : 8.9
C : 16.1
D : 21.6
E : 24.0
F : 24.9

##</code><code>##

C:\test>618798 -ITERS=1e4 -PICKS=6
Required frequencies
A : 1.6
B : 3.2
C : 6.3
D : 12.7
E : 25.4
F : 50.8

Actual frequencies:
F : 16.7
A : 16.7
D : 16.7
C : 16.7
E : 16.7
B : 16.7