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

Spoiler Alert: This weekly challenge deadline is due in a couple of days from now (on April 3, 2022 at 24:00). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Additive Primes

Write a script to find out all Additive Primes <= 100.

Additive primes are prime numbers for which the sum of their decimal digits are also primes.

Output

2, 3, 5, 7, 11, 23, 29, 41, 43, 47, 61, 67, 83, 89

Additive Primes in Raku

Using the is-prime (used twice), comb, and sum methods, this task can be solved in Raku with a simple one-liner:

say join ", ",  grep { .is-prime and .comb.sum.is-prime }, 1..100;

This script displays the following output:

$ raku ./add-prime.raku
2, 3, 5, 7, 11, 23, 29, 41, 43, 47, 61, 67, 83, 89

Additive Primes in Perl

Perl doesn’t have a built-in is_prime subroutine, so we implement it. In this case, we only need to check primality of integers smaller than than 100, which means that we need to check divisibility by primes smaller than 10, i.e. only four integers (2, 3, 5, 7).

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

my @small_primes = (2, 3, 5, 7);

sub is_prime {
    my $n = shift;
    for my $p (@small_primes) {
        return 1 if $p == $n;
        return 0 if $n % $p == 0;
    }
    return 1;
}

for my $n (grep {is_prime $_} 2..100) {
    my $sum = 0;
    $sum += $_ for split '', $n;
    print "$n " if is_prime $sum;
}
say "";

This script displays the following output:

$ perl ./add-prime.pl
2 3 5 7 11 23 29 41 43 47 61 67 83 89

Task 2: First Series Cuban Primes

Write a script to compute first series Cuban Primes <= 1000. Please refer to this Wikipedia page for more informations.

Output:

7, 19, 37, 61, 127, 271, 331, 397, 547, 631, 919.

A Cuban prime is a prime number that is also a solution to one of two different specific equations involving differences between third powers of two integers x and y.

The equation for the first series Cuban Primes is:

Replacing x with y + 1 in the first part of this equation leads to the following simplified formula: 3 y² + 3 y + 1.

Note that these numbers have apparently nothing to do with Cuba: their name is derived from the role cubes (third powers) play in the equations.

First Series Cuban Primes in Raku

We simply compute 3 y² + 3 y + 1 for successive integer values of y and print out those that yield prime integer result:

for 1..Inf -> $n {
    my $p = 3 * $n ** 2 + 3 * $n + 1;
    last if $p > 1000;
    print "$p, " if $p.is-prime;
}
say " ";

This program displays the following output:

$ raku ./cuban.raku
7, 19, 37, 61, 127, 271, 331, 397, 547, 631, 919,

First Series Cuban Primes in Perl

We update the is_prime subroutine of the previous task to work until 1000, so that we use primes between 2 and the square root of 1000, i.e. between 3 and 31. Besides that, this program is essentially a port to Perl of the Raku program above:

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

my @small_primes = (2, 3, 5, 7, 11,13, 17, 19, 23, 29, 31);

sub is_prime {
    my $n = shift;
    for my $p (@small_primes) {
        return 1 if $p == $n;
        return 0 if $n % $p == 0;
    }
    return 1;
}

for my $n (1..50) {
    my $p = 3 * $n ** 2 + 3 * $n + 1;
    last if $p > 1000;
    print "$p, " if is_prime $p;
}
say " ";

This program displays the following output:

$ perl ./cuban.pl
7, 19, 37, 61, 127, 271, 331, 397, 547, 631, 919,

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 April 10, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.

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

Spoiler Alert: This weekly challenge deadline is due in a couple of days from now (on March 27, 2022 at 24:00). 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: Pythagorean Numbers

You are given a set of integers.

Write a script to compute all three Pythagorean Means i.e Arithmetic Mean, Geometric Mean and Harmonic Mean of the given set of integers. Please refer to wikipedia page for more informations.

Example 1:

Input: @n = (1,3,5,6,9)
Output: AM = 4.8, GM = 3.9, HM = 2.8

Example 2:

Input: @n = (2,4,6,8,10)
Output: AM = 6.0, GM = 5.2, HM = 4.4

Example 3:

Input: @n = (1,2,3,4,5)
Output: AM = 3.0, GM = 2.6, HM = 2.2

