Перебрать два массива, удаляя наложения в Perl

Question

У меня есть два набора диапазонов, представленных значениями [start, stop].Некоторые диапазоны перекрываются, что означает, что начало одного диапазона находится между [началом, остановом] другого диапазона.Я хотел бы создать новый набор диапазонов, который не имеет такого перекрытия, а также не содержит никаких новых значений в диапазоне.

Диапазоны выглядят так:

@starts  @ends
      5    108 
      5    187
     44    187
     44    229 
     44    236 
     64    236 
    104    236
    580    644
    632    770

Ожидаемый результат будет следующим:

@starts  @ends
      5    236
    580    770

Это потому, что первые семь диапазонов перекрываются с интерваломиз 5 => 236, и последние два перекрываются с интервалом от 632 => 770.

Вот код, который я пробовал:

$fix = 0;
foreach (@ends) {  
    if ($starts[$fix + 1] < $ends[$fix]) {
        splice(@ends, $fix, $fix);
        splice(@starts, $fix + 1, $fix + 1);
    } else {
        $fix += 1;
    }
}

Я могу распечатать значения самостоятельно,Мне просто нужна помощь с алгоритмом слияния.

Answer 1

Это редактирует ваши массивы на месте, просто сворачивая границы, когда они перекрываются.

# Since they're sorted by @starts, accept the 0th interval, start at 1
for (1..$#starts) {
    # extra check on array bounds, since we edit in-place
    last unless $_ < @starts;
    # don't need to collapse if no overlap with previous end
    next unless $starts[$_] <= $ends[$_-1];
    # delete this start and the previous end
    splice(@starts,$_,1);
    splice(@ends,$_-1,1);
    # rerun this loop for the same value of $_ since it was deleted
    redo;
}

Answer 2

Поскольку массивы упорядочены по началу, проще всего работать с конца:

# this assumes at least one element in @starts, @ends
my $n = $#starts;
for (my $i = $#starts - 1; $i >= 0; $i--) {
    if ($ends[$i] < $starts[$n]) {
        # new interval
        $n--;
        ($starts[$n], $ends[$n]) = ($starts[$i], $ends[$i]);
    } else {
        # merge intervals - first scan for how far back to go
        while ($n < $#starts && $ends[$i] < $starts[$n+1]) {
            $n++;
        }
        $starts[$n] = $starts[$i];
    }
}
@starts = @starts[$n..$#starts];
@ends   = @ends[$n..$#ends];

Answer 3

Я думаю, что это то, что вы хотите.У вас есть ряд диапазонов формы [start, stop], и вы хотите объединить перекрывающиеся диапазоны.Подход ниже довольно прост.

1. Существует два набора диапазонов: исходный набор и объединенный набор.
2. Вы добавляете первый диапазон к набору объединенных (не перекрывающихся) диапазонов.Для каждого диапазона кандидатов, оставшегося от исходного набора, вы делаете выбор:
   • Если этот кандидат перекрывается с уже имеющимся в объединенном наборе, вы соответственно расширяете границы диапазона в объединенном наборе.
   • Если нет перекрытия между диапазоном кандидатов и любым диапазоном в объединенном наборе, вы добавляете кандидата в объединенный набор.смысл.Из твоего вопроса не слишком очевидно, что ты этого хотел, поэтому дай мне знать, если это не так.

     #!/usr/bin/perl
     
     use strict;
     use warnings;
     
     my @starts = qw/ 5 5 44 44 44 64 104 580 632 /;
     my @ends   = qw/ 108 187 187 229 236 236 236 644 770 /;
     
     my @ranges;
     while ( @starts && @ends ) {
         my $s = shift @starts;
         my $e = shift @ends;
         push @ranges, [ $s, $e ];
     }
     
     my @merged_ranges;
     push @merged_ranges, shift @ranges;
     
     foreach my $range (@ranges) {
         my $overlap = 0;
         foreach my $m_range (@merged_ranges) {
             if ( ranges_overlap($range,$m_range) ) {
                 $overlap = 1;
                 $m_range = merge_range($range,$m_range);
             }
         }
         if ( !$overlap ) {
             push @merged_ranges, $range;
         }
     }
     
     print join ' ', qw/ start end /;
     print "\n";
     foreach my $range (@merged_ranges) {
         print join ' ', ( $range->[0], $range->[1] );
         print "\n";
     }
     
     sub ranges_overlap {
         my $r1 = shift;
         my $r2 = shift;
     
         return ( $r1->[0] <= $r2->[1] && $r2->[0] <= $r1->[1] );
     }
     
     sub merge_range {
         my $r1 = shift;
         my $r2 = shift;
         use List::Util qw/ min max/;
     
         my $merged = [ min($r1->[0],$r2->[0]), max($r1->[1],$r2->[1]) ];
         return $merged;
     }
     

Answer 4

Я не свободно владею PERL, но следующее решение псевдокода, вероятно, может быть легко адаптировано:

for(i=0; i<N;){
    //we know that the next merged interval starts here:
    start = starts[i]
    end   = ends[i]

    for(i=i+1; i < N && starts[i] < end; i++){  //perhaps you want <= ?
        end = maximum(end, ends[i]);
    }

    add (start, end) to merged array
}

Answer 5

Как это?

#!perl

use strict;
use warnings;

my @starts = qw(5   5   44  44  44  64  104 580 632);
my @ends =   qw(108 187 187 229 236 236 236 644 770);

my @starts_new;
my @ends_new;

if ((scalar @starts) ne (scalar @ends)) {
    die "Arrays are not of equal length!\n";
}

my %ranges;
my $next_i = 0;
for (my $i=0; $i <= $#starts; $i=$next_i) {
    # If nothing changes below, the next array item we'll visit is the next sequential one.
    $next_i = $i + 1;

    # Init some temp stuff.
    my $start = $starts[$i]; # this one shouldn't change during this "for $i" loop
    my $end = $ends[$i];
    for (my $j=$i+1; $j <= $#ends; $j++) {
        if ($starts[$j] <= $end) {
            # This item further down the @starts array is actually less than
            # (or equal to) the current $end.
            # So, we need to "skip" this item in @starts and update
            # $end to reflect the corresponding entry in @ends.
            $next_i = $j +1;
            $end = $ends[$j] if ($ends[$j] > $end);
        }
    }
    # We have a valid start/end pair.
    push (@starts_new, $start);
    push (@ends_new, $end);
}

for (my $i=0; $i <= $#starts_new; $i++) {
    print "$starts_new[$i], $ends_new[$i]\n";
}