在Perl中合并两个列表中的非零、非重叠元素

Question

我正在Perl中寻找一个干净的方法来合并列表。所有的长度相同，每个主要由零，但也有非零的短连续段条目。例如，以下是长度25:

@flags1 = qw( 0  0  0  0 21 22 23  0  0  0  0  0  0  0  0 41 42 43  0  0  0  0  0  0  0);
@flags2 = qw(11 12 13  0  0  0  0  0  0  0  0  0  0 31 32 33  0  0  0  0  0 51 52  53 0);

目标是将@flags2的元素合并到所有位置的@flags1中其中@flags2中的非零元素的连续簇替换@flags1中只有零个条目。如果与@flags1的非零元素，相关的连续丛@flags2中的个非零值被丢弃，而不是合并。

因此对于上面的例子，@flags2[13..15]中的32和33被丢弃，因为条目，$flags2[15]为非零，并与$flags1[15]处的非零值冲突。生成所需的合并列表将是：

@merged = qw(11 12 13  0 21 22 23  0  0  0  0  0  0  0  0 41 42 43  0  0  0 51 52  53  0);

我曾尝试收集将非零元素放入列表中，然后进行比较使用for和if语句，但它一团糟，我认为它会任何其他开发人员都很难理解逻辑。如果任何人都可以提出一个更优雅的解决方案感谢。

Answer 1

use List::Util qw( none );
my $s = 0;
while (1) {
# Find start of next clump.
++$s while $s < @flags2 && !$flags2[$s];
# Exit if at end of array.
last if $s == @flags2;
# Find end of clump.
my $e = $s+1;
++$e while $e < @flags2 && $flags2[$e];
# Merge in clump.
my @clump = $s .. $e-1;
if ( none { $_ } @flags1[ @clump ] ) {      # Or `!grep { $_ }`
@flags1[ @clump ] = @flags2[ @clump ];
}
$s = $e;
# Exit if at end of array.
last if $s == @flags2;
}

---

这是另一种类似于合并排序的合并部分的方法。

sub get_next_clump {
my ( $f, $s ) = @_;
++$s while $s < @$f && !$f[$s];
return if $s == @$f;
my $e = $s+1;
++$e while $e < @$f && $f[$e];
return $s, $e;
}
my $ok1 = my ( $f1_s, $f1_e ) = get_next_clump( @flags1, 0 );
my $ok2 = my ( $f2_s, $f2_e ) = get_next_clump( @flags2, 0 );
while ( $ok1 && $ok2 ) {
if ( $f2_s < $f1_e && $f2_e > $f1_s ) {
$ok2 = ( $f2_s, $f2_e ) = get_next_clump( @flags2, $f2_e );
next;
}

if ( $f1_s < $f2_s ) {
$ok1 = ( $f1_s, $f1_e ) = get_next_clump( @flags1, $f1_e );
} else {
@flags1[ $f2_s .. $f2_e-1 ] = @flags2[ $f2_s .. $f2_e-1 ];
$ok2 = ( $f2_s, $f2_e ) = get_next_clump( @flags2, $f2_e );
}
}
while ( $ok2 ) {
@flags1[ $f2_s .. $f2_e-1 ] = @flags2[ $f2_s .. $f2_e-1 ];
$ok2 = ( $f2_s, $f2_e ) = get_next_clump( @flags2, $f2_e );
}

Answer 2

您的方法是可行的，它只需要一些组织。让我们一步一个脚印：

sub to_ranges {
my $in = shift;
my (@ret, $in_range);
for my $i (0 .. $#$in) {
if ($in->[$i]) {
if ($in_range) { # Extend an existing range
$ret[-1]{end} = $i;
push @{$ret[-1]{values}}, $in->[$i];
} else { # Start a new one
push @ret, { start => $i, end => $i, values => [ $in->[$i] ] };
$in_range = 1;
}
} else {
$in_range = 0;
}
}
# Dummy entry to make sure the output will be padded to the right length
push @ret, { start => scalar @$in, end => scalar @$in, values => [] };
return @ret;
}

这将一个列表变成一个列表；块"；，每一个都知道它的开始、结束以及它包含的值。(end不是严格必要的，但它使事情变得更整洁(。

sub from_ranges {
my $in = shift;
my @ret;
for my $r (@$in) {
push @ret, 0 while $#ret < $r->{end};
splice @ret, $r->{start}, $r->{end} - $r->{start} + 1, @{ $r->{values} };
}
return @ret;
}

这将执行反向转换：from_ranges(to_ranges(@x))应包含与@x相同的元素。

sub overlaps_any {
my ($r, $ll) = @_;
for my $l (@$ll) {
return 1 if $r->{start} >= $l->{start} && $r->{start} <= $l->{end};
return 1 if $r->{end} >= $l->{start} && $r->{end} <= $l->{end};
}
return 0;
}

如果范围$r与@$ll中的任何范围重叠，则这是一个返回true的辅助对象。

sub merge_ranges {
my ($ll, $rr) = @_;
my @rr_new = grep { !overlaps_any($_, $ll) } @$rr;
return [
sort {
$a->{start} <=> $b->{start}
} @$ll, @rr_new
];
}

这需要两组范围，@$ll和@$rr，并返回@$ll中的所有范围加上@$rr中不重叠的范围。sort实际上只是为了便于调试；如果你愿意，你可以只使用return [ @$ll, @rr_new ]。

sub merge {
my ($ll, $rr) = @_;
return from_ranges(
merge_ranges(
to_ranges($ll),
to_ranges($rr),
)
);
}

把这些碎片放在一起，它就起作用了。

ikegami提供了一个总体上更简单的解决方案，但我仍然会提供这个解决方案，因为也许你还有其他需要做的事情可以从这个表示中受益。