获得您想要的行为的主要更改是按其他顺序循环,即首先在 Set 2 上,然后在 Set 1 上。这是一种更自然的编程方式,因为您对 Set 2 的属性感兴趣。下面,让我们详细查看变化。
启用strict
和warnings
pragmata 很好!绝对保留那些。
#! /usr/bin/env perl
use strict;
use warnings;
因为您询问了完全不相交的范围,所以我们将在此处将其添加到 Set 2。
#Set 1: 1..6, 2..7, 3..8, 4..9, 5..10
my @set1_low = (1..5);
my @set1_up = (6..10);
my @set1 = ([@set1_low],[@set1_up]);
#Set 2: 2..7, 2..6, 22..32
my @set2_low = (2,2,22);
my @set2_up = (7,6,32);
my @set2 = ([@set2_low],[@set2_up]);
为了计算大小,已经隐含了标量上下文,因为您正在分配给标量。例如,写这些的一种不太罗嗦的方式是my $size1 = @set1_low;
。
my $size1 = scalar(@set1_low);
my $size2 = scalar(@set2_low);
你想计算完全未命中,所以我们在这里添加$no_match
.
my $low_count=0;
my $up_count=0;
my $match=0;
my $no_match=0;
请注意,循环是倒置的,但我$a
独自一人离开$b
。对于 Set 2 中的每个范围,代码按顺序查看 Set 1 中的范围,搜索第一个满足的属性。命中时,无需考虑 Set 1 中的其余范围,因为您的问题表明您不想重复计算,因此我们使用 终止内部循环last
。按重要性降序排列属性,以便程序中最早发生的测试优先。
如果没有属性匹配(即,如果$found_match
仍然为假),那么我们记录气味。
在文体上,仅仅用英文重述代码的注释是没有价值的。评论是为了解释原因和不明显的信息,所以我在下面删除了它们。
for(my $b=0; $b < $size2; $b++){
my $found_match=0;
for(my $a=0; $a < $size1; $a++){
my ($lower,$upper) = ($set1[0][$a],$set1[1][$a]);
if ($lower==$set2[0][$b] && $upper==$set2[1][$b]){
$match++;
$found_match++;
last;
}
elsif ($lower==$set2[0][$b] && $upper!=$set2[1][$b]){
$low_count++;
$found_match++;
last;
}
elsif ($lower!=$set2[0][$b] && $upper==$set2[1][$b]){
$up_count++;
$found_match++;
last;
}
}
unless ($found_match) {
$no_match++;
}
}
最后,打印结果。
print "Perfect match: $match\n";
print "lower match, upper unmatch: $low_count\n";
print "upper match, lower unmatch: $up_count\n";
print "No match: $no_match\n";
输出:
完美匹配:1
下匹配,上不匹配:0
上匹配,下不匹配:1
没有匹配:1
上面的数据结构和风格对 Perl 来说有点不自然。如果您告诉我们更多关于您要解决的问题的背景,我们可以为您提供更多有用的建议。
添加更多测试(例如部分重叠)的压力会迅速促使您选择更好的数据结构。而不是使用并行数组作为上限和下限——就像我们在 C 程序中可能必须做的那样——将每个范围视为一个单元。
my @set1 = ([1, 6], [2, 7], [3, 8], [4, 9], [5, 10], [90, 150]);
my @set2 = ([2, 7], [2, 6], [7, 8], [22, 32], [80, 140]);
将下限和上限附加到同一个标量(在这种情况下是对数组的引用),我们现在可以询问两个范围是否共享下限或是否共享上限。
sub lowers { $_[0][0] == $_[1][0] }
sub uppers { $_[0][1] == $_[1][1] }
有了这些定义,精确匹配的测试就很简单了。
sub match { lowers(@_) && uppers(@_) }
在测试重叠时,书写$range1[0]
很快$range2[1]
就会变得很累,所以下面我们将范围分解为(a 0,a 1)和(b 0,b 1)。然后我们测试一个范围的任一端点是否在另一个范围内。
sub overlap {
my($a0,$a1,$b0,$b1) = map @$_, @_;
$a0 >= $b0 && $a0 <= $b1 || $a1 >= $b0 && $a1 <= $b1;
}
测试每个条件的代码现在几乎相同,不同之处在于调用哪个函数和增加哪个计数,所以让我们分解并将测试与它们各自的计数相关联。因为测试彼此重叠,但最多有一个获得“信用”,所以准备好排列顺序@tests
以获得您期望的结果。
my $low_count=0;
my $up_count=0;
my $match=0;
my $overlap=0;
my $no_match=0;
my @tests = (
[\&match, \$match],
[\&lowers, \$low_count],
[\&uppers, \$up_count],
[\&overlap, \$overlap],
);
该算法的核心现在非常简短。该代码类似于您向另一个人解释它的方式。也就是说,对于第 2 组中的每个范围,然后对于我们的每个测试,扫描第 1 组中的所有范围。在匹配时,记下成功并继续到第 2 组中的下一个范围。在尝试所有测试后均未成功,记下失败并继续。
SET2:
foreach my $two (@set2) {
for (@tests) {
my($test,$count) = @$_;
if (grep $test->($_, $two), @set1) {
++$$count;
next SET2;
}
}
++$no_match;
}
是的,该算法很简洁,但它具有二次时间复杂度。例如,这意味着将集合大小增加三倍将产生大约 9 倍的减速。
输出代码如您所料。
print "Perfect match: $match\n";
print "lower match, upper unmatch: $low_count\n";
print "upper match, lower unmatch: $up_count\n";
print "Overlap: $overlap\n";
print "No match: $no_match\n";
输出:
完美匹配:1
下匹配,上不匹配:1
上匹配,下不匹配:1
重叠:1
没有匹配:1