如何在 Perl 中查找子列表模式的索引

Question

我有一个较长的列表，其元素是多字符符号，例如：

@c = qw(iim v7 v7 iM iv7 iM im iv7 iv7 bviiM im biio iim bviim biiM biim bviM bviM ivm iih v7 v7 v7 iiim iiih vi7 iim v7 v7 iM iv7 iM im iv7 bviiM im biio iim bviim bviim iiio iim v7 v7 v7 vm i7 ivM iiih vi7);

我想在此列表中找到与 S1+ S2+ S3+ 类型的子列表匹配的索引，其中“+”表示匹配一次或多次。因此，例如，子列表模式 (im iv7 bviiM) 将同时匹配 (im iv7 iv7 bviiM) 和 (im iv7 bviiM)，如上面以粗体突出显示的那样。该代码将为第一个匹配项提供索引 6、7、8、9，为第二个匹配项提供索引 32、33、34。

从表面上看，这似乎并不难，我尝试过使用多种方法（包括正则表达式）来实现它，但到目前为止它还是让我失望了。如果有一种简单的方法可以做到这一点，我将不胜感激。

Answer 1

一个有趣的问题，因为重复的元素也需要与给定子序列中的项目匹配，同时需要保持顺序。

use warnings;
use strict;
use feature 'say';
use Data::Dump qw(dd);

my @words = qw(iim v7 v7 iM iv7 iM im iv7 iv7 bviiM im biio iim bviim biiM
    biim bviM bviM ivm iih v7 v7 v7 iiim iiih vi7 iim v7 v7 iM iv7 iM im 
    iv7 bviiM im biio iim bviim bviim iiio iim v7 v7 v7 vm i7 ivM iiih vi7);

my @subseq = qw(im iv7 bviiM);

my (@all_seqs, @mi);
my $s = 0;

for my $i (0 .. $#words) { 
    if ($words[$i] eq $subseq[$s]) {  # first in @subseq or repeated from @words
        push @mi, $i;
    }   
    elsif (@mi and $s == @subseq-1) { # done, exhausted @subseq
        push @all_seqs, [ @mi ];  
        $s = 0;
        @mi = (); 
    }   
    elsif (@mi and $words[$i] eq $subseq[++$s]) { # next in @subseq
        push @mi, $i;
    }
    elsif (@mi) { # failed to match all from @subseq
        $s = 0;  
        @mi = ();
    }
}
dd \@all_seqs;

@mi 包含在第一个测试之后的所有测试中，因此只有在某些内容已经匹配时才会执行这些测试。

版画

[[6 .. 9], [32, 33, 34]]

取消注释打印行以跟踪其操作。这已经在上面的基本运行之外进行了测试，但还不够好。

或者，将所有单词连接成一个字符串，并通过正则表达式匹配连接成模式的子序列；那么很容易处理可能的重复。为了在匹配中从原始数组中获取索引，我在每个单词前面加上 __INDEX__.

# Same @words and @subseq from above

my $w = join '', map { '__'.$_.'__' . $words[$_] } 0.. $#words;

my $patt = '(' . 
    join('', map { '(?:' . '__[0-9]+__' . quotemeta($_) . ')+' } @subseq) . ')';

my @seqs = $w =~ /$patt/g;

my @seqs_idx = map { [ /__([0-9]+)__/g ]  } @seqs;

dd \@seqs_idx;

因为 __IDX__ 不能在 @words 或 @subseq 中，所以应该检查它。这会损害效率，所以也许使用一个更不可能的由索引构建的分隔符标记（如果它包含正则表达式特殊字符，则在基于 @subseq 的模式中通过 quotemeta）。

Answer 2

你的意思是这样的吗？

#! /usr/bin/env perl

use warnings;
use strict;
use utf8;
use feature qw<say>;
use List::Util qw<any>;

my @sub_pat = qw(im iv7 bviiM);
my @c =
    qw(
    iim v7 v7 iM 
    iv7 iM im iv7 
    iv7 bviiM im biio 
    iim bviim biiM biim 
    bviM bviM ivm iih
    v7 v7 v7 iiim 
    iiih vi7 iim v7 
    v7 iM iv7 iM 
    im iv7 bviiM im 
    biio iim bviim bviim 
    iiio iim v7 
    v7 v7 vm i7 
    ivM iiih vi7
    );

my %ans = ();

while (my ($i, $k) = each @c) {
    push @{$ans{$k}}, $i if any {$_ eq $k} @sub_pat;
}

while (my ($k, $v) = each %ans) {
    say "$k @{$v}";
}

exit(0);

如何在 Perl 中查找子列表模式的索引

How to find the indices of sub-list patterns in Perl

perl