laurent_r

These are some answers to the Week 142 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 December 12, 2021 at 24:00). 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: Divisor Last Digit

You are given positive integers, $m and $n.

Write a script to find total count of divisors of $m having last digit $n.

Example 1:

Input: $m = 24, $n = 2
Output: 2

The divisors of 24 are 1, 2, 3, 4, 6, 8 and 12.
There are only 2 divisors having last digit 2 are 2 and 12.

Example 2:

Input: $m = 30, $n = 5
Output: 2

The divisors of 30 are 1, 2, 3, 5, 6, 10 and 15.
There are only 2 divisors having last digit 5 are 5 and 15.

Divisor Last Digit in Raku

We first generate all divisors of the input integer (including 1 and the input number itself, as these may end-up with the right digit), using a grep testing the divisibility of each number less than or equal to the input integer, and then use another grep to keep all divisors ending with the same digit as the other input integer.

use v6;

sub count_divisors (UInt $m, UInt $n) {
    my @divisors = grep {$m %% $_}, 1..$m;
    my $last-digit = substr $n, *-1;
    my @eligible-divisors = grep { $last-digit == substr $_, *-1 }, @divisors;
    return @eligible-divisors.elems;
}

for (24, 34), (24, 12), (30, 45) {
  say "$_ -> ", count_divisors $_[0], $_[1];
}

This program displays the following output:

$ raku ./div_last_digit.raku
24 34 -> 2
24 12 -> 2
30 45 -> 2

Divisor Last Digit in Perl

This is essentially a Perl port of the Raku program just above:

use strict;
use warnings;
use feature "say";

sub count_divisors {
    my ($m, $n) = @_;
    my @divisors = grep {$m % $_ == 0} 1..$m;
    my $last_digit = substr $n, -1, 1;
    my @eligible_divisors = grep { $last_digit == substr $_, -1, 1 } @divisors;
    return scalar @eligible_divisors;
}
for ([24, 34], [24, 12], [30, 45]) {
  say "@$_ -> ", count_divisors $_->[0], $_->[1];
}

This program displays the following output:

$ perl ./div_last_digit.pl
24 34 -> 2
24 12 -> 2
30 45 -> 2

Task 2: Sleep Sort

Another joke sort similar to JortSort suggested by champion Adam Russell.

You are given a list of numbers.

Write a script to implement Sleep Sort. For more information, please checkout this post.

The basic idea of the sleep sort is that you launch a thread (or a process) for each item in the array to be sorted. Each thread then waits (or “sleeps”) for an amount of time proportional to the value of the element for which it was created and finally prints this value. If things go right, the array item with the smallest value is printed first, then the next higher value, and so on until lastly the item with largest value, so that you eventually get the array items in ascending sorted order.

Sleep Sort in Raku

For each value in the input array, we start a promise. In the code for each promise, the thread is made to sleep for an amount of time proportional to the value (here, half the value) and then prints the value:

use v6;

await <6 8 1 12 2 14 5 2 1 0>.map: { start {sleep $_/2; .say} };

This scripts prints out the following output:

$ raku ./sleep-sort.raku
0
1
1
2
2
5
6
8
12
14

This nice post by Andrew Shitov provides a somewhat similar solution also using promises, together with quite a bit of further explanations.

Sleep Sort in Perl

The Perl solution is similar, but spawns processes using fork. The solution looks simple, but since I had not used fork for ages, it took me quite a while to get it to work properly.

use strict;
use warnings;
use feature "say";

while ($_ = shift and @ARGV >= 1) {
    last unless fork;
}
sleep $_;
say;
wait;

This script displays the following output:

$ perl sleep-sort.pl 5 7 3 4 1 2 9
1
2
3
4
5
7
9

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 December 19, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.