将字符串标记与字符串数组标记进行比较

Question

我有一个包含空格分隔标记列表的字符串。

my $string = "--configure-option1 --configure-option2 --configure-option3 --configure-option4";

我有一个类似字符串的数组。

my @array = (
   "--configure-option20",
   "--configure-option2 --configure-option5",
   "--configure-option10 --configure-option11",
   "--configure-option15 --configure-option22 --configure-option27",
);

我想确定$string 中的任何标记是否也在@array 中的一个字符串中找到。例如，由于$string 和@987654326，上述值的结果都是正确的@ 包含令牌--configure-option2。

Answer 1

my $alt = join '|', map quotemeta, split ' ', $string;
my $re = qr/(?<!\S)(?:$alt)(?!\S)/;

my $match = grep /$re/, @array;

为了加快速度：

my $match = join(' ', @array) =~ /$re/;

为了加快速度并节省内存：

my $match = 0
for (@array) {
   if (/$re/) {
      $match = 1;
      last;
   }
}

Answer 2

如果我猜对了你的数据格式，我认为这可以解决你的问题

它将@failures 数组转换为一个散列，其中包含所有不同的选项，如果它们出现则应该导致拒绝。然后它通过@array（你的名字，不是我的！）运行并使用grep检查%failures哈希中是否出现任何组成选项，并打印结果

如果速度是个问题，那么您可能希望将 grep 替换为来自 List::MoreUtils 的 any

use strict;
use warnings;
use 5.010;

my @array = (
    '--configure-option1 --configure-option2 --configure-option3 --configure-option4',
    '--configure-option3 --configure-option4 --configure-option12',
);

my @failures = (
    '--configure-option20',
    '--configure-option2 --configure-option5',
    '--configure-option10 --configure-option11',
    '--configure-option15 --configure-option22 --configure-option27',
);

my %failures;
$failures{$_} = 1 for map split, @failures;

for my $options ( @array ) {
    my $reject = grep { $failures{$_} } split ' ', $options;
    say $options, '  ', $reject ? 'FAIL' : 'PASS';
}

输出

--configure-option1 --configure-option2 --configure-option3 --configure-option4  FAIL
--configure-option3 --configure-option4 --configure-option12  PASS

Answer 3

您的问题还不清楚。根据我在字里行间的阅读，我想出了这个：

#!/usr/bin/env perl

use strict;
use warnings;

use Set::CrossProduct;

my $x = '[--configure-option1 --configure-option2 --configure-option3 --configure-option4]';

my $y = '[--configure-option20][--configure-option2 --configure-option5][--configure-option10 --configure-option11][--configure-option15 --configure-option22 --configure-option27]';

my $pat = qr/([a-z0-9-]+)/;

my @x = ($x =~ /$pat/g);
my @y = ($y =~ /$pat/g);

my $it = Set::CrossProduct->new([\@x, \@y]);
while (my $el = $it->get) {
    if ($el->[0] eq $el->[1]) {
        printf "'%s' appears in both\n", $el->[0];
    }
}

输出：

C:\...\Temp> perl tt.pl
'--configure-option2' 出现在两者中

Answer 4

    #!/usr/bin/perl


my @pairs = (
    '--configure-option1 --configure-option2 --configure-option3 --configure-option4',
    '--configure-option3 --configure-option4 --configure-option12',
);

my @failures = (
    '--configure-option20',
    '--configure-option2 --configure-option5',
    '--configure-option10 --configure-option11',
    '--configure-option15 --configure-option22 --configure-option27',
);

$all = 0;
$size = $#pairs + 1;
my $string1;
my $string2;

while ($all < $size) {
##... Other code happening here
## Begin test case
####################################################

        # loop through the existing failure cases. Logic here is that
        # the failures array will always be < the build array.
        # (the full build array has thousands of options while the
        # failures array can not possibly grow larger than that and
        # ideally will be much smaller than that.
        foreach $string1 (@failures) {

            $string2 = $pairs[$all];

            # get string1 from the Failures array and parse it up into the
            # @compare1 array
            # get string2 from the current configure option and parse it into
            # @compare2 array

            my @compare1 = split(' ', $string1);
            my @compare2 = split(' ', $string2);

            # loop through both arrays storing each element in var1 and var2
            # for comparing
            foreach my $var1 (@compare1) {
                foreach my $var2 (@compare2) {

                    #see if var1 and var2 match
                    if ($var1 eq $var2) {
                        print "ALERT!!!!\n";
                        print "string1 is: \"$string1\"\n";
                        print "string2 is: \"$string2\"\n\n";
                        print "found match string1 contains $var1 and string2 contains $var2\n\n";
                        $reject = 1;
                    }
                }
            }
        }

        if ($reject eq 1) {
            print "\n$string2\n";
            print "didn't run this test because it's been rejected\n\n";

            # reset the reject flag
            $reject = 0;
        }
        else {
            print "\n$string2\n";
            print "This test did run\n\n";
        }

        $all = $all + 1;
####################################################
## End test case
##... Rest of script
}

运行输出：

ALERT!!!!
string1 is: "--configure-option2 --configure-option5"
string2 is: "--configure-option1 --configure-option2 --configure-option3 --configure-option4"

found match string1 contains --configure-option2 and string2 contains --configure-option2


--configure-option1 --configure-option2 --configure-option3 --configure-option4
didn't run this test because it's been rejected


--configure-option3 --configure-option4 --configure-option12
This test did run