Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Re: Rolling a biased die

by I0 (Priest)
on Apr 12, 2002 at 05:39 UTC ( #158490=note: print w/ replies, xml ) Need Help??


in reply to Rolling a biased die

my %bias = ( 1 => 3.1, 2 => 2.0234, 3 => 1.7, 4 => 1.542232, 5 => 1.321249563, 6 => 1.0142, ); my $sum = 0; while( my($k,$v) = each %bias ){ $rand = $k if rand($sum+=$v) < $v; }


Comment on Re: Rolling a biased die
Download Code
Re: Re: Rolling a biased die
by tommyw (Hermit) on Apr 12, 2002 at 11:32 UTC
Re: Re: Rolling a biased die
by ferrency (Deacon) on Apr 12, 2002 at 13:39 UTC
    Update:I'm totally wrong! Please ignore me! And take my advice: try the code before you claim it's broken :) Sorry, IO.

    I don't think you want to put the rand() inside the loop. I think to get the correct results, you need to choose one random number outside the loop, and test it vs. the sum as you go along.

    Try out a simple case by hand:

    my %bias = (1 => 1, 2 => 1);
    Assuming your first iteration picks up (1 => 1), you have:
    $rand = $k if rand($sum += $v) <= $v; # This simplifies to: # $rand = 1 if rand(1) <= 1 # this is always true. That's wrong.
    What you really want is something like this:
    my $sum = 0; $sum += $_ foreach (values %bias); my $target = rand($sum); $sum = 0; while (my ($k, $v) = each %bias) { if ($target <= ($sum += $v)) { $rand = $k; last; } }
    I'm sure there's a golfier way to do it, but this demonstrates the basic idea.

    Update: Okay, after actually trying the code, I believe I'm totally wrong. I think that what I thought was a combination of two bugs may actually be a clever solution. Though I'm still not sure I believe it produces the correct result distribution. IO, would you care to describe how it works? Sorry about that.

    Alan

Re: Re: Rolling a biased die
by tomazos (Deacon) on Apr 13, 2002 at 13:56 UTC
    Cool algorithm. It's like a king of the hill match.

    1 starts as king of the hill. ($rand = 1)

    2 comes along and challanges it. Whoever wins stays on top (is assigned to $rand).

    Just like 2, everyone else (3, 4, 5 and 6) gets a chance.

    Whoever is left on top ($rand) is declared the winner. :)


    To understand why the probabilities work you have to step through the algorithm backwards.

    ie. What is the chance that 6 (the final iteration) is going to win it's match against the king of the hill? $bias{6} / sum(values %bias), which is obvious.

    Now - consider the second last iteration (5). Given that 6 is going to have it's chance in a minute, and hence does not need to be included, what is the chance that 5 will win it's match? $bias{5} / (sum(values %bias) - $bias{6}). We remove 6 from the running by excluding it's weighting from the total.

    Update: This explanation is awful. :)

Re: Re: Rolling a biased die
by tomazos (Deacon) on Apr 13, 2002 at 14:38 UTC
    How about precaching a hash called %biasbase like this?

    my $sum = 0; $biasbase{$_} = ($sum += $bias{$_}) foreach (reverse keys %bias);

    And then iterate like this:

    while( my($k,$v) = each %bias and not defined $rand){ $rand = $k if rand($biasbase{$k}) < $v; }

    Does that make sense? That way you can bail out early.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://158490]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (8)
As of 2015-07-07 09:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (88 votes), past polls