This is my response to the Perl Weekly Challenge #147.
left digit is successively
removed, then all resulting numbers are primes.
9137 is one such left-truncatable prime since 9137, 137, 37 and 7 are
all prime numbers.
#! /usr/bin/env raku
unit sub MAIN ($limit = 20, :v(:$verbose)); # [1]
my $seq = (2 .. Inf).grep(*.&is-left-trunc); # [2]
say $seq[^$limit].join(", "); # [3]
sub is-left-trunc ($prime) # [4]
{
return False if $prime.contains: '0'; # [5]
for ^$prime.chars -> $start # [6]
{
say ": Checking $prime -> { $prime.substr($start) } - "
~ "{ $prime.substr($start).is-prime ?? "prime" !! "not prime" }"
if $verbose;
return False unless $prime.substr($start).is-prime; # [7]
}
return True; # [8]
}
[1] Get the 20 first values, unless we ask for another number of values.
[2] The first (lowest) prime numer is 2, so we start there. Apply the procedure
as filter on the sequence, resulting in values that are left-truncatable primes.
We could have written this line with an explicit prime check (as in
my $seq = (2 .. Inf).grep(*.is-prime).grep(*.&is-left-trunc);), but
it is not necessary as the procedure does take care of that.
[3] Print the values.
[4] Procedure checking if the input is a left-truncatable prime.
[5] It is not a left-truncatable prime if it has a zero
in it. We could have used a regex here instead (as in
return False if $prime ~~ /0/;), but contains is spot
on here - and probably faster.
See
docs.raku.org/routine/contains
for more information about contains.
[6] Start at the beginning (index 0, the whole number) and continute to the end (successively stripping off digits at the start),
[7] Check that the partial number is a prime.
[8] If it did not fail the test in the loop, it is indeed a left-truncatable prime.
Running it:
$ ./truncatable-prime
2, 3, 5, 7, 13, 17, 23, 37, 43, 47, 53, 67, 73, 83, 97, 113, 137, 167, 173, 197
Do you want more of them? Just specify the number of values:
$ ./truncatable-prime 100
2, 3, 5, 7, 13, 17, 23, 37, 43, 47, 53, 67, 73, 83, 97, 113, 137, 167, 173, 197, \
223, 283, 313, 317, 337, 347, 353, 367, 373, 383, 397, 443, 467, 523, 547, 613, \
617, 643, 647, 653, 673, 683, 743, 773, 797, 823, 853, 883, 937, 947, 953, 967, \
983, 997, 1223, 1283, 1367, 1373, 1523, 1613, 1823, 1997, 2113, 2137, 2347, 2383, \
2467, 2617, 2647, 2683, 2797, 2953, 3137, 3167, 3313, 3347, 3373, 3467, 3547, \
3613, 3617, 3643, 3673, 3797, 3823, 3853, 3947, 3967, 4283, 4337, 4373, 4397, \
4523, 4547, 4643, 4673, 4937, 4967, 5113, 5167
Verbose mode is useful for checking that the program does what it is supposed to do. Here is a partial output:
./truncatable-prime -v
...
: Checking 191 -> 191 - prime
: Checking 191 -> 91 - not prime
...
: Checking 196 -> 196 - not prime
: Checking 197 -> 197 - prime
: Checking 197 -> 97 - prime
: Checking 197 -> 7 - prime
2, 3, 5, 7, 13, 17, 23, 37, 43, 47, 53, 67, 73, 83, 97, 113, 137, 167, 173, 197
191 is a prime, but 91 is not. 196 is not a prime. 197 is a prime, as is 97 and 7.
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use feature 'signatures';
use Math::Prime::Util 'is_prime';
no warnings qw(experimental::signatures);
my $limit = int($ARGV[0] || 20);
my @seq;
my $candidate = 1;
while (@seq < $limit)
{
$candidate++;
push(@seq, $candidate) if is_left_trunc($candidate);
}
say join(", ", @seq);
sub is_left_trunc ($prime)
{
return 0 if $prime =~ /0/;
for my $start (0 .. length($prime) -1)
{
return 0 unless is_prime(substr($prime, $start));
}
return 1;
}
Running it gives the same result as the Raku version:
$ ./truncatable-prime-perl
2, 3, 5, 7, 13, 17, 23, 37, 43, 47, 53, 67, 73, 83, 97, 113, 137, 167, 173, 197
$ ./truncatable-prime-perl 10
2, 3, 5, 7, 13, 17, 23, 37, 43, 47
Pentagon Numbers whose
sum and difference are also a Pentagon Number.
The first 10 Pentagon Numbers are:
1, 5, 12, 22, 35, 51, 70, 92, 117 and 145.
P(4) + P(7) = 22 + 70 = 92 = P(8)
but
P(4) - P(7) = |22 - 70| = 48 is not a Pentagon Number.
Let us start with the sequence:
File: pentagon-numbers-seq
#! /usr/bin/env raku
unit sub MAIN ($limit = 10);
my $penta-seq = gather
{
state $index = 0;
loop
{
$index++;
take $index * ( 3 * $index -1) / 2;
}
}
say $penta-seq[^$limit].join(", ");
Running it:
./pentagon-numbers-seq
1, 5, 12, 22, 35, 51, 70, 92, 117, 145
./pentagon-numbers-seq 15
1, 5, 12, 22, 35, 51, 70, 92, 117, 145, 176, 210, 247, 287, 330
Looking good.
Then we can go on with the challenge itself:
File: pentagon-numbers
#! /usr/bin/env raku
unit sub MAIN ($limit = 10, :v(:$verbose));
my $penta-seq = gather
{
state $index = 0;
loop
{
$index++;
take $index * ( 3 * $index -1) / 2;
}
}
my @a = $penta-seq[^$limit]; # [1]
my %is-penta = @a.Set; # [2]
for @a -> $a # [3]
{
for @a -> $b # [4]
{
next if $b <= $a; # [5]
say ": Considering $a, $b" if $verbose;
if %is-penta{$a + $b} && %is-penta{$b - $a} # [6]
{
say "$a, $b"; # [7]
exit; # [7a]
}
}
}
say "(no match)";
[1] Expand the sequence, with the specified number of values only.
[2] Coerce the values to a Set, i.e. a hash(like structure) with the values from the array as keys.
See
docs.raku.org/type/Set
for more information about the Set type, and
docs.raku.org/routine/Set
for more information about the Set method.
[3] We are going to combine two values. This is the first,
[4] and this is the second.
[5] (1, 10) is the same as (10, 1) so we can skip the last one. (Note that indeces would have been better here, and I will indeed come back to that later.)
[6] Do we have the match?
[7] If so, say so and exit.
Running it:
$ ./pentagon-numbers
(no match)
$ ./pentagon-numbers 100
(no match)
$ ./pentagon-numbers 1000
(no match)
The problem is that we do not have a method that allows us to check if a given number is a Pentagon Number. We set the upper limit (on the number of values), as we have to generate the values up front. But we do require a value higher than that - as we add two of them together (possibly the two last ones in the sequence).
Setting the limit high enough gives the answer:
$ ./pentagon-numbers 10000
1560090, 7042750
The program used about 25 seconds on my pc.
What is «high enough»? Trial and error is the thing in this case, showing that the algorithm is rather stupid. You can certainly go overboard with a high enough number. 25000 works just as well as 10000, but the result will now take more than 90 seconds to compute.
Deciding if a number is a Pentagon Number or not is easy, according to Wikipedia:
File: pentagon-numbers-seq-grep
#! /usr/bin/env raku
unit sub MAIN ($limit = 10);
my $penta-seq = (1..Inf).grep(*.&is-pentagonial);
say $penta-seq[^$limit].join(", ");
sub is-pentagonial ($candidate)
{
my $is = (1 + (1 + 24 * $candidate).sqrt) / 6;
return $is.Int == $is;
}
The program gives the correct result:
$ ./pentagon-numbers-seq-grep
1, 5, 12, 22, 35, 51, 70, 92, 117, 145
$ ./pentagon-numbers-seq-grep 15
1, 5, 12, 22, 35, 51, 70, 92, 117, 145, 176, 210, 247, 287, 330
Using this procedure:
File: pentagon-numbers-loop
#! /usr/bin/env raku
for 2 .. Inf -> $a
{
for $a -1 ... 1 -> $b # [1]
{
my $penta-a = pentagonial($a);
my $penta-b = pentagonial($b);
if is-pentagonial($penta-a + $penta-b) &&
is-pentagonial($penta-a - $penta-b)
{
say "$penta-b, $penta-a";
exit;
}
}
}
sub is-pentagonial ($candidate)
{
my $check = (1 + (1 + 24 * $candidate).sqrt) / 6;
return $check.Int == $check;
}
sub pentagonial ($number)
{
return $number * ( 3 * $number -1) / 2;
}
say "(no match)";
[1] Counting down from the first value.
Running it gives the expected result:
$ ./pentagon-numbers-loop
1560090, 7042750
The program took about 28 seconds to run. Which is slower than the first version - even with an unoptimized limit. The reason: we recalculate the pentagon numbers again and again. Which is stupid.
Caching the values:
File: pentagon-numbers-loop-cached (changes only)
sub is-pentagonial ($candidate)
{
state @cache1;
return @cache1[$candidate] if @cache1[$candidate];
my $value = (1 + (1 + 24 * $candidate).sqrt) / 6;
@cache1[$candidate] = ( $value.Int == $value );
return @cache1[$candidate];
}
sub pentagonial ($number)
{
state @cache2;
return @cache2[$number] if @cache2[$number];
return @cache2[$number] = $number * ( 3 * $number -1) / 2;
}
Running this program takes about 100 seconds, so caching is actually bad (in this case). Just caching the «pentagonial» procedure gives timings in the same ballpark as the uncached program.
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use feature 'signatures';
no warnings qw(experimental::signatures);
my $a = 1;
while ($a++)
{
my $b = $a;
while ($b-- > 1)
{
my $penta_a = pentagonial($a);
my $penta_b = pentagonial($b);
if (is_pentagonial($penta_a + $penta_b) &&
is_pentagonial($penta_a - $penta_b))
{
say "$penta_b $penta_a";
exit;
}
}
}
sub is_pentagonial($candidate)
{
my $check = (1 + sqrt(1 + 24 * $candidate)) / 6;
return int($check) == $check;
}
sub pentagonial($number)
{
return $number * ( 3 * $number -1) / 2;
}
say "(no match)";
Running it gives the same result as the Raku version(s):
$ ./pentagon-numbers-loop-perl
1560090 7042750
This program took slighly less than 2 seconds to run, so we do not have to cache values here.
And that's it.