Finden und Zusammenführen von Intervallen in Perl

Question

meine Eingabe aus einer Datei sieht so aus: Die Datei hat Tab als Trennzeichen und ist alphabetisch für Proben und numerisch für die Funktionen in Spalte 2 und 3 sortiert. Was ich tun möchte, ist zu finden überlappende und enthaltene Funktionen und fusionieren sie zu einer Funktion.

SampleA 100 500 
SampleA 200 600 
SampleA 300 400 
SampleA 700 800 
SampleA 900 1100 
SampleA 1200 1500 
SampleA 1400 1700 
SampleA 1600 1900 
SampleB 400 600 
SampleB 700 900 
SampleB 1000 1800  
SampleB 1500 1600 
SampleB 1900 2500  
SampleB 2500 2600  
SampleB 3000 3600  
SampleB 3100 3400 

Zum Beispiel: Die ersten drei SampleA Fälle würden:

Sample A 100 600 

Mein Problem ist im Moment, dass ich die Fälle finden kann, wenn ich über meine Datenstruktur durchlaufen, aber ich bin etwas stecken beim Versuch, meine Samples zusammenzuführen. Meine Idee war nur, meine Schleife zu wiederholen, bis alles gefunden und zusammengeführt wurde, aber ich bin mir nicht sicher, wie das zu erreichen ist. die Daten in einem 2D-Array Im Moment wie folgt gespeichert werden: @storage = [SampleA, start, stop]

my $j = 1; 

for (my $i = 0; $i < scalar(@storage); $i++) { 

    if ($storage[$i][0] eq $storage[$j][0]) { 

     if ($storage[$i][2] > $storage[$j][1] && $storage[$i][2] < $storage[$j][2]) { 

      print "Found Overlapp!\n"; 

     }elsif ($storage[$i][2] > $storage[$j][1] && $storage[$i][2] > $storage[$j][2]) { 

      print "Found Feature in Feature!\n"; 

     } 
    } 
    unless ($j == scalar(@storage)){$j++}; 
} 

Mein Ziel wäre es, diese Schleife erneut ausführen, bis keine Übereinstimmung gefunden wird und dadurch alle Intervalle nicht überlappend sind, aber ich bin eher hier stecken geblieben. Jede Hilfe wäre willkommen, danke.

Answer 1

ich glaube, ich es so tun würde:

#!/usr/bin/env perl 

use strict; 
use warnings; 
use Data::Dumper; 

my %ranges; 

#iterate line by line. 
while (<>) { 
    chomp; 
    #split by line 
    my ($name, $start_range, $end_range) = split; 
    #set a variable to see if it's within an existing range. 
    my $in_range = 0; 
    #iterate all the existing ones. 
    foreach my $range (@{ $ranges{$name} }) { 

     #merge if start or end is 'within' this range. 
     if (
     ($start_range >= $range->{start} and $start_range <= $range->{end}) 

     or 

     ($end_range >= $range->{start} and $end_range <= $range->{end}) 
     ) 
     { 


     ## then the start or end is within the existing range, so add to it: 
     if ($end_range > $range->{end}) { 
      $range->{end} = $end_range; 
     } 
     if ($start_range < $range->{start}) { 
      $range->{start} = $start_range; 
     } 
     $in_range++; 
     } 

    } 
    #didn't find any matches, so create a new range identity. 
    if (not $in_range) { 
     push @{ $ranges{$name} }, { start => $start_range, end => $end_range }; 
    } 
} 

print Dumper \%ranges; 

#iterate by sample 
foreach my $sample (sort keys %ranges) { 
    #iterate by range (sort by lowest start) 
    foreach 
    my $range (sort { $a->{start} <=> $b->{start} } @{ $ranges{$sample} }) 
    { 
     print join "\t", $sample, $range->{start}, $range->{end}, "\n"; 
    } 
} 

Ausgänge mit Ihren Daten:

SampleA 100 600 
SampleA 700 800 
SampleA 900 1100  
SampleA 1200 1900  
SampleB 700 900 
SampleB 1000 1800  
SampleB 1900 2600  
SampleB 3000 3600  

Dies ist wahrscheinlich, wenn auch nicht der effizienteste Algorithmus ist, weil es alle prüft die Bereiche - aber Sie müssen wahrscheinlich nicht, weil die Eingabedaten geordnet sind - Sie können stattdessen nur die "neuesten" überprüfen.

Answer 2

Da die Eingabe gut sortiert ist, können Sie sie nur mit festem Speicher effizient filtern.

$_ = <> or exit; 
my @sample = split; 
while (<>) { 
    my @newsample = split; 
    if ($sample[0] ne $newsample[0] 
     || $newsample[2] < $sample[1] 
     || $sample[2] < $newsample[1]) { 
     # Unmergeable sample 
     print "$sample[0]\t$sample[1]\t$sample[2]\n"; 
     @sample = @newsample; 
    } 
    elsif ($sample[1] <= $newsample[1] && $newsample[2] <= $sample[2]) { 
     # @newsample is included in @sample. Nothing to do 
    } 
    elsif ($sample[1] <= $newsample[1]) { 
     # This @newsample raises the upper limit 
     $sample[2] = $newsample[2]; 
    } 
    elsif ($newsample[2] <= $sample[2]) { 
     # This @newsample lowers the lower limit. 
     $sample[1] = $newsample[1]; 
    } 
    else { 
     # This @newsample moves both limits 
     @sample = @newsample; 
    } 
} 
# Output the last sample 
print "$sample[0]\t$sample[1]\t$sample[2]\n";