是否有一个内置的Perl函数来查找数组中的重复子数组(精确顺序)?

mqkwyuun  于 2022-11-15  发布在  Perl
关注(0)|答案(2)|浏览(128)

假设数组是(1,2,3,4,5,6,7,8,9),另一个子数组为(2,3,4)是否有函数检查子阵列模式(完全精确的顺序)是否存在于数组中?在这种情况下,它将返回任何指示符如果数组中存在多个子数组,则还需要处理重复项,如(4,2,3,4,2,3,4)。如果它恰好多次匹配,例如:数组=(2,3,2,3,2,2,3,2)子数组=(2,3,2)只返回匹配项的起始索引,顺序为:0,2,5或者如果它移除,会产生(3,2)
编辑:元素不必为num

q8l4jmvw

q8l4jmvw1#

没有内置的方法,但是很容易编写:

#!/usr/bin/env perl
use warnings;
use strict;
use feature qw/say/;

# Takes two arrayrefs of numbers.
#
# Returns the first index in the first one where the second list appears, or
# -1 if not found.
sub find_sublist(++) {
  my ($haystack, $needle) = @_;
  my $nlen = @$needle;
  my $hlen = @$haystack;
  return -1 if $hlen == 0 || $nlen == 0;
 HAYSTACK_POS:
  for (my $n = 0; $n <= $hlen - $nlen; $n++) {
    for (my $m = 0; $m < $nlen; $m++) {
      if ($haystack->[$n + $m] != $needle->[$m]) {
        next HAYSTACK_POS;
      }
    }
    return $n;
  }
  return -1;
}

# Takes two arrayrefs of numbers.
#
# Returns a list of the starting indexes of the first list
# of every run of the second list. Returns an empty list if
# there are no matches.
sub find_sublists(++) {
  my ($haystack, $needle) = @_;
  my $nlen = @$needle;
  my $hlen = @$haystack;
  my @positions;
  return @positions if $hlen == 0 || $nlen == 0;
 HAYSTACK_POS:
  for (my $n = 0; $n <= $hlen - $nlen; $n++) {
    for (my $m = 0; $m < $nlen; $m++) {
      if ($haystack->[$n + $m] != $needle->[$m]) {
        next HAYSTACK_POS;
      }
    }
    push @positions, $n;
  }
  return @positions;
}

# Takes two arrayrefs of numbers.
#
# Returns a new list that is the first one with every non-overlapping run of
# the second second list removed.
sub remove_sublists(++) {
  my @haystack = @{$_[0]};
  my $needle = $_[1];
  while ((my $pos = find_sublist @haystack, $needle) != -1) {
    splice @haystack, $pos, @$needle;
  }
  return @haystack;
}

my @list1 = (1,2,3,4,5,6,7,8,9);
my @list2 = (4,2,3,4,2,3,4);
my @list3 = (2,3,2,3,2,2,3,2);
say find_sublist(@list1, [2, 3, 4]);            # Returns 1
say find_sublist([2,9,3,4], [2,3,4]);           # Returns -1
my @positions = find_sublists(@list2, [2,3,4]); # 1,4
say join(",", @positions);
@positions = find_sublists(@list3, [2,3,2]); # 0,2,5
say join(",", @positions);
say join(",", remove_sublists(@list1, [2,3,4])); # 1,5,6,7,8,9
say join(",", remove_sublists(@list3, [2,3,2])); # 3,2
xxslljrj

xxslljrj2#

如果输入是可由perl的整数表示的数字(如图所示),则可以使用
第一个
如何处理重叠:

/---\     /---\   Removed
2,3,2 from 2,3,2,3,2,2,3,2 
               \---/         Not removed

请注意,如果您可以将输入Map到数字,这也是可行的。

my ( %map_f, @map_r );
for ( @array, @pattern ) {
   if ( !exists{ $map{ $_ } } ) {
      $map_f{ $_ } = @map_r;
      push @map_r, $_;
   }
}

my $pattern = pack "W*", @map_f{ @pattern };
my $array   = pack "W*", @map_f{ @array   };
$array =~ s/\Q$pattern//g;
@array = @map_r[ unpack "W*", $array ];

这不是最好的算法,但通过将工作从Perl转移到regex引擎,它应该会非常快。

相关问题