Perl Weekly Challenge: Week 102

Challenge 1:

Rare Numbers

You are given a positive integer $N.

Write a script to generate all Rare numbers of size $N if exists. Please checkout the page for more information about it.

Examples
(a) 2 digits: 65
(b) 6 digits: 621770
(c) 9 digits: 281089082

I'm going to show you the Raku code for my solution in a slightly different order than it appears in the actual script. The basics of what we need to do looks like this:

sub MAIN(
    Int $N #= length of rare number
) {
    for (10 ** ($N - 1)) ..^ (10 ** $N) -> $n {

We range through all the integers of the required length.

        my $r = $n;
        my $r1 = "$n".flip.Int;

$r1 is created by treating $r (actually $n as they are equivalent) as a string, reversing the string, and then casting it back to an integer.

        if isRare($r, $r1) {
            say $r;

Then if it is a rare number we print it.

        }
    }
}

The isRate function is shown below.

sub isRare(Int $r, Int $r1) {
    return sqrt($r + $r1) %% 1 && sqrt($r - $r1) %% 1;
}

%% 1 means if a number is evenly divisible by 1 i.e. it has no fractional component or in other words it is an integer. If both the square root of $r + $r1 and the square root of $r - $r1 are integers, we have a rare number otherwise we don't.

This will work but it will be extremely slow for larger values of $N as we will be processing many numbers which have no chance of being rare numbers and it will also give false positives in the case of palindromes such as 242 which are not deemed rare numbers.

The problem of palindrames can easily be addressed with the following check just after $r and $r1 have been defined:

if ($r == $r1) {
    next;
}

To try and weed out useless prospects, we can employ certain properties of rare numbers. If a rare number is even, $r + $r1 will have a factor of 11 if it is less than 3 digits or 121 if it is greater. If a rare number is odd, $r - $r1 will have a factor of 11 if it is less than 4 digits and 1089 if it is greater. Expressed in code that is:

my $xfactor = $N < 3 ?? 11 !! 121;
my $yfactor =  $N < 4 ?? 11 !! 1089;

Now the inside of our loop can look like this:

if $N %% 2 {
    if ($r + $r1) %% $xfactor && isRare($r, $r1) {
        say $r;
    }
} else {
    if ($r - $r1) %% $yfactor && isRare($r, $r1) {
        say $r;
    }
}

(Full code on Github.)

There is still more optimization that can be done but with only these changes, $N = 9 completed in less than 2 minutes which was good enough for me so I left it as is.

For the Perl version, I tried to follow the same course but I ended up having to make some adjustments.

sub isRare {
    my ($r, $r1) = @_;
    my $x = sqrt($r + $r1);
    if ($r1 > $r) {
        return undef;
    }
    my $y = sqrt($r - $r1);
    return $x == int($x) && $y == int($y);
}

In particular the isRare() function gave me problems. Perl doesn't have an equivalent to Rakus' %% operator that works the same way. Also Perls' sqrt() apparently doesn't do negative numbers like Raku does. As that would only occur for an invalid rare number anyway, I just added a check to make sure $r is greater than $r1 and return a false value if it is not.

my ($N) = @ARGV;

my $xfactor = $N < 3 ? 11 : 121;
my $yfactor =  $N < 4 ? 11 : 1089;

for my $n ((10 ** ($N - 1)) .. ((10 ** $N) - 1)) {
    my $r = $n;
    my $r1 = 0 + reverse "$n";

    if ($r == $r1) {
        next;
    }

    if ($N % 2 == 0) {
        if (($r + $r1) % $xfactor == 0 && isRare($r, $r1)) {
            say $r;
        }
    } else {
        if (($r - $r1) % $yfactor == 0 && isRare($r, $r1)) {
            say $r;
        }
    }
}

(Full code on Github.)

Other than those minor inconveniences, the Perl version follows the same pattern as the Raku version.

Challenge 2:

Hash-Counting String

You are given a positive integer $N.

Write a script to produce Hash-counting string of that length.

The definition of a hash-counting string is as follows:

It can be shown that for every positive integer N there is exactly one such length-N string.

Examples
(a) "#" is the counting string of length 1
(b) "2#" is the counting string of length 2
(c) "#3#" is the string of length 3
(d) "#3#5#7#10#" is the string of length 10
(e) "2#4#6#8#11#14#" is the string of length 14

This one was a lot easier. I shall start with Raku again.

sub MAIN(
    Int $N #= length of hash-counting string
) {
    my $wasHash = 0;

    my @hash-counting;
    my $pos = $N;

    while $pos > 0 {
        if $wasHash {
            @hash-counting.unshift("$wasHash");
            $pos -= "$wasHash".chars;
            $wasHash = 0;
        } else {
            @hash-counting.unshift('#');
            $wasHash = $pos;
            $pos--;
        }
    }

    @hash-counting.join(q{}).say;
}

(Full code on Github.)

What I did was built up the hash-counting string backwards. I stored its' components in an array as they are of variable length. We know from the description that the last character (at the end of the array i.e. position $N) is always going to be a #. The one before that will be the value $N with a length of the number of digits in $N. The one before that will be # again, and the one before that its' position and so on until we get to the beginning of the string (the start of the array i.e. position 1.)

How do we know whether to add a # or a number? If the last element of the array added was a #, the variable $wasHash contains its' position. If it wasn't, $wasHash = 0.

This is the Perl version. It is a straight copy of the Raku code.

my ($N) = @ARGV;

my $wasHash = 0;
my @hashCounting;
my $pos = $N;

while ($pos > 0) {
    if ($wasHash) {
        unshift @hashCounting, "$wasHash";
        $pos -= length "$wasHash";
        $wasHash = 0;
    } else {
        unshift @hashCounting, '#';
        $wasHash = $pos;
        $pos--;
    }
}

say join q{}, @hashCounting;

(Full code on Github.)