Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Complex Sort - using varying numbers of parameters

by George_Sherston (Vicar)
on Jul 04, 2002 at 12:08 UTC ( #179436=perlquestion: print w/replies, xml ) Need Help??
George_Sherston has asked for the wisdom of the Perl Monks concerning the following question:

I have an array of hashes, @Tree. One of the elements in each hash, Path is itself an array of digits. For each element in @Tree, $_->{Path} can have from one to five (at present - could be even more) elements. And I need to sort @Tree so that it's sorted first by $_->{Path}->[0], then by $_->{Path}->[1] and so on.

In case that doesn't make any sense, I've done
for my $h (@Tree) { print "$_ " for @{$h->{Path}}; print "\n"; }
... for before and after, to show what I'm trying to achieve:


BEFORE
5 32 37 5 32 38 5 32 39 3 12 11 19 20 3 12 11 21 3 12 22 3 12 23 5 32 40 3 12 24 5 32 41 3 25 5 32 42 2 26 5 32 43 2 26 27 2 26 28 2 26 29 0 1 1 2 1 3 3 12 10 1 4 3 12 11 1 5 3 12 2 6 3 12 13 3 12 7 3 12 11 19 14 3 12 8 2 26 30 3 12 11 19 15 3 12 9 5 32 31 3 12 11 19 16 5 32 3 12 11 19 17 5 32 33 3 12 11 19 18 5 32 34 3 12 11 19 5 32 35 5 32 36
AFTER:
0 1 2 1 3 1 4 1 5 2 6 2 26 2 26 27 2 26 28 2 26 29 2 26 30 3 12 3 12 7 3 12 8 3 12 9 3 12 10 3 12 11 3 12 11 19 3 12 11 19 14 3 12 11 19 15 3 12 11 19 16 3 12 11 19 17 3 12 11 19 18 3 12 11 19 20 3 12 11 21 3 12 13 3 12 22 3 12 23 3 12 24 3 25 5 32 5 32 31 5 32 33 5 32 34 5 32 35 5 32 36 5 32 37 5 32 38 5 32 39 5 32 40 5 32 41 5 32 42 5 32 43
I've tried lots of different variations on
for (5..0) { @Tree = sort { $a->{Path}->[$_] <=> $b->{Path}->[$_] } @Tree; }
... none of which worked. In the end I gave up in disgust and did
for my $page (@Tree) { my $Sort = 0; my $M = 100; for (@{$page->{Path}}) { $Sort += $M * $_; $M = $M / 100; } $page->{Sort} = $Sort; } @Tree = sort {$a->{Sort} <=> $b->{Sort}} @Tree;
... which works, but is UGLY and probably slow and fattening. I'd really love to see a more elegant solution, if some monk can suggest one. Now, I got this result with the following rather clunky method:

§ George Sherston

2002-07-06 Edit by Corion: Added readmore tag

Replies are listed 'Best First'.
Re: Complex Sort - using varying numbers of parameters
by Abigail-II (Bishop) on Jul 04, 2002 at 13:17 UTC
    Use a Guttman-Rosler Transform:
    #!/usr/bin/perl use strict; use warnings 'all'; print "@$_\n" foreach map {[unpack 'N*', $_]} sort map { pack 'N*', @$_} map {[/\d+/g]} <DATA>; __DATA__ 5 32 37 5 32 38 5 32 39 3 12 11 19 20 3 12 11 21 3 12 22 3 12 23 5 32 40 3 12 24 5 32 41 3 25 5 32 42 2 26 5 32 43 2 26 27 2 26 28 2 26 29 0 1 1 2 1 3 3 12 10 1 4 3 12 11 1 5 3 12 2 6 3 12 13 3 12 7 3 12 11 19 14 3 12 8 2 26 30 3 12 11 19 15 3 12 9 5 32 31 3 12 11 19 16 5 32 3 12 11 19 17 5 32 33 3 12 11 19 18 5 32 34 3 12 11 19 5 32 35 5 32 36

    Abigail

Re: Complex Sort - using varying numbers of parameters
by RMGir (Prior) on Jul 04, 2002 at 12:38 UTC
    It's mildly ugly, but in fact it's not really slow or all that fattening :)

    The only problem with it is that you're going to be carrying the Sort key after you no longer need it.

    ST to the rescue!

    sub computeSortKey { my $aref=shift; my $sort; my $M = 100; for (@{$aref}) { $sort += $M * $_; $M = $M / 100; } return $sort; } #Schwartzian Transform @Tree = map {$_->[0]} sort {$a->[1] <=> $b->[1]} map {[ $_, computeSortKey($_->{Path})]} @Tree;
    Note that I don't have perl on this PC, so I can't double check the code for syntax errors, but I think that'll work for you.

    The advantages of doing it this way are that
    1) it's a well known idiom, so a lot of perl programmers will grok right away what you're trying to do, and
    2) you don't keep the sort key around after you no longer need it, so it keeps @Tree relatively clean.
    --
    Mike

