## Perl Weekly Challenge 147: Truncatable Primes and Pentagon Numbers

These are some answers to the Week 147 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 January 16, 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.

Write a script to generate first 20 left-truncatable prime numbers in base 10.

In number theory, a left-truncatable prime is a prime number which, in a given base, contains no 0, and if the leading left digit is successively removed, then all resulting numbers are primes.

Example:

``````9137 is one such left-truncatable prime since 9137, 137, 37 and 7 are all prime numbers.
``````

### Truncatable Prime in Raku

We first build an infinite lazy list (`@el-primes`) of primes with no 0 digit. For each integer in the list, we then try to truncate the left-most digit and check whether the truncated number is prime, and so one until we get to the last digit. The process stops when 20 such primes have been generated.

``````my @truncatables;
my \$count = 0;
my @el-primes = grep {.is-prime and not /0/}, 2..Inf;
for @el-primes -> \$candidate {
my \$length = \$candidate.chars;
my \$is-truncatable = True;
for 1..\$length -> \$i {
my \$truncated = substr \$candidate, \$length - \$i;
\$is-truncatable = False, last unless \$truncated.is-prime;
}
if \$is-truncatable {
push @truncatables, \$candidate;
\$count++;
}
last if \$count >= 20;
}
say @truncatables;
``````

This program displays the following output:

``````raku ./truncatable.raku
[2 3 5 7 13 17 23 37 43 47 53 67 73 83 97 113 137 167 173 197]
``````

### Truncatable Prime in Perl

This Perl program is based on essentially the same idea as the Raku implementation, except that we build a hash of primes along the way. We need to check primality only when we meet a new number the first time: for the truncated numbers, we simply check their primality by looking up into the hash.

``````use strict;
use warnings;
use feature "say";
use constant MAX => 20;

my @primes = (2, 3, 5);
my %primes_h = map {\$_ => 1} @primes;
my @truncatables = @primes;;
my \$candidate = \$primes[-1];
my \$count = scalar @truncatables;;
while (\$count < MAX) {
\$candidate += 2;
my \$not_prime = 0;
next if \$candidate =~ /0/;
my \$sq_cand = sqrt \$candidate;
for my \$i (@primes) {
\$not_prime = 1, last unless \$candidate % \$i;
last if \$i > \$sq_cand;
}
next if \$not_prime;
push @primes, \$candidate;
\$primes_h{\$candidate} = 1;
# now check if truncatable prime
my \$length = length \$candidate;
my \$is_truncatable = 1;
for my \$i (1..\$length) {
my \$truncated = substr \$candidate, \$length - \$i;
\$is_truncatable = 0, last unless exists \$primes_h{\$truncated};
}
if (\$is_truncatable) {
push @truncatables, \$candidate;
\$count++;
}
}
say "@truncatables";
``````

This program displays the following output:

``````\$ perl  ./truncatable.pl
2 3 5 7 13 17 23 37 43 47 53 67 73 83 97 113 137 167 173 197
``````

### Truncatable Prime in Ring

I continue here my exploration of Ring, a quite recent programming language. The program below is a port to Ring of the Perl program above.

``````max = 20
primes = [2, 3, 5]
primes_h = []
count = len(primes)
for i = 1 to count
primes_h[string(primes[i])] = i
next
truncatables = primes
candidate = primes[count]
while count < max
candidate += 2
not_prime = false
pos = substr(string(candidate), "0")
if pos > 0 loop ok
sq_cand = floor(sqrt(candidate))
for i in primes
if candidate % i = 0
not_prime = true
exit
ok
if i > sq_cand exit ok
next
if not_prime loop ok
primes_h[string(candidate)] = 1
// We've found a prime, now check if truncatable prime
length = len(string(candidate))
is_truncatable = true
for i = 1 to length
truncated = right(string(candidate), i)
if isnull(primes_h[truncated])
is_truncatable = false
exit
ok
next
if is_truncatable
count += 1
ok

end
for val in truncatables see "" + val + " " next
see " " + nl
``````

Output:

``````\$ ring ./truncatable.ring
2 3 5 7 13 17 23 37 43 47 53 67 73 83 97 113 137 167 173 197
``````

Write a script to find the first pair of Pentagon Numbers whose sum and difference are also a Pentagon Number.

Pentagon numbers can be defined as P(n) = n(3n - 1)/2.

Example:

The first 10 Pentagon Numbers are: 1, 5, 12, 22, 35, 51, 70, 92, 117 and 145.

``````P(4) + P(7) = 22 + 70 = 92 = P(8)
but
P(4) - P(7) = |22 - 70| = 48 is not a Pentagon Number.
``````

### Pentagon Numbers in Raku

