perl entfernen Sie identische ID und ähnliche ID, pflegen Sie die Array-Reihenfolge und drucken Sie sie wie Matrix

Question

meine erste Datei haben einige Schlüssel. Beispiel

Eur1 
Eur2 
Eur3 
Eur4 
Eur5 

Die andere Datei ist die tatsächliche Eingabe. getrennt durch ":" (Header auf der linken Seite ist rechtse Seite ist "|" begrenzt passende IDs.) es aussehen wird,

Eur2_1116: Eur1_9816|Eur1_916|Eur3_16|Eur4_17|Eur5_716 
Eur3_2980: Eur1_8568|Eur2_98|Eur2_92|Eur4_12.3|Eur4_12.1|Eur4_12.9 
Eur4_786: Eur2_0909|Eur5_1090|Eur5_2535|Eur1_233 
Eur1_10616: 
Eur5_5634: Eur3_1868|Eur4_8634|Eur1_35923 
Eur1_34312: 
Eur3_0000: Eur5_8235 
Eur3_3433: 
Eur5_3354: Eur2_245|Eur2_245|Eur1_34 
Eur3_1122: Eur4_4431 

in meiner Definition,

identischer IDs identisch ist. Beispiel (Eur2_245, Eur2_245 in Zeile 9)

ähnliche IDs werden von demselben Schlüssel mit unterschiedlichem Wert abgeleitet. Beispiel (Eur1_9816 und Eur1_916 in Zeile 1) oder (Eur4_12.3, Eur4_12.1 und Eur4_12.9 in Zeile 2).

Ich möchte die identischen IDs entfernen. Auch die ähnlichen IDs nach dem ersten Match. Beispiel, Eur1_9816 sollte die Ausgabezeile 2. oder Eur4_12.3 für Zeile 2 gehen. Weil sie die erste ähnliche ID unter anderen ähnlichen IDs sind.

meine gewünschte Ausgabe sollte wie Matrix sein, die Header in der ersten Spalte genau wie die Eingabe-Header. Gefolgt von den geordneten Schlüsseln in den aufeinanderfolgenden Spalten. Zu beachten ist, dass Header auch zu einem der geordneten Schlüssel gehören. So wird der Header selbst zu einer passenden ID in einer entsprechenden Spalte.

Beispiel, Zeile 1, Eur2_1116 ist die Kopfzeile. Es wird in der Zeile 1 als Header und ALSO wird es Teil der "Eur2" geordneten Schlüsselspalte sein.

Und in ähnlicher Weise sollten alle anderen entsprechenden Übereinstimmungen (nach dem Ausschließen identischer, ähnlicher Übereinstimmungen) zu den entsprechenden Spalten gehen.

gewünschter Ausgang # 1

Column1 Eur1 Eur2 Eur3 Eur4 Eur5 

Eur2_1116  Eur1_9816  Eur2_1116  Eur3_16 Eur4_17 Eur5_716 
Eur3_2980  Eur1_8568  Eur2_98 Eur3_2980  Eur4_12.3 
Eur4_786  Eur1_233  Eur2_0909    Eur4_786  Eur5_1090 
Eur1_10616  Eur1_10616 
Eur5_5634  Eur1_35923    Eur3_1868  Eur4_8634  Eur5_5634 
Eur1_34312  Eur1_34312 
Eur3_0000      Eur3_0000    Eur5_8235 
Eur3_3433  Eur3_3433 
Eur5_3354  Eur1_34 Eur2_245      Eur5_3354 
Eur3_1122      Eur3_1122  Eur4_4431 

mein eigentlicher Code ist, (nach = für Kommentarzeilen, dieser Codeblock ist falsch). Könntest du es bitte korrigieren? Wenn möglich, um die identischen und ähnlichen Übereinstimmungen zu verfolgen, kann ich es in eine separate Datei schreiben?

use strict; 
use warnings 'all'; 

my $ipArr = $ARGV[0]; chomp $ipArr; #setArr.txt 
open (IN,"$ipArr") or die "Unalbe to open the file:$!\n"; 

my $orderArr = $ARGV[1]; chomp $orderArr; #orderArr.txt 
open(OA,"$orderArr") or die "Unable to open the order array:$!\n"; 
my @orderKeys = <OA>; chomp @orderKeys; close OA; 

