laurent_r

These are some answers to the Week 116 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a couple of days (June 13, 2021). 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: 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.

Example:

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.

Number Sequence in Raku

One way to see it is to say that we want to partition the digits of the input number in such a way that each partition (with one or several digits) is a number one more than the preceding one.

In Raku, my first idea was to use the combinations built-in method to generate the particions, but this turned out to be impractical. So I decided to use a completely different route: in Raku, the regex sub-language has an exhaustive (or ex for short) adverb which generate all possible matches between a string and the searches pattern. With this adverb and a pattern such as (\d+)+, we can generate all possible combinations of digits of an input number. This leads to the following program:

use v6;

sub num-seq (Int $in) {
    MATCH: for $in ~~ m:ex/^(\d+)+$/ -> $m {
        my @match = $m[0].map({~$_}); # stringify the match object
        next MATCH if @match.elems < 2; 
        for 1..@match.end -> $i {
            next MATCH if @match[$i] ~~ /^0/ or # remove a match starting with 0
                @match[$i] - @match[$i - 1] != 1;
        }
        return @match;
    }
    return $in
}

for <1234 91011 10203> -> $test {
    say join ', ', num-seq $test;
}

This program displays the following output:

raku ./num-seq.raku
1, 2, 3, 4
9, 10, 11
10203

Number Sequence in Perl

Perl regexes don’t have a functionality for exhaustive pattern matching. So our Perl solution will be entirely different.

We use a num_seq recursive subroutine to potentially generate all possible partitions, except that we don’t really generate all partitions, as we filter out early in the process beginnings of partitions that cannot yield a solution,

use strict;
use warnings;
use feature "say";
my $end_result;

sub num_seq {
    my $cur_val = shift; 
    my $result = shift;
    my @digits = @_;

    my $len = length $cur_val;
    return if scalar @digits < $len;
    $cur_val = $digits[0] - 1 unless $cur_val;
    for my $i ($len - 1 .. $#digits) {
        my $new_val = join "", @digits[0..$i];
        next if $new_val - $cur_val != 1 or $new_val =~ /^0/;
        push @{$result}, join "", @digits[0..$i];
        # say "@$result";
        if (scalar @digits > $len) {
            num_seq($new_val, $result, @digits[$i+1..$#digits]);
        } else {
            $end_result = $result;
            return;
        }
    }
}

for my $test (qw<1234 91011 10203>) {
    $end_result = "";
    num_seq 0, [], split "", $test;
    if ($end_result) { 
        say join ", ", @$end_result;
    } else {
        say $test;
    }
}

This script displays the following output:

$ perl  num-seq.pl
1, 2, 3, 4
9, 10, 11
10203

Task 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.

Example:

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

Note that all multiples of ten until 100 satisfy the perfect square condition, as well as all multiples of 100 until 1000 (and so on). Also note that since 34 satisfies the condition, as shown in the example above, then its anagram 43 also does.

Sum of Squares in Raku

Just straight forward: for every number in the test input range, we check whether the sum of digit squares is a perfect square.

use v6;

sub sum-squares (Int $n where * >= 10) {
    my $sum-sq = [+] $n.comb.map({$_²});
    my $sqrt-int = $sum-sq.sqrt.Int;
    return $sqrt-int² == $sum-sq ?? 1 !! 0;
}
say "$_: ", sum-squares $_ for 10..71;

This program displays the following output:

$ raku  ./sum-squares.raku
10: 1
11: 0
12: 0
13: 0
14: 0
15: 0
16: 0
17: 0
18: 0
19: 0
20: 1
21: 0
22: 0
23: 0
24: 0
25: 0
26: 0
27: 0
28: 0
29: 0
30: 1
31: 0
32: 0
33: 0
34: 1
35: 0
36: 0
37: 0
38: 0
39: 0
40: 1
41: 0
42: 0
43: 1
44: 0
45: 0
46: 0
47: 0
48: 0
49: 0
50: 1
51: 0
52: 0
53: 0
54: 0
55: 0
56: 0
57: 0
58: 0
59: 0
60: 1
61: 0
62: 0
63: 0
64: 0
65: 0
66: 0
67: 0
68: 1
69: 0
70: 1
71: 0

Sum of Squares in Raku

This is a port to Perl of the Raku program above:

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

sub sum_squares {
    my $n = shift;
    my $sum_sq = 0;
    $sum_sq += $_ ** 2 for split //, $n;
    my $sqrt_int = int sqrt $sum_sq;
    return $sqrt_int ** 2 == $sum_sq ? 1 : 0;
}
say "$_: ", sum_squares $_ for 10..71;

This program displays the same output as the Raku program above:

$ perl  ./sum-squares.pl
10: 1
11: 0
12: 0
13: 0
14: 0
15: 0
16: 0
17: 0
18: 0
19: 0
20: 1
21: 0
22: 0
23: 0
24: 0
25: 0
26: 0
27: 0
28: 0
29: 0
30: 1
31: 0
32: 0
33: 0
34: 1
35: 0
36: 0
37: 0
38: 0
39: 0
40: 1
41: 0
42: 0
43: 1
44: 0
45: 0
46: 0
47: 0
48: 0
49: 0
50: 1
51: 0
52: 0
53: 0
54: 0
55: 0
56: 0
57: 0
58: 0
59: 0
60: 1
61: 0
62: 0
63: 0
64: 0
65: 0
66: 0
67: 0
68: 1
69: 0
70: 1
71: 0

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