# Perl Weekly Challenge 147: truncating pentagons

It is sad that, after more than two years of me doing Raku, I still don’t have any production code project to work on. Therefore, in order to keep my coding and Raku-ing (is that a term?) knowdledge, I try to solve every Perl Weekly Challenge tasks.

In the following, the assigned tasks for Challenge 147.

And this week, as for the previous PWC, I had time to quickly implement the tasks also on PostgreSQL `plpgsql` language:

## PWC 147 - Task 1

The first task was about finding out a left truncated prime number, that is a prime number that is made by right prime numbers. In other words, given a prime number, and removing one at a time the leftmost digit, the right number is still a prime number itself.
The task asked to find out the first 20 numbers, so I placed a default variable that decides the limit for generating the truncated prime numbers:

``````sub MAIN( Int \$limit = 20 ) {

my @primes;

for 10 .. Inf -> \$current {
next if \$current ~~ / 0 /;
next if ! \$current.is-prime;
my @values.push: \$current.comb[ \$_ .. * - 1 ].join.Int for 0 ..^ \$current.Str.chars;
@primes.push: \$current if @values.grep( *.is-prime ).elems == @values.elems;
last if @primes.elems >= \$limit;

}

@primes.join( "\n" ).say;
}

``````

Since I need to truncate a number, it does not make sense to start from a single digit number, thus I start the loop from `10` to infinity. I skip all numbers containing one or more zeros and that are not prime. Then, I build a `@values` array made of all truncations of a number. Now, if I can find that all `ovalues` is made by primes, that is the number of primes is equal to the number of elements of the array, the number is a truncated prime, and thus can be added to the `@primes` array. The loop is terminated as soon as the `\$limit` of searched for numbers is found. And the rest of the program is just the printing of the result.

## PWC 147 - Task 2

This task was tricky, not because it was conceptually complex, but because it required a lot of resources at first.
It was asked to find out the first couple of pentagons numbers that summed give a pentagon number and that subtracted give also a pentagon number. A pentagon number is computed as `n * ( 3 * n - 1 ) / 2`.

`````` sub MAIN( Int \$limit = 3000 ) {

my ( %pentagons, %inverse-pentagons );
%pentagons{ \$_ } = ( \$_ * ( 3 * \$_ - 1 ) / 2 ) for 1 .. \$limit;
%inverse-pentagons{ %pentagons{ \$_ } } = \$_ for %pentagons.keys.sort;

for %pentagons.keys.sort -> \$index-left {
for %pentagons.keys.sort -> \$index-right {
next if \$index-left == \$index-right;

my ( \$sum, \$diff ) = %pentagons{ \$index-left } + %pentagons{ \$index-right },
abs( %pentagons{ \$index-left } - %pentagons{ \$index-right } );

# this is too slow, therefore I use an inverse hash!
# next if ! %pentagons.values.grep( * ~~ \$sum );
# next if ! %pentagons.values.grep( * ~~ \$diff );
next if %inverse-pentagons{ \$diff }:!exists;
next if %inverse-pentagons{ \$sum }:!exists;

"P( \$index-left ) + P( \$index-right ) = { %pentagons{ \$index-left } } + { %pentagons{ \$index-right } } = \$sum = P( { %inverse-pentagons{ \$sum } } )".say;
"P( \$index-left ) - P( \$index-right ) = { %pentagons{ \$index-left } } + { %pentagons{ \$index-right } } = \$diff = P( { %inverse-pentagons{ \$diff } } )".say;
exit;
}
}

}

``````

First of all, I prepare a `%pentagons` hash that has the key as the `n` number and the value as the pentagon value. Then I perform a nested loop other the keys of the hash to find out a couple of pentagon numbers that have the sum and the difference that provide two pentagon numbers. Computing the `\$sum` and the `\$diff` is easy, and at first I thought that just `grep`ping the values would suffice. The problem is that the program never ends, I mean, after `11 minutes` it was still running.
Therefore I introduced the `inverse-pentagons` hash that is indexed the opposite from `%pentagons`: the keys are the pentagons values and the values are the number that generated them. So far, it just suffice to apply `:exists` and `:!exists` on such hash to see, in a very quick way, if the `\$sum` and `\$diff` are pentagon numbers. This also allows me to print out a full expression that represents the result, and now the program ends in a couple of seconds:

``````% time raku ch-2.p6
P( 1020 ) + P( 2167 ) = 1560090 + 7042750 = 8602840 = P( 2395 )
P( 1020 ) - P( 2167 ) = 1560090 + 7042750 = 5482660 = P( 1912 )
raku ch-2.p6  2,41s user 0,05s system 107% cpu 2,277 total

``````

## PWC 147 - Task 1 in PostgreSQL

A PostgreSQL implementation of the Raku version: a function to see if a number is prime and one to compute the truncated primes over a list of numbers.

``````CREATE OR REPLACE FUNCTION
f_is_prime( n bigint )
RETURNS bool
AS
\$CODE\$
DECLARE
i int;
BEGIN
FOR i IN 2 .. ( n - 1 ) LOOP
IF n % i = 0 THEN
RETURN false;
END IF;
END LOOP;

RETURN true;
END
\$CODE\$
LANGUAGE plpgsql;

CREATE OR REPLACE FUNCTION
f_generate_truncated_primes( l int = 20 )
RETURNS SETOF int
AS
\$CODE\$
DECLARE
i int;
current bigint;
fnd   int := 0;
BEGIN
<<MAIN_LOOP>>
FOR current IN SELECT * FROM generate_series( 10, 999999 ) LOOP
CONTINUE WHEN current::text LIKE '%0%';

