CGI/Perl Guide | Learning Center | Forums | Advertise | Login
Site Search: in

  Main Index MAIN
INDEX
Search Posts SEARCH
POSTS
Who's Online WHO'S
ONLINE
Log in LOG
IN

Home: Perl Programming Help: Intermediate:
Sorting sub-routine

 



mmcw
User

Nov 4, 2003, 10:52 AM

Post #1 of 4 (505 views)
Sorting sub-routine Can't Post

I have the following sub-routine:


Code
   

#########################################################################
# #
# subroutine sort_data #
# Subroutine that does the actual sort. #
# Accepts 4 params viz. #
# 1. The column number to sort. Column no. start from 0. #
# 2. The type of sort numeric or alphabetic. Default is Alphabetic. #
# 3. The order of sort. Default order is ascending #
# 4. The referrence of the array that needs to be sorted. #
#########################################################################

sub sort_data {

my ($row,$type,$sort_order,$r_data) = @_;
my (@array);

if ($type eq "n") {
if ($sort_order eq "d") {
@array = map { (split ('<->', $_))[1] }
reverse sort {$a <=> $b}
map { join ('<->', lc ((split('\|', $_))[$row]) , $_) }
@{$r_data};
}
else {
@array = map { (split ('<->', $_))[1] }
sort {$a <=> $b}
map { join ('<->', lc ((split('\|', $_))[$row]) , $_) }
@{$r_data};
}
}
else {
if ($sort_order eq "d") {
@array = map { (split ('<->', $_))[1] }
reverse sort {$a cmp $b}
map { join ('<->', lc ((split('\|', $_))[$row]) , $_) }
@{$r_data};
}
else {
@array = map { (split ('<->', $_))[1] }
sort {$a cmp $b}
map { join ('<->', lc ((split('\|', $_))[$row]) , $_) }
@{$r_data};
}
}

return (\@array)
}



Someone rewrote it for me to make it more efficient and to make the warning that did showup in the error log file the moment I added the -W option to the perl command.


Code
   

#########################################################################
# #
# subroutine sort_data #
# Subroutine that does the actual sort. #
# Accepts 4 params viz. #
# 1. The column number to sort. Column no. start from 0. #
# 2. The type of sort numeric or alphabetic. Default is Alphabetic. #
# 3. The order of sort. Default order is ascending #
# 4. The referrence of the array that needs to be sorted. #
#########################################################################

sub sort_data {

my ($row,$type,$sort_order,$r_data) = @_;
my (@array);

if ($type eq "n") {
if ($sort_order eq "d") {
@array = map { $_->[1] }
sort {$b->[0] <=> $a->[0]}
map { [ lc ((split('|', $_))[$row]) , $_] }
@{$r_data};
}
else {
@array = map { $_->[1] }
sort {$a->[0] <=> $b->[0]}
map { [ lc ((split('|', $_))[$row]) , $_] }
@{$r_data};
}
}
else {
if ($sort_order eq "d") {
@array = map { $_->[1] }
sort {$b->[0] cmp $a->[0]}
map { [ lc ((split('|', $_))[$row]) , $_] }
@{$r_data};
}
else {
@array = map { $_->[1] }
sort {$a->[0] cmp $b->[0]}
map { [ lc ((split('|', $_))[$row]) , $_] }
@{$r_data};
}
}

return (\@array)
}



But it isn't working like the old version is! It isn't the same. What is different?

Forexample:

$row = 0;
$type = "n";
$sort_order = "a";

will work in the old version but not in the new version. Trying to learn perl by learning what is wrong and why. Can someone help me to fix the new code?


KevinR
Veteran


Nov 4, 2003, 11:52 PM

Post #2 of 4 (498 views)
Re: [mmcw] Sorting sub-routine [In reply to] Can't Post

whats not working like the old script is?


the big difference I see is that the old script is splitting the data:

@array = map { (split ('<->', $_))[1] }

but the new script is not:

@array = map { $_->[1] }
-------------------------------------------------


davorg
Thaumaturge / Moderator

Nov 5, 2003, 2:07 AM

Post #3 of 4 (497 views)
Re: [mmcw] Sorting sub-routine [In reply to] Can't Post

Looks to me like both versions are using the Schwartzian Transform In a slightly strange manner. I'd write it like this (note that I've reordered the parameters so that you can omit the least used ones and have sensible defaults.

Code
sub sort_data { 
my $r_data = shift
|| die "Must pass array ref to sort_data";
my $col = shift || 0; # default to sort on first column
my $type = shift || 'a'; # default to ascii sort
my $sort_order = shift || 'a'; # default to asc

my @array;

if ($type eq 'a') {
# ascii sort
@array = map { $_->[0] }
sort { $a->[1] cmp $b->[1] }
map { [ $_, (split /\|/)[$col] ] } @$r_data;
} else {
# numeric sort
@array = map { $_->[0] }
sort { $a->[1] <=> $b->[1] }
map { [ $_, (split /\|/)[$col] ] } @$r_data;
}

@array = reverse @array if $sort_order eq 'd';

return \@array;
}


Does that do what you want?

--
Dave Cross, Perl Hacker, Trainer and Writer
http://www.dave.org.uk/
Get more help at Perl Monks


uri
Thaumaturge

Nov 11, 2003, 10:18 PM

Post #4 of 4 (484 views)
Re: [davorg] Sorting sub-routine [In reply to] Can't Post

you could even simplify it further and speed it up some by these changes.

instead of the duplicated ST code you could select the sort comparison sub based on the order and type codes. a reverse sort can be made just by reversing the order of the comparison. this save the need for the reverse line. there are two values for each code so we need 4 comparison codes. we will use a hash keyed by the joined order and type codes:

<highly untested>

Code
my %sort_mode_to_sub = ( 
'aa' => sub { $a->[1] cmp $b->[1] },
'ad' => sub { $b->[1] cmp $a->[1] },
'na' => sub { $a->[1] <=> $b->[1] },
'nd' => sub { $b->[1] <=> $a->[1] },
) ;

then we lookup the sort sub in the main code:

Code
my $cmp_sub = $sort_mode_to_sub{ "$sort_type$sort_order" } or  
die "bad sort format '[$sort_type][$sort_order]'"

then sort (add the rest of the ST if desired):

Code
my @sorted = sort { $cmp_sub->() } @unsorted ;

and if major speedups are needed, then use the GRT which usually is faster than the ST as it eliminates the callback to the comparison sub.


uri

 
 


Search for (options) Powered by Gossamer Forum v.1.2.0

Web Applications & Managed Hosting Powered by Gossamer Threads
Visit our Mailing List Archives