Perl Weekly Challenge: Week 149

Challenge 1:

Fibonacci Digit Sum

Given an input $N, generate the first $N numbers for which the sum of their digits is a Fibonacci number.

Example

f(20)=[0, 1, 2, 3, 5, 8, 10, 11, 12, 14, 17, 20, 21, 23, 26, 30, 32, 35, 41, 44]

I have to admit I needed to google how to find if a number is in the Fibonacci sequence. I have implemented the method shown on this page in the following two functions.

sub isFibonacci($n) {
    return isPerfectSquare(5 * $n² + 4) || isPerfectSquare(5 * $n² - 4);
}

sub isPerfectSquare($n) {
    my $s = $n.sqrt.Int;
    return $s² == $n;
}

I love how you can use unicode characters as operators like ² for squaring a number.

Anyway, now we can solve the challenge. We will store the fibonacci digit sums in this array.

my @sums;

We will start with the number 0 and work upwards until...

my $n = 0;

...we have reached $N number of sums. Actually it will be easier if we start at $N and count down to 0. In any case, this variable will keep track of our current progress.

my $count = $N;

Now while $count is not 0...

while $count {

...we split $n into individual digits with .comb() and add them together with .sum(). Then we take the result and check it to see if it is a Fibonacci number.

    if isFibonacci( $n.comb.sum ) {

If so, $n is added to @sums and $count is decremented.

        @sums.push($n);
        $count--;
    }

We continue on to the next number by incrementing $n.

    $n++;
}

When $count is 0, we have all the sums we need so we print them nicely with commas and spaces.

@sums.join(q{, }).say;

(Full code on Github.)

This is the Perl version.

sub isFibonacci($n) {
    return isPerfectSquare(5 * $n * $n + 4) || isPerfectSquare(5 * $n * $n - 4);
}

sub isPerfectSquare($n) {
    my $s = int(sqrt($n));
    return $s * $s == $n;
}

Instead of ², we have to explicitly say $n * $n. Boring!

The rest of the code works just like the Raku version.

my @sums;
my $n = 0;
my $count = $N;

while ($count) {
    my $sum = sum((split //, $n));
    if (isFibonacci($sum)) {
        push @sums, $n;
        $count--;
    }
    $n++;
}

say join q{, }, @sums;

(Full code on Github.)

Challenge 2:

Largest Square

Given a number base, derive the largest perfect square with no repeated digits and return it as a string. (For base>10, use ‘A’..‘Z’.)

Example

f(2)="1"
f(4)="3201"
f(10)="9814072356"
f(12)="B8750A649321"

We get the number base from the command-line parameters as a scalar $base. Then we assign storage for the largest perfect square in that base.

my $max = 0;

In my first attempted solution, I went through all the integers from 1 onwards, checking to see if they were perfect squares using the isPerfectSquare() function from challenge 1. But this was exceedingly slow and inefficient.

Instead what I am doing now is going through the integers but immediately squaring them and working with that number. A perfect square by definition has to be a square. I also took the oportunity to convert it into the required base.

for 1 .. ∞ -> $n {
    my $square = ($n²).base($base);

If this square number has more digits than the base, a digit must have repeated. This is a sign we have gone too far and can stop processing.

    if $square.chars > $base {
        last;
    } 

Then the sqaured number is split into digits with .comb().

    my @digits = $square.comb;

The previous check was not enough. A number shorter than the base could also have non-unique digits too. If the squared number is ok, it becomes the new value of $max.

    if @digits == @digits.unique {
        $max = $square;
    }
}

Whatever is the value of $max when the loop ends is the right answer and is printed out.

say $max;

(Full code on Github.)

Translating Raku code to Perl usually involves supplying functions to replace Raku amenities which aren't available. Luckily after all this time, I can go back to previous challenges and cut and paste stuff I had already written. unique() for instance, I just used recently but for base() I had to go all the way back to PWC 43!

With these in hand, the rest of the script is the same as Raku.

my $max = 0;
my $n = 1;

while(true) {
    my $square = base($n * $n, $base);
    if (length($square) > $base) {
        last;
    } 

    my @digits = split //, $square;

    if (scalar @digits == scalar unique(@digits)) {
        $max = $square;
    }

    $n++;
}

say $max;

(Full code on Github.)