Cluster das Muster nach Positionen?

Question

Ich habe die Datei wie folgt eingegeben.

ggaaaa (973026 to 973032) ctggag (1849680 to 1849686) = 6 
ggaaaa (973056 to 973062) ctggag (1849706 to 1849712) = 6 
ggaaaa (97322 to 97328) ctggag (184962 to 184968) = 6 
cctgtggataacctgtgga (1849554 to 1849572) tccacaggttatccacagg (1849615 to 1849633) = 19 
ggcccccccggagtt (470079 to 470093) aactccgggggggcc (1849574 to 1849588) = 15 
ctggag (18497062 to 18497068) ggaaaa (9730562 to 9730568) = 6 

Die erste Zeichenfolge ist ein Muster mit der Position des Klammermusters. Die zweite Saite wiederholt sich in der wiederholten Position der Klammer. Das erste 3-Linien-Muster und das 6.-Linien-Wiederholen sind gleich, aber die Positionen sind unterschiedlich. Deshalb mag ich es als einen Cluster wie diese durch ihre Positionen Zweite Zeichenfolge wiederholen und gefolgt von ihren Positionen und TAB seperator ist die Länge der Zeichenfolge meiner Ausgabe wieder

ggaaaa==>(973026 to 973032)(973056 to 973062)(97322 to 97328)(9730562 to 9730568) ctggag==>(1849680 to 1849686)(1849706 to 1849712)(184962 to 184968)(18497062 to 18497068) 6 8 
cctgtggataacctgtgga==>(1849554 to 1849572) tccacaggttatccacagg==>(1849615 to 1849633) 19 2 
ggcccccccggagtt==>(470079 to 470093) aactccgggggggcc==>(1849574 to 1849588) 15 2 

So erste Saite sind Muster und anschließend machen TAB Separator Summe der Muster- und Wiederholungspositionen

Ich versuchte, kleine Datei, die ich Ausgabe aber große Datei erhält, die nicht ausgegeben wird. Ich habe meinen Code unten eingefügt.

my $file = $_[0]; 
my %hashA; 
my %hashB; 
my @sorted; 
my $i = 1; 
my $j=$k=0; 
my $tmplen = $len = 0; 

my @sorted = `sort -nk10 $file`; 

push(@sorted,"***"); 

open (FLWR,">$file") or die "File can't open $!"; 

$lengt = $sorted[0]; 
print FLWR $lengt; 
my $linelen = @sorted; 

while($i < $linelen) 
{ 
    ($seqs,$len) = split(/\=/,$sorted[$i]); 
    $len =~s/\s+//g; 
    my($first,$second,$third,$fourth) = split(/\s+(?!to|\d+)/,$seqs); 
    if($len != $tmplen || $sorted[$i] eq "***") 
    { 
     if($tmplen != 0) 
     {   
      foreach $Alev2 (sort keys %{$hashA{$tmplen}}) 
      { 
       foreach $Alev3 (sort keys %{$hashA{$tmplen}{$Alev2}}) 
       { 
        foreach $Blev2 (sort keys %{$hashB{$tmplen}}) 
        {       
         foreach $Blev3 (sort keys %{$hashB{$tmplen}{$Blev2}}) 
         {    
          if($Alev3 eq $Blev3 && $Alev2 != $Blev2) 
          {   
           ($Akey) = keys (%{$hashA{$tmplen}{$Blev2}});         
           ($Akey1) = keys (%{$hashA{$tmplen}{$Blev2}{$Akey}}); 

           foreach $Blev4 (sort keys %{$hashB{$tmplen}{$Blev2}{$Blev3}}) 
           { 
            $hashA{$tmplen}{$Alev2}{$Alev3}{$Blev4}++; 
            $hashB{$tmplen}{$Alev2}{$Akey}{$Akey1}++ ; 
           } 
           delete($hashB{$tmplen}{$Blev2}); 
           delete($hashA{$tmplen}{$Blev2}); 
          } 
         } 
        } 
       }    
      } 
     } 
     $tmplen = $len; 
    } 
    if($first ne $dump_first) 
    { 
     $dump_first = $first; 
     $j++;  
    } 

    $hashA{$tmplen}{$j}{$dump_first}{$second}++; 
    $hashB{$tmplen}{$j}{$third}{$fourth}++; 

    $i++; 
} 

foreach $s1(sort keys %hashA) 
{ 
    foreach $s2 (sort keys %{$hashA{$s1}}) 
    { 
     my $seq_concat = ""; 
     my $a_concat = ""; 
     my $b_concat = ""; 
     my $a_inc = 0; 
     my $b_inc = 0; 
     foreach $s3 (sort keys %{$hashA{$s1}{$s2}}) 
     { 
      next if($s3 eq ""); 
      $Aseq_concat = "$s3==>"; 

      foreach $s4 (sort keys %{$hashA{$s1}{$s2}{$s3}}) 
      { 
       $a_inc++; 
       $a_concat .= $s4; 
      } 
     } 

     $s3 = ""; 
     foreach $s3 (sort keys %{$hashB{$s1}{$s2}}) 
     { 
      next if($s3 eq ""); 

      $Bseq_concat = "$s3==>"; 
      foreach $s4 (sort keys %{$hashB{$s1}{$s2}{$s3}}) 
      { 
       $b_inc++; 
       $b_concat .= $s4; 
      } 
     } 

     next if($b_concat eq ""); 
     $Bseq_concat = uc($Bseq_concat); 
     $b_concat = uc($b_concat); 
     $Aseq_concat = uc($Aseq_concat); 
     $a_concat = uc($a_concat); 
     if($a_inc > $b_inc) 
     { 
      print FLWR $Bseq_concat.$b_concat,"\t",$Aseq_concat,$a_concat; 
     } 
     else 
     { 
      print FLWR $Aseq_concat.$a_concat,"\t",$Bseq_concat,$b_concat; 
     } 
     print FLWR "\t$s1\t"; 
     print FLWR $a_inc+$b_inc; 
     print FLWR "\n"; 

    } 
} 

