摘要： 鉴于您对如何确定“均匀分布”的描述，我编写了一个算法来计算每个可能排列的“权重”。然后可以暴力破解最佳排列。
称量物品的排列
所谓“均匀分布”是指字符串每两次出现之间的间隔以及字符串的起点和第一次出现之间的间隔以及最后一次出现和结束点之间的间隔必须尽可能接近尽可能相等，其中 '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} }
}
这将返回至少一种给定的可能性。如果确切的不重要，则可以选择返回数组的任意元素。
Bug：这依赖于浮点数的字符串化，因此会出现各种不同的 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 提供该项目。