提取perl中兩個數組的唯一區間？

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的其餘內容是所需範圍的列表。如果您需要進一步處理結果並使用print，則我已使用Data::Dump顯示它，以便您可以看到輸出與您的問題中的所需結果相匹配。

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 

我認爲是正確的。