2 Dateien/Tabellen mergen/vergleichen (Allgemeines zu Perl)

[thread]17051[/thread]

2 Dateien/Tabellen mergen/vergleichen

Tags: perl5 Similar Threads

Readers: 19

Articles: hide open all | hide show old branches

+3 replies

Chibi

2012-01-07 23:04

User since
2012-01-07
1 article
BenutzerIn
[default_avatar]

Hallo, ich hab da mal ne Frage. Ich hab da schon einiges Probiert, bin aber nicht weitergekommen.

Fakten:
Ich habe 2 Tabellen die jeweils unterschiedliche sowie auch gleich Spaltenbezeichnungen haben und auch unterschiedlich lang sind. Desweiteren ist die 1. Spalte beider Tabellen eine ID. In beiden Tabellen gibt es gleiche und unterschiedliche IDs.

bsp.
Tabelle1/Datei1

Code: (dl )

 V1 V2 V3 V4 V5
ID1 aa nn zz ii  
ID2 ss rr oo ll
ID4 qq mm öö pp
ID5 nn vv bb xx
...
...

Tabelle2/Datei2

Code: (dl )

 V1 V2 V3 V4 V5 V6
ID1 aa nn zz ii 45 
ID3 ff xx yy tt 45
ID4 qq mm öö pp 45
ID6 uu kk nn ff 45
ID7 qq ww ee rr 45
...
...

Das Problem ist nun:
Nach einer bestimmten Tabelle sollen die IDs gemerged werden, so das dann von allen IDs in der einen Tabelle die Spalten herausgefiltert werden, die auch in der anderen anderen Tabelle vorhanden sind. Die einzelnen Zeilen sollen quasi aktualisiert werden. Hier werden ID1 und ID4 aus Tabelle 1 "aktualisiert".

Bsp. Ergebniss:

Code: (dl )

 V1 V2 V3 V4 V5 V6
ID1 aa nn zz ii 45 
ID2 ss rr oo ll
ID4 qq mm öö pp 45
ID5 nn vv bb xx
...
...

Zum Schluss müssten dann jeweiles die Zeilen angeben werden (komplett) die nicht mit gemerged wurden. Das heisst die nur in Tabelle 1 vorhanden waren und andersherum die nur in Tabelle 2 vorhanden waren. Vlt auch noch mir Zeilenanzahl,
z.B.

45 Zeilen wurden nicht gemerged in Tabelle 1:

Code: (dl )

1
2
3

ID2 ss rr oo ll
ID5 nn vv bb xx
...

30 Zeilen wurden nicht gemerged in Tabelle 2:

Code: (dl )

ID3 ff xx yy tt 45
ID6 uu kk nn ff 45
ID7 qq ww ee rr 45
...

Hat da einer ne Idee womit ich das am besten realisieren kann? Die Tabellen können übrigens einige tausend Zeilen lang sein.

modedit Editiert von pq: code-tags hinzugefügt
Last edited: 2012-01-08 00:22:02 +0100 (CET)

FIFO

2012-01-08 10:19

User since
2005-06-01
469 articles
BenutzerIn

user image

Für sowas gibt's doch Datenbanken :)

In Perl würde ich versuchen, das in eine Datenbank-artige Struktur zu packen, die mir auch später noch andere Operationen erlaubt. Das geht natürlich auch einfacher, aber es ist nicht immer gut, sich darauf zu verlassen, dass z.B. die Struktur der Dateien unveränderlich ist (Reihenfolge der Spalten, etc.).

Gruß FIFO

Code (perl): (dl )

use warnings;
use strict;

use Data::Dump qw(dump);

my %db;             # Datenbank
my $using = 'V1';   # Spalte fuer JOIN

# Daten einlesen, hier aus DATA-Segment

for my $table ('table1', 'table2') {
    my $id_col;
    while (my $line = <DATA>) {
        last if $line !~ /\S/;

        # Spaltennamen incl. Reihenfolge sichern, 
        # Spaltennummer der $using-Spalte ermitteln
        
        if (! exists $db{'col_names'}{$table}) {
            my @cols = split ' ', $line; 
            grep { $id_col = $_ if $cols[$_] eq $using } 0..$#cols;
            die "$table does not contain col '$using'\n" if ! defined $id_col;
            @{$db{'col_names'}{$table}} = @cols;
            next;
        }

        my @cols = split ' ', $line;
        my $id = $cols[$id_col];

        # Daten in Datenbanktabelle einlesen
        $db{$table}{$id} = {
            map { @{$db{'col_names'}{$table}}[$_] => $cols[$_] } 0..$#cols
        };
    }
}

# Spaltennamen fuer Differenz-Tabellen und Join-Tabelle erzeugen,
# Namen, die nur in table2 vorhanden sind, an join-Spaltennamen anhaengen

@{$db{'col_names'}{'not_in_table1'}} = @{$db{'col_names'}{'table2'}};
@{$db{'col_names'}{'not_in_table2'}} = @{$db{'col_names'}{'table1'}};
@{$db{'col_names'}{'table_join'}}    = @{$db{'col_names'}{'table1'}};


