Arrays mit Paaren vergleichen (Allgemeines zu Perl)

[thread]15449[/thread]

Arrays mit Paaren vergleichen

Leser: 24

Articles: hide open all | hide show old branches

+7 replies

pktm

2010-09-09 23:29

User since
2003-08-07
2921 Artikel
BenutzerIn

Liebe Alle!

Ich habe hier zwei Arrays, die jeweils Paare aus Zahlen beinhalten.
Das eine Array kommt aus einer Datenbank, das andere aus einer Nutzereingabe.

Jetzt will
a) ich all die Paare, die der Nutzer angegeben hat und die noch nicht in der DB waren, in die DB einfügen und
b) alle Paare, die der Nutzer nicht angegeben hat, aus der DB löschen.

Dafür muss ich die beiden Arrays vergleichen. Im Moment macht das bei mir untenstehender Code.

Geht das auch besser / einfacher?

Code (perl): (dl )

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper qw/Dumper/;

my @pairs_in_db = ([1,2],[1,9],[3,4],[5,6]);
my @pairs_from_somewhere_else = ([1,2],[5,6],[7,18]);

my %map = ();
foreach my $pair ( @pairs_in_db ) {
        $map{$pair->[0]}->{$pair->[1]} = 1;
}

my %keep = ();
foreach my $pair ( @pairs_from_somewhere_else ) {
        if( exists $map{$pair->[0]} && exists $map{$pair->[0]}->{$pair->[1]} ) {
                printf("<%s, %s> was in db\n", @{$pair});
                $keep{$pair->[0]}->{$pair->[1]} = 1;
        }else{
                printf("<%s, %s> has to be inserted into the databse\n", @{$pair});
        }
}

foreach my $pair ( @pairs_in_db ) {
        unless( exists $keep{$pair->[0]} && exists $keep{$pair->[0]}->{$pair->[1]} ) {
                printf("<%s, %s> will be removed\n", @{$pair});
        }
}

http://www.intergastro-service.de (mein erstes CMS :) )

topeg

2010-09-10 00:07

User since
2006-07-10
2611 Artikel
BenutzerIn

user image

Ein verschachtelter Hash ist nicht nötig:

Code (perl): (dl )

#!/usr/bin/perl

use strict;
use warnings;

my @pairs_in_db = ([1,2],[1,9],[3,4],[5,6]);
my @pairs_from_somewhere_else = ([1,2],[5,6],[7,18]);

#prepare map
my %map;
# set original and a counter
$map{join(',',@$_)}=[$_,0] for(@pairs_in_db);

for(@pairs_from_somewhere_else)
{
  my $str=join(',',@$_);
  if(exists($map{$str}))
  {
    $map{$str}->[1]++;
    printf("<%02u, %02u> was in db\n", @{$map{$str}->[0]});
  }
  else
  {
    printf("<%02u, %02u> has to be inserted into the databse\n", @$_);
  }
}

for(values(%map))
{
  unless($_->[1])
  {
    printf("<%02u, %02u> will be removed\n", @{$_->[0]});
  }
}

+5 replies
Gast JaUnd

2010-09-10 02:53
2010-09-09T21:29:25 pktm
Jetzt will
a) ich all die Paare, die der Nutzer angegeben hat und die noch nicht in der DB waren, in die DB einfügen und
b) alle Paare, die der Nutzer nicht angegeben hat, aus der DB löschen.

hä? Heißt dass nicht alle alten Paare löschen und alle neuen Paare einfügen???

hier mit höherem Zeitaufwand und weniger code:
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

