我有一個較長的串列，其元素是多字符符號，例如：
@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 bioi i7 viim vii7 vim 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。
從表面上看，這似乎并不難，我已經嘗試使用各種方法（包括正則運算式）來實作這一點，但到目前為止，它擊敗了我。如果有一種簡單的方法可以做到這一點，我將不勝感激。
uj5u.com熱心網友回復：
一個有趣的問題，因為重復元素也需要與給定子序列中的專案匹配，同時需要保持順序。
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應該真的被檢查。這將損害效率，或者用一個更不可能分離令牌與索引建立（如果它包含了正則運算式，特殊字符，把它通過quotemeta在@subseq基于模式）。
uj5u.com熱心網友回復：
你的意思是這樣的嗎？
#! /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);
轉載請註明出處，本文鏈接：https://www.uj5u.com/caozuo/386128.html
標籤：perl