-1

我有两组这样的数字范围。

Set 1: 1..6, 2..7, 3..8, 4..9, 5..10
Set 2: 2..7, 2..6

我想将 Set 2 中的范围与 Set 1 中的范围进行比较,所以

  1. 计算完美匹配的数量(2..7)

  2. 计算匹配的低数和不匹配的高数的实例数 ( 2..6)

  3. 计算不匹配的低数和不匹配的高数的实例数 ( 1..7)

以下代码有效,但它计数2.两次3.。例如:2..7来自 Set 2 的范围同时符合2.3.。如何只记录一个实例?

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

#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
my @set2_low = (2,2);
my @set2_up = (7,6);
my @set2 = ([@set2_low],[@set2_up]);

my $size1 = scalar(@set1_low);
my $size2 = scalar(@set2_low);

my $low_count=0;
my $up_count=0;
my $match=0;

for(my $a=0; $a < $size1; $a++){
    my ($lower,$upper) = ($set1[0][$a],$set1[1][$a]);
    for(my $b=0; $b < $size2; $b++){
        #If lower and upper are same to set1, $both++
        if ($lower==$set2[0][$b] && $upper==$set2[1][$b]){
            $match++;
            next;
        }

        #If lower match but upper unmatch, $low_count++
        elsif ($lower==$set2[0][$b] && $upper!=$set2[1][$b]){
            $low_count++;
            next;
        }

        #if upper match but lower unmatch, $up_count++
        elsif ($lower!=$set2[0][$b] && $upper==$set2[1][$b]){
            $up_count++;
            next;
        } 
     }
 }
 print "Perfect match: $match\n";
 print "lower match, upper unmatch: $low_count\n";
 print "upper match, lower unmatch: $up_count\n";

此外,如果 Set 2 包含一个范围,例如22..32,我将如何检测不与 Set 1 中的任何范围重叠的范围?有什么想法或建议吗?

4

2 回答 2

1
my @set1 = map [ split /\.\./ ], split /\s*,\s*/, '1..6, 2..7, 3..8, 4..9, 5..10';
my @set2 = map [ split /\.\./ ], split /\s*,\s*/, '2..7, 2..6';

my (%exact, %lo, %hi);
for (@set2) {
   my ($l,$h) = @$_;
   ++$exact{$l}{$h};
   ++$lo{$l};
   ++$hi{$h};
}

my $exact               = 0;
my $partial_match_lo_hi = 0;
my $partial_match_lo    = 0;
my $partial_match_hi    = 0;
my %mismatch;
for (@set1) {
   my ($l,$h) = @$_;
   if    ( $exact{$l}{$h}     ) { ++$exact;               }
   elsif ( $lo{$l} && $hi{$h} ) { ++$partial_match_lo_hi; }
   elsif ( $lo{$l}            ) { ++$partial_match_lo;    }
   elsif ( $hi{$h}            ) { ++$partial_match_hi;    }
}
于 2013-03-09T18:08:35.977 回答
1

获得您想要的行为的主要更改是按其他顺序循环,首先在 Set 2 上,然后在 Set 1 上。这是一种更自然的编程方式,因为您对 Set 2 的属性感兴趣。下面,让我们详细查看变化。

启用strictwarningspragmata 很好!绝对保留那些。

#! /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 0a 1)和(b 0b 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
于 2013-03-09T20:34:40.727 回答