按使用频率随机选择字母

时间:2013-03-07 09:33:12

标签: perl random random-sample

在为我的Perl脚本提供少量莎士比亚书籍之后,我有一个带有26个英文字母作为键的散列和它们在文本中出现的数量 - 作为值:

%freq = (
    a => 24645246,
    b => 1409459,
    ....
    z => 807451,
);

当然还有所有字母的总数 - 让我们说$total变量。

是否有一个很好的技巧来生成一个包含16个随机字母的字符串(一个字母可以在那里出现几次) - 按使用频率加权?

用于类似Ruzzle的文字游戏:

enter image description here

优雅的东西 - 就像从Perl Cookbook收据中建议的那样从文件中挑选一条随机行:

rand($.) < 1 && ($line = $_) while <>;

3 个答案:

答案 0 :(得分:5)

我对Perl语法一无所知所以我只会编写伪代码。你可以做那样的事情

sum <= 0
foreach (letter in {a, z})
  sum <= sum + freq[letter]
pick r, a random integer in [0, sum[ 
letter <= 'a' - 1
do
  letter <= letter + 1
  r <= r - freq(letter)
while r > 0

letter is the resulting value

这段代码背后的想法是为每个字母制作一堆盒子。每个框的大小是字母的频率。然后我们在这个堆栈上选择一个随机位置,看看我们登陆的是哪个字母的框。

示例:

freq(a) = 5
freq(b) = 3
freq(c) = 3
sum = 11

|    a    |  b  |  c  | 
 - - - - - - - - - - - 

当我们选择0&lt; = r&lt; 11,我们有以下概率

  • 选择'a'= 5/11
  • 选择'b'= 3/11
  • 选择'c'= 3/11

这正是我们想要的。

答案 1 :(得分:5)

用于挑选随机线的Perl Cookbook技巧(也可以在perlfaq5中找到)也可以用于加权采样:

my $chosen;
my $sum = 0;
foreach my $item (keys %freq) {
    $sum += $freq{$item};
    $chosen = $item if rand($sum) < $freq{$item};
}

此处,$sum对应于行计数器$.$freq{$item}对应Cookbook版本中的常量1


如果您要选择大量加权随机样本,可以通过一些准备加快这一点(注意这会破坏%freq,所以如果你想保留它,请先复制一份):

# first, scale all frequencies so that the average frequency is 1:
my $avg = 0;
$avg += $_ for values %freq;
$avg /= keys %freq;
$_ /= $avg for values %freq;

# now, prepare the array we'll need for fast weighted sampling:
my @lookup;
while (keys %freq) {
    my ($lo, $hi) = (sort {$freq{$a} <=> $freq{$b}} keys %freq)[0, -1];
    push @lookup, [$lo, $hi, $freq{$lo} + @lookup];
    $freq{$hi} -= (1 - $freq{$lo});
    delete $freq{$lo};
}

现在,要从准备好的分布中绘制随机加权样本,您只需执行以下操作:

my $r = rand @lookup;
my ($lo, $hi, $threshold) = @{$lookup[$r]};
my $chosen = ($r < $threshold ? $lo : $hi);

(这基本上是Marsaglia,Tsang&amp; Wang(2004),"Fast Generation of Discrete Random Variables" J.Stat。Soft。 11(3)中描述的方形直方图方法,最初是由于AJ沃克(1974)。)

答案 2 :(得分:2)

您可以先构建一个频率为running sum的表格。因此,如果您有以下数据:

%freq = (
    a => 15,
    b => 25,
    c => 30,
    d => 20
);

运行总和将是;

%running_sums = (
    a => 0,  
    b => 15, 
    c => 40, # 15 + 25
    d => 70, # 15 + 25 + 30
);
$max_sum = 90; # 15 + 25 + 30 + 20

要选择具有加权频率的单个字母,您需要选择[0,90)之间的数字,然后您可以在running_sum表上对包含该字母的范围进行线性搜索。例如,如果您的随机数是20,那么适当的范围是15-40,这是字母'b'。使用线性搜索给出O(m*n)的总运行时间,其中m是我们需要的字母数,n是字母表的大小(因此m = 16,n = 26)。这基本上就是@default语言环境。

您还可以在running_sum表上进行二进制搜索,以获得最接近的舍入数字,而不是线性搜索。这使得总运行时间为O(m*log(n))

虽然选择m个字母,但速度比O(m*log(n))更快,特别是n < m。首先,您按排序顺序(m中的which can be done without sorting)生成O(n)个随机数,然后对已排序的随机数列表和运行总和列表之间的范围进行线性匹配。这给出了O(m+n)的总运行时间。 The code in its entirety running in Ideone

use List::Util qw(shuffle);

my %freq = (...);

# list of letters in sorted order, i.e. "a", "b", "c", ..., "x", "y", "z"
# sorting is O(n*log(n)) but it can be avoided if you already have 
# a list of letters you're interested in using
my @letters = sort keys %freq;

# compute the running_sums table in O(n)
my $sum = 0;
my %running_sum;
for(@letters) {
    $running_sum{$_} = $sum;
    $sum += $freq{$_};
}

# generate a string with letters in $freq frequency in O(m)
my $curmax = 1;
my $curletter = $#letters;
my $i = 16; # the number of letters we want to generate
my @result;
while ($i > 0) {
    # $curmax generates a uniformly distributed decreasing random number in [0,1)
    # see http://repository.cmu.edu/cgi/viewcontent.cgi?article=3483&context=compsci
    $curmax = $curmax * (1-rand())**(1. / $i);

    # scale the random number $curmax to [0,$sum)
    my $num = int ($curmax * $sum);

    # find the range that includes $num
    while ($num < $running_sum{$letters[$curletter]}) {
        $curletter--;
    }

    push(@result, $letters[$curletter]);

    $i--;
}

# since $result is sorted, you may want to use shuffle it first
# Fisher-Yates shuffle is O(m)
print "", join('', shuffle(@result));