while (my $line = <IN>) 
{ 
    chomp ($line); 
    my ($header,$matchSet) = ""; 
    my (@tmpSet, @setArr1, @setArr2) =(); 
    ($header,$matchSet) = split("\:",$line); 
    $matchSet =~ s/\s+//g; 
    @tmpSet = split (/\|/, $matchSet); 
    push(@setArr1,$header,@tmpSet); 
    sub uniq { 
     my % seen; 
     grep !$seen{$_}++, @_; 
    } 
    @setArr2 = uniq(@setArr1); 
    print join "\t", @setArr2,"\n"; 
} 

=for 
    foreach my $g (@setArr2) 
    { 
     my ($k,$val) = ""; 
     $g =~ /^(\w.*)\_(\w.*)$/; 
     $k = $1; $val = $2; 
     $hash{$k} = {$val}; 
    } 
} 
    foreach $S (@orderKeys) 
     { 
      if($setArr[$i] =~ /^$S\_.*$/) 
      { 
      print "$S\t"; 
      } 
     } 
    } 

    print "\n"; 
} 
close IN; 

Answer 1

Code:

use strict; 
use warnings; 
open FH,"tmp1" or die "Error\n";#orderArr.txt 
my %myhash; 
my $count++; 
my @firstarray = ("Eur1","Eur2", "Eur3", "Eur4", "Eur5"); 
while (<FH>){ 
     chomp($_); 
     my @val = split(/:/,$_); 
     $val[1] =~ s/\s//; 
     if($val[1] ne "") 
     { 
       my @arr = split(/\|/,$val[1]); 
       foreach my $id (@arr) 
       { 
         my @val1 = split(/_/,$id); 
         push(@{$myhash{$count}{$val[0]}{$val1[0]}},$id); 
       } 
     } 
     my @val1 = split(/_/,$val[0]); 
     push(@{$myhash{$count}{$val[0]}{$val1[0]}},$val[0]); 

     $count++; 
     #print "$val[0]\n"; 

} 
foreach my $count (sort { $a <=> $b} keys %myhash) 
{ 
     foreach my $id (keys %{$myhash{$count}}) 
     { 
       print "$id"; 
       foreach my $idlist (@firstarray) 
       #foreach my $idlist(keys %{$myhash{$count}{$id}}) 
       { 
         #print " t $idlist t "; 
         if(exists $myhash{$count}{$id}{$idlist}) 
         { 
           my $value =$myhash{$count}{$id}{$idlist}[0]; 
           print "\t$value"; 
         } 
         else 
         { 
           print "\t"; 
         } 
       } 
       print "\n"; 

     } 
} 

Ausgang:

Eur2_1116  Eur1_9816  Eur2_1116  Eur3_16 Eur4_17 Eur5_716 
Eur3_2980  Eur1_8568  Eur2_98 Eur3_2980  Eur4_12.3 
Eur4_786  Eur1_233  Eur2_0909    Eur4_786  Eur5_1090 
Eur1_10616  Eur1_10616 
Eur5_5634  Eur1_35923    Eur3_1868  Eur4_8634  Eur5_5634 
Eur1_34312  Eur1_34312 
Eur3_0000      Eur3_0000    Eur5_8235 
Eur3_3433      Eur3_3433 
Eur5_3354  Eur1_34 Eur2_245      Eur5_3354 
Eur3_1122      Eur3_1122  Eur4_4431 

Answer 2

Ich bin nicht wirklich sicher, warum Sie wollte Duplikate entfernen rufen, wenn Ihr Endziel das erste Element aus jeder Kategorie zu finden ist, die auf der Linie vorhanden ist, aber ich habe, dass für den Fall, rufen Sie in gehalten Du machst etwas, das hier nicht gezeigt wird. Der Code, den Sie in Ihrem ersten for-Schleife haben funktioniert, außer Sie $val statt {$val} und von der Problembeschreibung zuweisen möchten, können Sie das erste Spiel wollen, das heißt, dass Sie // (oder wenn in der alten Perl ||) verwenden möchten Sie geben $hash{$k} //= $val;

Dann würde Ihre zweite Schleife

foreach $S (@orderKeys) 
{ 
    if(defined $hash{$S}) 
    { 
     print "$S\t"; 
    } 
} 

werden (das wird nicht gedruckt, was Sie wollen, aber es ist die minimale Änderung, dass Code „Arbeit“ zu machen)