Since the task description doesn’t explain it, let me provide some formulas for arithmetic mean (AM), geometric mean (GM) and harmonic mean (AM):

Pythagorean Numbers in Raku

The Raku build-in [ ] reduce metaoperator makes it possible to compute each of the means with just one simple code-line:

for (1,3,5,6,9), (2,4,6,8,10), (1,2,3,4,5) -> @in {
    my $n = @in.elems;
    my $am = ([+] @in)/ $n;
    my $gm = ([*] @in)** (1/$n);
    my $hm = $n / ([+] map { 1/$_}, @in);
    printf  "%-10s -> AM: %0.1f, GM: %0.1f, HM: %0.1f\n", "@in[]", $am, $gm, $hm;
}

This script displays the following output:

$ raku ./means.raku
1 3 5 6 9  -> AM: 4.8, GM: 3.8, HM: 2.8
2 4 6 8 10 -> AM: 6.0, GM: 5.2, HM: 4.4
1 2 3 4 5  -> AM: 3.0, GM: 2.6, HM: 2.2

Pythagorean Numbers in Perl

Perl doesn’t have a built-in reduce operator. We could either implement a reduce subroutine (I’ve done that in some previous PWC challenge), or compute each mean separately. Here, I’ve chosen the second option.

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

for my $test ([1,3,5,6,9], [2,4,6,8,10], [1,2,3,4,5]) {
    my @in = @$test;
    my $n = scalar @in;

    my $sum = 0;
    $sum += $_ for @in;
    my $am = $sum / $n;

    my $prod = 1;
    $prod *= $_ for @in;
    my $gm = $prod ** (1/$n);

    my $invsum = 0;
    $invsum += 1/$_ for @in;
    my $hm = $n / $invsum;
    printf  "%-10s -> AM: %0.1f, GM: %0.1f, HM: %0.1f\n", "@in", $am, $gm, $hm;
}

This script displays the following output:

$ perl ./means.pl 1 3 5 6 9 -> AM: 4.8, GM: 3.8, HM: 2.8 2 4 6 8 10 -> AM: 6.0, GM: 5.2, HM: 4.4 1 2 3 4 5 -> AM: 3.0, GM: 2.6, HM: 2.2

Task 2: Brazilian numbers

You are given a number $n > 3.

Write a script to find out if the given number is a Brazilian Number.

A positive integer number N has at least one natural number B where 1 < B < N-1 where the representation of N in base B has same digits.

Example 1:

Input: $n = 7
Output: 1

Since 7 in base 2 is 111.

Example 2:

Input: $n = 6
Output: 0

Since 6 in base 2 is 110,
      6 in base 3 is 20 and
      6 in base 4 is 12.

Example 3:

Input: $n = 8
Output: 1

Since 8 in base 3 is 22.

Well to start with, I find the above definition of a Brazilian number to be not completely clear. This is another definition:

Brazilian” numbers are numbers n such that there is a natural number b with 1 < b < n-1 such that the representation of n in base b has all equal digits.

First, the condition b < n-1 is important because every number n has representation 11 in base n-1. Then, every even number 2P >= 8 is Brazilian, because 2P = 2(P-1) + 2, which is 22 in base P-1 when P-1 > 2. Finally, we will extend the task to a search of all Brazilian numbers less than or equal to 36, since working with bases larger than 36 (the 1..9, 'a'..'z' range) would require a different data model.

Brazilian Numbers in Raku

We use the Raku built-in base to convert the input number to a string using $base as base.

sub is-brazilian (Int $n) {
    return True if $n %% 2 and $n >= 8;
    return False if $n <= 3;
    for 2..^($n-1) -> $base {
        return True if $n.base($base) ~~ /^(\d)$0+$/;
    }
    False;
}

say "Brazilian numbers less than or equal to 36 are:";
for 1..36 -> $m {
    print "$m " if is-brazilian $m;
}
say "";

This script displays the following Brazilian numbers:

$ raku ./brazilian_number.raku
Brazilian numbers less than or equal to 36 are:
7 8 10 12 13 14 15 16 18 20 21 22 24 26 27 28 30 31 32 33 34 35 36

Brazilian Numbers in Perl

The program below if basically a port to Perl of the Raku program above. The only significant change is that we had to implement the to_base_b subroutine to perform decimal-to-some_base conversion.

