 No such thing as a small change PerlMonks

### Re: Randomly choosing from a set of alternatives with varying popularity

by salva (Canon)
 on Mar 29, 2022 at 07:48 UTC Need Help??

But I can't figure out how to favor those with the least popularity

There are several ways to do that. Which one is the most appropriate is very dependent on your final problem.

Anyway, I have not seen anybody propose an exponential solution, so let me do it. The idea is that every subject start with the same score, 1.0, for instance, and every time one of them gets a vote, you reduce its score multiplying it by a factor c such that 0 < c < 1.

As in your particular case, you have already done a draw, you can calculate the current scores as \$score{\$k} = \$c ** \$votes{\$k}.

The only issue remaining is how to pick c. The key here is how much you want to penalize the popular ones.

Replies are listed 'Best First'.
Re^2: Randomly choosing from a set of alternatives with varying popularity
by ibm1620 (Pilgrim) on Mar 29, 2022 at 23:59 UTC
Another interesting idea. I modified LanX's code to try this for several different values of c:
```#!/usr/bin/env perl
use 5.010;
use strict;
use warnings;
use Data::Dump qw/pp dd/;

my %vote = ( alligator => 100, bear => 90, cat => 80, jellyfish => 10
+);
my \$N =0;
\$N += \$_ for values %vote;
say "Vote";
show(\%vote, 1);

# --- invert by exponentiation
for my \$C ( 0.9, 0.95, 0.96, 0.97, 0.98, 0.99) {
my \$N4=0;
my %vote4 = map {
my \$v4 = \$C ** \$vote{\$_};
\$N4 += \$v4;
\$_ => \$v4;
} keys %vote;

my %dist4;
my \$e=5;
\$dist4{pick(\$N4,\%vote4)}++ for 1..10**\$e;
say "C=\$C";
show( \%dist4, -1);
}

sub show { # show counts and percentages
my \$href = shift;
my \$dir = shift; # sort direction 1=ascending, -1=descending
my \$tot=0;
\$tot += \$_ for values %\$href;
for my \$k (sort {\$dir * (\$a cmp \$b)} keys %\$href) {
printf "%s => %5d (%5.2f%%)  ",
\$k, \$href->{\$k}, 100*(\$href->{\$k}/\$tot);
}
say '';
}

sub pick {
my (\$N,\$h_vote)=@_;
my @deb;
my \$r   =rand(\$N);
push @deb,\$r;
scalar keys %\$h_vote;                 # reset each
while ( my (\$k,\$v) = each %\$h_vote) {
\$r -= \$v;
push @deb,[\$r,\$k,\$v];
return \$k if \$r <=0;
}
die "ERROR", pp \@deb;
}
Output:
```Vote
alligator =>   100 (35.71%)  bear =>    90 (32.14%)  cat =>    80 (28.
+57%)  jellyfish =>    10 ( 3.57%)
C=0.9
jellyfish => 99902 (99.90%)  cat =>    65 ( 0.07%)  bear =>    24 ( 0.
+02%)  alligator =>     9 ( 0.01%)
C=0.95
jellyfish => 94748 (94.75%)  cat =>  2712 ( 2.71%)  bear =>  1599 ( 1.
+60%)  alligator =>   941 ( 0.94%)
C=0.96
jellyfish => 89102 (89.10%)  cat =>  5269 ( 5.27%)  bear =>  3440 ( 3.
+44%)  alligator =>  2189 ( 2.19%)
C=0.97
jellyfish => 78766 (78.77%)  cat =>  9190 ( 9.19%)  bear =>  6939 ( 6.
+94%)  alligator =>  5105 ( 5.10%)
C=0.98
jellyfish => 62428 (62.43%)  cat => 15076 (15.08%)  bear => 12415 (12.
+41%)  alligator => 10081 (10.08%)
C=0.99
jellyfish => 42944 (42.94%)  cat => 20843 (20.84%)  bear => 18984 (18.
+98%)  alligator => 17229 (17.23%)

Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://11142488]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (5)
As of 2022-09-30 07:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
I prefer my indexes to start at:

Results (125 votes). Check out past polls.

Notices?