在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);

目標是將@flags2 的元素合并到@flags1 中，用于@flags2 中連續的非零元素簇僅替換@flags1 中的零條目的所有位置。如果與@flags1 的任何非零元素重疊，則@flags2 中相關的連續非零值簇將被丟棄而不是被合并。

因此，對于上面的示例，@flags2[13..15] 中的值 31、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 陳述句進行比較，但這很混亂，我認為任何其他開發人員都很難理解邏輯。如果有人能提出一個更優雅的解決方案，將不勝感激。

uj5u.com熱心網友回復：

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

uj5u.com熱心網友回復：

你的方法是可行的，它只需要一些組織。讓我們一步一步來：

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與 中的任何范圍重疊，則回傳 true @$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回傳所有范圍@$ll加上@$rr不重疊的范圍。在sort僅僅為了除錯的實際上是; return [ @$ll, @rr_new ]如果你愿意，你可以。

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

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

ikegami 提供了一個整體上更簡單的解決方案，但我仍然會提供這個，因為也許您還有其他需要做的事情會從這種表示中受益。

標籤：

上一篇：Perl錯誤的UTF-8輸出

下一篇：s~在Perl中有什么作用？[復制]