use strict;
use warnings;
use feature qw /say/;
use constant DIGITS => ('0'..'9', 'A'..'Z');

sub to_base_b { # Converts decimal number to base b string
    my($dec, $base) = @_;
    my @digits;
    while ($dec) {
        unshift @digits, (DIGITS)[$dec % $base];
        $dec = int($dec/$base);
    }
    return join "", @digits;
}

sub is_brazilian {
    my $n = shift;
    return 1 if $n % 2 == 0 and $n >= 8;
    return 0 if $n <= 3;
    for my $base (2..$n-2) {
        return 1 if to_base_b($n, $base) =~ /^(\d)\1+$/;
    }
    0;
}

say "Brazilian numbers less than or equal to 36 are:";
for my $m (1..36) {
    print "$m " if is_brazilian($m);
}
say "";

This program displays the following output:

$ perl brazilian_number.pl
Brazilian numbers less than or equal to 36 are:
7 8 10 12 13 14 15 16 18 20 21 22 24 26 27 28 30 31 32 33 34 35 36

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 April 3, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.

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

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on March 20, 2022 at 24:00). 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: Pernicious Numbers

Write a script to permute first 10 Pernicious Numbers.

A pernicious number is a positive integer which has prime number of ones in its binary representation.

The first pernicious number is 3 since binary representation of 3 = (11) and 1 + 1 = 2, which is a prime.

Expected Output:

3, 5, 6, 7, 9, 10, 11, 12, 13, 14

I’m not sure why the task description speaks about permuting the first 10 pernicious numbers. It seems we’re simply requested to display them.

Pernicious Numbers in Raku

In Raku, we can use the base method to convert a real number into a string representation with a chosen base. To find the number of 1 in the resulting binary string, we can just sum the digits. Then, Raku has the built in is-prime to find out whether the 1 count is a prime numbers. We end up with a method invocation pipeline ($n.base(2).comb.sum.is-prime) that does all the real work.

my $count = 0;
for 2..* -> $n {
    if $n.base(2).comb.sum.is-prime {
        $count++;
        print "$n, " and next if $count < 10;
        say $n and last;
    }
}

This program displays the following output:

$ raku ./pernicious.raku
3, 5, 6, 7, 9, 10, 11, 12, 13, 14

Pernicious Numbers in Perl

In Perl, we will simply use the sprintf built-in function with a %b formatting string to convert the input integer into a binary representation. The program is otherwise similar to the Raku implementation, except for finding if the 1 count is prime. We could write a subroutine for that (or, rather, re-use one of the numerous such subroutines that I have implemented for previous Perl Weekly Challenge task implementations, including last week for PWC 155). But since we don’t need any large prime, I’ll simply hard-code the first eight prime numbers (those less than 20) known to all people having even only a slight inclination for maths , and store them in a hash for fast lookup

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

my $count = 0;
my %primes = map { $_ => 1 } (2, 3, 5, 7, 11, 13, 17, 19);

for my $n (2..100) {
    my $bin = sprintf "%b", $n;
    my $num_1 = 0;
    $num_1 += $_ for split "", $bin;
    if (exists $primes{$num_1}) {
        $count++;
        print "$n, " and next if $count < 10;
        say $n and last;
    }
}

This script displays the following output:

$ perl pernicious.pl
3, 5, 6, 7, 9, 10, 11, 12, 13, 14

Pernicious Numbers in Julia

primes = Dict(2 => 1, 3 => 1, 5 => 1, 7 => 1, 11 => 1, 13 => 1, 17 => 1, 19 => 1)
count = 0
for n in 2:20
    n_bin = string(n, base=2)
    num_1 = 0
    for digit in n_bin
        num_1 += parse(Int64, digit)
    end
    if num_1 ∈ keys(primes)
        global count
        count += 1
        print(n, " ")
        count >= 10 && break
    end
end
println("")

Output:

3 5 6 7 9 10 11 12 13 14

Pernicious Numbers in Python

primeset = {2, 3, 5, 7, 11, 13, 17, 19}
count= 0
for n in range(2, 20):
    bin_n = format(n, 'b')
    num_1 = 0
    for x in bin_n:
        if x == '1':
            num_1 += 1

    if num_1 in primeset:
        count += 1
        print(n, end =" ")
        if count >= 10:
            break
