摘要：鉴于您对如何确定“均匀分布”的描述，我编写了一个算法，为每个可能的排列计算“权重”。然后可以暴力破解最佳排列。
称量物品的排列
“均匀分布”是指字符串的每两次出现之间的间隔以及字符串的起始点和第一次出现之间的间隔以及最后一次出现和结束点之间的间隔必须尽可能接近相等其中 'interval' 是其他字符串的数量。
计算字符串出现之间的距离是微不足道的。我决定以示例组合的方式计数
A B A C B A A
会给计数
A: 1 2 3 1 1
B: 2 3 3
C: 4 4
即两个相邻的字符串的距离为 1，并且开头或结尾的字符串与字符串边缘的距离为 1。这些属性使距离更容易计算，但只是一个常数，稍后将被删除。
这是计算距离的代码：
sub distances {
my %distances;
my %last_seen;
for my $i (0 .. $#_) {
my $s = $_[$i];
push @{ $distances{$s} }, $i - ($last_seen{$s} // -1);
$last_seen{$s} = $i;
}
push @{ $distances{$_} }, @_ - $last_seen{$_} for keys %last_seen;
return values %distances;
}
接下来，我们计算每组距离的标准方差。一个距离d的方差描述了它们与平均值a相差多远。因为它是平方的，所以大的异常会受到严重的惩罚：
variance(d, a) = (a - d)²
我们通过对每个项目的方差求和，然后计算平方根来得到一个数据集的标准方差：
svar(items) = sqrt ∑_i variance(items[i], average(items))
表示为 Perl 代码：
use List::Util qw/sum min/;
sub svar (@) {
my $med = sum(@_) / @_;
sqrt sum map { ($med - $_) ** 2 } @_;
}
我们现在可以通过计算距离的标准方差来计算排列中一个字符串的出现次数。该值越小，分布越均匀。
现在我们必须将这些权重组合成我们组合的总权重。我们必须考虑以下属性：
- 出现次数多的字符串应该比出现次数少的字符串具有更大的权重。
- 不均匀分布应该比均匀分布具有更大的权重，以强烈惩罚不均匀性。
以下可以通过不同的程序换出，但我决定通过将每个标准方差提高到出现次数的幂来衡量每个标准方差，然后添加所有加权方差：
sub weigh_distance {
return sum map {
my @distances = @$_; # the distances of one string
svar(@distances) ** $#distances;
} distances(@_);
}
事实证明，这更喜欢良好的分布。
我们现在可以通过将给定排列传递给 来计算给定排列的权重weigh_distance。因此，我们可以决定两个排列是否均匀分布，或者是否优先选择一个：
选择最佳排列
给定一系列排列，我们可以选择那些最佳排列：
sub select_best {
my %sorted;
for my $strs (@_) {
my $weight = weigh_distance(@$strs);
push @{ $sorted{$weight} }, $strs;
}
my $min_weight = min keys %sorted;
@{ $sorted{$min_weight} }
}
这将返回至少一种给定的可能性。如果确切的一个不重要，则可以选择返回数组的任意元素。
错误：这依赖于浮点数的字符串化，因此对各种不同的 epsilon 错误都是开放的。
创建所有可能的排列
对于给定的多组字符串，我们希望找到最佳排列。我们可以将可用字符串视为将字符串映射到剩余可用事件的哈希。通过一点递归，我们可以构建所有排列，例如
use Carp;
# called like make_perms(A => 4, B => 1, C => 1)
sub make_perms {
my %words = @_;
my @keys =
sort # sorting is important for cache access
grep { $words{$_} > 0 }
grep { length or carp "Can't use empty strings as identifiers" }
keys %words;
my ($perms, $ok) = _fetch_perm_cache(\@keys, \%words);
return @$perms if $ok;
# build perms manually, if it has to be.
# pushing into @$perms directly updates the cached values
for my $key (@keys) {
my @childs = make_perms(%words, $key => $words{$key} - 1);
push @$perms, (@childs ? map [$key, @$_], @childs : [$key]);
}
return @$perms;
}
_fetch_perm_cache返回一个对缓存排列数组的引用，以及一个用于测试成功的布尔标志。我使用了以下具有深度嵌套哈希的实现，它将排列存储在叶节点上。为了标记叶节点，我使用了空字符串——因此进行了上述测试。
sub _fetch_perm_cache {
my ($keys, $idxhash) = @_;
state %perm_cache;
my $pointer = \%perm_cache;
my $ok = 1;
$pointer = $pointer->{$_}[$idxhash->{$_}] //= do { $ok = 0; +{} } for @$keys;
$pointer = $pointer->{''} //= do { $ok = 0; +[] }; # access empty string key
return $pointer, $ok;
}
不是所有的字符串都是有效的输入键是没有问题的：每个集合都可以枚举，所以make_perms可以给定整数作为键，它们被转换回调用者表示的任何数据。请注意，缓存使此非线程安全（如果%perm_cache是共享的）。
连接碎片
现在这是一个简单的问题
say "@$_" for select_best(make_perms(A => 4, B => 1, C => 1))
这将产生
A A C A B A
A A B A C A
A C A B A A
A B A C A A
根据使用的定义，它们都是最优解。有趣的是，解决方案
A B A A C A
不包括在内。这可能是称重过程的不良边缘情况，它强烈倾向于将稀有字符串的出现放在中心。参见进一步的工作。
完成测试用例
首选版本是：AABAA ABAAA, ABABACA ABACBAA(连续两个'A'), ABAC ABCA
我们可以运行这些测试用例
use Test::More tests => 3;
my @test_cases = (
[0 => [qw/A A B A A/], [qw/A B A A A/]],
[1 => [qw/A B A C B A A/], [qw/A B A B A C A/]],
[0 => [qw/A B A C/], [qw/A B C A/]],
);
for my $test (@test_cases) {
my ($correct_index, @cases) = @$test;
my $best = select_best(@cases);
ok $best ~~ $cases[$correct_index], "[@{$cases[$correct_index]}]";
}
出于兴趣，我们可以计算这些字母的最佳分布：
my @counts = (
{ A => 4, B => 1 },
{ A => 4, B => 2, C => 1},
{ A => 2, B => 1, C => 1},
);
for my $count (@counts) {
say "Selecting best for...";
say " $_: $count->{$_}" for keys %$count;
say "@$_" for select_best(make_perms(%$count));
}
这给我们带来
Selecting best for...
A: 4
B: 1
A A B A A
Selecting best for...
A: 4
C: 1
B: 2
A B A C A B A
Selecting best for...
A: 2
C: 1
B: 1
A C A B
A B A C
C A B A
B A C A
进一步的工作
- 因为称重对边缘距离的重要性与对字母之间距离的重要性相同，所以首选对称设置。这种情况可以通过减少到边缘的距离值来缓解。
置换生成算法有待改进。记忆可能会导致加速。完毕！现在，合成基准的排列生成速度提高了 50 倍，并且可以访问O(n)中的缓存输入，其中n是不同输入字符串的数量。- 找到一种启发式方法来指导置换生成，而不是评估所有可能性，这将是很棒的。一种可能的启发式方法会考虑是否有足够多的不同字符串可用，以至于没有字符串必须与其自身相邻（即距离 1）。此信息可用于缩小搜索树的宽度。
- 将递归 perm 生成转换为迭代解决方案将允许将搜索与权重计算交织在一起，这将更容易跳过或推迟不利的解决方案。
标准方差被提高到出现次数的幂。这可能并不理想，因为大量事件的大偏差比少数事件的小偏差轻，例如
weight(svar, occurrences) → weighted_variance
weight(0.9, 10) → 0.35
weight(0.5, 1) → 0.5
这实际上应该反过来。
编辑
下面是一个更快的过程，它近似于一个良好的分布。在某些情况下，它会产生正确的解决方案，但通常情况并非如此。输出对于具有许多不同字符串的输入是不好的，其中大多数字符串很少出现，但通常可以接受，只有少数字符串很少出现。它比蛮力解决方案要快得多。
它的工作原理是定期插入字符串，然后分散可避免的重复。
sub approximate {
my %def = @_;
my ($init, @keys) = sort { $def{$b} <=> $def{$a} or $a cmp $b } keys %def;
my @out = ($init) x $def{$init};
while(my $key = shift @keys) {
my $visited = 0;
for my $parts_left (reverse 2 .. $def{$key} + 1) {
my $interrupt = $visited + int((@out - $visited) / $parts_left);
splice @out, $interrupt, 0, $key;
$visited = $interrupt + 1;
}
}
# check if strings should be swapped
for my $i ( 0 .. $#out - 2) {
@out[$i, $i + 1] = @out[$i + 1, $i]
if $out[$i] ne $out[$i + 1]
and $out[$i + 1] eq $out[$i + 2]
and (!$i or $out[$i + 1 ] ne $out[$i - 1]);
}
return @out;
}
编辑 2
我将算法推广到任何对象，而不仅仅是字符串。我通过将输入转换为抽象表示来做到这一点，例如“第一件事中的两个，第二件事中的一个”。这里最大的优势是我只需要整数和数组来表示排列。此外，缓存更小，因为A => 4, C => 2和C => 4, B => 2表示$regex => 2, $fh => 4相同的抽象多集。在外部、内部和缓存表示之间转换数据的必要性所导致的速度损失被递归数量的减少大致平衡。
最大的瓶颈在select_best子程序中，我在 Inline::C 中大量重写了它（仍然占用了大约 80% 的执行时间）。
这些问题有点超出了原始问题的范围，所以我不会在这里粘贴代码，但我想一旦我消除了皱纹，我会通过 github 提供该项目。