laurent_r

These are some answers to the Week 238, Task 2 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 October 15, 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 2: Persistence Sort

You are given an array of positive integers.

Write a script to sort the given array in increasing order with respect to the count of steps required to obtain a single-digit number by multiplying its digits recursively for each array element. If any two numbers have the same count of steps, then print the smaller number first.

Example 1

    Input: @int = (15, 99, 1, 34)
    Output: (1, 15, 34, 99)

    15 => 1 x 5 => 5 (1 step)
    99 => 9 x 9 => 81 => 8 x 1 => 8 (2 steps)
    1  => 0 step
    34 => 3 x 4 => 12 => 1 x 2 => 2 (2 steps)

Example 2

    Input: @int = (50, 25, 33, 22)
    Output: (22, 33, 50, 25)

    50 => 5 x 0 => 0 (1 step)
    25 => 2 x 5 => 10 => 1 x 0 => 0 (2 steps)
    33 => 3 x 3 => 6 (1 step)
    22 => 2 x 2 => 4 (1 step)

Sorting items in accordance with a computed value is quite simple both in Perl and in Raku. The note that, "if any two numbers have the same count of steps, then print the smaller number first", makes it slightly more complicated, and the solution employed to obtain this behavior will be very different between Perl and Raku.

Persistence Sort in Raku

First, we write a to-single-digit subroutine to compute the number of steps required to obtain a single-digit number by multiplying its digits recursively for each array element. When the first argument to a sort is a code block or a subroutine taking only one argument, then it is assumed to be a code object implementing the transformation to be applied to each item before performing the comparison. This makes the sort more efficient, because the transformed items are cached, and the transformation is performed only once for each item.

But how do we implement the rule that items having the same number of steps should be ordered according to their value? We use the fact that Raku's sort is stable, i.e. that items comparing equal are left in their original order. So, if we first sort the input array in ascending order, that order will be preserved for values comparing equal for their step count. So, the my-sort subroutine first sorts the items in accordance with their values, and then sorts them again according to their step count.

sub to-single-digit ($in) {
    my $prod = $in;
    my $count = 0;
    while $prod > 9 {
        $prod = [*] $prod.comb;
        $count++;
    }
    return $count;
}

sub my-sort (@in) {
    my @sorted = sort @in;
    return sort &to-single-digit, @sorted;
}

my @tests = <15 99 1 34>, <50 25 33 22>;
for @tests -> @test {
    printf "%-15s => ", "@test[]";
    say join ", ", my-sort @test;
}

This program displays ther following output:

$ raku ./persistence-sort.raku
15 99 1 34      => 1, 15, 34, 99
50 25 33 22     => 22, 33, 50, 25

Persistence Sort in Perl

Again, we have a to_single_digit subroutine to compute the number of steps required to obtain a single-digit number by multiplying its digits recursively for each array element. But Perl's sort does not have the Raku property that make it possible to implicitly apply a transformation to each item of the input array for the purpose of the sort. We have to do it explicitly and an efficient way to do it is the so-called Schwartzian Transform, named after Randal Schwartz, a famous Perl author. Consider the following construct:

    map { $_->[0] }
    sort { $a->[1] <=>  $b->[1] }
    map { [$_, to_single_digit $_] } @input;

This creates a data pipeline. To understand it, read it from bottom to top. The first map (third line at the bottom) takes the @input array and creates a list of anonymous two-item arrays, in which the first element is the original value and the second one the value returned by the to_single_digit subroutine. Next (second line), this list of arrays is sorted in accordance with the second value (returned by the to_single_digit subroutine), and, finally (first line), the final map extract the first item from each array of the sorted list.

We still have to deal with the rule that items having the same number of steps should be ordered according to their value. We could do it the same way as in Raku, i.e. perform a preliminary sort according to the values. But we can do better here. Since we are defining explicitly the comparison code block, we can add a second sort criterion applying only when the first sort criterion determines the comparison values to be equal:

    sort { $a->[1] <=>  $b->[1] || $a->[0] <=> $b->[0] }

When $a->[1] is found to be equal to $b->[1], the comparison block $a->[1] <=> $b->[1] returns 0, and this triggers the second comparison block, $a->[0] <= > $b->[0], which compares the first items of the arrays, i.e. the original array values. The complete code is as follows:

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

sub to_single_digit {
    my $prod = shift;
    my $count = 0;
    while ($prod > 9) {
        my $temp = 1;
        $temp *= $_ for split //, $prod;
        $prod = $temp;  
        $count++;
    }
    return $count;
}

sub my_sort {
    # Schwartzian Tranform
    return map { $_->[0] }
        sort { $a->[1] <=>  $b->[1] || $a->[0] <=> $b->[0] }
        map { [$_, to_single_digit $_] } @_;
}

my @tests = ([<15 99 1 34>], [<50 25 33 22>]);
for my $test (@tests) {
    printf "%-15s => ", "@$test";
    say join ", ", my_sort @$test;
}

This program displays the following output:

$ perl ./persistence-sort.pl
15 99 1 34      => 1, 15, 34, 99
50 25 33 22     => 22, 33, 50, 25

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