for my $col (@{$db{'col_names'}{'table2'}}) {
    if (! grep { $_ eq $col } @{$db{'col_names'}{'table_join'}}) {
        push @{$db{'col_names'}{'table_join'}}, $col;
        }
}

# Daten mergen, Datensaetze aus table2 ueberschreiben die aus table1

for my $id (keys %{$db{'table2'}}) {
    if (exists $db{'table1'}{$id}) {
        %{$db{'table_join'}{$id}} = %{$db{'table2'}{$id}};
        }
    else {
        %{$db{'not_in_table1'}{$id}} = %{$db{'table2'}{$id}};
    }
}

for my $id (keys %{$db{'table1'}}) {
    if (! exists $db{'table2'}{$id}) {
        %{$db{'not_in_table2'}{$id}} = %{$db{'table1'}{$id}};
        %{$db{'table_join'}{$id}} = %{$db{'table1'}{$id}};
    }
}

# Entkommentieren, um Datenstruktur anzusehen:
# dump(%db);

# Ausgabe

no warnings 'uninitialized';

for my $table ('table_join', 'not_in_table1', 'not_in_table2') {
    printf(
        "$table: %d Zeilen\n\n%s\n",
        scalar(keys %{$db{$table}}),
        join("\t", @{$db{'col_names'}{$table}})
    );

    for my $row (sort keys %{$db{$table}}) {
        printf(
            "%s\n",
            join("\t",
                map { $db{$table}{$row}{$_} } @{$db{'col_names'}{$table}}
            )
        );
    }
    print "\n";
}

__DATA__
 V1 V2 V3 V4 V5
ID1 aa nn zz ii
ID2 ss rr oo ll
ID4 qq mm öö pp
ID5 nn vv bb xx

 V1 V2 V3 V4 V5 V6
ID1 aa nn zz ii 45
ID3 ff xx yy tt 45
ID4 qq mm öö pp 45
ID6 uu kk nn ff 45
ID7 qq ww ee rr 45

Ausgabe:

Code: (dl )

table_join: 4 Zeilen

V1	V2	V3	V4	V5	V6
ID1	aa	nn	zz	ii	45
ID2	ss	rr	oo	ll	
ID4	qq	mm	öö	pp	45	
ID5	nn	vv	bb	xx	

not_in_table1: 3 Zeilen

V1	V2	V3	V4	V5	V6
ID3	ff	xx	yy	tt	45
ID6	uu	kk	nn	ff	45
ID7	qq	ww	ee	rr	45

not_in_table2: 2 Zeilen

V1	V2	V3	V4	V5
ID2	ss	rr	oo	ll
ID5	nn	vv	bb	xx

Editiert von FIFO: Rohdaten korrigiert, Typo
Last edited: 2012-01-09 12:57:36 +0100 (CET)

Everyone knows that debugging is twice as hard as writing a program in the first place. So if you're as clever as you can be when you write it, how will you ever debug it? -- Brian Kernighan: "The Elements of Programming Style"

rosti

2012-01-08 12:22

User since
2011-03-19
3802 articles
BenutzerIn

Hi,
das Mergen geht am Besten über einen Hash. Untenstehend ein bischen Code dazu:

Code (perl): (dl )

#!/usr/bin/perl

use strict;
use warnings;
use IO::File;
use Data::Dumper;

# Tabellen auf hash lesen: t1.txt, t2.txt
my $tab1 = tabContent('t1.txt');
my $tab2 = tabContent('t2.txt');

# mergen
my %result = (%{$tab1}, %{$tab2}); # Keys in {1} kriegen Update von {2] 
print Dumper \%result;


sub tabContent{
        my $file = shift;
        my $fh = IO::File->new;
        $fh->open($file, "r") or die $!;
        my $r = {}; # hashref return

        # erste Zeile mit den Überschriften einlesen
        my $headline = <$fh>; # weg damit
        # lese den Rest
        while(my $line = <$fh>){
                my $namedef = Names->new(
                        {0 => 'V1', 1 => 'V2', 2 => 'V3', 3 => 'V4', 4 => 'V5', 5 => 'V6'},
                        [split /\s+/, $line]
                );
                $r->{$namedef->{V1}} = $namedef;
        }
        $fh->close;
        return $r;
}

# ein kleines Helferlein
package Names;

###########################################################################
# Rolf Rost, 14.2.2011
# Anonyme Array-Elemente bekommen Namen
###########################################################################
use strict;

# Setzt ein Array in ein Objekt um
sub new{
        my $class = shift;
        my $maps  = shift; # {3 => 'Day', 4 => 'Month', 5 => 'Year'}
        my $aref  = shift; # p.e. from localtime, stat, etc.
        return if ref $maps ne 'HASH';
        return if ref $aref ne 'ARRAY';
        my $self  = {};
    for(my $i = 0; $i < scalar(@$aref); $i++){
       $self->{$maps->{$i}} = $aref->[$i] if exists $maps->{$i};
    }
    
    return bless $self, $class;
}
1; ########################################################################

Last edited: 2012-01-08 12:24:24 +0100 (CET)

https://www.rolfrost.de/

Forum zu Fragen unserer Zeit

View all threads created 2012-01-07 23:04.