Wenn Sie etwas gereinigt Code wollen Das tut alles, was du beschreibst Bett in Ihrer Probe bitte sehen Sie sich das unten an.

use strict; 
use warnings; 

# List::Util also exports uniq, but the stock one usually doesn't so 
# you may still need to define it if you don't want to upgrade to the 
# newest version of the library for some reason. 
use List::Util qw(first uniq); 

my ($ipFilename, $orderFilename) = @ARGV; 

# The 3 argument open is preferred for safety and using a scalar 
# instead of a global bareword will help your sanity if you ever 
# want do put these things in subroutines. 
open(my $ip, '<', $ipFilename) or die "Unable to open $ipFilename for read: $!"; 
my @orderKeys = do { 
    open(my $order, '<', $orderFilename) or die "Unable to open $orderFilename for read: $!"; 
    <$order>; 
}; 
chomp(@orderKeys); 

# Tell perl to print array elements joined with tabs. 
local $" = "\t"; # comment to fix github formatting " 

print "Column1\t@orderKeys\n"; 

while (my $line = <$ip>) { 
    chomp($line); 
    my ($header, $matches) = split(/\s*\:\s*/, $line, 2); 
    my @matches = ($header, split(/\s*\|\s*/, $matches)); 
    # I don't use or need this, but if you need it for some other purpose, it can still be here 
    my @uniqueMatches = uniq @matches; 
    # Get the first item from each category that starts with the given key. 
    my @slots = map { my $key = $_; first { /^\Q$key\E/ } @matches } @orderKeys; 
    no warnings 'uninitialized'; 
    print "$header\t@slots\n"; 
} 

Answer 3

Ich bin mir nicht sicher, dass meine Aufnahme will Sie wollen. Wenn die ID der Spalte 1 mit einer der nachfolgenden IDs einer Zeile übereinstimmt, wird keine nachfolgende übereinstimmende ID aufgelistet.Stattdessen wird die ID col 1 verwendet (in ihrer jeweiligen Position).

Update: Die '++' nach dem gesehenen Hash hinzugefügt - ich habe es ursprünglich weggelassen.

#!/usr/bin/perl 
use strict; 
use warnings; 

my @order_keys = qw/ 
Eur1 
Eur2 
Eur3 
Eur4 
Eur5 
/; 

my $fmt = "%-15s" x 6 . "\n"; 
printf $fmt, '', @order_keys; 

while (<DATA>) { 
    my ($id, @data) = split /[:\|\s]+/; 
    my %seen; 
    my %tmp = map {@$_} 
       grep !$seen{$_->[0]}++, 
       map {[ /^([^_]+)/, $_ ]} ($id, @data); 

    printf $fmt, $id, map $_ // '', @tmp{@order_keys}; 
} 

__DATA__ 
Eur2_1116: Eur1_9816|Eur1_916|Eur3_16|Eur4_17|Eur5_716 
Eur3_2980: Eur1_8568|Eur2_98|Eur2_92|Eur4_12.3|Eur4_12.1|Eur4_12.9 
Eur4_786: Eur2_0909|Eur5_1090|Eur5_2535|Eur1_233 
Eur1_10616: 
Eur5_5634: Eur3_1868|Eur4_8634|Eur1_35923 
Eur1_34312: 
Eur3_0000: Eur5_8235 
Eur3_3433: 
Eur5_3354: Eur2_245|Eur2_245|Eur1_34 
Eur3_1122: Eur4_4431 

Ausgang:

   Eur1   Eur2   Eur3   Eur4   Eur5 
Eur2_1116  Eur1_9816  Eur2_1116  Eur3_16  Eur4_17  Eur5_716 
Eur3_2980  Eur1_8568  Eur2_98  Eur3_2980  Eur4_12.3 
Eur4_786  Eur1_233  Eur2_0909      Eur4_786  Eur5_1090 
Eur1_10616  Eur1_10616 
Eur5_5634  Eur1_35923     Eur3_1868  Eur4_8634  Eur5_5634 
Eur1_34312  Eur1_34312 
Eur3_0000         Eur3_0000      Eur5_8235 
Eur3_3433         Eur3_3433 
Eur5_3354  Eur1_34  Eur2_245          Eur5_3354 
Eur3_1122         Eur3_1122  Eur4_4431