08 November 2026

Challenge 147

Primal Pentagons

• TASK #1 › Truncatable Prime
• TASK #2 › Pentagon Numbers

TASK #1 › Truncatable Prime

Submitted by: Mohammad S Anwar

---

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.

---

Solution

This is my solution dated 1 May 2023:

use strict;
use warnings;
use Math::Prime::Util qw(fromdigits todigits);

sub is_truncatable_prime ($p, $b) {
    my @p = todigits($p, $b);
    while (@p) {
        $p = fromdigits([@p], $b);
        return unless is_prime($p);
        shift @p;
    }
	1;
}

See the full solution to task 1.

TASK #2 › Pentagon Numbers

Submitted by: Mohammad S Anwar

---

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.

---

Solution

The formula for a Pentagon number

\[\operatorname{p}(n) = \frac{n(3n - 1)}{2}\]

can easily be inverted as

\[\operatorname{p}^{-1}(m) = \frac{\sqrt{24m + 1} + 1}{6}\]

resulting in a real number. To see if a number \(m\) is a Pentagon number, we may check if the inverse of \(m\) is an integer.

To find a pair of Pentagon numbers where both sum and difference are Pentagon numbers, we may process two nested loops where one (increasing) Pentagon number is checked against all smaller ones.

Perl

use strict;
use warnings;
use experimental 'signatures';

sub pentagon_pair {
    state sub pentagon ($k) {
        $k * (3 * $k - 1) / 2;
    }

    state sub is_pentagon ($n) {
        my $m = (sqrt(24 * $n + 1) + 1) / 6;
        $m == int $m;
    }

    my @seen;
    my $i;
    while () {
        my $pi = pentagon(++$i);
        is_pentagon($pi - $_) && is_pentagon($pi + $_) && return ($pi, $_)
            for @seen;
        push @seen, $pi;
    }
}

See the full solution to task 2.

J

Though it may not look that way, the J solution is basically the Perl solution ported to J.

NB. use a:,a: as argument to find the first pair
pentagon_pair =: _(adverb define)
  NB. pentagon number and its inverse
  pn =. ([: -: ] * <: @ (3&*)) :. (%&6 @ >: @ %: @ >: @(24&*))

  NB. pentagon numbers have an integer inverse,
  NB. check if all are pentaton numbers
  all_p =. *./ @: (] = <.) @: (pn inv)

  NB. incremented input list's size is the next
  NB. numbers index
  next =. pn @ >: @ # @ (0&{::)

  NB. check if last element is an empty box
  empty_tail =. a: = {:

  NB. find an element y1 of y such that x + y1 and x - y1 are
  NB. pentagon numbers
  find_other =. ] #~ all_p @ (-`+`:0)

  NB. - find the next number for the given list
  NB. - find the "other" part for "next" in the list
  NB. - return the list, extended by "next" and
  NB.   "other" in a separate box
  list =. 0&{::
  step =. next (,~ ; find_other) list

  NB. repeat "step" until it returns a matching "other",
  NB. pick the last element of the list and the "other" as result
  while =. ^:^:_.
  {: S:0 @ (step while empty_tail) f.
)

The vectorized version is a bit faster:

$ time perl/ch-2.pl 
7042750 1560090

real    0m0.807s
user    0m0.805s
sys     0m0.001s

$ time j/ch-2.ijs 
7042750 1560090

real    0m0.444s
user    0m0.390s
sys     0m0.054s

See the full solution.