10. sort map grep

Created Saturday 26 April 2014

BASIC SORTING

sort LIST
sort BLOCK LIST
sort SUBNAME LIST

The simplest sort in Perl:
my @list = sort qw(this is a list);
print "@list"; # a is list this

Sorting Numerically

print join "\n", sort qw/1 9 10 99 222/; # 1\n10\n222\n9\n99
To sort numerically providing a sort block:
print join"\n", sort {$a<=>$b} qw/1 9 10 99 222/; # 1\n9\n10\n99\n222

Reverse Sorting

my @reversed_names = reverse sort @names;

Sorting directly into reverse descending order:
my @reversed_names = sort {$b cmp $a} @names;
my @descending = sort {$b<=>$a} @numbers;

Complex Sort Conditions

Example of complex sorting:
use strict;
use warnings;
use diagnostics;
my @employees = (
{
name => 'Sally Jones',
years => 4,
payscale => 4,
},
{
name => 'Abby Hoffman',
years => 1,
payscale => 10,
},
{
name => 'Jack Johnson',
years => 4,
payscale => 5,
},
{
name => 'Mr. Magnate',
years => 12,
payscale => 1,
},
);
@employees =
sort {
$b->{years}<=>$a->{years}
||
$a->{payscale}<=>$b->{payscale}
||
$a->{name} cmp $b->{name}
}
@employees;
printf "Name Years Payscale\n";
foreach my $employee (@employees) {
printf "%-15s %2d %2d\n" => @{$employee}{qw/name years payscale/};
}

Writing a sort Subroutine

sub by_seniority_then_pay_then_name {

$b->{years}<=>$a->{years}
||
$a->{payscale}<=>$b->{years}
||
$a->{name} cmp $b->{name}
}
@employees = sort by_seniority_then_pay_then_name @employees;

Sorting and Unicode Fun

Using Unicode::Collate:
use strict;
use warnings;
use diagnostics;
use utf8::all;
use Unicode::Collate;
my @apples = (
"\N{U+212B}pples",
"\N{U+00C5}pples",
"\N{U+0041}\N{U+030A}pples",
"apples",
"Apples",
);
my @bad = sort @apples;
my @sorted = Unicode::Collate->new->sort(@apples);
print "Original: @apples\n";
print "Sorted: @bad\n";
print "Collated: @sorted\n";
# Original: Åpples Åpples Åpples apples Apples
# Sorted: Apples Åpples apples Åpples Åpples
# Collated: apples Apples Åpples Åpples Åpples

Using Unicode::Collate::Locale to get the correct sort order:
use strict;
use warnings;
use utf8::all;
use Unicode::Collate::Locale;
my @letters = qw(z ö);
my @reversed = reverse @letters;
my $german = Unicode::Collate::Locale->new(locale => 'de_DE');
my $swedish = Unicode::Collate::Locale->new(locale => 'sv_SE');
foreach my $letters (\@letters, \@reversed) {

print "Original: @$letters\n";
my @german = $german->sort(@$letters);
my @swedish = $swedish->sort(@$letters);
print "German: @german\n";
pring "Swedish: @swedish\n\n";
}
Original: z ö
German: ö z
Swedish: z ö
Original: ö z
German: ö z
Swedish: z ö

map and grep

Using grep

NEWLIST = grep BLOCK LIST;
NEWLIST = grep EXPRESSION, LIST;
To use only numbers greater than zero:
my @greater = grep {$_ > 0} @numbers;
my @greater = grep $_ > 0, @numbers;
my @greater = grep($_ > 0, @numbers);
To grab the palindromes from a list, use this code:
my @palindromes = grep {uc eq reverse uc} @words; # uc operates on $_ by default, the scalar is forced by the eq
Frendlier form:
my @palindromes = grep {uc($_) eq scalar reverse uc($_)} @words;
To find words beginning with the vowels:
my @starts_with_vowels = grep {/^[aeiou]/} @words;
Find all numbers greater than or equal to 10 and return them sorted from lowest to highest:
my @numbers = (13, 3, -2, 7, 270, 19, -3.2, 10.1);
my @result = sort {$a<=>$b} grep {$_ >= 10} @numbers;
print join ', ', @result;
Inefficient:
my @positive = grep {$_ > 0} @numbers;
my $first = $positive[0];
Efficient:
my $first;
for (@numbers) {
if ($_ > 0) {
$first = $_;
last;
}
}
Get prime numbers:
use strict;
use warnings;
use diagnostics;
use List::MoreUtils 'uniq';
use Time::HiRes qw(gettimeofday tv_interval);
my $is_slow = 1;
my @numbers = qw(3 2 39 7919 997 631 200 7919 459 7919 623 997 867 15);
@numbers = (@numbers) x 200000;
my @primes;
my $start = [gettimeofday];
if ($is_slow) {
    @primes = grep {is_prime($_)} @numbers;
} else {
    my %is_prime;
    @primes = grep {
        (exists $is_prime{$_} and $is_prime{$_})
        or
        ($is_prime{$_} = is_prime($_))
    } @numbers;
}
my $elapsed = tv_interval($start);
printf "We took %0.1f seconds to find the primes\n", $elapsed;
print join ', ' => sort {$a <=> $b} uniq @primes;
sub is_prime {
    my $number = $_[0];
    return if $number < 2;
    return 1 if $number == 2;
    for (2 .. int sqrt($number)) {
        return if !($number % $_);
    }
    return 1;
}

Using map

NEWLIST = map BLOCK LIST;
NEWLIST = map EXPRESSION, LIST;
To uppercase every word in a list:
my @UPPER = map {uc} @words;
Take a square root of those numbers greater than zero:
my @roots = map {sqrt($_)}
grep {$_ > 0} @numbers;
Printing Celsius from Fahrenheit:
use strict;
use warnings;
binmode STDOUT, ':encoding(UTF-8)';
my %fahrenheit = (
'absolute zero' => -459.67,
'freezing water' => 32,
'body temperature' => 98.6,
'boiling water' => 212,
);
my %celsius =
map {$_ => 5 / 9 * ($fahrenheit{$_} - 32)} keys %fahrenheit;
while (my ($name, $temp) = each %celsius) {
print "The temperature for $name is $temp\N{U+00B0} celsius\n";
}

Aliasing Issues

Schwartzian Transform (aka decorate, sort, undecorate)

Inefficient:
my @sorted = sort by_id <>;
sub by_id {
$a =~ /\|(\d+)/;
my $a_id = $1;
$b =~ /\|(\d+)/;
my $b_id = $1;
return $a_id<=>$b_id;
}
Efficient:
my @sorted = map {$_->[0]} # undecorate
sort {$a->[1]<=>$b->[1]} # sort
map {/\|(\d+)/; [$_, $1]} <>; # decorate
With hashes:
my @sorted = map {$_->{original}}
sort {$a->{id}<=>$b->{id}}
map {/\|(\d+)/; {original => $_, id => $1}} <>;
Using index instead of regex
my @sorted = map {$_->[0]}
sort {$a->[1]<=>$b->[1]}
map {my $i = 1 + index $_, "|";
my $length = index($_, "|", $i) - $i;
[$_, substr $_, $i, $length]
} <>;

Guttman-Rosler Transform

my @sorted = map {substr $_, 4}
sort
map {/\|(\d+)/; pack("A4", $1) . $_} <>;



Backlinks: