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 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64
#!/usr/bin/perl -w use strict; use warnings; my %uebergabe = ( data => { 1 => { 1 => 'aaron', 2 => 'suppe', 3 => 10, }, 2 => { 1 => 'aaron', 2 => 'zander', 3 => 20, }, 3 => { 1 => 'hannes', 2 => 'zander', 3 => 20, }, }, art => ['a','a','n'], # Art der Spalte a=Alpha oder n=Nummer sortierprio => [1,2,3], # Erst nach Spalte 1, dann nach 2, dann nach 3 sortierricht => [1,0,1], # Sortierrichtung 0=abwärts/rückwärts oder 1=aufwärts/vorwärts ); tabellenhandler(\%uebergabe); ############################################################################### sub tabellenhandler { my ($input) = @_; foreach my $zeile ( sort { for (my $sp_sort = 0; $sp_sort < scalar @{$input->{sortierprio}}; $sp_sort ++) { if ($input->{sortierricht}[$sp_sort]) { if ($input->{art}[$sp_sort] eq 'n') { $input->{data}{$a}{$input->{sortierprio{$sp_sort}}} <=> $input->{data}{$b}{$input->{sortierprio{$sp_sort}}} } else { $input->{data}{$a}{$input->{sortierprio{$sp_sort}}} cmp $input->{data}{$b}{$input->{sortierprio{$sp_sort}}} } } else { if ($input->{art}[$sp_sort] eq 'n') { $input->{data}{$b}{$input->{sortierprio{$sp_sort}}} <=> $input->{data}{$a}{$input->{sortierprio{$sp_sort}}} } else { $input->{data}{$b}{$input->{sortierprio{$sp_sort}}} cmp $input->{data}{$a}{$input->{sortierprio{$sp_sort}}} } } } } keys %{$input->{data}} ) { print "Zeile:"; foreach my $spalte ( keys %{$input->{data}{$zeile}} ) { print " - ".$input->{data}{$zeile}{$spalte}; } print "\n"; } }
QuoteUseless use of numeric comparison (<=>) in void context at sub_tabellenhandler.pl line 38.
Useless use of string comparison (cmp) in void context at sub_tabellenhandler.pl line 41.
Useless use of numeric comparison (<=>) in void context at sub_tabellenhandler.pl line 46.
Useless use of string comparison (cmp) in void context at sub_tabellenhandler.pl line 49.
Can't call method "sortierprio" without a package or object reference at sub_tabellenhandler.pl line 41.
1 2 3 4 5 6 7 8 9 10
use List::Util qw(min); sub arraycmp { my ($a, $b) = @_; for my $_ (0 .. min($#$a, $#$b)) { my $d = $a->[$_] <=> $b->[$_]; return $d unless $d == 0; } return 0; }
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 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
#!/usr/bin/perl -w use strict; use warnings; my %uebergabe = ( data => { 1 => { 1 => 'aaron', 2 => 'suppe', 3 => 10, }, 2 => { 1 => 'aaron', 2 => 'zander', 3 => 20, }, 3 => { 1 => 'hannes', 2 => 'zander', 3 => 20, }, }, art => ['a','a','n'], # Art der Spalte a=Alpha oder n=Nummer sortierprio => [3,2,1], # Nummer der Spalte in der Reihenfolge der Sortierung sortierricht => [1,1,1], # Sortierrichtung 0=abwärts/rückwärts oder 1=aufwärts/vorwärts ); tabellenhandler(\%uebergabe); ############################################################################### sub tabellenhandler { my ($input) = @_; foreach my $zeile ( sort { my $return = 0; my $spalte = -1; while (!$return && $spalte < scalar @{$input->{sortierprio}}) { $spalte ++; my $vergleich_spalte = $input->{sortierprio}[$spalte]; if ($input->{sortierricht}[$vergleich_spalte - 1]) { if ($input->{art}[$vergleich_spalte - 1] eq 'n') { $return = $input->{data}{$a}{$vergleich_spalte} <=> $input->{data}{$b}{$vergleich_spalte}; } else { $return = $input->{data}{$a}{$vergleich_spalte} cmp $input->{data}{$b}{$vergleich_spalte}; } } else { if ($input->{art}[$vergleich_spalte - 1] eq 'n') { $return = $input->{data}{$b}{$vergleich_spalte} <=> $input->{data}{$a}{$vergleich_spalte}; } else { $return = $input->{data}{$b}{$vergleich_spalte} cmp $input->{data}{$a}{$vergleich_spalte}; } } } $return; } keys %{$input->{data}} ) { print "Zeile:"; foreach my $spalte ( sort {$a <=> $b} keys %{$input->{data}{$zeile}} ) { print " - ".$input->{data}{$zeile}{$spalte}; } print "\n"; } }
2012-12-26T15:11:01 murphyDer Code sieht korrekt aus, wenn auch ein wenig umständlich und unübersichtlich.
2012-12-26T15:11:01 murphyIch finde zum Beispiel, dass Schleifen der Form for my $VAR (0 .. $BOUND) klarer lesbar sind als while-Schleifen mit manuellem Zählermanagement.
2012-12-26T15:11:01 murphyUnd eine Steuerung der Sortierrichtung könnte man beispielsweise elegant durch Multiplikation des Vergleichsergebnisses mit +1 oder -1 erreichen.
2012-12-26T15:11:01 murphyÜbrigens verstehe ich auch nicht ganz, warum die Daten in Hashes mit numerischen Schlüsseln abgelegt sind. Wären da nicht vielleicht Arrays sinnvoller?
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 40 41 42 43 44 45 46 47
use 5.012; use warnings; use constant { # Common collation sequences ALPHA => sub { my ($a, $b) = @_; $a cmp $b }, NUMERIC => sub { my ($a, $b) = @_; $a <=> $b }, # Sort orders ASC => +1, DSC => -1 }; # Multicolumn sort function. # Params: # $columns = Arrayref of sort column definitions in priority order. # Each column definition is a hashref with the keys # index => Column index in the data rows # collate => Binary subref defining collation order # order => ASC for ascending or DSC for descending order # $data = Arrayref of data rows # Returns: # Arrayref of sorted data rows sub multisort { my ($columns, $data) = @_; [sort { for my $column (@$columns) { my $d = $column->{order} * $column->{collate}->($a->[$column->{index}], $b->[$column->{index}]); return $d unless $d == 0; } } @$data]; } # Runnable example: my @data = ( ['aaron', 'zander', 20], ['hannes', 'zander', 20], ['aaron', 'suppe', 10], ); my @columns = ( {index => 2, collate => NUMERIC, order => ASC}, {index => 1, collate => ALPHA, order => ASC}, {index => 0, collate => ALPHA, order => ASC}, ); use Data::Dumper; print Dumper multisort(\@columns, \@data);
2012-12-26T16:59:39 murphySieht schlank aus. Danke für die Inspiration. Diese constant Geschichte könnte ich in einem anderen Bereich nochmal überdenken und bringt mich auf ganz neue Gedanken.Bei mir sähe es in etwa so aus:
2012-12-26T16:59:39 murphyWas genau passiert im Moment der Zuweisung von collate => zu NUMERIC?Code (perl): (dl )1 2 3 4 5my @columns = ( {index => 2, collate => NUMERIC, order => ASC}, {index => 1, collate => ALPHA, order => ASC}, {index => 0, collate => ALPHA, order => ASC}, );
{index => 2, collate => NUMERIC, order => ASC}
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 40 41 42 43 44 45 46 47 48 49 50 51
use 5.012; use warnings; my %collations = ( ALPHA => sub { my ($a, $b) = @_; $a cmp $b }, NUMERIC => sub { my ($a, $b) = @_; $a <=> $b }, ); my %orders = ( ASC => +1, DSC => -1 ); # Multicolumn sort function. # Params: # $columns = Arrayref of sort column definitions in priority order. # Each column definition is a hashref with the keys # index => Column index in the data rows # collate => Collation order # order => 'ASC' for ascending or 'DSC' for descending order # $data = Arrayref of data rows # Returns: # Arrayref of sorted data rows sub multisort { my ($columns, $data) = @_; [sort { for my $column (@$columns) { my $order = $orders{$column->{order}} or die 'illegal sort order ' . $column->{order}; my $collate = $collations{$column->{collate}} or die 'illegal collation sequence ' . $column->{collate}; my $index = $column->{index}; my $d = $order * $collate->($a->[$index], $b->[$index]); return $d unless $d == 0; } } @$data]; } # Runnable example: my @data = ( ['aaron', 'zander', 20], ['hannes', 'zander', 20], ['aaron', 'suppe', 10], ); my @columns = ( {index => 2, collate => 'NUMERIC', order => 'ASC'}, {index => 1, collate => 'ALPHA', order => 'ASC'}, {index => 0, collate => 'ALPHA', order => 'ASC'}, ); use Data::Dumper; print Dumper multisort(\@columns, \@data);
1 2 3 4 5 6
my $sub = 'sub { my ($a, $b) = @_; '; if ($type == NUMERIC) { $sub .= ' $a <=> $b '; } else ... $sub .= '}'; my $sortSub = eval $sub;