TGI has asked for the wisdom of the Perl Monks concerning the following question:

I've written some code to sort an array by the values in another array. I'd like some monastery reaction, pointers, and correction.

Precisely what I want to do, is sort the elements of an array, @sortme = qw(foo bar baz cat dog elephant bird, based on the order of the elements in another array, @order = (whale elephant dog cat), placing unlisted (in @order) items at the end of the list.

Here's the code: 

#!/usr/bin/perl -w

use strict;
use Data::Dumper;


my @sites = qw(Hillsboro Rialto Santa_Ana Memphis Richmond);

my @sortme = sort {$a cmp $b} @sites;
unshift @sortme, 'Foo', 'Bar';


print Dumper \@sortme;

{    my %order;
    foreach (0..$#sites)
    {    $order{$sites[$_]} = $_;  # build index
    }
    $order{DEFAULT} = $#sites + 1;
    
my @sorted = sort    {    if (exists $order{$a} && exists $order{$b})
                        {    $order{$a} <=> $order{$b}
                        } elsif  ( exists $order{$a})
                        {    $order{$a} <=> $order{DEFAULT}
                        } elsif ( exists $order{$b} )
                        {    $order{DEFAULT} <=> $order{$b}
                        } else
                        {    $a cmp $b }
                    } @sortme;

print Dumper \@sorted
}

[download]
This seems to work fine. But, I'd like to know, is there a better/faster/cleaner algorithm that I would know of if I didn't always sleep through my CS classes? Should I be using map to do this?

TIA


TGI says moo

Replies are listed 'Best First'.
Re: Sorting an array by another array
by Masem (Monsignor) on Dec 04, 2001 at 23:34 UTC
    How about something like: 
    my $VERY_LARGE_NUMBER = 999999999;
sub index_of {
   my ( $item, @array ) = @_;
   my $i = 0;
   while ( $i < @array ) {
       return $i if ( $array[$i] eq $item );
       $i++;
   }
   return $VERY_LARGE_NUMBER;
}

# Use the Schwatz, luke!
@sorted = map { $_->[1] } 
          sort { $a->[0] <=> $b->[0] }
          map { [ index_of( $_, @order ), $_ ] } @to_be_sorted;

    [download]
    (update fixed if statement, and the sort line)

    -----------------------------------------------------
    Dr. Michael K. Neylon - mneylon-pm@masemware.com || "You've left the lens cap of your mind on again, Pinky" - The Brain
    "I can see my house from here!"
    It's not what you know, but knowing how to find it if you don't know that's important

[reply]
[d/l]
Re: Sorting an array by another array
by clintp (Curate) on Dec 05, 2001 at 00:16 UTC
    Similar to Masem's approach, but simpler (I think) and debugged. 
    @to_be_sorted=qw( cat bird dog tiger puma mouse );
@order=qw( mouse cat dog lion elephant );

%order=();
for($_=0; $_<@order; $_++) { $order{$order[$_]}=$_; }

@sorted=sort {
        $order{$a}=@order unless exists $order{$a};
        $order{$b}=@order unless exists $order{$b};
        $order{$a}<=>$order{$b}
         } @to_be_sorted;

    [download]
    Enjoy!
[reply]
[d/l]
Re: Sorting an array by another array
by sfink (Deacon) on Dec 05, 2001 at 00:22 UTC
    I think you've got the right algorithm already, but you can use a few tricks to shave it down to a readable size. However, I notice that your script adds an additional condition that I don't handle below -- elements unlisted in @order are placed at the end of the list in dictionary order. Not sure if you require that or not. 
    my %order;
$order{$order[$_]} = @order-$_ for (0..$#order);
{
    local $^W=0;
    my @sorted = sort { $order{$b} <=> $order{$a} } @sortme;
}

    [download]
    or slightly slower, if you don't like mucking with warnings, 
    my %order;
$order{$order[$_]} = $_+1 for (0..$#order);
my @sorted = sort { ($order{$a}||@order) <=> ($order{$b}||@order) }
             @sortme;

    [download]
[reply]
[d/l]
[select]
Re: Sorting an array by another array
by duelafn (Parson) on Dec 05, 2001 at 00:27 UTC
    This is a bit of code I hacked up once upon a time that did this: 
    
sub SuggestionSort {
    my ($toSort, $Suggestion) = @_;
    my (%sugg, $i, @sorted);
    foreach (@{$Suggestion}) { $sugg{$_} = $i++ };
    foreach (@{$toSort}) {
    if (defined $sugg{$_}) { $sorted[$sugg{$_}] = $_ }
    else { $sorted[$i++] = $_ }
    }
    grep defined, @sorted;
}

    [download]
    You would call it this way: 
    use strict;

my @order = qw(whale elephant dog cat);
my @sortme = qw(foo bar baz cat dog elephant bird);

print join(", ", &SuggestionSort(\@sortme, \@order)),"\n";

    [download]
    Good Day,
      Dean
[reply]
[d/l]
[select]
Re: Sorting an array by another array
by runrig (Abbot) on Dec 05, 2001 at 01:01 UTC 
    my @sortme = qw(a b c d);
my @order = qw(d c e f);
my %sortme; @sortme{@sortme}=();
my %order; @order{@order}=();
my @sorted = (grep(exists $sortme{$_}, @order),
              sort grep !exists $order{$_}, @sortme)
);
print "$_\n" for @sorted;

    [download]
[reply]
[d/l]
Re: Sorting an array by another array
by stefp (Vicar) on Dec 05, 2001 at 07:27 UTC
    adapted fron runrig, assuming no duplicate:

    my @sortme = qw(a b c d); my @order = qw(d c e f); my %sortme;
$sortme{$_}++ for @sortme;
local $,=' ';
print ((grep {$sortme{$_}-- } @order), grep { $sortme{$_} } @sortme);

    [download]
    prints "d c a b"

    -- stefp

[reply]
[d/l]

Back to Seekers of Perl Wisdom