3

在向我的 Perl 脚本提供了几本莎士比亚书籍之后，我得到了一个以 26 个英文字母作为键的哈希，以及它们在文本中出现的次数 - 作为值：

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

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

是否有一个很好的技巧来生成一个包含 16 个随机字母的字符串（一个字母可以在那里出现多次） - 按它们的使用频率加权？

用于类似于 Ruzzle 的文字游戏：

在此处输入图像描述

一些优雅的东西——比如从文件中随机挑选一行，正如Perl Cookbook收据所建议的那样：

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

3 回答 3

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 <= r < 11 时，我们有以下概率

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

这正是我们想要的。

于 2013-03-07T09:40:45.640 回答
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对应于行计数器$.和Cookbook 版本$freq{$item}中的常量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 & Wang (2004), "Fast Generation of Discrete Random Variables" , J. Stat. Soft. 11(3) 中描述的方形直方图方法，最初归功于 AJ Walker (1974)。）

于 2013-03-07T10:37:41.503 回答
2

您可以先建立一个频率运行总和的表。因此，如果您有以下数据：

%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))，尤其是 if n < m。首先，您m按排序顺序生成随机数（无需排序即可完成），O(n)然后对已排序随机数列表和运行总和列表之间的范围进行线性匹配。这给出了总运行时间O(m+n)。整个代码在 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));
于 2013-03-07T12:34:04.563 回答