String 均匀分布重复的字符串

我需要尽可能均匀地分布一组重复的字符串

有没有比使用简单的洗牌更好的方法？它不能满足我的需要

例如，如果输入是

aaa
aaa
aaa
bbb
bbb

我需要的输出

aaa
bbb
aaa
bbb
aaa

重复字符串的数量没有任何限制，任何字符串的重复次数也没有限制。 可以将输入更改为列出

代表的字符串编号

aaa 3
bbb 2
... .
zzz 5

有没有现成的工具、Perl模块或算法可以做到这一点？

摘要：根据您对如何确定“均匀分布”的描述，我编写了一个算法，用于计算每个可能排列的“权重”。这样就可以对最佳排列进行暴力处理

衡量物品的排列 “均匀分布”是指字符串每两次出现之间的间隔，以及字符串起点和第一次出现之间的间隔，以及最后一次出现和终点之间的间隔必须尽可能接近相等，其中“间隔”是其他字符串的数量

计算字符串出现之间的距离很简单。我决定用一种方法来计算示例组合

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(@_);
}

事实证明，这更倾向于良好的分布

现在，我们可以通过将给定排列传递到

weight\u 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} }
}

这将返回至少一个给定的可能性。如果精确的元素不重要，则可以选择returend数组的任意元素

错误：这依赖于浮点的字符串化，因此对各种各样的off-by-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;
}

\u fetch\u perm\u 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\u缓存

）

连接各部分 现在这是一个简单的问题

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;
}