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
posted at: 12:39 by: Adam Russell | path: /perl | permanent link to this entry