This comes up from time to time. For example, also see Weighted random numbers generator.

Yep... which points to Rolling a biased die, where a very good solution was already presented.

use List::Util qw(sum);
my $total = sum values %$group;
my $picked;
for (keys %$group){
    if (rand() < $group->{$_} / $total){
        $picked = $_;
        last;
    }
    # update: I forgot this line:
    $total -= $group->{$_};
    # without this line items later in the hash are chosen
    # too seldom, and you might chose none at all. Very bad.
}
[download]

I somehow think it's not entirely fair, but I can't get a straight thought on stochastic at this time (0:30 AM here), maybe I can think of a prove (or disprove) tomorrow.

Hmmm... Not totally sure this'll give me the right weighting. But it has inspired me to write:-

use List::Util qw(sum);
my $total = sum values %$group;

my $rnd = rand( $total );
my $runningtot = 0;

foreach ( keys %$group ) {
    
    if ( $rnd > $runningtot && $rnd <= ( $runningtot + $group->{$_} ) 
+) {
        $picked = $_;
        last;
    }#if

    $runningtot += $group->{$_};

}#foreach
[download]

rand() is only called once. No array is made. Straight forward if and a last to drop out once found. Haven't tested for efficiency but I'm guessing it's pretty good.

Lyle

Now (after the correction) later items are chosen too often (just try the test case, ad1 gets picked very very seldom).

Which shows that one shouldn't post answers when dead tired. ;-)

        while ( $group->{$advert} > 0 ) {
            push( @rndselect, $advert );
            $group->{$advert}--;
        }#while
[download]

        push( @rndselect, ($advert) x $group->{$advert} );
[download]

my %group = ( ad1 => 1, ad2 => 2, ad3 => 3 );

my @rndselect = map { ($_) x $group{$_} } keys %group;
$advertinfo->{advert} = $rndselect[rand @rndselect];
[download]

Update: I seem to remember that Knuth had something to say about this in The Art of Computer Programming (probably volume 1). I'll have a look for it tomorrow.

A simple and efficient method is to build an array of items to pick where each item is replicated the number of times to match it's weighting. (Note: I factored the weights by 5 as that reduces the size of the array.);

Then you just pick (once!) from that array and your guaranteed to get darn close to your chosen weightings:

#! perl -slw
use strict;
use List::Util qw[ sum ];

our $N ||= 1e3;

my %group = ( ad1 => 1, ad2 => 2, ad3 => 4 );

my $t = sum values %group;

print "Expected";
for ( sort keys %group ) {
    printf "$_ to be chosen %f%%\n", $group{ $_ } / $t * 100;
}



my( $key, $value, @choices );
push @choices, ($key) x $value while ( $key, $value ) = each %group;

my %picks;
for ( 1.. $N ) {
    $picks{ @choices[ rand @choices ] } ++;
}

print "\nActual";
for ( sort keys %picks ) {
    printf "$_ chosen %f%%\n", $picks{ $_ } / $N * 100;
}

__END__
C:\test>700683 -N=1e6
Expected
ad1 to be chosen 14.285714%
ad2 to be chosen 28.571429%
ad3 to be chosen 57.142857%

Actual
ad1 chosen 14.276200%
ad2 chosen 28.601600%
ad3 chosen 57.122200%

C:\test>700683 -N=1e6
Expected
ad1 to be chosen 14.285714%
ad2 to be chosen 28.571429%
ad3 to be chosen 57.142857%

Actual
ad1 chosen 14.309300%
ad2 chosen 28.577100%
ad3 chosen 57.113600%
[download]

Isn't this pretty much what I had in the first place?

Isn't this pretty much what I had in the first place?

Having re-inspected your code, yes. Kinda. I didn't recognise as such the first time I looked.

That does raise a question though. Why do you think it is inefficient?

The cost of building @choices (your @rndselect) is a one-off up front cost. And hardly onorous at that unless you have thousand or millions of choices.

The actual runtime cost: $choices[ rand @choices ]; is as minimal as it is possible to be, and totally fair. One random number generation and one access to the array.

The only real alternative to it (for fairness) is the Knuth algorithm and from memory that requires you to:

1. Pick a random number;
2. traverse (on average) half the weights array (or hash) accumulating the weights until the sum is greater than the random number you picked.
3. Then obtain the number (either from a parallel array or the hash).

So O(N(/2)) compared to O(1).

If you have sufficient choices that the memory for the array is a concern, then pack indexes into a string and cut your memory requirement to 1/8th.

---

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

"Science is about questioning the status quo. Questioning authority".

In the absence of evidence, opinion is indistinguishable from prejudice.

"Too many [] have been sedated by an oppressive environment of political correctness and risk aversion."

If you do mind, you could just sum up the all the weights and do the looking up on a second walkthrough. Definitely more memory efficient and if your weights are above 2 on average it would be faster too.

You could also keep a running weight total that would be updated on every addition or deletion in the group.

my $pick;
my $weight;
while (my ($p, $w) = each %$group) 
{
    $weight += $w;
    $pick = $p if rand ($weight) < $w;
}
#
# $pick now contains a weighted choice.
#
[download]