IF NOT f_is_prime( current ) THEN
CONTINUE MAIN_LOOP;
END IF;

FOR i IN 1 .. length( current::text ) LOOP
IF NOT f_is_prime( substring( current::text FROM i )::int ) THEN
CONTINUE MAIN_LOOP;
END IF;
END LOOP;

fnd := fnd + 1;
RETURN NEXT current;
IF fnd >= l THEN
RETURN;
END IF;
END LOOP;

RETURN;
END
\$CODE\$
LANGUAGE plpgsql;

``````

An interesting thing to note is that the main `FOR` loop is labeled as `MAIN_LOOP` and I use quick short-circuit `CONTINUE` to start other as soon as a number is not appropriate.
Testing if a number is a truncated prime requires to loop other the length of the number in terms of digit, `substring` moving tirght and test if the result is a prime number.

## PWC 147 - Task 2 in PostgreSQL

I decided to implement the second task by means of generating a table, named `pentagons`, that contain the `n` number that generates the `p` pentagon. Such column is a generated (sometime called virtual) column.

``````CREATE OR REPLACE FUNCTION
f_pentagon( n bigint )
RETURNS bigint
AS
\$CODE\$
SELECT ( n * ( 3 * n - 1 ) / 2 );
\$CODE\$
LANGUAGE sql
IMMUTABLE;

DROP TABLE IF EXISTS pentagons;
CREATE TABLE pentagons
(
n bigint
, p bigint GENERATED ALWAYS AS ( f_pentagon( n ) ) STORED
);

INSERT INTO pentagons( n )
SELECT generate_series( 1, 5000 );

``````

Now, a function performs a record-by-record scan of the table, and for every tuple it searches for another tuple that provides the sum and difference within the table itself. If found, a new record is returned and the function returns.

``````CREATE OR REPLACE FUNCTION
f_pentagons_pairs()
RETURNS TABLE ( n1 bigint, n2 bigint,  s bigint, d bigint, ps bigint, pd bigint )
AS \$CODE\$
DECLARE
current_tuple pentagons%rowtype;
other_tuple   pentagons%rowtype;
fnd           int := 0;
BEGIN

FOR current_tuple IN SELECT * FROM pentagons ORDER BY n LOOP
SELECT *
INTO other_tuple
FROM pentagons pp
WHERE EXISTS(
SELECT *
FROM pentagons ps
WHERE ps.p = current_tuple.p + pp.p
)
AND EXISTS (
SELECT *
FROM pentagons ps
WHERE ps.p = abs( current_tuple.p - pp.p )
);

IF FOUND THEN
SELECT current_tuple.n
, other_tuple.n
, current_tuple.p
, other_tuple.p
, current_tuple.p + other_tuple.p
, abs( current_tuple.p - other_tuple.p )
, p1.n
, p2.n
INTO n1, n2, s, d, ps, pd
FROM pentagons p1, pentagons p2
WHERE p1.p = current_tuple.p + other_tuple.p
AND   p2.p = abs( current_tuple.p - other_tuple.p );

RAISE INFO 'P(%) + P(%) = P(%) =  %',
n1, n2, ps, s;

RAISE INFO 'P(%) - P(%) = P(%) =  %',
n1, n2, pd, d;

fnd := fnd + 1;
RETURN NEXT;
RETURN;
END IF;

END LOOP;

RETURN;
END
\$CODE\$
LANGUAGE plpgsql;

``````

The `RAISE` instruction provide a descriptive output of the found solution.

``````testdb=> select * from f_pentagons_pairs();
INFO:  P(1020) + P(2167) = P(8602840) =  1560090
INFO:  P(1020) - P(2167) = P(5482660) =  7042750
n1  |  n2  |    s    |    d    |   ps    |   pd
------+------+---------+---------+---------+---------
1020 | 2167 | 1560090 | 7042750 | 8602840 | 5482660
(1 row)

Time: 7257,715 ms (00:07,258)

``````

As you can see, this requires a lot more time than the Raku solution, but please note I’ve run this on a busy server. However, in this case SQL results in a much more compact and declarative approach than Raku is, essentially the `EXISTS` query.

## PWC 147 - Task 2 in PostgreSQL: a CTE only solution

The solution for the second task can be rewritten using only a recusrive CTE. Instead of using a table, the content of the `pentagons` numbers can be materialized with a recursive common table expression that exploits the very same function `f_pentagon` to compute a single pentagon value.
But most notably, instead of using a record based approach, as in the function `f_pentagon_pairs`, the query can be expressed as a full join:

``````WITH RECURSIVE pentagons( n, p )
AS
(
SELECT 1 AS n
, f_pentagon( 1 ) AS p

UNION
SELECT p.n + 1
, f_pentagon( p.n + 1 )
FROM pentagons p
WHERE p.n < 5000
)

SELECT format( '%s, %s', l.n, r.n ) AS pentagon_pairs
FROM pentagons l, pentagons r
WHERE EXISTS(
SELECT *
FROM pentagons ps
WHERE ps.p = l.p + r.p
)
AND EXISTS (
SELECT *
FROM pentagons ps
WHERE ps.p = abs( l.p - r.p )
)
;

``````

The query executes in a little less time than the approach using the table and the record-based function:

`````` pentagon_pairs
----------------
1020, 2167
2167, 1020
(2 rows)

Time: 5820,066 ms (00:05,820)

``````

The article Perl Weekly Challenge 147: truncating pentagons has been posted by Luca Ferrari on January 10, 2022