We’ve decided to use the built-in combinations method to generate the pairs of pentagon numbers. Note that we cannot use an infinite list of pentagon numbers because the `combinations` routine cannot operate on an infinite list. So I just tried various increasing values for the `\$max` variable until I obtained a result satisfying the criteria. Note that I use a `%penta` hash to store the pentagon values, so the verifying whether and sum and the difference values are pentagon number is just a matter of a fast hash lookup.

``````my \$max = 4000;
my @pentanums = map { (3 * \$_² - \$_)/2 }, 1..\$max;
my %penta = map {@pentanums[\$_] => \$_+1}, 0..\$max-1;
for @pentanums.combinations(2) -> \$comb {
next unless %penta{\$comb.sum}:exists;
next unless %penta{\$comb[1]-\$comb[0]}:exists;
say \$comb, " = Pentagon numbers N° %penta{\$comb[0]} and %penta{\$comb[1]}";
say "Sum is ", \$comb.sum, " (Pentagon number ", %penta{\$comb.sum}, ")";
say "Difference is ", \$comb[1]-\$comb[0], " (Pentagon number ", %penta{\$comb[1]-\$comb[0]}, ")";
last;
}
say now - INIT now, " seconds";
``````

This script displays the following output:

``````raku ./pentanums.raku
(1560090 7042750) = Pentagon numbers N° 1020 and 2167
Sum is 8602840 (Pentagon number 2395)
Difference is 5482660 (Pentagon number 1912)
101.7166579 seconds
``````

This program is relatively slow (101 seconds execution time). I found that using two nested loops (as in the Perl program below) rather than the `combinations` routine make the program at least 20 times faster (only a few seconds). So it seems that the `combinations` routine is quite slow. This is a bit unfortunate as `combinations` is really useful and makes the code simpler and cleaner. I still prefer to present this version, but if you need better performance, then use two nested loops as in the Perl implementation below.

### Pentagon Numbers in Perl

This is essentially the same idea as the Raku program above. However, as mentioned above, we don’t have `combinations` routine in Perl, so we use two nested loops to generate all the combinations. The advantage is that this runs much faster.

``````use strict;
use warnings;
use feature "say";
use constant MAX => 4000;

my @pentanums = map { \$_ * (3 * \$_ - 1)/2 } 1..MAX;
my %penta_h = map {\$pentanums[\$_] => \$_+1 } 0..MAX-1;
# say Dumper \%penta_h;

OUTER: for my \$i (0..MAX-1) {
for my \$j (\$i+1..MAX-1) {
my \$sum = \$pentanums[\$i] + \$pentanums[\$j];
next unless exists \$penta_h{\$sum};
my \$diff = \$pentanums[\$j] - \$pentanums[\$i];
next unless exists \$penta_h{\$diff};
say "First pair of pentagon numbers is \$pentanums[\$i] (rank ", \$i+1, ") and \$pentanums[\$j] (rank ", \$j+1, ")";
say "Sum is \$sum (rank \$penta_h{\$sum}) and difference is \$diff (rank \$penta_h{\$diff})";
last OUTER;
}
}
``````

This program displays the following output:

``````\$ time perl  ./pentanums.pl
First pair of pentagon numbers is 1560090 (rank 1020) and 7042750 (rank 2167)
Sum is 8602840 (rank 2395) and difference is 5482660 (rank 1912)

real    0m2,043s
user    0m1,703s
sys     0m0,108s
``````

### Pentagon Numbers in Ring

Again a port to Ring of the Perl implementation:

``````max = 3000
pentanums = []
for i = 1 to max
add (pentanums,  i * (3 * i - 1) / 2)
next
// see pentanums + nl
penta_h = []
for i = 1 to max
penta_h[ string(pentanums[i])] = i
next
for i = 1 to max
for j = i+1 to max
diff = pentanums[j] - pentanums[i]
diff_s = string(diff)
if isnull(penta_h[diff_s]) loop ok
sum = pentanums[i] + pentanums[j]
sum_s = string(sum)
if isnull(penta_h[sum_s]) loop ok
see "" + diff + " " + sum + " " + pentanums[i] + " " + pentanums[j] + nl
next
next
``````

Output:

``````\$ ring ./pentanums.ring
5482660 8602840 1560090 7042750
``````

### Pentagon Numbers in Julia

``````max = 4000
pentanums = map((x) -> Int(x * (3 * x -1)/2), 1:max)
penta_h = Dict(map((x) -> Int(x * (3 * x -1)/2) => x, 1:max))
for i in 1:4000-1
for j in (i + 1):4000-1
sum = pentanums[i] + pentanums[j]
continue
end
diff = pentanums[i] - pentanums[j]
# if (haskey(penta_h, Int(diff)) == 0)
#    continue
# end
println(i, " ", j, " ", pentanums[i], " ", pentanums[j], " ", sum)
end
end
``````

Output:

``````\$ julia pentanums.jl
Indices 1020 and 2167 ; Pentanums: 1560090 7042750; Sum: 8602840; Diff: 5482660
1020 2167
``````

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