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

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.

Comment on Re: Randomly choosing from a set of alternatives with varying popularity Select or Download Code

Replies are listed 'Best First'.

Re^2: Randomly choosing from a set of alternatives with varying popularity
by ibm1620 (Hermit) on Mar 29, 2022 at 23:59 UTC

#!/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;
}
[download]

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%)
[download]

[reply]
[d/l]
[select]


Clear questions and runnable code get the best and fastest answer
	PerlMonks