Answer 1

Ich würde es vorziehen, einige Updates, um Ihren Code vorzuschlagen, anstatt die Hand aus eine völlig überarbeitete Lösung - aber ich habe mich einfach in der Ebene verloren der Verschachtelung Sie oben haben.

Nur ein paar wichtige Punkte;

1. mit dieser Der beste Angriff ist die Ermittlung, dass die Bereiche das gleiche Format sind - also einen regulärer Ausdruck mit ‚global‘ verwenden, /g Option in einer while-Schleife.
2. Nachdem entschieden wurde, die Lösung auf eine Regex zu zentrieren, ist es am besten, den erweiterten Modus und viele Leerzeichen und Kommentare zu verwenden.
3. Die Kerndatenstruktur ist ein Hash von Hashes. Die erste Ebene wird in die Musterzeichenfolge eingegeben, die innere auf die Bereichsspezifikationszeichenfolge.
4. Ihre Spezifikation impliziert, dass alle Muster auf einer gegebenen Zeile der Daten die gleiche Länge haben - der Code, den ich unten gebe, beruht auf dieser Tatsache.
5. Ich habe einige Checks zu der gegebenen Patternlänge und den Start- und Endpositionen hinzugefügt - wenn die Daten solide sind, brauchen Sie sie vielleicht nicht?
6. Ihr gewünschtes Ausgabeformat hat dem Code Komplexität hinzugefügt - wenn es für jedes Muster eine Berichtszeile gäbe, wäre der Code viel einfacher. So wie es ist, erscheint ein Muster bei einer bestimmten Zeilennummer im Bericht, wenn es zuerst auf der entsprechenden Zeile in den Daten erscheint. Das Aufzeichnen der Zeile, zu der ein Muster zuerst angezeigt wird, hat dem Code erheblich hinzugefügt.
7. Der Code ist Unix-Filter-Stil geschrieben - Daten über STDIN geliefert und auf STDOUT gedruckt. Fehler und Warnungen auf STDERR

Also, angesichts dieser Punkte;

use v5.12; 
use warnings; 

my $pattern_regex = qr/ 

    (\w+)    # capture actual pattern to $1 
    \s*    # optional whitespace after pattern 
    (    # capture the following to $2 
     \(   # literal open bracket 
     (\d+)   # capture start pos to $3 
     \s* to \s* 
     (\d+)   # capture end pos to $4 
     \)   # literal close bracket 
    )     # close capture whole range spec to $1 
    \s*    # gobble up any whitespae between patterns 

/x ;     # close regex - extended mode 

my %ranges ; 
my @first_seen_on_line ; 

while (<>) { 
    chomp ; 
    my ($patterns_str, $given_length) = split /\s*=\s*/ ; 
    die "No length on line $." unless defined $given_length ; 

    # Repeatedly look for patterns and range-specifications 
    while ($patterns_str =~ /$pattern_regex/g) { 
     my ($pattern, $range_spec, $start_pos, $end_pos) = ($1,$2,$3,$4); 
     warn "Incorrect length for '$pattern' on line $.\n" 
      unless length($pattern) == $end_pos - $start_pos + 1 
       && length($pattern) == $given_length ; 

     # Is this the first time we've seen this pattern? 
     if (defined $ranges{ $pattern }) { 
      # No its not - add this range to the hash of ranges for this pattern 
      $ranges{ $pattern }{ $range_spec }++ ; 
     } 
     else { 
      # Yes it is - record the fact that it was on this line and 
      # initialize the hash of ranges for this pattern 
      push @{ $first_seen_on_line[ $. ] }, $pattern ; 
      $ranges{ $pattern } = { $range_spec => 1 } ; 
     } 
    } 
} 

for my $line (1 .. $#first_seen_on_line) { 
    # Might not be anything to do for this line 
    next unless defined $first_seen_on_line[$line] ; 

    # Get the patterns that first appeared on this line 
    my @patterns = @{ $first_seen_on_line[$line] } ; 

    my ($pat_length , $range_count) ; 
    for my $pat (@patterns) { 
     # Get all the ranges for this pattern and print them 
     my @ranges = keys %{ $ranges{ $pat } }; 
     print $pat, '==>', @ranges, "\t" ; 
     $range_count += @ranges ; 
     $pat_length = length($pat) ; 
    } 
    print $pat_length, "\t"; 
    print $range_count, "\n" ; 
    # print length $pat, "\t", scalar @ranges, "\n" ; 
} 

Lief auf die Daten oben, es produziert;

gaaaa==>(973026 to 973032)(973056 to 973062)(97322 to 97328)(9730562 to 9730568) ctggag==>(1849680 to 1849686)(1849706 to 1849712)(184962 to 184968)(18497062 to 18497068) 6 8 
cctgtggataacctgtgga==>(1849554 to 1849572) tccacaggttatccacagg==>(1849615 to 1849633) 19 2 
ggcccccccggagtt==>(470079 to 470093) aactccgggggggcc==>(1849574 to 1849588) 15 2