laurent_r

These are some answers to the Week 217 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 May 21, 2023 at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 1: Sorted Matrix

You are given a n x n matrix where n >= 2.

Write a script to find 3rd smallest element in the sorted matrix.

Example 1

Input: @matrix = ([3, 1, 2], [5, 2, 4], [0, 1, 3])
Output: 1

The sorted list of the given matrix: 0, 1, 1, 2, 2, 3, 3, 4, 5.
The 3rd smallest of the sorted list is 1.

Example 2

Input: @matrix = ([2, 1], [4, 5])
Output: 4

The sorted list of the given matrix: 1, 2, 4, 5.
The 3rd smallest of the sorted list is 4.

Example 3

Input: @matrix = ([1, 0, 3], [0, 0, 0], [1, 2, 1])
Output: 0

The sorted list of the given matrix: 0, 0, 0, 0, 1, 1, 1, 2, 3.
The 3rd smallest of the sorted list is 0.

Sorted Matrix in Raku

The find-third-smallest subroutine simply sorts the values of the matrix in ascending order and returns the third item of the list (index 2). The only slight difficulty is to properly flatten the matrix data structure into a simple list, which requires here the use of two nested calls to the flat routine. The bulk of the work is done in just one code-line.

sub find-third-smallest (@matrix) {
    return (flat map {.flat}, @matrix).sort[2];
}

for ([3, 1, 2], [5, 2, 4], [0, 1, 3]),
    ([2, 1], [4, 5]),
    ([1, 0, 3], [0, 0, 0], [1, 2, 1])
        -> @test {
    say @test, " => ", find-third-smallest(@test);
}

This program displays the following output:

$ raku ./third-smallest.raku
([3 1 2] [5 2 4] [0 1 3]) => 1
([2 1] [4 5]) => 4
([1 0 3] [0 0 0] [1 2 1]) => 0

Sorted Matrix in Perl

The is no flat routine in Perl, but the task is somewhat easier in Perl than in Raku because, in many situations, Perl automatically flattens the arguments to a subroutine. Note that in Perl, we need the { $a <=> $b } argument to the sort function to force a numeric sort (in Perl, the default is lexicographic sort).

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

sub find_third_smallest {
    return (sort { $a <=> $b } map { @$_ } @_)[2];
}

for my $test ( [ [3, 1, 2], [5, 2, 4], [0, 1, 3] ],
               [ [2, 1], [4, 5] ],
               [ [1, 0, 3], [0, 0, 0], [1, 2, 1] ] ) {
    print map "[@$_] ", @$test;
    say " => ", find_third_smallest @$test;
}

This program displays the following output:

$ perl ./third_smallest.pl [3 1 2] [5 2 4] [0 1 3] => 1 [2 1] [4 5] => 4 [1 0 3] [0 0 0] [1 2 1] => 0

Task 2: Max Number

You are given a list of positive integers.

Write a script to concatenate the integers to form the highest possible value.

Example 1:

Input: @list = (1, 23)
Output: 231

Example 2:

Input: @list = (10, 3, 2)
Output: 3210

Example 3:

Input: @list = (31, 2, 4, 10)
Output: 431210

Example 4:

Input: @list = (5, 11, 4, 1, 2)
Output: 542111

Example 5:

Input: @list = (1, 10)
Output: 110

Basically, we need to reorder the input integers in such a way that numbers starting with the largest digit come first. In other words, we need to perform a lexicographic sort (in descending order) on the input integers. In Raku, implementing this approach could be as simple as this, using the leg operator for comparing various input operands within the sort built-in function:

# Caution: wrong solution
sub reorder (@in) {
    return @in.sort({$^b leg $^a}).join: "";
}

This gives a correct solution for most input lists, but, unfortunately, this doesn’t work as I originally expected for some input lists. For example, if given the (1, 10) input list, the lexicographic sort would produce (10, 1), leading to the number 101, whereas it is obvious that the proper solution is 110.

So, we need some variation to the lexicographic sort in which we would obtain (1, 10).

Max Number in Raku

So, the leg operator sometimes doesn’t work as desired for our purpose when one of the integers to be compared is equal to the beginning of the other, as in the (10, 1) example.

At this point, we could decide to go for a radically different approach, but, since it is quite easy to create new operators in Raku, I decided that I’d rather want to keep the approach and to create my own custom myleg operator to properly handle the special case described above. Basically, it returns the same thing as leg, except when it hits the aforesaid special case.

sub infix:<myleg> ($a, $b) {
    return $a leg $b if $a.chars == $b.chars;
    if $a.chars > $b.chars {
        my $c = substr $a, 0, $b.chars;
        return $a leg $b if $c != $b;
        return (substr $a, $b.chars + 1) leg $c ;
    } else {
        my $c = substr $b, 0, $a.chars;
        return $a leg $b if $c != $a;
        return $c leg (substr $b, $a.chars + 1);    
    }
}    

sub reorder (@in) {
    return @in.sort({$^b myleg $^a}).join: "";
}

for (1, 23), (10, 3, 2), (31, 2, 4, 10), 
    (5, 11, 4, 1, 2), (1, 10), (10, 1), 
    (1, 10), (1, 100), (100, 1) -> @test {
    say "@test[]".fmt("%-15s => "), reorder @test;
}

This program now works as expected and displays the following output:

$ raku ./max-number.raku
1 23            => 231
10 3 2          => 3210
31 2 4 10       => 431210
5 11 4 1 2      => 542111
1 10            => 110
10 1            => 110
1 10            => 110
1 100           => 1100
100 1           => 1100

I got a bit carried away by my original (wrong) solution. The code of the myleg infix operator could be made much simpler:

sub infix:<myleg> ($a, $b) {
    return $a~$b <=> $b~$a;
}

The modified program displays the same output as before.

Max Number in Perl

This is a port to Perl of the Raku program just above. Please refer to the above section for explanations. We cannot create new operators in Perl, but we might as well write a subroutine to be called by the sort function.

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

sub mycmp {
    my ($i, $j) = @_;
    return $i.$j <=> $j.$i;
}

sub reorder {
    return join "", sort { mycmp ($b, $a) } @_;
}

for my $test ([1, 23], [10, 3, 2], [31, 2, 4, 10], 
    [5, 11, 4, 1, 2], [1, 10], [10, 1], 
    [1, 10], [1, 100], [100, 1]) {
    printf "%-15s => ", "@$test";
    say reorder @$test;
}

This program displays the following output:

$ perl ./max-number.pl
1 23            => 231
10 3 2          => 3210
31 2 4 10       => 431210
5 11 4 1 2      => 542111
1 10            => 110
10 1            => 110
1 10            => 110
1 100           => 1100
100 1           => 1100

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 May 28, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.