Complex Sort - using varying numbers of parameters

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";
    }
[download]

... 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
[download]

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
[download]

I've tried lots of different variations on

    for (5..0) {
        @Tree = sort {
        $a->{Path}->[$_] <=> $b->{Path}->[$_]
    } @Tree;
    }
[download]

... 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;
[download]

... 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

Comment on Complex Sort - using varying numbers of parameters Select or Download Code

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` [download] Abigail	[reply] [d/l]
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;` [download] 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	[reply] [d/l]
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}}; }` [download] is enough to create keys; you compare these keys with cmp, so you don't need to pass a coderef to sort (yay!).	[reply] [d/l] [select]
•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;` [download] 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}	[reply] [d/l]
Re: Complex Sort - using varying numbers of parameters by Abigail-II (Bishop) on Jul 04, 2002 at 15:04 UTC
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;` [download] BTW, what's a GSR? Abigail	[reply] [d/l]
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); [download] ---- kurt	[reply] [d/l]
Re: Re: Complex Sort - using varying numbers of parameters by RMGir (Prior) on Jul 04, 2002 at 12:46 UTC
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	[reply]
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__` [download] 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	[reply] [d/l]
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` [download] It should be for( 0 .. ($la>$lb?$lb:$la)-1 ) of course	[reply] [d/l]


Your skill will accomplish what the force of many cannot
	PerlMonks