string - 均匀分布重复字符串

Question

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

有什么办法比使用unsort进行简单改组更好呢？它不能满足我的需求。

例如，如果输入是

aaa
aaa
aaa
bbb
bbb

我需要的输出

aaa
bbb
aaa
bbb
aaa

重复字符串的数量没有任何限制，而且任何字符串的重复次数也没有限制。
输入可以更改为列表 string number_of_reps

aaa 3
bbb 2
... .
zzz 5

是否有现成的工具，Perl模块或算法来执行此操作？

Answer 1

摘要：鉴于您对如何确定“平均分布”的描述，我编写了一种算法，可为每个可能的排列计算“权重”。这样就可以对最佳排列进行暴力破解。

称量物品的排列


“均匀分布”是指每两次出现的字符串之间的间隔以及字符串的起点和第一次出现之间的间隔以及最后一次出现和结束点之间的间隔必须尽可能接近其中“间隔”是其他字符串的数量。


计算出现的字符串之间的距离很简单。我决定以示例组合的方式进行计数

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

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

错误：这依赖于浮点数的字符串化，因此容易出现各种偏离ε的错误。

创建所有可能的排列

对于给定的字符串多集，我们希望找到最佳排列。我们可以将可用字符串视为将字符串映射到剩余可用出现的哈希值。通过一点递归，我们可以构建所有排列，例如

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将ref返回到缓存的排列数组，并返回一个布尔标志以测试是否成功。我将以下实现与深度嵌套的哈希一起使用，该哈希将置换存储在叶节点上。为了标记叶节点，我使用了空字符串，因此进行了上述测试。

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）。该信息可用于缩小搜索树的宽度。
将递归烫发生成转换为迭代解决方案，将可以使权重计算与搜索交织在一起，从而可以更轻松地跳过或推迟不利的解决方案。
将标准方差提高到出现次数的幂。这可能是不理想的，因为大量事件的大偏差比少数事件的小偏差轻。

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提供该项目。