Perl Weekly Challenge 169.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 169.

Task 1: Brilliant Numbers

Submitted by: Mohammad S Anwar
Write a script to generate first 20 Brilliant Numbers.

Brilliant numbers are numbers with two prime factors of the
same length.

The number should have exactly two prime factors, i.e. it’s
the product of two primes of the same length.

For example,

24287 = 149 x 163
24289 = 107 x 227

Therefore 24287 and 24289 are 2-brilliant numbers.
These two brilliant numbers happen to be consecutive as there
are no even brilliant numbers greater than 14.

Output
4, 6, 9, 10, 14, 15, 21, 25, 35, 49, 121, 143, 169, 187, 209,
221, 247, 253, 289, 299

A straightforward solution consists of generating all one digit primes, all of their disctinct pairs, and multiply them, then proceed with two digit primes, three digit primes and so on. Finally, order the results and display them. This yields a simple three liner

perl -MMath::Prime::Util=primes -MMath::Cartesian::Product -E '$N=shift; $m=1;
while(@b<$N){$p=primes($m, 10*$m); $m*=10; push @b, sort {$a <=> $b} map
{$_->[0]*$_->[1]} cartesian {$_[0]>=$_[1]} $p, $p;} say join " ", @b[0..$N-1];' 20

Results:

4 6 9 10 14 15 21 25 35 49 121 143 169 187 209 221 247 253 289 299

Here I use primes from Math::Prime::Util to generate primes in a given range, cartesian from Math::Cartesian::Product to generate distinct pairs of primes, I multiply them, sort the results and store them in an array from which I extract the desired results. A problem with this approach is that the work required for finding $N brilliant numbers jumps when $N crosses certain thresholds. For instance, for $N=240 and 241 it takes about 22ms in my laptop, but for $N=242 it jumps to 42ms, as I have to multiply not only all pairs of 2-digit primes, but also all pairs of 3-digit ones. The time remains almost constant until $N=10537 and for $N=10538 it jumps to 1.054s, about 25 times larger, since now it multiplies all pairs of 4 digit primes. Anyway, I don’t guess we’ll need that many.

The full code is:

 1  # Perl weekly challenge 169
 2  # Task 1: Brilliant numbers
 3  #
 4  # See https://wlmb.github.io/2022/06/13/PWC169/#task-1-brilliant-numbers
 5  use v5.12;
 6  use warnings;
 7  use Math::Prime::Util qw(primes);
 8  use Math::Cartesian::Product;
 9  die "Usage: ./ch-1.pl N\nto obtain the first N Brilliant numbers" unless @ARGV;
10  my $N=shift;
11  my $low=1;
12  my @brilliant_numbers;
13  while(@brilliant_numbers<$N){
14      my $primes=primes($low, 10*$low); # generate primes with 1, 2, 3... digits
15      $low*=10;
16      push @brilliant_numbers,
17          sort {$a <=> $b}
18              map {$_->[0]*$_->[1]}
19                  cartesian {$_[0]>=$_[1]} $primes, $primes;
20  }
21  say "The first $N brilliant numbers are: ", join " ", @brilliant_numbers[0..$N-1];

Example:

./ch-1.pl 20|fmt

Results:

The first 20 brilliant numbers are: 4 6 9 10 14 15 21 25 35 49 121 143
169 187 209 221 247 253 289 299

Task 2: Achilles Numbers

Submitted by: Mohammad S Anwar
Write a script to generate first 20 Achilles Numbers. Please
checkout wikipedia for more information.

An Achilles number is a number that is powerful but imperfect
(not a perfect power). Named after Achilles, a hero of the
Trojan war, who was also powerful but imperfect.

A positive integer n is a powerful number if, for every prime
factor p of n, p^2 is also a divisor.

A number is a perfect power if it has any integer roots
(square root, cube root, etc.).

For example 36 factors to (2, 2, 3, 3) - every prime factor
(2, 3) also has its square as a divisor (4, 9). But 36 has an
integer square root, 6, so the number is a perfect power.

But 72 factors to (2, 2, 2, 3, 3); it similarly has 4 and 9 as
divisors, but it has no integer roots. This is an Achilles
number.


Output
 72, 108,  200,  288,  392,  432,  500,  648,  675,  800,
 864, 968, 972, 1125, 1152, 1323, 1352, 1372, 1568, 1800

A simple procedure is to test all integers in sequence by generating their factors, checking that there are more than one, that all appear more than once and that there is no common divisor greater than 1 for all their powers. Thus, if n=p1e1 p2e2… there must be more than one prime factor p1, p2…, pn should be raised to a power en > 1, so that n is powerful, and there must be no common divisor of e1, e2… other than the trivial 1. Otherwise, if en=k fn with k>1, then n=(p1f1 p2f2…)k, and the number would be perfect.

I may use the routine factor_exp from Math::Prime::Util to factorize and obtain the power of each factor, and gcd from Math::Utils to get their greatest common divisor

perl -MMath::Utils=gcd -MMath::Prime::Util=factor_exp -MList::Util=all -E '
$N=shift; $n=1; while(@a<$N){@f=map{$_->[1]} factor_exp(++$n);
push @a,$n if @f>1 and (all {$_>1} @f) and gcd(@f)==1;} say join " ", @a;' 20|fmt

Results:

72 108 200 288 392 432 500 648 675 800 864 968 972 1125 1152 1323 1352
1372 1568 1800

So, it seems to work.

An alternative would be to generate Achilles numbers from a few powers of a few primes, as in

perl -MMath::Utils=gcd -MMath::Cartesian::Product -MList::Util=product -E '
@p=(2,3,5,7, 11, 13); $e=[0,2..7]; my @e=cartesian {@n=grep{$_} @_; @n>1 and gcd(@n)==1} ($e)x@p;
for $c(@e){push @r, product map {$p[$_]**$c->[$_]}(0..@p-1);} say join " ", grep {$m++<20} sort {$a <=> $b} @r;
'|fmt

Results:

72 108 200 288 392 432 500 648 675 800 864 968 972 1125 1152 1323 1352
1372 1568 1800

The problem here is how to choose the set of small primes ((2,3,5,7,11,13)) above, and the set of small powers ((0,2,3,4,5,6,7)) in order not to skip any of the first $N Achilles numbers. Furthermore, as it took longer, generating some huge Achilles numbers that were later unused, I guess I can discard it and keep the first method. This kind of method would become more useful if there were a systematic way of generating the Achilles numbers in order, so as not to throw away most of the work at the end.

The full code is then

 1  # Perl weekly challenge 169
 2  # Task 2: Achilles numbers
 3  #
 4  # See https://wlmb.github.io/2022/06/13/PWC169/#task-2-achilles-numbers
 5  use v5.12;
 6  use warnings;
 7  use Math::Utils qw(gcd);
 8  use Math::Prime::Util qw(factor_exp);
 9  use List::Util qw(all);
10  die "Usage: ./ch-2.pl N\nto generate the first N Achilles numbers" unless @ARGV;
11  my $N=shift;
12  my $candidate=1;
13  my @achilles_numbers;
14  while(@achilles_numbers<$N){
15      my @exponents=map{$_->[1]} factor_exp(++$candidate);
16      push @achilles_numbers, $candidate
17          if @exponents>1 and (all {$_>1} @exponents) and gcd(@exponents)==1;
18  }
19  say "The first $N Achilles numbers are: ", join " ", @achilles_numbers;

Example:

./ch-2.pl 20|fmt

Results:

The first 20 Achilles numbers are: 72 108 200 288 392 432 500 648 675
800 864 968 972 1125 1152 1323 1352 1372 1568 1800
Written on June 13, 2022