區(qū)間合并

Chinaaa123

各位大俠晚上好！
向大家請教：一個文件中有兩列，每一行是一個區(qū)域，順序是從上向下遞增
start          end
10467        10472
10469        10474
10482        10487
10487        10492
10491        10496
10495        10500
10523        10528
10540        10545
10561        10566
10569        10574
10575        10580

目的：當滿足$end-$start(下一行)=1條件時，才合并該區(qū)域，如上述所示10492-10491=1,10496-10495=1;
得到最后結(jié)果應(yīng)該是：10487   10500；
麻煩大家了！

flywithperl

# data input
my $line;
my (@start, @end);
my $i;

while ($line = <>) {
        chomp($line);
        my ($start, $end) = split(/\s+/, $line);
        print "$start\t\t$end\n";
        push @start, $start;
        push @end, $end;
}
print "\n\n";


# data merge
my (@first, @second);

if (@start) {
        push @first, $start[0];
        for ($i=0; $i<$#start; $i++) {
                if ($end[$i] - $start[$i + 1] != 1) {
                        push @second, $end[$i];
                        push @first, $start[$i + 1];
                }
        }
        push @second, $end[-1];
}

# show result
print "\n\n";
for ($i=0; $i<@first; $i++) {
        print "$first[$i]\t\t$second[$i]\n";
}

Chinaaa123

回復(fù) 2# flywithperl
多謝這位大俠，我也是你這種思路，寫的比較坎坷，感謝幫忙！
想了下 另一種思路可以一次讀兩行進行判斷！

kk861123

逐行處理

1. #!/usr/bin/env perl
   
2. use strict;
   
3. use warnings;
   
4. use Data::Dumper;
   
5. 
   
6. my @stack;
   
7. while (<DATA>) {
   
8.     my $rec = [split];
   
9.     if (@stack) {
   
10.         merge(\@stack, $rec);
    
11.     } else {
    
12.         push @stack, $rec;
    
13.     }
    
14. }
    
15. 
    
16. print "@$_\n" for @stack;
    
17. exit 0;
    
18. 
    
19. sub merge {
    
20.     my ($stack, $new) = @_;
    
21.     my $last;
    
22.     while (@$stack) {
    
23.         $last = pop @$stack;
    
24.         if ($last->[1] - $new->[0] == 1) {
    
25.             $new = [ $last->[0], $new->[1] ];
    
26.         } else {
    
27.             push @$stack, $last;
    
28.             last;
    
29.         }
    
30.     }
    
31.     push @$stack, $new;
    
32. }
    
33. 
    
34. __DATA__
    
35. 10467        10472
    
36. 10469        10474
    
37. 10482        10487
    
38. 10487        10492
    
39. 10491        10496
    
40. 10495        10500
    
41. 10523        10528
    
42. 10540        10545
    
43. 10561        10566
    
44. 10569        10574
    
45. 10575        10580

復(fù)制代碼

kk861123

逐行處理

1. #!/usr/bin/env perl
   
2. use strict;
   
3. use warnings;
   
4. use Data::Dumper;
   
5. 
   
6. my @stack;
   
7. while (<DATA>) {
   
8.     my $rec = [split];
   
9.     if (@stack) {
   
10.         merge(\@stack, $rec);
    
11.     } else {
    
12.         push @stack, $rec;
    
13.     }
    
14. }
    
15. 
    
16. print "@$_\n" for @stack;
    
17. exit 0;
    
18. 
    
19. sub merge {
    
20.     my ($stack, $new) = @_;
    
21.     my $last;
    
22.     while (@$stack) {
    
23.         $last = pop @$stack;
    
24.         if ($last->[1] - $new->[0] == 1) {
    
25.             $new = [ $last->[0], $new->[1] ];
    
26.         } else {
    
27.             push @$stack, $last;
    
28.             last;
    
29.         }
    
30.     }
    
31.     push @$stack, $new;
    
32. }
    
33. 
    
34. __DATA__
    
35. 10467        10472
    
36. 10469        10474
    
37. 10482        10487
    
38. 10487        10492
    
39. 10491        10496
    
40. 10495        10500
    
41. 10523        10528
    
42. 10540        10545
    
43. 10561        10566
    
44. 10569        10574
    
45. 10575        10580

復(fù)制代碼

523066680

如果數(shù)據(jù)量不大

1. use File::Slurp;
   
2. STDOUT->autoflush(1);
   
3. 
   
4. my $data = read_file( "src.txt" );
   
5. 
   
6. $data =~s/(\d+)\n(\d+)\s+/if ($1-$2 == 1) {print "Remove: $1 $2\n"; "";} else { ${&} }/eg;
   
7. print $data;
   

復(fù)制代碼

Remove: 10492 10491
Remove: 10496 10495
start          end
10467        10472
10469        10474
10482        10487
10487        10500
10523        10528
10540        10545
10561        10566
10569        10574
10575        10580