print("")

Output:

$ python3 pernicious.py
3 5 6 7 9 10 11 12 13 14

Task 2: Weird Numbers

You are given number, $n > 0.

Write a script to find out if the given number is a Weird Number.

According to Wikipedia, it is defined as:

The sum of the proper divisors (divisors including 1 but not itself) of the number is greater than the number, but no subset of those divisors sums to the number itself.

Example 1:

Input: $n = 12
Output: 0

Since the proper divisors of 12 are 1, 2, 3, 4, and 6, which sum to 16; but 2 + 4 + 6 = 12.

Example 2:

Input: $n = 70
Output: 1

As the proper divisors of 70 are 1, 2, 5, 7, 10, 14, and 35; these sum to 74, but no subset of these sums to 70.

If a number is equal to the sum of its proper divisors, it is said to be a perfect number (such as 6, 28, 496, etc.). If it it less than the sum of its divisors, it is said to be abundant and it it is more than the sum of its divisors, it is deficient. If a number is equal to the sum of a subset of its proper divisors (such as 12), it it said to be semi-perfect). With these definitions in mind, a weird number is an abundant number that is not semi-perfect.

Weird Numbers in Raku

The is-weird subroutine first finds the proper divisors of the input integer (testing divisibility for all integers less than or equal to the input integer). Then it returns False if the sum of the divisors is less than or equal to the input integer (i.e. if the input number is deficient or perfect). For the remaining integers (the so-called abundant numbers), it uses the combinations method on the @divisors list to test all subsets of at least 2 items and returns False if the sum of the items of any such subset is equal to the input numbers. If no such subset has been found, then the number is not semi-perfect and the subroutine returns True.

sub is-weird (Int $n where * > 0) {
    my @divisors = grep {$n %% $_}, 1..$n/2;
    return False if @divisors.sum <= $n;
    for @divisors.combinations: 2..@divisors.elems -> $subset {
        return False if $subset.sum == $n;
    }
    True;
}

for 2..1000 -> $m {
    say "Found $m" if is-weird($m);
}

This script finds only two integers less than 1000 that are weird:

raku ./wierd_nrs.raku
Found 70
Found 836

Weird Numbers in Perl

This is essentially a port to Perl of the Raku implementation above, except that we had to implement two helper subroutines, sum and combine. The first one simply computes the sum of the items of an input list or array, and the second is a recursive subroutine that computes all subsets of the input divisors list and returns a false value (0) if the sum of any subset is equal to the input integer, and a true value (1) otherwise.

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

sub sum {
    my $sum = 0;
    $sum += $_ for @_;
    return $sum;
}

