Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Generate Dynamic Sort Expressions

by lofichurch (Beadle)
on Nov 27, 2002 at 18:48 UTC ( [id://216152]=CUFP: print w/replies, xml ) Need Help??

Well, it got to be that for a web interface, I needed to generate tons of tables, where the user could re-sort lists based on values they click on, and that the values stack up (but other configuration options could cause them to change the order, reverse, etc.). Rather than deal with static (or poorly dynamic) sort routines, here's to constructing expressions for sort() on-the-fly.

The data retrieved from the DB is stored in a 2-d hash with each top-level key being the record #, and having keys that represent 'columns' of data below each of those. So, with that in mind -- here's the (simple) solution to doing dynamic sorts on column-based data. A sub that accepts the columns to sort by, in order, as an arrayref, and then constructs the expression for sort, then executes it for you.

sub is_num_col { # do something to look up whether or not # a given column is numeric or # alphabetic. I use a hash for lookup, # e.g.: return($hash{"$_[0]"}); # # should return 1 if the column is # numeric, 0 otherwise. } sub sort_hash { # this sub creates a sort expression on-the-fly # given an array reference containing the keys # (column names) to sort a 2-d hash by. The 2-d # hash should be provided by reference as the second # argument to the sub. # # The 2-d hash model is used in that the first # dimension referrs to a record (or row), and the second # dimension to the columns within that record. # # An array reference is returned, where each element # is a key from hashref, in the order returned from the sort # # If you wish to reverse the sort order (descending) for # a column/key, simply add 'r-' to the column name. # # example: # # my $aRef = sort_hash(['id','r-name','type'],\%hash); # # Where it will first sort the hash by the id key, then # (descending) by the name key, and then by the type key. my $aRef = shift; my $hRef = shift; die("[sort_hash] Not enough Arguments!\n") if(!defined($aRef) || !def +ined($hRef)); die("[sort_hash] Incorrect Arguments!\n") if(ref($aRef) ne 'ARRAY' || + ref($hRef) ne 'HASH'); my @tests; foreach my $column (@{ $aRef }) { next if(!defined($column)); my $rev = 0; if($column =~ /^r-(.*)$/) { $rev = 1; $column = $1; } if( is_num_col($column) ) { # if this is a numeric column... if($rev == 1) { # descending push(@tests,"\$hRef->{\"\$b\"}{'$column'} <=> \$hRef->{\"\ +$a\"}{'$column'}"); } else { #ascending push(@tests,"\$hRef->{\"\$a\"}{'$column'} <=> \$hRef-> +{\"\$b\"}{'$column'}"); } } else { # if this is an alphabetic column... if($rev == 1) { # descending push(@tests,"\$hRef->{\"\$b\"}{'$column'} cmp \$hRef-> +{\"\$a\"}{'$column'}"); } else { #ascending push(@tests,"\$hRef->{\"\$a\"}{'$column'} cmp \$hR +ef->{\"\$b\"}{'$column'}"); } } } #end foreach # now, create our actual expression via join... my $sort_expr = join(' || ',@tests); # we create an anonymous subref, as doing an eval inside of # the sort's BLOCK can occaisonally cause problems, especially # nested way down in some module. my $SortSub = sub { return(eval $sort_expr); }; my @sorted = sort { &$SortSub } keys(%{ $hRef }); return(\@sorted); }

Replies are listed 'Best First'.
•Re: Generate Dynamic Sort Expressions
by merlyn (Sage) on Nov 28, 2002 at 00:49 UTC
    Ouch. That's doing it the hard way. You're gonna eval on every sort invocation!

    Better to do something like:

    my $SortSub = eval "sub { return $sort_expr; }";
    I didn't look at the rest of your code for possible eval hitches, though.

    -- Randal L. Schwartz, Perl hacker
    Be sure to read my standard disclaimer if this is a reply.

Re: Generate Dynamic Sort Expressions
by Aristotle (Chancellor) on Nov 28, 2002 at 14:49 UTC
    Hardly any eval STRING necessary. You can do entirely without, but it's not practical.
    use Carp; use vars qw(%data); my %comparison; sub init_comparison_for { local $_ = shift; my $op = /^string/ ? 'cmp' : /^num/ ? '<=> : croak "unknown comparison type $_"; @comparison{@_} = map { eval "sub { \$data{\$a}{$_} $op \$data{\$b}{$_} }" } @_; @comparison{map "r-$_", @_} = map { eval "sub { \$data{\$b}{$_} $op \$data{\$a}{$_} }" } @_; } sub sortedkeys (\%@) { my $hash; unless( ($hash = shift) and ('HASH' eq ref $hash) ) { croak "not a hashref: $hash"; } local *data = shift; my @funcs = @comparison{@_}; if(my @unknown = grep !defined $func[$_], 0 .. $#_) { croak "unknown field name(s): @unknown"; } sort { my $r = 0; ($r ||= &$_) && last for @funcs; $r } keys %data; }
    Use as in
    init_comparison_for string => qw(fname lname email address position); init_comparison_for numeric => qw(id salary zip); print $employee{$_}->{fname}, " ", $employee{$_}->{lname} for sortedkeys %employee, qw(r-salary id);
    This should be improved by taking and returning a hashref in the initialization so there can be multiple different comparison function tables. It might be worthing turning this into an object. You can get even fancier with a tied interface to override the keys behaviour.. the possibilities are endless. (I'm surprised noone has written a module for that yet.)

    Makeshifts last the longest.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://216152]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others admiring the Monastery: (6)
As of 2024-03-29 13:46 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found