#!/usr/bin/perl use strict; use warnings; use Data::Dumper qw/Dumper/; my @pairs_in_db = ([1,2],[1,9],[3,4],[5,6]); my @pairs_from_somewhere_else = ([1,2],[5,6],[7,18]); my @pairs_to_delete=@pairs_in_db; my @pairs_to_create; NEW: for my $new (@pairs_from_somewhere_else) { for my $old (@pairs_to_delete) { if (defined($old) and "@$new" eq "@$old" ) { $old=undef; next NEW; } } push @pairs_to_create,$new; } print Dumper \@pairs_to_create,\@pairs_to_delete;
Mengenoperationen wie du sie bräuchtest konnte ich in List::MoreUtils leider nicht entdecken, gibts dafür ein Core Modul?
Last edited: 2010-09-10 04:51:23 +0200 (CEST)
- +3 replies
- vstm
  
  2010-09-10 08:44
  User since
  2010-08-17
  4 Artikel
  BenutzerIn
  Ja, mit Mengenoperationen könnte man das ziemlich schön formulieren. Habe nach kurzem Googlen keine vorhandene Lib gefunden, aber man kann die Funktionalität relativ einfach nachbauen (array_diff und array_union unterscheiden sich nur minimal bei der grep-Bedingung):
  
  Code (perl): (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
  
  #!/usr/bin/perl use strict; use warnings; sub pair_hash { return $_[0][0] . ',' . $_[0][1]; } sub array_union { my ($a, $b) = @_; my %bhash = map { &pair_hash($_) => 1 } @{$b}; return grep { defined $bhash{ &pair_hash($_) } } @{$a}; } sub array_diff { my ($a, $b) = @_; my %bhash = map { &pair_hash($_) => 1 } @{$b}; return grep { !defined $bhash{ &pair_hash($_) } } @{$a}; } my @pairs_in_db = ([1,2],[1,9],[3,4],[5,6]); my @pairs_from_somewhere_else = ([1,2],[5,6],[7,18]); my @was_in_db = &array_union(\@pairs_in_db, \@pairs_from_somewhere_else); my @pairs_to_delete = &array_diff(\@pairs_in_db, \@pairs_from_somewhere_else); my @pairs_to_create = &array_diff(\@pairs_from_somewhere_else, \@pairs_in_db); foreach my $ext (@was_in_db) { printf("<%s, %s> was in db\n", @{$ext}); } foreach my $ins (@pairs_to_create) { printf("<%s, %s> has to be inserted into the databse\n", @{$ins}); } foreach my $del (@pairs_to_delete) { printf "<%s, %s> will be removed\n", @{$del}; }
  
  Gruss Stefan
  Last edited: 2010-09-10 08:45:11 +0200 (CEST)
  - pktm
    
    2010-09-10 11:54
    
    User since
    2003-08-07
    2921 Artikel
    BenutzerIn
    
    2010-09-10T06:44:02 vstm
    Ja, mit Mengenoperationen könnte man das ziemlich schön formulieren. Habe nach kurzem Googlen keine vorhandene Lib gefunden, [...]
    
    Set::Array kann das, wenn ich mich recht entsinne.
    Mal sehen, was ich nehmen werde, hab ja die große Auswahl hier :)
    http://www.intergastro-service.de (mein erstes CMS :) )
  - Gast JaUnd
    
    2010-09-10 13:37
    was du "union" nennst sollte besser "intersection" heißen :)
    
    es zeigt sich auch dass es in diesem Fall nicht so trivial ist weil man eine Vergleichsfunktion braucht, um Arrayrefs zu vergleichen. M.a.W. entscheiden ob ein Arrayref ein Element oder eine Untermenge ist.
    
    Auch der Vergleich von Mengen ist nicht trivial, meine Lösung
    
    Code: (dl )
    
    "@$a" eq "@$b"
    
    könnte bei refs als Elementen nicht funktionieren.
    
    Was verwirrt ist das Perl bei Klammerung wohl ein Listassign kennt also
    
    Code: (dl )
    
    ($a,$b)=($b,$a)
    
    aber kein Listcompare
    
    Code: (dl )
    
    (@a)==(@b)
    
    . (die Längen werden verglichen)
    
    Dafür gibts jetzt smartmatch, das aber rekursiv in die Tiefe geht:
    
    Code: (dl )
    
    1 2
    
    perl -E'@a=(1,[]);@b=(1,[]);print @a~~@b' 1
    
    Last edited: 2010-09-10 13:43:19 +0200 (CEST)
- pktm
  
  2010-09-10 11:50
  
  User since
  2003-08-07
  2921 Artikel
  BenutzerIn
  
  Im Prinzip heißt das in der Tat einfach alles alte löschen und alles neue einfügen. Aber da hängen größere Statements hinten dran, weswegen ich gerne die Anzahl der Abfragen gering halten möchte. Das soll die DB schön selber machen :)
  http://www.intergastro-service.de (mein erstes CMS :) )

View all threads created 2010-09-09 23:29.