Re^2: an algorithm to randomly pick items that are present at different frequencies

[efoss]

Hi BrowserUK, Sorry about the lack of clarity. I meant these to be relative frequencies, with something getting picked every time.

[BrowserUk]

Then something like this should do the trick:

#! perl -slw
use strict;
use Data::Dump qw[ pp ];

sub genPicker {
    my $fh = shift;
    my( @vals, @odds ); ( $vals[ @vals ], $odds[ @odds ] ) = split( ' 
+' ) for <$fh>;

    ## Sort if not sorted
    my @order = sort{ $odds[ $a ] <=> $odds[ $b ] } 0 .. $#odds;
    @odds = @odds[ @order ];
    @vals = @vals[ @order ];

    ## Calculate and accumulate break points
    my $t = 0; $t += $_ for @odds;
    $_ /= $t for @odds;
    $odds[ $_ + 1 ] += $odds[ $_ ] for 0 .. $#odds - 1;

    ## Generate a subroutine to do the picking
    return sub {
        my $r = rand();
        $r < $odds[ $_ ] and return $vals[ $_ ] for 0 .. $#odds;
    };
}

my $pick = genPicker( *DATA );

## run a quick test
my %tally; ++$tally{ $pick->() } for 1 .. 10e6;

pp \%tally;

__DATA__
A 1e-7
B 20e-7
C 10e-5

Produces:

C:\test>1127420
{ A => 9949, B => 195307, C => 9794744 }

C:\test>1127420
{ A => 10077, B => 196613, C => 9793310 }

[efoss]

Hi BrowserUk,

Thanks very much for this. Unfortunately, this syntax is above my head, though I would like to understand it. For starters, what exactly am I passing to "genPicker"? A file handle? A file name? I made a space-delimited file with A, B and C in the first column and the frequencies in the second column and tried in various ways to pass that into the subroutine but without success.

my $pick = genPicker( *DATA );

What is "*DATA" here? I don't know how to get the "__DATA__" that you list near the bottom into *DATA form. Any help would be much appreciated.

Best wishes, Eric

[BrowserUk]

what exactly am I passing to "genPicker"? A file handle?

You answered your own question :) Yes, its a file handle. *DATA is a (pseudo)filehandle that allows access the 'file' after __DATA__.

So,if you had your input in a file called numbs.dat, you do this:

...
open my $fh, '<', 'numbs.dat' or die $!;

my $pick = genPicker( $fh ); ## Reads the file and generates a picker 
+subroutine according to its contents.

close $fh;

### use $pick->() each time you want a new random number.