Perl:自定义排序顺序?
速记键盘具有特定顺序的键:STKPWHRAO *#EUFRPBLGTS。Perl:自定义排序顺序?
我正在尝试输入$字,并确定它的字母是否遵循此顺序,从左到右。
所以KAT是有效的,但FRAG不会,因为虽然F在右边R之前,但它们不在A-之前。 TKPWAUL会工作,但GAUL不会,因为-G不在A之前。键必须从左到右排列。
我被一些字母在订单中出现两次而绊倒。
非常感谢您的任何ieas!
你可以用锚来创建一个正则表达式来开始和结束字符串,并允许每个字符0或一次。这里有一个例子:
sub match {
my $yesno = $_[0] =~ /^S?T?K?P?W?H?R?A?O?\*?#?E?U?F?R?P?B?L?G?T?S?\.?$/g;
print $_[0] . " " . ($yesno ? 'yes' : 'no') . "\n";
}
match 'KAT';
match 'FRAG';
match 'TKPWAUL';
match 'GAUL';
提供
KAT yes
FRAG no
TKPWAUL yes
GAUL no
你可以使用split
,join
等
下面是一个简单的算法生成一个列表,正则表达式。这应该是有效的,并且如果需要也可以改进。
迭代单词中的字符,搜索参考序列中的每个字符。比较匹配在序列中的位置和前一个字符的位置。继续搜索所有匹配,因为一些字母在序列中重复。搜索使用index
。
sub accept_word {
my ($refseq, $word) = @_;
my ($mark, $pos) = (0, 0);
foreach my $ch (split '', $word) {
# search until position is >= $mark, or the word is bad
while (($pos = index($refseq, $ch, $pos)) != -1) {
$mark = $pos, last if $pos >= $mark;
}
return 0 if $pos < $mark;
}
return 1;
}
for my $word (qw(KAT FRAG TKPWAUL GAUL SAS)) {
print "$word is " . (accept_word($refseq, $word) ? 'accepted' : 'rejected') . "\n";
}
评论:
如果需要,这可以被拧紧了不少。搜索可以大大优化,因为在开始和结束时只有'S'和'T'重复(见评论)。或者,可以通过先查看序列中字母的数量(例如通过('S' => 2, 'T' => 2, 'K' => 1)
等)来优化,以便index
不会做不必要的工作。查看tba的评论,他的链接是稍微更紧凑的版本,以及与他发布的正则表达式解决方案之间的基准,该解决方案使用了不同的算法。
本分步解决方案的详细措辞描述。用字符遍历整个单词,每个单词都执行以下操作:
遍历参考序列,一旦找到匹配项,就会在序列中记录它的数字索引。在第一遍(第一个单词字符)时,这成为最高位置,例如$mark
。
对于其余的迭代,需要小心,因为参考序列有重复的字符。 (感谢tba发表评论。)由于发现字符在序列中匹配,匹配的索引将与$mark
进行比较,如果它是>=
,我们将$mark
重置为它并转到下一个字符。如果位置为< $mark
,则在丢弃该单词(字符位于前一个字符的左侧)时,搜索和比较将继续进行,直到找到>=
或者序列已用尽。改进:从$mark
开始搜索,如果找到匹配项,则将$mark
重置为$mark
,并移至下一个字符,否则该字将被丢弃(通过上面代码中的index
完成)。当你在你的字中匹配字符时,你正在爬取参考序列并记住你有多远。
这种方式将单词映射到基于参考字符串的非递减数字序列,或丢弃。在上面的代码中,如果需要,可以记录数字编码。
如果使用散列进行查找,则不能重复字符。例如,“S”是最左边和最右边的字符。单词'SAS'将被允许,但算法的散列和索引版本会将该标记标记为坏词。 – kba
更正,再次感谢。没想到这一点,只是没有抓住它,而我理解OP的“两次按顺序”错误的方式。 (不会发表对此的另一个评论,但我不能编辑第一个。) – zdim
只是为了它,我实现了你的方法(不像在答案中工作,你不需要'$ mark '如果使用3-arg'index')并且对这两者进行基准测试,请参阅https://gist.github.com/kba/879f3cb33311f15c4d44。使用'index'比较快。 – kba
你的问题是什么,你到目前为止尝试过什么? –