Schrift
Start · Board · Anwendungen/Programme/Skripte in Perl · Allgemeines zu Perl
[thread]8154[/thread]

perlfaq4 - How do I compute the difference of: three arrays?

Leser: 1


<< >> 6 Einträge, 1 Seite
pktm
 2006-07-10 20:11
#68024 #68024
User since
2003-08-07
2921 Artikel
BenutzerIn
[Homepage]
user image
Hallo!

In der perlfaq4 ist ein schönes Kapitel über die Berechnung der Unterschiede zwischen 2 Arrays gegeben. Ich habe das mal für strict umgeformt:

Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
my @array1 = qw(mitteldeutschem mitteldeutsches mitteleuropaeisch mitteleuropaeische);
my @array2 = qw(mitteldeutschem mitteldeutsches);

my @union = ();
my @intersection = ();
my @difference = ();
my %count = ();

foreach my $element (@array1, @array2) { $count{$element}++ };

foreach my $element (keys %count) {
    push @union, $element;
    push @{ $count{$element} > 1 ? \@intersection : \@difference }, $element;
}


Jetzt habe ich aber 3 Arrays. Hat das schonmal jemand gemacht? Gibts dafür kleine Helferlein auf CPAN oder hat jemand einen Codeschnipsel dafür?

Grüße, pktm
http://www.intergastro-service.de (mein erstes CMS :) )
murphy
 2006-07-10 21:10
#68025 #68025
User since
2004-07-19
1776 Artikel
HausmeisterIn
[Homepage]
user image
Das müsste doch völlig analog zum Beispiel so funktionieren:
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

[...]
my @arrays = (\@array1, \@array2, [...]);

my @union;
my @intersection;
my @difference;

my %counts;

foreach my $array (@arrays) {
    $counts{$_}++ foreach (@$array);
}

foreach my $item (keys %counts) {
    push @union, $item;
    push @{ $counts{$item} == scalar(@arrays) ? \@intersection : \@difference }, $item;
}


(Code ist ungetestet)
When C++ is your hammer, every problem looks like your thumb.
Linuxer
 2006-07-10 21:12
#68026 #68026
User since
2006-01-27
3890 Artikel
HausmeisterIn

user image
Hi,

Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
#!/usr/bin/perl
use strict;
use warnings;

use vars qw( @a1 @a2 @a3 %cnt @help );

# diese arrays sollen verglichen werden
@a1 = qw/ abc def 123 456 /;
@a2 = qw/ abc 123 789 /;
@a3 = qw/ def ghi 123 000 /;


# hilfsarray, damit wir die arrays identifizieren koennen,
# ohne dass wir sym.ref. benutzen muessen
@help = (
    [ @a1 ],
    [ @a2 ],
    [ @a3 ],
);

# fuer jeden array
for my $hh ( 0 .. $#help ) {

    # fuer jedes element eines array
    for my $aa ( 0 .. $#{$help[$hh]} ) {
        # das vorkommen eines elements erzeugt einen key
        # und als value dient ein Array, in dem der Index aus
        # @help abgelegt, in dem der string gefunden wurde
        $cnt{$help[$hh]->[$aa]} = [] unless ( exists($cnt{$help[$hh]->[$aa]}) );
        push(@{$cnt{$help[$hh]->[$aa]}}, $hh);
    }

}

# fuer jeden key 
for ( keys %cnt ) {
    # gib aus, welches element in welchen arrays gefunden wurde
    print "'$_' found in: @{$cnt{$_}}", $/;
}

Ist allerdings nur eine spontane und schnell zusammengetippte Idee.
Inwiefern sie Sinn macht und/oder praktikabel ist, sei dahin gestellt.
meine Beiträge: I.d.R. alle Angaben ohne Gewähr und auf Linux abgestimmt!
Die Sprache heisst Perl, nicht PERL. - Bitte Crossposts als solche kenntlich machen!
topeg
 2006-07-10 23:23
#68027 #68027
User since
2006-07-10
2611 Artikel
BenutzerIn

user image
Eine etwas unortodoxe Lösung:
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
#!/usr/bin/perl
use strict;
use warnings;

my @a1 = qw{ abc def 123 456 };
my @a2 = qw{ abc 123 789 };
my @a3 = qw{ def ghi 123 000 };

my @zusammen=sort(@a1,@a2,@a3);

my @neu=();

my $alt="";
while(@zusammen>0)
{
  my $wert=shift(@zusammen);
  push(@neu,$wert)if($wert eq $zusammen[0] and $alt ne $wert);
  $alt=$wert;
}

print "#### VORGABE ####\n@a1\n@a2\n@a3\n";
print "#### ERGEBNIS ####\n@neu\n";
\n\n

<!--EDIT|topeg|1152560033-->
pktm
 2006-07-11 01:17
#68028 #68028
User since
2003-08-07
2921 Artikel
BenutzerIn
[Homepage]
user image
Ja cool! Danke!

Das von topeg scheint noch nicht so ganz zu funktionieren. Das Ergebnis ist 123 abc def, wobei abc nicht in allen Arrays vorkmmt.

Kann mir jemand erklären, was der Code aus der perlfaq4 denn macht?
So ganz blicke ich da leider noch nicht durch.

Grüße, pktm
http://www.intergastro-service.de (mein erstes CMS :) )
topeg
 2006-07-11 08:14
#68029 #68029
User since
2006-07-10
2611 Artikel
BenutzerIn

user image
Achso. Ich dachte es würde reichen, wenn ein Wert in zwei Arrays vorkommt. Wenn der Wert in allen dreien vorkommen soll muß der Code so aussehen:

Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
#!/usr/bin/perl
use strict;
use warnings;

my @a1 = qw{ abc def 123 456 };
my @a2 = qw{ abc 123 789 };
my @a3 = qw{ def ghi 123 000 };

my @zusammen=sort(@a1,@a2,@a3);

my @neu=();

my $alt="";
my $cnt=1;
while(@zusammen>0)
{
  my $wert=shift(@zusammen);
  if($alt eq $wert)
  { $cnt++ }
  else
  {
    push(@neu,$alt)if($cnt==3);
    $cnt=1;
  }
  $alt=$wert;
}

print "#### VORGABE ####\n@a1\n@a2\n@a3\n#### ERGEBNIS ####\n@neu\n";


Zu deinem Code.
Als erstes wird ein Hash mit den Einträgen aller Arrays als Schlüsselnamen erstellt, wenn er nicht existiert, und um 1 hochgezählt. Man bekommt allso ein Hash in dem die Werte der Arrays als Schlüssel enthalten sind und die Anzahl der Einträge über alle Arrays. Danach wird nurnoch gezählt wie häufig ein Wert vorkam und der Wert wird entweder in @intersection oder in @difference geschrieben.
Das ist Übrigens dein Beispiel mit drei Arrays:
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
my @array1 = qw(mitteldeutschem mitteldeutsches mitteleuropaeisch mitteleuropaeische);
my @array2 = qw(mitteldeutschem mitteldeutsches);

my @union = ();
my @intersection = ();
my @difference = ();
my %count = ();

foreach my $element (@array1, @array2, @array3) { $count{$element}++ };

foreach my $element (keys %count) {
   push @union, $element;
   push @{ $count{$element} > 2 ? \@intersection : \@difference }, $element;
}
<< >> 6 Einträge, 1 Seite



View all threads created 2006-07-10 20:11.