Perl Weekly Challenge: Week 155

Challenge 1:

Fortunate Numbers

Write a script to produce first 8 Fortunate Numbers (unique and sorted).

According to Wikipedia

A Fortunate number, named after Reo Fortune, is the smallest integer m > 1 such that, for a given positive integer n, pn# + m is a prime number, where the primorial pn# is the product of the first n prime numbers.

Expected Output
3, 5, 7, 13, 17, 19, 23, 37

This is my Raku solution:

First we set up an array to hold the results.

my @fortunates;

Then we loop until we have the full set of 8 results we want.

my $i = 0;
while @fortunates.elems < 8 {

The primorials mentioned in the spec are generated by a lazy list of integers from 2 onwards. From this list, we grep an amount of prime numbers using .is-prime() equal to n (though for some reason I named the variable $i instead of $n.) These primes are multiplied together using the [*] operator.

    my $pn = [*] (2  ... ∞).grep({ .is-prime; })[0 .. $i++];

Now from $pn + 2 we begin counting upwards. 2 because the next number after a prime cannot be prime except for the case of 2 and 3.

    for $pn + 2 .. ∞ -> $m {

If this number, $m is prime and the difference between it and $pn hasn't already been included in our results...

        if ($m.is-prime && $m - $pn ∉ @fortunates) {

...we add the difference to the results and break the loop so we can find the next fortunate number.

            @fortunates.push($m - $pn);
            last;
        }
    }
}

Finally, all that needs to be done is to print out the results.

@fortunates.sort.join(q{, }).say;

(Full code on Github.)

The Perl version works the same way for the most part except I had to re-use my trusty isPrime() and nextPrime() functions from previous challenges.

my @fortunates;

my $i = 0;
while (scalar @fortunates < 8) {
    my $pn = nextPrime(1);

And I made up for a lack of [*] by multiplying in a loop.

    for my $j (1 .. $i++) {
        $pn *= nextPrime();
    }

    my $m = $pn + 1;

    while($m++) {
        if (isPrime($m) && !grep { $_ == $m - $pn } @fortunates) {
            push @fortunates, $m - $pn;
            last;
        }
    }
}

say join q{, }, sort {$a <=> $b} @fortunates;

(Full code on Github.)

Challenge 2:

Pisano Period

Write a script to find the period of the 3rd Pisano Period.

In number theory, the nth Pisano period, written as π(n), is the period with which the sequence of Fibonacci numbers taken modulo n repeats.

The Fibonacci numbers are the numbers in the integer sequence:

0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, 2584, 4181, 6765, ...

For any integer n, the sequence of Fibonacci numbers F(i) taken modulo n is periodic. The Pisano period, denoted π(n), is the value of the period of this sequence. For example, the sequence of Fibonacci numbers modulo 3 begins:

0, 1, 1, 2, 0, 2, 2, 1,
0, 1, 1, 2, 0, 2, 2, 1,
0, 1, 1, 2, 0, 2, 2, 1, ...

This sequence has period 8, so π(3) = 8.

One of the things I love about Raku is the complete unicode support which lets you do things like name a subroutine π.

This lets us be really expressive. The solution looks like this:

say π(3);

How cool is that!?

The actual π() is shown below. It takes a number $n (In hindsight I should have explicitly made it an Int) which is the Pisano period we are calculating. (Last week Padua and this week Pisa; where in Italy will the weekly challenge take us next?)

sub π($n) {

We need fibonacci numbers. The line below creates them efficiently as a lazy sequence.

    my @fibs = 0, 1, -> $a, $b { $a + $b} ... ∞;

Now we grow a list of moduli (moduluses?) of fibonacci numbers two at a time so we can evenly divide it into two halves.

    my $i = 2;
    loop {
        my @moduli = @fibs[0 ..^ $i].map({ $_ mod $n; });

The two halves are compared using a combination of Z== and .all(). I keep forgetting that Raku has an eqv operator does the same thing in a more readable fashion. Oh well, this works too.

        if (@moduli[0 ..^ $i / 2] Z== @moduli[$i / 2 .. *]).all {

If the two halves are the same, we have a recurring sequence. The length of a half, which is the Pisano period, is returned.

            return $i / 2;
        }

        $i += 2;
    }
}

(Full code on Github.)

In the Perl version, I generated Fibonacci numbers using a recursive function like this:

sub fibonacci {
    my ($n) = @_;

    if ($n <= 1) {
        return $n;
    }
    return fibonacci($n - 1) + fibonacci($n - 2);
}

and it worked well enough for $n = 3 which is all the spec asks for. However just to see if my code was working correctly, I calculated all the first 10 Pisano periods. I found that the code got really slow for $n > 4. I pulled the plug on $n == 10 when it looked like it would never finis. This is because a recursive function has to keep calculating intermediate results over and over again. An easy solution for this problem is to use Memoize; and add this line of code:

memoize('fibonacci');

The Memoize module caches intermediate results giving fibonacci() a tremendous speedup, though by $n = 10, it was starting to bog down a little. Atleast it finished though.

I noticed Raku could calculate even the 10th Pisano period with ease. I wonder what it is doing behind the scenes to be so fast?

Perl is more limited in characters that can be used as identifiers unless you use utf8; which I always forget to do so I gave the function the boring name pisano() instead.

sub pisano {
    my ($n) = @_;
    my $i = 2;

    while (1) {
        my @moduli = map { fibonacci($_) % $n; } 0 .. $i -1;

In Perl also, I try to detect a recurring sequence by comparing two halves of an array. This time however, the comparison is done using the smartmatch operator ~~. Although it has been around for a long time, ~~ is still considered experimental so you have to add no warnings 'experimental'; to avoid an annoying warning message.

        if (@moduli[0 .. $i / 2 - 1] ~~ @moduli[$i / 2 .. $#moduli]) {
            return $i / 2;
        }
        $i += 2;
    }
}

say pisano(3);

(Full code on Github.)