RabbitFarm

2022-06-19

Brilliantly Discover Achilles' Imperfection

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

Write a script to generate the first 20 Brilliant Numbers.

Solution


use strict;
use warnings;
sub prime_factor{
    my $x = shift(@_); 
    my @factors;    
    for(my $y = 2; $y <= $x; $y++){
        next if $x % $y;
        $x /= $y;
        push @factors, $y;
        redo;
    }
    return @factors;  
}

sub is_brilliant{
    my($n) = @_;
    my @factors = prime_factor($n); 
    return @factors == 2 && length($factors[0]) == length($factors[1]);
}

sub n_brilliants{
    my($n) = @_;
    my @brilliants;
    my $i = 0;
    {
       push @brilliants, $i if is_brilliant($i);
       $i++;
       redo if @brilliants < $n;
    }
    return @brilliants;
}

MAIN:{
    print join(", ", n_brilliants(20)) . "\n";
}

Sample Run


$ perl perl/ch-1.pl
4, 6, 9, 10, 14, 15, 21, 25, 35, 49, 121, 143, 169, 187, 209, 221, 247, 253, 289, 299

Notes

The solution here incorporated a lot of elements from previous weekly challenges. That is to say it is quite familiar, I continue to be a fan of redo!

Part 2

Write a script to generate the first 20 Achilles Numbers.

Solution


use strict;
use warnings;
use POSIX;
use boolean;

sub prime_factor{
    my $x = shift(@_); 
    my @factors;    
    for (my $y = 2; $y <= $x; $y++){
        next if $x % $y;
        $x /= $y;
        push @factors, $y;
        redo;
    }
    return @factors;  
}

sub is_achilles{
    my($n) = @_;
    my @factors = prime_factor($n); 
    for my $factor (@factors){
        return false if $n % ($factor * $factor) != 0;
    }
    for(my $i = 2; $i <= sqrt($n); $i++) {
        my $d = log($n) / log($i) . "";
        return false if ceil($d) == floor($d);  
    }
    return true;
}

sub n_achilles{
    my($n) = @_;
    my @achilles;
    my $i = 1;
    {
       $i++;
       push @achilles, $i if is_achilles($i);
       redo if @achilles < $n;
    }
    return @achilles;
}

MAIN:{
    print join(", ", n_achilles(20)) . "\n";
}

Sample Run


$ perl perl/ch-2.pl
72, 108, 200, 288, 392, 432, 500, 648, 675, 800, 864, 968, 972, 1125, 1152, 1323, 1352, 1372, 1568, 1800

Notes

This problem revealed something interesting with how, apparently, certain functions will handle integer and floating point values. The issue arises when we are computing logarithms. We can see the issue in isolation in a one liner.

perl -MPOSIX -e '$d = log(9) / log(3); print ceil($d) . "\t" . floor($d) . "\t$d\n"'

which prints 3 2 2. Notice that log(9) / log(3) is exactly 2 but, ok, floating point issues maybe it is 2.0000000001 and ceil will give 3. But why does this work?

perl -MPOSIX -e '$d = sqrt(9); print ceil($d) . "\t" . floor($d) . "\t$d\n"'

which gives 3 3 3. I am not sure what sqrt is doing differently? I guess how it stores the result internally? By the way, I am doing this to check is the result is an integer. That is if ceil($x) == floor($x), but that isn't working here as expected but I have used that trick in the past. I guess only with sqrt in the past though so never encountered this.

The trick to work around this, in the solution to the challenge is like this:

perl -MPOSIX -e '$d = log(9) / log(3) . ""; print ceil($d) . "\t" . floor($d) . "\t$d\n"'

this does what I want and gives 2 2 2. I guess that drops the infinitesimally small decimal part when concatenating and converting to a string which stays gone when used numerically?

Of course, there are other ways to do this. For example abs($x - int(x)) < 1e-7 will ensure that, within a minuscule rounding error, $x is an integer.

References

Challenge 169

posted at: 12:39 by: Adam Russell | path: /perl | permanent link to this entry