Perl Weekly Challenge: Week 116

Before I begin discussing the weekly challenges, let me address the recent brouhaha over a post made by Bartosz Jarzyna which I missed being rather busy lately. Personally I mostly do C++ these days and lately some Kotlin. I don't use Perl professionally very much and I have no occasion to use Raku whatsoever. The PWC is my lifeline to keeping my skills sharp in the languages I love the most and I applaud the amount of effort put into it. God bless you Mohammed and I hope people will put their energy into helping you instead of backbiting.

On the subject of blogs, God knows my contributions are hardly compelling reading though once in a while someone has told me something I wrote was helpful. But the point is that without the PWC I wouldn't be blogging at all. Bartosz must surely have noticed that Perl/Raku content is hardly thick on the ground at this time. When it picks up again we can discuss curating content a little more discriminately but right now isn't the fact that anyone is discussing these languages at all a good thing? The only valid point I think he made is it is better to have more distinct titles and URLs for SEO and visibility. When I revisit the script that builds this blog soon I will look into it.

Challenge 1:

Number Sequence

You are given a number $N >= 10.

Write a script to split the given number such that the difference between two consecutive numbers is always 1 and it shouldn’t have leading 0.

Print the given number if it impossible to split the number.

Input: $N = 1234
Output: 1,2,3,4

Input: $N = 91011
Output: 9,10,11

Input: $N = 10203
Output: 10203 as it is impossible to split satisfying the conditions.

I made a couple of failed attempts at this problem before I came up with a solution. This is the Raku version.

I start by setting up a boolean variable that will hold if a valid sequence has been found or not.

my $found = True;

We do a loop of the size of each group of digits in the sequence from single digits upto half the length of the input. (Because there must be atleast two groups to make a sequence.)

for 1 .. $N.chars / 2 -> $len {

We reset $found again here because it may have become false during a previous iteration of the loop.

    $found = True;

If the number of digits in the input is not an even multiple of the size of the group, we have to add some padding 0s.

    my $n =  '0' x ($N.chars % $len) ~ $N;

Now we can split the digits into groups and put those groups into a list.

    my @digits = $n.comb($len);

Starting at the second element, we go through the list and compare with the previous element. If the difference isn't 1 or if the element begins with a 0 (because we started from the second element, the padding 0s in the first element will not be affected,) we have a problem so we set $found to false and bail out of the search.

    for 1 ..^ @digits.elems -> $group {
        if @digits[$group].substr(0, 1) == '0' || @digits[$group] - @digits[$group - 1] != 1 {
            $found = False;

If after going through the search, $found is true, we have a match. The sequnce is printed out (with leading 0s removed) and the script is finished.

    if $found {
        say{ s/^0//; $_; }).join(q{,});

If after going through groups of all sizes $found is false, it means we couldn't create a sequence so the original number is printed.

if !$found {
    say $N;

(Full code on Github.)

This is the Perl version.

my $found = 1;

for my $len (1 .. (length $N) / 2) {
    $found = 1;

    my $n =  '0' x ((length $N) % $len) . $N;
    my @digits = $n =~ /.{1,$len}/g;
    for my $group (1 .. scalar @digits - 1) {
        if (substr($digits[$group], 0, 1) == '0' || $digits[$group] - $digits[$group - 1] != 1) {
            $found = undef;

    if ($found) {
        @digits = map { s/^0//; $_; } @digits;
        say join q{,}, @digits;

if (!$found) {
    say $N;

(Full code on Github.)

Challenge 2:

Sum of Squares

You are given a number $N >= 10.

Write a script to find out if the given number $N is such that sum of squares of all digits is a perfect square. Print 1 if it is otherwise 0.

Input: $N = 34
Ouput: 1 as 3^2 + 4^2 => 9 + 16 => 25 => 5^2

Input: $N = 50
Output: 1 as 5^2 + 0^2 => 25 + 0 => 25 => 5^2

Input: $N = 52
Output: 0 as 5^2 + 2^2 => 25 + 4 => 29

This one is almost a one-liner in Raku but I split it up a bit for clarity.

We split the number into digits and then square each one. These squares are stored in the list @digits.

    my @digits = ${ $_ * $_; });

Then @digits is totalled up using the [+] operator and the square root of the result is taken. If it is an integer (%% is the integer modulus operator,) 1 is printed or else 0.

    say ([+] @digits).sqrt %% 1 ?? 1 !! 0;

(Full code on Github.)

This is the Perl translation.

my @digits = map { $_ * $_} split //, $N;

It is a little more verbose because we don't have that handy [+] but the code below does the trick.

my $total = 0;
for my $digit (@digits) {
    $total += $digit;

Also there doesn't seem to be a quick way to see if a number is an integer without using a module so I just checked if it is all digits (i.e. no decimal point etc.)

say sqrt($total) =~ / ^ [[:digit:]]+ $ /x ? 1 : 0;

(Full code on Github.)