sub combine {
    my ($test, $comb, $div) = @_;
    my @comb_so_far = @$comb;
    my @divisors = @$div;
    # say "(@comb_so_far) (@divisors)";
    return 0 if sum(@comb_so_far) == $test;
    return 1 if scalar @divisors == 0;
    for my $i (0..$#divisors) {
        my $result = combine($test, [@comb_so_far, $divisors[$i]],
                             [@divisors[($i+1)..$#divisors]]);
        return 0 if $result == 0;
    }
    return 1;
}

sub is_weird {
    my $n = shift;
    my @divisors = grep {$n % $_ == 0} 1..($n/2);
    return 0 if sum(@divisors) <= $n;
    return combine($n, [], [@divisors]);
}

for my $m (2..6000) {
    say "Found $m" if is_weird($m);
}

With the wider range used in this program, it displays the following output:

$ perl weird_nrs.pl
Found 70
Found 836
Found 4030
Found 5830

This program is becoming very slow for the larger values of the input integer. It took more than 25 minutes on my computer to find the four weird numbers below 6,000 above.

Note that all four weird numbers found above are even. In fact, although there are infinitely many weird numbers, all known weird numbers are even, and it is not known whether there exists any odd weird number (this is an unsolved problem in mathematics). So if you can find an odd weird number, or else if you can prove that no such number exists, you might become famous.

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 March 27, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.

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

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on March 13, 2022 at 24:00). 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: 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

Fortunate Numbers in Raku

We first create an infinite (lazy) list (@primes) of prime numbers. Then, we use it to create a list of primordials (@primorials). And then, we use it to find fortunate numbers.

my @primes = grep { .is-prime }, 1..Inf;
my @primorials = (0, | (gather { take ([*] @primes[0..$_-1]) for 1..20}));
# say @primorials[0..8];  # (0 2 6 30 210 2310 30030 510510 9699690)

sub find-fortunate (Int $n) {
    my $pn = @primorials[$n-1];
    # say $pn;
    for 2..Inf -> $m {
        return $m if is-prime $pn + $m;
    }
}
my $fortunates = (map { find-fortunate $_ }, 2..20).Set;
say ($fortunates.keys.sort)[0..7];

This program displays the following output:

$ raku ./fortunate.raku
(3 5 7 13 17 19 23 37)

Fortunate Numbers in Perl

This a port to Perl of the Raku program above. We need to roll out our own is_prime and prime_list subroutines.

use strict;
use warnings;
use feature "say";
use constant MAX => 1000; # MAX must be an even number

my @primes = prime_list(MAX);
my %fortunates = map { find_fortunate($_) => 1} 1..15;
my @result = sort { $a <=> $b } keys %fortunates;
say join " ", @result[0..7];

sub is_prime {
        my $num = shift;
        return 1 if $num == 2;
        return 0 unless $num % 2;
        my $test = 3;
        while ($test < $num/2) {
                return 0 if $num % $test == 0;
                $test += 2;
        }
        return 1;
}

sub prime_list {
    my $max = shift;
    my @prime_list = (2, 3, 5);
    for my $c (7..$max) {
        push @prime_list, $c if is_prime($c);
    }
    return @prime_list;
}


sub find_fortunate {
    my $n = shift;
    my $pn = 1;
    $pn *= $_ for @primes[0..$n-1];
    # say $pn;
    for my $m (2..50) {
        return $m if is_prime($pn + $m);
    }
}

This program displays the following output:

$ perl ./fortunate.pl
 3 5 7 13 17 19 23 37

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

Well, the fact that we find the same sequence repeated three times as in the example above might not be an absolute mathematical proof that the sequence is really periodic. But it is a quite strong indication that it probably is. If we have a repeated sequence of (at least) two numbers, then the third (or next) number ought to be the same, and so on for the next terms. But that doesn’t necessarily mean we’ve found the longest repeated sequence.

Finding such sequences is relatively easy, but a bit painful with bunches of nested loops. We have a tool specialized in doing this kind of work: regexes.

Pisano Period in Raku

First, we use the infix ... sequence operator to compute an infinite list of Fibonacci numbers modulo 3. All terms will be one-digit integers between 0 and 2. The we join part of this list (say the first 30 terms) into a string. Then we use a regex to find a repeated pattern. Finally, we output the length of this pattern:

my @fibmod = 1, 1, (* + *) % 3 ... *;
my $seq = @fibmod[0..30].join('');
# say $seq; # 1120221011202210112022101120221
my $repeated = $0 if $seq ~~ /(.+) $0+/;
say $repeated.chars;

This script displays the following output:

$ raku ./pisano.raku
8

Pisano Period in Perl

This is essentially a port to Perl of the Raku program above, with the slight change that we’re using a loop to populate the Fibonacci numbers modulo 3.

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

my @fibmod = (1, 1);
$fibmod[$_] = ($fibmod[$_-1] + $fibmod[$_-2]) % 3 for 2..30;
my $seq = join '', @fibmod[0..30];
# say $seq; # 1120221011202210112022101120221 
my $repeated = $1 if $seq =~ /(.+)\1+/;
say length $repeated;

This program displays the following output:

$ perl ./pisano.pl
8

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

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

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on March 6, 2022 at 24:00). 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: Missing Permutations

You are given possible permutations of the string ‘PERL’.

PELR, PREL, PERL, PRLE, PLER, PLRE, EPRL, EPLR, ERPL,
ERLP, ELPR, ELRP, RPEL, RPLE, REPL, RELP, RLPE, RLEP,
LPER, LPRE, LEPR, LRPE, LREP

Write a script to find any permutations missing from the list.

We’ll assume that the permutations provided are correct, but that at least one is missing. In fact, if one of the permutation is wrong, this would not alter the result. For this task, we’ll generate all permutations and compare the result with the given list of permutations.

Missing Permutations in Raku

First, we store the given permutations in a set for fast lookup. Then, we use the permutations built-in routine to generate all permutations and loop through them to find those that are missing from the given list.

my $given_perm = set(qw/
    PELR PREL PERL PRLE PLER PLRE EPRL EPLR ERPL
    ERLP ELPR ELRP RPEL RPLE REPL RELP RLPE RLEP
    LPER LPRE LEPR LRPE LREP /);
for "PERL".comb.permutations>>.join("") -> $perm {
    say "$perm is missing" if $perm ∉ $given_perm;
}

This script produces the following output:

$ raku ./missing_permutations.raku
LERP is missing

Here, we have hard-coded the “PERL” word used to generate all permutations, but, assuming the given list has only correct permutations, we can just pick any permutation from the list as the starting point. We’ll do that in the implementation below, using the $given_perm.keys[0] syntax. Another possible variation is that, since we’re using sets, we could store the full list of permutations in another set and use the built-in set difference operator ((-) or ∖) to find the missing permutations. Here, I won’t use the ∖ operator because I find it a bit confusing (it looks too much like the \ backslash operator).

my $given_perm = set(qw/
    PELR PREL PERL EPRL EPLR ERPL
    ERLP ELPR ELRP RPEL RLPE RLEP
    LPER LPRE LEPR LRPE LREP /);
my $perms = set($given_perm.keys[0].comb.permutations>>.join(""));
say "Missing: ", ~($perms (-) $given_perm);

Notice that I have also removed some permutations from the given list, in order to show what happens when there is more than one permutation missing.

This script produces the following output:

$ raku ./missing_permutations2.raku
Missing: PRLE REPL RPLE RELP PLER PLRE LERP

Missing Permutations in Perl

Perl doesn’t have sets, but we can achieve the same result (fast lookup) with hashes. Since there is also no built-in permutation function, we implement our own recursive permute subroutine.

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

my @permutations;
my %given_perm = map { $_ => 1 } qw/
    PELR PREL PERL PRLE PLER PLRE EPRL EPLR ERPL
    ERLP ELPR ELRP RPEL RPLE REPL RELP RLPE RLEP
    LPER LPRE LEPR LRPE LREP /;

sub permute { 
    my ($str, @vals) = @_;
    if (scalar @vals == 0) {
        push @permutations, $str;
        return;
    }
    permute("$str" . $vals[$_], @vals[0..$_-1], 
        @vals[$_+1..$#vals]) for 0..$#vals;
}
permute "", split //, (keys %given_perm)[0];
for my $perm (@permutations) {
    say "$perm is missing" unless exists $given_perm{$perm};
}

This program displays the following output:

$ perl ./missing_permutations.pl
LERP is missing

Task 2: Padovan Primes

A Padovan Prime is a Padovan Number that’s also prime.

In number theory, the Padovan sequence is the sequence of integers P(n) defined by the initial values.

P(0) = P(1) = P(2) = 1

and then followed by

P(n) = P(n-2) + P(n-3)

First few Padovan Numbers are as below:

1, 1, 1, 2, 2, 3, 4, 5, 7, 9, 12, 16, 21, 28, 37, ...

Write a script to compute first 10 distinct Padovan Primes.

Expected Output:

2, 3, 5, 7, 37, 151, 3329, 23833, 13091204281, 3093215881333057

So, the Padovan sequence is built in a way very similar to the Fibonacci sequence, except that instead of using Fibonacci’s P(n-1) + P(n-2), the Padovan sequence uses the following recurrence relation: P(n-2) + P(n-3). The terms quickly come close to a geometric progression with a common ratio of approximately 1.3247 (known as the plastic number). So it is growing very rapidly (but less rapidly than the Fibonacci sequence, whose common ratio is the golden mean, 1,618).

To give an idea of the growth, these are the first 140 Padovan numbers:

1 1 1 2 2 3 4 5 7 9 12 16 21 28 37 49 65 86 114 151 200 265 351 465 616 816 1081 1432 1897 2513 3329 4410 5842 7739 10252 13581 17991 23833 31572 41824 55405 73396 97229 128801 170625 226030 299426 396655 525456 696081 922111 1221537 1618192 2143648 2839729 3761840 4983377 6601569 8745217 11584946 15346786 20330163 26931732 35676949 47261895 62608681 82938844 109870576 145547525 192809420 255418101 338356945 448227521 593775046 786584466 1042002567 1380359512 1828587033 2422362079 3208946545 4250949112 5631308624 7459895657 9882257736 13091204281 17342153393 22973462017 30433357674 40315615410 53406819691 70748973084 93722435101 124155792775 164471408185 217878227876 288627200960 382349636061 506505428836 670976837021 888855064897 1177482265857 1559831901918 2066337330754 2737314167775 3626169232672 4803651498529 6363483400447 8429820731201 11167134898976 14793304131648 19596955630177 25960439030624 34390259761825 45557394660801 60350698792449 79947654422626 105908093453250 140298353215075 185855747875876 246206446668325 326154101090951 432062194544201 572360547759276 758216295635152 1004422742303477 1330576843394428 1762639037938629 2334999585697905 3093215881333057 4097638623636534 5428215467030962 7190854504969591 9525854090667496 12619069972000553 16716708595637087 22144924062668049 29335778567637640 38861632658305136 51480702630305689 68197411225942776

Padovan Primes in Raku

We first build an infinite (lazy) list of Padovan numbers using the infix ... sequence operator. We then loop over these numbers and, for each of hem, check whether it is prime using the is-prime built-in routine.

my @padovans = 1, 1, 1, -> $a, $b, $c { $a + $b } ... *;
# say @padovans[0..10];  # (1 1 1 2 2 3 4 5 7 9 12)
my $max = 10;
my $prev_pad = 1;
for @padovans -> $pad {
    next if $prev_pad == $pad;
    if $pad.is-prime {
        print "$pad ";
        $max--;
    }
    $prev_pad = $pad;
    last if $max <= 0;
}
say "";
say now - INIT now;

This program displays the following output:

$ raku ./padovan_prime.raku
2 3 5 7 37 151 3329 23833 13091204281 3093215881333057 
0.2039814

Note that I timed the execution and found the duration (0.2 sec.) to be much less than I feared for computations on such large numbers. I suppose that the Miller-Rabin primality test used by the is-prime built-in routine is so fast that you can use it more than 100 times in a split second (the tenth Padovan prime, 3,093,215,881,333,057, is the 129th Padovan number).

Padovan Primes in Perl

Here again, I was afraid about numerous primality tests on very large integers, and decided to first build a list of prime numbers so that I would have to test each Padovan numbers against only prime numbers (up to a certain limit), rather than, say, all odd numbers, in order to speed up the process. It turns out that it wasn’t really necessary as the process runs in about only 6 seconds without this optimization. Worse yet, the performance optimization improves the execution duration only by a very marginal factor (perhaps by at most 20%). Clearly, it wasn’t worth the effort. I know very well Donald Knuth’s famous quote about “premature optimization (being) the source of all evil.” I thought I knew better in this specific case, but that was a mistake.

use strict;
use warnings;
use feature "say";
use constant MAX => 10000; # MAX must be an even number

my @primes = prime_list(MAX);
# say "@primes"; # 2 3 5 7 11 13 17 19 23 29 31 37 41 ...

my @padovans = (1, 1, 1);
for my $i (3..140) {
    $padovans[$i] = $padovans[$i-2] + $padovans[$i-3]
} 
# say "@padovans"; # 1 1 1 2 2 3 4 5 7 9 12 16 21 28 37 ...

my $count = 0;
my $last_pad = 0;
for my $pad (@padovans) {
    next if $pad == $last_pad;
    $last_pad = $pad;
    next unless is_prime($pad);
    say $pad;
    $count++;
    last if $count > 9;
}

sub prime_list {
    my $max = shift;
    my @prime_list = (2, 3, 5);
    PRIMES: for my $c (7..$max) {
            for my $i (2..$c/2) {
                next PRIMES unless $c % $i;
            }
            push @prime_list, $c;
    }
    return @prime_list;
}
sub is_prime {
    my $num = shift;
    for my $prime (@primes) {
        return 1 if $num == $prime;
        return 0 if $prime > $num;
        return 0 unless $num % $prime;
    }
    my $test = MAX+1;
    while ($test < int(sqrt($num))) {
        return 0 unless $num % $test;
        $test += 2;
    }
    return 1;
}

This program displays the following output:

$ perl ./padovan_prime.pl
2
3
5
7
37
151
3329
23833
13091204281
3093215881333057

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 March 13, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.