Perl Weekly Challenge: Week 169

Challenge 1:

Brilliant Numbers

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

Luckily, last weeks challenges also involved prime factors so I already had a factorize() function to calculate them. So solving this problem was already 75% done.

my $n = 2;
my @brilliants;

We start from the number two as 1 obviously only has 1 prime factor (or 0 if you don't count 1 as a prime number.) We also set up a list to hold the results.

until @brilliants.elems == 20 {

until we have found 20 brilliant numbers...

    my @factors = factorize($n);

...we find the prime factors of $n.

    if @factors.elems == 2 && @factors[0].chars == @factors[1].chars {

If there are exactly two prime factors and they have the same number of digits...

        @brilliants.push($n);

...we add it to the results.

    }
    $n++;

Then we move on to the next number.

}

@brilliants.join(q{, }).say;

(Full code on Github.)

Finally we print our list of results nicely separated by commas.

This is the Perl version which works the same way minus the usual syntactic differences.

my $n = 2;
my @brilliants;

until (scalar @brilliants == 20) {
    my @factors = factorize($n);
    if (scalar @factors == 2 && length $factors[0] == length $factors[1]) {
        push @brilliants, $n;
    }
    $n++;
}

say join q{, }, @brilliants;

(Full code on Github.)

Challenge 2:

Achilles Numbers

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

In order to solve this task, we need to know two things about a number; is it powerful and is it (not) a perfect power. To this end, I wrote two functions which in Raku were only one line each.

sub isPowerful(Int $n) {
    return so $n %% factorize($n).unique.map({ $_ ** 2; }).all;
} 

Jumping around the line a bit, factorize($n) is the routine from last week used in challenge 1. It gives a list of prime factors which may be duplicates. .unique() deduplicates that list. .map() squares each member of the list. .all() converts the list into an all junction. Junctions are a very cool feature of Raku inspired by the concept of quantum superpositions in physics. Basically when an operation is applied to an all junction, it is applied to all values of that junction and will only be true if all applications to each value are true. Now you could do achieve the same effect with .map() or even a for loop (which is what I did for the Perl version) but a junction is more concise, readable and possibly more efficient. So $n %% {all junction} means that if all values of the junction are evenly divisible into $n (i.e. they are factors of $n) then return True else return False. (so forces Boolean context which would have been implicit otherwise.)

sub isPerfect(Int $n) {
    return so (2 .. $n.sqrt).map({ $n.log($_).round(0.001); }).any %% 1;
} 

In this function we take the numbers upto $n and testing to see if they can equal $n when raised to a particular power. Actually we can simplify this a bit by only testing the numbers from two to the square root of $n. Using .map() we take the logarithm of $n to the base of that number. This time we use .any() to create an any junction. This means that if any of those logarithms are evenly divisible by one (i.e. they are integers) then we return True. If not a single one is an integer, we return False. Once again so forces boolean context.

Now you have probably noticed I've left out the usage of .round(). Originally I didn't have it and I noticed I would get some spurious answers. For example isPerfect(125) was returning False but log5(125) is 3 so the result should be True. Some investigation revealed floating point error was occuring in .log(). 125.log(5) was actually returning something like 3.00000004 instead of 3. Adding the call to .round() and rounding the result to three decimal places got rid of this problem.

Armed with these two functions, solving the challenge is easy.

my $n = 2;
my @achilles;

until @achilles.elems == 20 {
    if  isPowerful($n) && !isPerfect($n) {
        @achilles.push($n);
    }
    $n++;
}

@achilles.join(q{, }).say;

(Full code on Github.)

Just as in challenge 1, we start $n at 2 and have an empty list to hold our results. As we count upwards we check each value of $n to see if it isPowerful() and not isPerfect(). If both conditions are met, we add it to the results. Finally when we have 20 Achilles numbers, we stop and print the list.

Translating the Raku code to Perl posed several problems of missing features especially junctions but somehow I managed.

First isPowerful()...

sub isPowerful {
    my ($n) = @_;
    my %primeFactors;

    for my $factor (factorize($n)) {
        $primeFactors{$factor}++;
    }

I created a hash for prime factors and added the results of factorize() to it. Now the keys of the hash are unique prime factors.

    for my $factor (keys %primeFactors) {
        if ($n % ($factor ** 2) != 0) {
            return undef;
        }
    }

Now for each of those unique prime factors, you square it and if the result is not a factor of $n you know the number is not powerful so undef, which always evaluates to false in a boolean context, is returned.

    return 1;
} 

If you make it through the loop, it means all the squared, unique prime factors are factors so 1 which evaluates to true is returned.

On to isPerfect().

sub isPerfect {
    my ($n) = @_;

    for my $i (map { nearest(0.001, log($n) / log($_ )) } 2 .. sqrt($n)) {

The logarithm of $n to the base of each number from 2 to the square root of $n is taken. Because Perls log() function works differently, you have to divide it from log to get this. I used the Math::Round modules nearest() function for rounding. (Not round(). This trips me up every time.)

        if ($i == int $i) {
            return 1;
        }

If this logarithm is an integer we can stop looking; the number is perfect. We return 1 meaning true.

    }

    return undef;
} 

If none of them were integers we return undef meaning false.

my $n = 2;
my @achilles;

until (scalar @achilles == 20) {
    if  (isPowerful($n) && !isPerfect($n)) {
        push @achilles, $n;
    }
    $n++;
}

say join q{, }, @achilles;

(Full code on Github.)

Just as in Raku, we ascend through the integers beginning with two until we have 20 Achilles numbers then print out the results.