entfernen Redundanz in einem Perl-Hash

Question

Ich habe eine Datei, die so aussieht.

a_8_3_1-b_30_5_6-c_6_2_1- + b_30_5_6- 
a_123_1_1- + d_144_1_7- 
a_123_1_1- + c_1_4_1- 
b_50_1_1- + d_144_1_7- 
a_123_1_1- + c_2_1_2- 
c_1_4_1- + a_123_1_1- 
a_123_1_1- + a_93_1_2- 
d_144_1_7- + a_123_1_1- 
c_2_1_2- + a_123_1_1- 
a_123_1_1- + c_2_1_2- 

Es hat 2 Spalten, die durch ein '+' Zeichen getrennt sind. Ich muss die Anzahl der eindeutigen Kombinationen zählen, die in dieser Datei vorhanden sind.

Wie man sieht, wird eine Kombination gebildet, sagen wir zwischen a_123_1_1- UND c_2_1_2- und auch zwischen c_2_1_2- + a_123_1_1-. Jetzt muss ich das Nein zählen. von Vorkommen solcher Paare in einer solchen Datei, wo ich weiß, dass diese Kombination (unabhängig von ihrer relativen Reihenfolge) 3 mal vorkommt.

Ähnlich ist der Fall mit a_123_1_1- UND d_144_1_7-. Sie treten in zwei Kombinationen auf. Jede Kombination wird einmal angezeigt. Daher ist die kumulative Zählung von diesem = 2

Ich habe ab jetzt versucht, alle diese Zeilen in einem Hash (d. H. Jede Zeile ist ein Schlüssel und sein Vorkommen wird der entsprechende Wert sein) und Drucken der Nr. von Vorkommen mit Kartenfunktion in PERL.

Aber wie kann ich eine solche Redundanz einbeziehen und dieses Problem der Ordnung zwischen einzelnen Elementen lösen?

Bitte helfen.

Answer 1

Wie immer, wenn mit Perl zu tun Es gibt mehr als einen Weg, um es zu tun, aber man kann:

1. Split jede Zeile, so dass es eine @pair von zwei Einträgen
2. Art ergeben Ihre @pair, so dass ein einzigartiges Paar führt immer in der gleichen Reihenfolge
3. concat der sortierten @pair, so dass Sie eine Zeichenfolge
4. Speicher Zeichenfolge in einem% hash und Vorkommen zählen erhalten

---

Wie im folgende Beispiel:

use warnings; 
use strict; 

use Data::Dumper; 

my %count; 

for (<DATA>) { chomp; 
    my $str_pair = join ':', sort split/\+ /; 
    $count{$str_pair}++; 
} 

print STDERR Dumper \%count; 

__DATA__ 
a_8_3_1-b_30_5_6-c_6_2_1- + b_30_5_6- 
a_123_1_1- + d_144_1_7- 
a_123_1_1- + c_1_4_1- 
b_50_1_1- + d_144_1_7- 
a_123_1_1- + c_2_1_2- 
c_1_4_1- + a_123_1_1- 
a_123_1_1- + a_93_1_2- 
d_144_1_7- + a_123_1_1- 
c_2_1_2- + a_123_1_1- 
a_123_1_1- + c_2_1_2- 

Ausgang

$VAR1 = { 
      'a_8_3_1-b_30_5_6-c_6_2_1-:b_30_5_6-' => 1, 
      'a_123_1_1-:c_2_1_2-' => 3, 
      'a_123_1_1-:c_1_4_1-' => 2, 
      'a_123_1_1-:a_93_1_2-' => 1, 
      'b_50_1_1-:d_144_1_7-' => 1, 
      'a_123_1_1-:d_144_1_7-' => 2 
     }; 

Answer 2

my %terms; 
while (<>) { 
    next unless my @parts = split /\s*\+\s*/; 
    $terms{$_}++ foreach @parts; 
} 

say +(keys %terms) . ' unique terms.'; 

Answer 3

Thisis ein einzeiliges Programm die Daten, die Sie

perl -naF"/[\s+]+/" -e "$p{join ' ', sort @F}++; END{print 0+keys %p, qq(unique pairs\n)}" myfile 

beschreiben zu verarbeiten

Mit den Daten in Ihrer Frage, diese gibt

6 unique pairs 

Wenn Sie etwas mehr erarbeiten benötigen, müssen Sie ein volles Programm zurückzukehren. Dies entspricht dem obigen Code

use strict; 
use warnings; 

my %pairs; 

while (<>) { 
    my $key = join ' ', sort split /[\s+]+/; 
    $pairs{$key}++; 
} 

printf "%d unique pairs\n", scalar keys %pairs;