合并 Perl 中两个列表中的非零、非重叠元素
Merging non-zeros, non-overlapping elements from two lists in Perl
我正在 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);
objective是将@flags2的元素全部合并到@flags1中
@flags2 中的连续非零元素块替换
@flags1 中只有零个条目。如果与任何一个有重叠
@flags1 的非零元素,关联的连续丛
@flags2 中的非零值被丢弃而不是被
合并。
因此,对于上面的示例,值 31 的连续块,
@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 语句,但它是一团糟,我认为它会
任何其他开发人员都很难理解其中的逻辑。如果
任何人都可以提出一个更优雅的解决方案
赞赏。
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 );
}
您的方法是可行的,只是需要一些组织。让我们一步一个脚印:
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
.
中的任何范围重叠,returns 为真
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
以及 returns @$ll
中的所有范围加上 @$rr
中的范围不要重叠。 sort
其实只是为了方便调试;如果你愿意,你可以 return [ @$ll, @rr_new ]
。
sub merge {
my ($ll, $rr) = @_;
return from_ranges(
merge_ranges(
to_ranges($ll),
to_ranges($rr),
)
);
}
拼凑起来,然后it works。
ikegami 提供了一个整体上更简单的解决方案,但我仍然会提供这个解决方案,因为也许您需要做其他事情会从这种表示中受益。
我正在 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);
objective是将@flags2的元素全部合并到@flags1中 @flags2 中的连续非零元素块替换 @flags1 中只有零个条目。如果与任何一个有重叠 @flags1 的非零元素,关联的连续丛 @flags2 中的非零值被丢弃而不是被 合并。
因此,对于上面的示例,值 31 的连续块, @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 语句,但它是一团糟,我认为它会 任何其他开发人员都很难理解其中的逻辑。如果 任何人都可以提出一个更优雅的解决方案 赞赏。
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 );
}
您的方法是可行的,只是需要一些组织。让我们一步一个脚印:
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
.
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
以及 returns @$ll
中的所有范围加上 @$rr
中的范围不要重叠。 sort
其实只是为了方便调试;如果你愿意,你可以 return [ @$ll, @rr_new ]
。
sub merge {
my ($ll, $rr) = @_;
return from_ranges(
merge_ranges(
to_ranges($ll),
to_ranges($rr),
)
);
}
拼凑起来,然后it works。
ikegami 提供了一个整体上更简单的解决方案,但我仍然会提供这个解决方案,因为也许您需要做其他事情会从这种表示中受益。