All Sorts of Sorts
#!/usr/bin/perl -w
############################## Sorting Lists ###############################
@list = (2,1,21,3);
@list = sort @list;
print "@list\n"; ###### Produces 1 2 21 3 because default is ASCII sort.
@list = sort by_num @list;
print "@list\n";
@list = sort by_num_descending @list;
print "@list\n";
@list = sort by_ASCII_descending @list;
print "@list\n";
sub by_num
{
$a <=> $b; ##### Must use $a and $b. The <=> is NUMERIC comparison.
} ##### Sort subs must return +1, 0, or -1. Thus, <=> or
##### cmp are generally in the final expression.
sub by_num_descending
{
$b <=> $a;
}
sub by_ASCII_descending
{
$b cmp $a;
}
##################### Reversing the Order of a List #####################
@list = (1,2,3,4,5);
@list = reverse @list;
print "@list\n";
$var = "abc12xyzjlk*340dfdf10";
@list = reverse $var =~ /\d+/g; ###### List functions work on anything
###### which creates a list, not just on
###### list variables!
print "@list\n";
########################## Program Output Below #########################
1 2 21 3 ###### ASCIIbetical order.
1 2 3 21 ###### Numeric order -- sub by_num called.
21 3 2 1 ###### Descending numeric order -- sub by_num_descending.
3 21 2 1 ###### Descending ASCIIbetical order. By_ASCII_descending called.
5 4 3 2 1 ###### Reversal of (1,2,3,4,5) list.
10 340 12 ###### Grabs 12 340 10 out of the chaotic scalar and then
###### submits this list to the reverse function.
#!/usr/bin/perl -w
######################### Complex Sort Demo ############################
@list = ("Williams,Jim 34 40000.00 2\n", ###### Demo of secondary and
"Clinton,Hillary 34 80000.00 2\n", ###### tertiary keys.
"Discussion,Frank 45 66555.00 4\n",
"Doubt,Flip 34 70000.00 3\n",
"Jones,Jenny 34 80000.00 4\n");
@list = sort by_age_then_salary_then_deps @list;
print @list;
sub by_age_then_salary_then_deps
{
($ageA, $salaryA, $depsA) = (split /\s+/, $a) [1..3];
($ageB, $salaryB, $depsB) = (split /\s+/, $b) [1..3];
$ageA <=> $ageB
or
$salaryA <=> $salaryB ##### Use salary to break tie in ages.
or
$depsA <=> $depsB; ##### Use number of dependents to break tie
} ###### in ages.
############################################################################
@list = qw(goofy foobar xxxxxx john perl);
foreach $string (@list)
{
$sum = 0;
foreach $char (split //, $string)
{
$sum += ord($char); ###### Do computation to check sort.
}
print "Sum for $string: $sum\n";
}
########## See if we can sort by sum of ordinal
########## values of characters in strings.
foreach $element (sort by_sum_of_chars @list)
{
print "$element\n";
}
sub by_sum_of_chars
{
my ($sum1, $sum2, $char);
$sum1 = $sum2 = 0;
foreach $char (split //,$a)
{
$sum1 += ord($char);
}
foreach $char (split //, $b)
{
$sum2 += ord($char);
}
$sum1 <=> $sum2;
}
########## See if we can sort a list of lists by list size.
@L1 = qw(foo bar junk snafu);
@L2 = qw(huh what);
@L3 = qw(hello);
@L4 = qw(why are there so many words here);
@L5 = qw(just three words);
@LoL = (\(@L1, @L2, @L3, @L4, @L5)); ###### List of refs shortcut!!
foreach $element (sort by_list_size @LoL) {
print "@$element\n";
}
sub by_list_size
{
@$a <=> @$b;
}
############################################################################
########## See if we can sort a list of lists by total ordinal value
########## of all chars in each list.
$ror = [ [qw(foo bar why)],[qw(foo bar why not)],[qw(foo)],[qw(xxx yyy zzz)] ];
foreach $listref (@$ror)
{
$sum = 0;
foreach $element (@$listref) {
foreach $char (split //, $element) {
$sum += ord($char); ##### Do computation to check sort.
}
}
print "sum of (@$listref) is: $sum\n";
}
foreach $listref (sort by_sum_all_chars @$ror) ##### Here's the sort!!
{
print "@$listref\n";
}
sub by_sum_all_chars
{
my ($sumA, $sumB, $char);
$sumA = $sumB = 0;
foreach $element (@$a) {
foreach $char (split //, $element) {
$sumA += ord($char);
}
}
foreach $element (@$b) {
foreach $char (split //, $element) {
$sumB += ord($char);
}
}
$sumA <=> $sumB;
}
########################### Output Below ###########################
Williams,Jim 34 40000.00 2 ##### Secondary and tertiary keys worked!!
Doubt,Flip 34 70000.00 3
Clinton,Hillary 34 80000.00 2
Jones,Jenny 34 80000.00 4
Discussion,Frank 45 66555.00 4
Sum for goofy: 548 ###### Calculations of sum of ord(chars).
Sum for foobar: 633
Sum for xxxxxx: 720
Sum for john: 431
Sum for perl: 435
john ###### Sort by the sum of ord(chars) -- it worked!!
perl
goofy
foobar
xxxxxx
hello ###### Sort by size of list (number of elements). It worked!!
huh what
just three words
foo bar junk snafu
why are there so many words here
sum of (foo bar why) is: 977 ####### Calculation of sum of ord of
sum of (foo bar why not) is: 1314 ####### all ascii chars of all elements
sum of (foo) is: 324 ####### of a list.
sum of (xxx yyy zzz) is: 1089
foo ####### Sort by the above-mentioned sum. It worked!!
foo bar why
xxx yyy zzz
foo bar why not
######################## Sorting Hashes by Value #########################
#!/usr/bin/perl -w
opendir(D, ".") or die "Cannot open current directory!\n";
foreach $file (readdir D) ###### Files come out in random order!!
{
$nlinks{$file} = (stat $file)[3];
}
printf "%-20s%-5s\n", "File", "Links";
printf "%-20s%-5s\n", "----", "-----";
############### $a cmp $b breaks ties in number of links in
############### ascending order by the key (filename).
foreach $file (sort {$nlinks{$a} <=> $nlinks{$b} || $a cmp $b} keys %nlinks)
{
printf("%-22s%-3d\n", $file, $nlinks{$file});
}
############################ Results Below ##############################
$ cd garbage
$ sortval.pl
File Links
---- -----
c 1 ##### Ties in links broken by ASCII value of
sortval.demo 1 ##### filename.
sortval.pl 1
x 1
. 2
a 3
aa 3
aaa 3
e 3
ee 3
eee 3
b 4
bb 4
bbb 4
bbbb 4
d 5
dd 5
ddd 5
dddd 5
ddddd 5
.. 6
ls -la listing of garbage directory:
drwx------ 2 jwp2286 staff 512 Feb 1 19:19 .
drwxr-xr-x 6 jwp2286 staff 7168 Feb 1 19:16 ..
-rw------- 3 jwp2286 staff 0 Feb 1 19:09 a
-rw------- 3 jwp2286 staff 0 Feb 1 19:09 aa
-rw------- 3 jwp2286 staff 0 Feb 1 19:09 aaa
-rw------- 4 jwp2286 staff 0 Feb 1 19:09 b
-rw------- 4 jwp2286 staff 0 Feb 1 19:09 bb
-rw------- 4 jwp2286 staff 0 Feb 1 19:09 bbb
-rw------- 4 jwp2286 staff 0 Feb 1 19:09 bbbb
-rw------- 1 jwp2286 staff 0 Feb 1 19:09 c
-rw------- 5 jwp2286 staff 0 Feb 1 19:09 d
-rw------- 5 jwp2286 staff 0 Feb 1 19:09 dd
... and so on ...
################# Sorting "Records": Sorting Lists of Hashes ###############
#!/usr/bin/perl -w
@people = (
{ "ID" => "123456", "NAME" => "James Thomas", "AGE" => 46, "SALARY" => 54344},
{ "ID" => "789098", "NAME" => "Mister Ed", "AGE" => 24, "SALARY" => 40000},
{ "ID" => "345678", "NAME" => "Buck Naked", "AGE" => 40, "SALARY" => 99000},
{ "ID" => "176543", "NAME" => "Frank Discussion", "AGE" => 9, "SALARY" => 100},
{ "ID" => "745676", "NAME" => "Ben Dover", "AGE" => 28, "SALARY" => 200000},
{ "ID" => "888888", "NAME" => "Carl Dover", "AGE" => 23, "SALARY" => 125000});
@people = sort by_name @people;
foreach $personRef (@people)
{
%temp = %$personRef;
print "@temp{NAME,ID,AGE,SALARY}\n";
}
sub by_name
{
my ($lnameA, $fnameA, $lnameB, $fnameB);
($fnameA, $lnameA) = split /\s+/, $a->{NAME};
($fnameB, $lnameB) = split /\s+/, $b->{NAME};
$lnameB cmp $lnameA ## Descending order of lastname!
or
$fnameB cmp $fnameA
}
############################### Output Below #############################
James Thomas 123456 46 54344 ## Sorted properly!!
Buck Naked 345678 40 99000
Mister Ed 789098 24 40000
Carl Dover 888888 23 125000
Ben Dover 745676 28 200000
Frank Discussion 176543 9 100