dimmesdale has asked for the wisdom of the Perl Monks concerning the following question:

I'm trying to write a perl script (one which I plan to post in the Cool Uses or Craft area), but I have come accross a problem. I have a hash that has a variable amount of keys, all of which add up to another variable(though this is 100 most of the time).

The function has a reference to the aforementioned hash and an array that contains they keys of the hash
What I need from this is to select from the array an element(or this could be thought of as one key from the hash). The trick is, though, that the values from the hash each contain the probability of that key being chosen out of the variable $amnt. Let's assume that $amnt is 100; if $hash{key} equalled 50, key would have a 50/100, or %50 chance of being chosen. I figured out that if I put this:
int(rand(99)) < 50 ? "a" : "b" that a would have a %50 chance of being chosen(or so I think).

The problem is that I do not know what I would need to do to have this work for many(a variable number of) objects. I came up with some code, but it is incomplete becaus I stopped when I discovered the problem. Here it is, however, for what little worth it may be to you: 

sub get_cat { #cat stands for category, by the way
  my($hash,$amnt) = @_;
  my $code;
  for(@$cats) {
      unless($_ eq $cats->[-1]) {
          $code .= "int(rand($amnt-1))<$hash->{$_}?$_:"
        } else {
          $code .= "$hash->{$_};";
        }
  }
...and I planned to eval $code, but I realized the problem
}

[download]

I hope I've been clear, but if I haven't I'll try to summarize what my problem is:
I have a hash. I want to choose one key out of the hash to return. However, each key has a chance of getting chosen that is equal to $hash{$key} over $amnt. I do not know enough math to make this work, since I figured that the following code wouldn't do what I expected:
int(rand(99)) < 50 ? "a" : int(rand(99)) < 40 ? "b" : "c";

[download]
I realize that there is a %40 of a %50 chance for "b" to be chosen, or so I think, but I want to be able to make the code whereas there is a %50 chance for a, %40 for b, and %10 for c (though this is just an example to explain; I need more general code than this)

Replies are listed 'Best First'.
Re: Per cents and Probabilities
by btrott (Parson) on Jun 25, 2001 at 02:28 UTC
    It seems like what you want is biased/weighted random number selection, where the weights are stored as the keys of a hash. You might take a look at this previous node, which has some good responses: Biased random number selection. You could probably adapt one of those responses to your own needs.
[reply]
Re: Per cents and Probabilities
by cLive ;-) (Prior) on Jun 25, 2001 at 02:24 UTC
    I think you need rand(100) for 0-100, excluding 100. Using that, how about something like this: 
    use strict;

# five options, with 50%, 25%, 10%, 10% and 5%
# chances respectively.
my %hash = ( option1 => 50,
             option2 => 25,
             option3 => 10,
             option4 => 10,
             option5 => 5);

# get rand num - may want to seed it first though :)
my $rnd_num = int(rand(100));

my ($total,$key);

# cycle through hash values
for (keys %hash) {

  # keep running total
  $total += $hash{$_};

  # keep going until rand num exceeded
  next unless ($total >= $rnd_num);

  # then set this as value selected and stop loopin
  $key = $_; last;
}

# randomly selected key is...
print "$key selected\n";

    [download]

    cLive ;-)

    PS - If total isn't always 100, change the 100 in the rand as follows: 

    my $value_sum = eval join '+', values %hash;
my $rnd_num = int(rand($value_sum ));

    [download]
[reply]
[d/l]
[select]
Re: Per cents and Probabilities
by bikeNomad (Priest) on Jun 25, 2001 at 02:12 UTC
    Well, here's one way, but I don't know how efficient it is:

    #!/usr/bin/perl -w
use strict;

my %probs = (
 'fifty'  => 50,
 'ten' => 10,
 'forty' => 40,
);

# generate lookup for the above
my @lookup;
foreach my $key (keys(%probs))
{
 for (1..$probs{$key})
 {
  push @lookup, $key;
 }
}

# now pick one:
sub pickOne
{
 $lookup[ int(rand($#lookup)) ];
}

# test it

my %bins;
for (1..1000)
{
 $bins{ pickOne() }++;
}

for my $key (keys(%bins))
{
 print $key, "\t", $bins{$key}/10, "%\n";
}

    [download]
[reply]
[d/l]
Re: Per cents and Probabilities
by I0 (Priest) on Jun 25, 2001 at 10:50 UTC 
    $my $total=0;
for( @$cats ){
   my $p = $hash->{$_};
   $cat = $_ if( rand($total+=$p)<$p );
}
return $cat;

    [download]
[reply]
[d/l]

Back to Seekers of Perl Wisdom