laurent_r

These are some answers to the Week 279, Task 1, of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on July 28, 2024, at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 1: Sort Letters

You are given two arrays, @letters and @weights.

Write a script to sort the given array @letters based on the @weights.

Example 1

Input: @letters = ('R', 'E', 'P', 'L')
       @weights = (3, 2, 1, 4)
Output: PERL

Example 2

Input: @letters = ('A', 'U', 'R', 'K')
       @weights = (2, 4, 1, 3)
Output: RAKU

Example 3

Input: @letters = ('O', 'H', 'Y', 'N', 'P', 'T')
       @weights = (5, 4, 2, 6, 1, 3)
Output: PYTHON

Sort Letters in Raku

We need some way of combining the data of the two arrays to be able to sort the items of the @letters array in accordance with the values of the @weights array. For example, we could build an intermediate data structure of records containing each a letter and the value of its weight, sort his data structure in accordance with the weight and then extract the letters from the sorted data structure.

We don't need, however to create a new variable to contain an array with this intermediate data structure. We will use an anonymous array of pairs to host this data structure and perform the required operations on a data pipeline. The solution is often called Schwartzian Transform, because it was suggested by Randall Schwartz on a Perl newsgroup back in 1995, in the early days of Perl 5.

A literal translation to Raku of the canonical Perl Schwartzian Transform might look like this:

sub sort-letters (@letters, @weights) {
    return join "", map { $_[0] }, 
    sort { $^a[1] <=> $^b[1] }, 
    map { @letters[$_], @weights[$_] }, 0..@letters.end;
}

When trying to understand this construct, it is probably best to read from bottom to top, and from right to left. On the last line, the 0..@letters.end code at the end creates a list of subscripts used in the beginning of that line to create an anonymous array of arrays. The next line upwards sorts the data according to the weights and, finally, the map on the first line extracts the letters from sorted array.

This is, as I said, a Raku translation of how we would do it in Perl. But Raku offers some opportunities for improvement. In Raku, when the code block or subroutine called by sort takes only one parameter, then it specifies not the comparison subroutine, but the transformation to be applied to each item of the input data before sorting. So, we can simplify our Schwartzian Transform as follows:

sub sort-letters2 (@letters, @weights) {
    return join "", map { $_[0] }, sort { $_[1] }, 
    map { @letters[$_], @weights[$_] }, 0..@letters.end;
}

In addition, the creation of the intermediate data strucure can be greatly simplified using the zip routine, leading to a one-line Schwartzian Transform. We now display the full program:

sub sort-letters3 (@let, @w) {
    join "", map { $_[0] }, sort { $_[1] }, zip @let, @w;
}

my @tests = (< R E P L>, <3 2 1 4>),
            (<A U R K>, <2 4 1 3>),
            (<O H Y N P T>, <5 4 2 6 1 3>);
for @tests -> @test {
    printf "%-14s => ", "@test[0]";
    say sort-letters3 @test[0], @test[1];
}

This program (as well as its previous versions) displays the following output:

$ raku ./sort-letters.raku
R E P L        => PERL
A U R K        => RAKU
O H Y N P T    => PYTHON

Sort Letters in Perl

This is a port to Perl of the first Raku program above, with the original implementation of the Schwartzian Transform. Please refer to the above section if you need explanations.

use strict;
use warnings;
use feature 'say';

sub sort_letters {
    my @letters = @{$_[0]};
    my @indices = @{$_[1]};
    return map $_->[0], sort { $$a[1] <=> $$b[1] } 
    map [ $letters[$_], $indices[$_] ], 0..$#letters;
}

my @tests = ( [ [< R E P L>], [<3 2 1 4>] ],
              [ [<A U R K>], [<2 4 1 3>] ],
              [ [<O H Y N P T>], [<5 4 2 6 1 3>] ] );
for my $test (@tests) {
    printf "%-14s => ", "@{$test->[0]}";
    say sort_letters $test->[0], $test->[1];
}

This program displays the following output:

$ perl  ./sort-letters.pl
R E P L        => PERL
A U R K        => RAKU
O H Y N P T    => PYTHON

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on August 4, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.