Question

我试图从具有间隔的两个文件中提取非重叠间隔（那些是唯一的）。案例如下：

FILE1.TXT

Start End
1 3
5 9
13 24
34 57

FILE2.TXT

Start End
6 7
10 12
16 28
45 68

预期结果：具有元素的数组，其中元素仅出现在一个文件中：

1-3 , 10-12

这就是全部......非常感谢你！

Answer 1

逐行处理文件。如果没有重叠，请报告先前开始的间隔并推进其文件。如果出现重叠，请将两个文件前进。

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

use Data::Dumper;

my @F;
open $F[0], '<', 'file1.txt' or die $!;
open $F[1], '<', 'file2.txt' or die $!;

# Skip headers.
readline $_ for @F;

my @boundaries;
my @results;

sub earlier {
    my ($x, $y) = @_;
    if (! @{ $boundaries[$y] }
        or $boundaries[$x][1] < $boundaries[$y][0]
    ) {
        push @results, $boundaries[$x];
        $boundaries[$x] = [ split ' ', readline $F[$x] ];
        return 1
    }
    return 0
}

sub overlap {
    my ($x, $y) = @_;
    if ($boundaries[$x][1] < $boundaries[$y][1]) {
        do { $boundaries[$x] = [ split ' ', readline $F[$x] ] }
          until ! @{ $boundaries[$x] }
          or $boundaries[$x][0] > $boundaries[$y][1];
        $boundaries[$y] = [ split ' ', readline $F[$y] ];
        return 1
    }
    return 0
}

sub advance_both {
    @boundaries = map [ split ' ', readline $_ ], @F;
}

# init.
advance_both();
while (grep defined, @{ $boundaries[0] }, @{ $boundaries[1] }) {

    earlier(0, 1)
    or earlier(1, 0)
    or overlap(0, 1)
    or overlap(1, 0)
    or advance_both();
}

print join(' , ', map { join '-', @$_ } @results), "\n";

Answer 2

这个程序就像你问的那样。它将所有范围加载到@pairs（不需要区分file1和file2的内容）并将列表复制到数组@unique中。然后测试两个范围的每个可能组合以查看它们是否重叠，如果是，则从@unique删除这两个范围。

@unique的剩余内容是所需范围的列表。我已使用Data::Dump显示它，以防您需要进一步处理结果，并使用print，以便您可以看到输出与您问题中所需的结果相符。

use strict;
use warnings;

our @ARGV = qw/ file1.txt file2.txt /;

my @ranges;

while (<>) {
  my @pair = /\d+/g;
  next unless @pair == 2;
  push @ranges, \@pair;
}

my @unique = @ranges;

for my $i (0 .. $#unique) {
  for my $j ($i+1 .. $#unique) {
    if ($unique[$i][0] <= $unique[$j][1] and $unique[$i][1] >= $unique[$j][0]) {
      ++$unique[$_][2] for $i, $j;
    }
  }
}

@unique = grep { not $_->[2] } @unique;


use Data::Dump;
dd \@unique;

print join(', ', map join('-', @$_), @unique), "\n";

<强>输出

[[1, 3], [10, 12]]
1-3, 10-12

<强>更新

使用@Choroba的数据（谢谢）输出现在是

[[1, 3], [1000, 1001], [10, 12]]
1-3, 1000-1001, 10-12

我认为是正确的。

从perl中的两个数组中提取唯一的区间？

2 个答案: