Guh*_*uha 9 string bash perl distribution evenly
我需要尽可能均匀地分配一组重复的字符串.
有没有办法做到这一点,然后使用unsort进行简单的改组？它不能做我需要的.
例如,如果输入是
aaa
aaa
aaa
bbb
bbb
我需要的输出
aaa
bbb
aaa
bbb
aaa
重复字符串的数量没有任何限制,也没有任何字符串的reps数.输入可以更改为列表string number_of_reps
aaa 3
bbb 2
... .
zzz 5
是否有现成的工具,Perl模块或算法来做到这一点？
amo*_*mon 11
摘要:鉴于您对如何确定"均匀分布"的描述,我编写了一种计算每种可能排列的"权重"的算法.然后可以强制推进最佳排列.
通过"均匀分布",我的意思是字符串的每两次出现之间的间隔以及字符串的起始点和第一次出现之间的间隔以及最后一次出现和结束点之间的间隔必须尽可能接近相等.其中'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描述了他们是如何远从平均一个.由于它是平方的,大的异常会受到严重惩罚:
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.因此,我们可以决定两个排列是否同样分布良好,或者是否优先选择一个排列:
考虑到permations的选择,我们可以选择最佳的排列:
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返回一个裁判排列的高速缓存阵列,和一个布尔标志来测试成功.我使用以下实现与深度嵌套的哈希,它存储叶节点上的排列.为了标记叶子节点,我使用了空字符串 - 因此进行了上述测试.
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
标准差异被提升到事件的力量.这可能并不理想,因为大量事件的大偏差比几次出现的小偏差重,例如
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;
}
我概括了任何对象的算法,而不仅仅是字符串.我通过将输入转换为抽象表示来实现这一点,例如"第一件事中的两件,第二件事之一".这里的最大优点是我只需要整数和数组来表示排列.此外,缓存更小,因为A => 4, C => 2,C => 4, B => 2并$regex => 2, $fh => 4代表相同的抽象多集.在外部,内部和高速缓存表示之间转换数据的必要性所引起的速度损失大致由递减的递归数量来平衡.
大的瓶颈在select_bestsub中,我在Inline :: C中大部分重写了(仍然占用了大约80%的执行时间).
这些问题有点超出了原始问题的范围,所以我不会在这里粘贴代码,但我想我会在解决皱纹之后通过github使项目可用.