在 Perl 的 rexp 中搜索最大数量的匹配项答案

【问题标题】：Search for largest number of matches in rexp in Perl在 Perl 的 rexp 中搜索最大数量的匹配项
【发布时间】：2014-10-06 10:55:19
【问题描述】：

我正在尝试搜索一些数组以获得最佳匹配。例如，给定 @source 和 @search 列表：

my @source = ("John Ronald Reuel Tolkien","John Ronald S Tolkien","Trent Reznor","Barack Hussein Obama II","Barack Hussein II"); #note that the second item is wrong and should be discarded!
my @search = ("John Ronald Reuel T","Trent Reznor","Barack Hussein II","Barack Hussein Obama II","No match here");

我想将@search 列表与@source 列表中的最佳匹配相关联。我想这可以通过几个ORs 的搜索模式来完成，但我被卡住了。请参阅下面的示例：

#!/usr/local/bin/perl
use strict;
use warnings;

my @source = ("John Ronald Reuel Tolkien","John Ronald S Tolkien","Trent Reznor","Barack Hussein Obama II","Barack Hussein II");
my @search = ("John Ronald Reuel T","Trent Reznor","Barack Hussein II","Barack Hussein Obama II","No match here");

print "twonames\t\talternativesearch\n";
foreach my $s (@search){
    #gets first two names
    (my $twonames=$s)=~s/^(\w+ \w+).*$/$1/;

    #gets all other names, if they exist
    (my $others=$s)=~s/^(\w+ \w+)//;
    if ($others){
        #deletes initial space
        (my $alternativesearch=$others)=~s/^\s//;
        $alternativesearch=~s/\s/\|/g;
        print "$twonames\t\t$alternativesearch\n";
    }
    else {
        print "$twonames\t\tNO OTHER NAMES PRESENT\n";
    }
}
    #prints
    # twonames                alternativesearch
    # John Ronald             R|Tolkien
    # Trent Reznor            NO OTHER NAMES PRESENT
    # Barack Hussein          II
    # Barack Hussein          Obama|II

在此搜索中，我希望在@search 项和@source 项之间建立一个关联，以产生最佳匹配。比如：

# search                    source
# John Ronald Reuel T       John Ronald Reuel Tolkien
# Trent Reznor              Trent Reznor
# Barack Hussein Obama II   Barack Hussein Obama II
# No match here

请注意，在 Obama 的情况下，它匹配整个数组，在第一行匹配前两个单词加上其他内容，而在最后一个情况下，它什么也没找到。您将如何继续寻找最佳匹配？谢谢

编辑：这是交叉发布的on PerlMonks。 Edit2：即使我在示例中使用了人名，但我的真实案例没有人名，以防万一。

【问题讨论】：

您是否在 cpan 上查看过单词匹配/模糊匹配模块？那里已经有一个数字，除非您对“最佳匹配”有特定定义（例如，整个单词匹配都可以，但没有部分单词匹配；字符串之间的最小 Levenshtein 距离），您可以通过以下方式为自己节省大量时间使用现有模块。
太棒了！我会去找那个！谢谢！
交叉发布：perlmonks.org/?node_id=1102921
@choroba - 谢谢，我相应地编辑了我的帖子。

标签： regex perl pattern-matching match

【解决方案1】：

如果您对“最佳匹配”的定义是简单的长度，这似乎来自您的示例，那么您也可以按反向长度对您的 @source 数组进行排序，然后如果您匹配其中一个，您只需跳过其余的部分。标签可以方便地控制两个循环：

#!/usr/local/bin/perl
use strict;
use warnings;

my @source = ("John Ronald Reuel Tolkien","John Ronald S Tolkien","Trent Reznor","Barack Hussein Obama II","Barack Hussein II");
my @search = ("John Ronald Reuel T","Trent Reznor","Barack Hussein II","Barack Hussein Obama II","No match here");

# print header line
printf "%-32s\t%-32s\n", 'search', 'source';

search:
for my $se (@search) {

    source:
    for my $so (reverse sort {length($a) <=> length($b)} @source) {

        if ($so =~ /^\Q$se\E/) {
            printf "%-32s\t%-32s\n", $se, $so;
            next search;
        }
    }
    print "No match here\n";
}

输出：

$ perl myscript.pl
search                                  source
John Ronald Reuel T                     John Ronald Reuel Tolkien
Trent Reznor                            Trent Reznor
Barack Hussein II                       Barack Hussein II
Barack Hussein Obama II                 Barack Hussein Obama II
No match here
$

您确实不需要正则表达式或模式匹配来执行此操作，如果没有它会更快。上面只有一个正则表达式，它区分大小写，并且锚定在字符串的开头。因此我们可以使用substr 来代替。它可以说更容易/更易于维护，但绝对更高效（在我的基准测试中它的速度是它的两倍多）：

        if (substr($so, 0, length($se)) eq $se) {

【讨论】：