Re: Complex Sort - using varying numbers of parameters
by ariels (Curate) on Jul 04, 2002 at 12:52 UTC
    Beyond using the Schwartzian transform, you can use the magic of pack to create your sort keys! Keys N, n and C can all work, if your IDs are nonnegative and small enough (0xFFFFFFFF for the first [which will anyway put you in trouble when you try to manipulate them, or 0xFFFF for the second, or a measly 0xFF for the third).

    sub make_key { my $x = shift; pack 'N*', @{$x->{Path}}; }
    is enough to create keys; you compare these keys with cmp, so you don't need to pass a coderef to sort (yay!).
•Re: Complex Sort - using varying numbers of parameters
by merlyn (Sage) on Jul 04, 2002 at 14:54 UTC
    I saw a few GRTs, and a few awkward Schwartzian Transforms, so I thought I'd throw my own in:
    my @sorted = map $_->[0], sort { for (1..1000) { return @$a <=> @$b if $_ > $#$a or $_ > $#$b; $_ and return $_ for $a->[$_] <=> $b->[$_]; } } map [$_, split /\s+/], @inputdata;
    Presumes less than 1000 sort fields. Probably reasonable.

    -- Randal L. Schwartz, Perl hacker


    updated to reflect a few missing dollar signs and a brain confusion in a pre-caffiene state. {sigh}
      Next time, test your code. It doesn't even want to compile with 'use strict', and produces rubbish otherwise. Here's a tested version:
      my @sorted = map $_->[0], sort { for (1..1000) { return @$a <=> @$b if $_ > $#$a or $_ > $#$b; $_ and return $_ for $a->[$_] <=> $b->[$_]; } } map [$_, split /\s+/], @inputdata;
      BTW, what's a GSR?

      Abigail

Re: Complex Sort - using varying numbers of parameters
by amphiplex (Monk) on Jul 04, 2002 at 12:33 UTC
    Hi !

    This script should do what you want, specifically my_sort(), the rest is just to get a test environment.
    use strict; sub my_sort { my $max_index = $#{@{$a->{Path}}} > $#{@{$b->{Path}}} ? $#{@{$a->{P +ath}}} : $#{@{$b->{Path}}}; for (0..$max_index) { my $r = $a->{Path}->[$_] <=> $b->{Path}->[$_]; return $r if $r; } return 0; } sub print_tree { my $tree = shift; for my $member (@$tree) { print join (' ', @{$member->{Path}})."\n"; } } my $input = <<EOF; 5 32 37 5 32 38 5 32 39 3 12 11 19 20 3 12 11 21 3 12 22 3 12 23 5 32 40 3 12 24 5 32 41 3 25 5 32 42 2 26 5 32 43 2 26 27 2 26 28 2 26 29 0 1 1 2 1 3 3 12 10 1 4 3 12 11 1 5 3 12 2 6 3 12 13 3 12 7 3 12 11 19 14 3 12 8 2 26 30 3 12 11 19 15 3 12 9 5 32 31 3 12 11 19 16 5 32 3 12 11 19 17 5 32 33 3 12 11 19 18 5 32 34 3 12 11 19 5 32 35 5 32 36 EOF # # prepare array of hashes # my @Tree; for (split "\n", $input) { my @a = split (' ', $_); push @Tree, {Path=>\@a}; } print "ORIGINAL:\n"; print_tree(\@Tree); my @Tree_sorted = sort my_sort @Tree; print "SORTED:\n"; print_tree(\@Tree_sorted);
    ---- kurt
      The problem with doing it this way is that you're going to be running "my_sort" many many times, introducing a lot of overhead.

      That's what the Schwartzian Transform, GRT, or Orcish Maneuvre save you from; they only compute each key once.

      George_Sherston's original solution also avoided recomputing keys unnecessarily, by storing them in ->{Sort} beforehand.
      --
      Mike

Re: Complex Sort - using varying numbers of parameters
by Courage (Parson) on Jul 04, 2002 at 12:40 UTC
    Following code seems to work for me:
    my @arr = map {[split /\s+/]} <DATA>; sub criteria { my $r = 0; $r ||= (($a->[$_]||0) <=> ($b->[$_]||0)) for 0..5; $r; } @arr = sort {criteria} @arr; print join "\n", map {join " ", @$_} @arr; __DATA__
    This could be optimized to return from 0..5 loop earlier, and sub could be inlined, but let's do this another time.

    Courage, the Cowardly Dog

Re: Complex Sort - using varying numbers of parameters
by fruiture (Curate) on Jul 04, 2002 at 12:42 UTC
    @Tree = sort { my $la = @{ $a->{Path} }; #length of left side my $lb = @{ $b->{Path} }; # ~ of right side my $r; # r = return for( 0 .. ($la > $lb ? $lb : $la) ){ $r = $a->{Path}[$_] <=> $b->{Path}[$_] and return $r #return if not 0 } $r #return last comparison } @Tree; # HTH
    It should be for( 0 .. ($la>$lb?$lb:$la)-1 ) of course

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://179436]
Approved by dwiz
Front-paged by broquaint
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (2)
As of 2019-04-24 03:53 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    I am most likely to install a new module from CPAN if:
















    Results (121 votes). Check out past polls.

    Notices?