Merge pull request #5513 from polettix/polettix/pwc147

Add polettix's solution to challenge-147

6 files changed, 221 insertions, 0 deletions

diff --git a/challenge-147/polettix/blog.txt b/challenge-147/polettix/blog.txt
new file mode 100644
index 0000000000..4ad8c79ae3
--- /dev/null
+++ b/challenge-147/polettix/blog.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2022/01/12/pwc147-truncatable-prime/
diff --git a/challenge-147/polettix/blog1.txt b/challenge-147/polettix/blog1.txt
new file mode 100644
index 0000000000..8cd6bee5f9
--- /dev/null
+++ b/challenge-147/polettix/blog1.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2022/01/13/pwc147-pentagon-numbers/
diff --git a/challenge-147/polettix/perl/ch-1.pl b/challenge-147/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..61db33f1f5
--- /dev/null
+++ b/challenge-147/polettix/perl/ch-1.pl
@@ -0,0 +1,40 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+
+say nth_left_truncatable($_) for 1 .. shift // 20;
+
+sub nth_left_truncatable ($nth) {
+   state $cache = [ grep { is_prime($_) && is_prime(substr $_, 1) } 10 .. 99 ];
+   state $prefix = 1;
+   state $first_id = 0;
+   state $next_first_id = $cache->@*;
+   state $id = $first_id;
+   while ($cache->@* < $nth) {
+      my $candidate = $prefix . $cache->[$id++];
+      push $cache->@*, $candidate if is_prime($candidate);
+      if (length($candidate) == length($cache->[$id])) { # toppled over!
+         if ($prefix < 9) {
+            ++$prefix;
+         }
+         else {
+            $prefix = 1;
+            ($first_id, $next_first_id) = ($next_first_id, $id);
+         }
+         $id = $first_id; # just reset the cursor
+      }
+   }
+   return $cache->[$nth - 1];
+}
+
+sub is_prime { # https://en.wikipedia.org/wiki/Primality_test
+   return if $_[0] < 2;
+   return 1 if $_[0] <= 3;
+   return unless ($_[0] % 2) && ($_[0] % 3);
+   for (my $i = 6 - 1; $i * $i <= $_[0]; $i += 6) {
+      return unless ($_[0] % $i) && ($_[0] % ($i + 2));
+   }
+   return 1;
+}
diff --git a/challenge-147/polettix/perl/ch-2.pl b/challenge-147/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..f895123c24
--- /dev/null
+++ b/challenge-147/polettix/perl/ch-2.pl
@@ -0,0 +1,74 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+
+$|++;
+my ($delta, $X, $Y, $sum) = lowest_difference_superpentagonals();
+say '';
+my @n = map { invert_pentagonal($_) } ($delta, $X, $Y, $sum);
+
+say "delta<$delta> ($n[0])";
+say "    X<$X> ($n[1])";
+say "    Y<$Y> ($n[2])";
+say "  sum<$sum> ($n[3])";
+
+say " Y - X - delta = @{[$Y - $X - $delta]}";
+say " Y + X - sum   = @{[$Y + $X - $sum]}";
+
+#
+#  X < Y are our candidates.
+#  delta = Y - X  -->   Y =  X + delta
+#  sum   = Y + X  --> sum = 2X + delta
+#
+sub lowest_difference_superpentagonals {
+   my ($delta, $n_delta) = (0, 0);
+   my @upper;
+   while ('necessary') {
+      $delta += 3 * $n_delta++ + 1; # we have to find the minimum delta
+      print "\r$n_delta ($delta)";
+      return @upper if @upper && $upper[0] <= $delta;
+
+      # X = P(n_X)   and P(n_X + 1) - X = 3 * n_X + 1
+      #
+      # This means that delta MUST be greater than 3 * n_X + 1, otherwise
+      # it will not "allow" X to reach any of the following pentagonal
+      # number. This means:
+      #
+      # delta >= 3 * n_X + 1  => n_X <= (delta - 1) / 3
+      my $max_n_X = int(($delta - 1) / 3);
+
+      # X *might* be less than delta, of course, but we will check this
+      # on the way, so we will only consider values of X greater than that
+      my $X = $delta;
+      for my $n_X ($n_delta + 1 .. $max_n_X) {
+         $X += 3 * $n_X - 2;
+         my $Y = $X + $delta; # this does not change inverting roles
+         invert_pentagonal($Y) or next;
+
+         # now let's consider delta < X  --> $sum = $Y + $X
+         my $sum = $Y + $X;
+         return ($delta, $X, $Y, $sum) if invert_pentagonal($sum);
+
+         # now let's consider X < delta and swap their roles...
+         $sum = $Y + $delta;
+         if (my $n_sum = invert_pentagonal($sum)) {
+
+            # we just record that we have an upper limit for delta here,
+            # but still there might be some better delta in between
+            @upper = ($X, $delta, $Y, $sum)
+               if !@upper || $X < $upper[0];
+
+            say "  current candidate @upper";
+         }
+      }
+   }
+}
+
+sub invert_pentagonal ($P) {
+   my $root = int sqrt(my $maybe_square = 1 + 24 * $P);
+   return unless $root * $root == $maybe_square;
+   return if ++$root % 6;
+   return $root / 6;
+}
diff --git a/challenge-147/polettix/raku/ch-1.raku b/challenge-147/polettix/raku/ch-1.raku
new file mode 100644
index 0000000000..95499efd49
--- /dev/null
+++ b/challenge-147/polettix/raku/ch-1.raku
@@ -0,0 +1,54 @@
+#!/usr/bin/env raku
+use v6;
+
+sub MAIN (Int:D $n = 20, :$exclusive = False) {
+   $exclusive ?? exclusive($n) !! constructive($n);
+}
+
+
+sub constructive ($n) { put nth-left-truncatable($_) for 1 .. $n }
+
+sub nth-left-truncatable ($nth) {
+   state @cache = (10..99).grep({ .is-prime && .substr(1, 1).is-prime });
+   state $prefix = 1;
+   state $first-id = 0;
+   state $next-first-id = @cache.elems;
+   state $id = $first-id;
+   while @cache < $nth { # find moar!
+      my $candidate = ($prefix ~ @cache[$id++]).Int;
+      @cache.push($candidate) if $candidate.is-prime;
+      if $candidate.chars == @cache[$id].chars { # toppled over!
+         if $prefix < 9 {
+            ++$prefix;
+         }
+         else {
+            $prefix = 1;
+            ($first-id, $next-first-id) = ($next-first-id, $id);
+         }
+         $id = $first-id; # just reset the cursor
+      }
+   }
+   return @cache[$nth - 1];
+}
+
+
+sub exclusive (Int:D $n is copy = 20) {
+   my $i = 9;
+   while $n > 0 {
+      next unless is-left-truncatable($i = $i + 2);
+      $i.put;
+      --$n;
+   }
+}
+
+sub is-left-truncatable ($n) {
+   return False if $n < 10 || $n ~~ /0/;
+   return False unless $n.is-prime;
+   state %cache;
+   if %cache{$n}:!exists {
+      my $truncated = $n.substr(1);
+      return $truncated.is-prime if $truncated < 10;
+      %cache{$n} = is-left-truncatable($truncated);
+   }
+   return %cache{$n};
+}
diff --git a/challenge-147/polettix/raku/ch-2.raku b/challenge-147/polettix/raku/ch-2.raku
new file mode 100644
index 0000000000..4e71985319
--- /dev/null
+++ b/challenge-147/polettix/raku/ch-2.raku
@@ -0,0 +1,51 @@
+#!/usr/bin/env raku
+use v6;
+sub MAIN {
+   my ($delta, $X, $Y, $sum) = lowest-difference-superpentagonals();
+   put '';
+   my @n = ($delta, $X, $Y, $sum).map: { invert-pentagonal($_) };
+
+   put "delta<$delta> ({@n[0]})";
+   put "    X<$X> ({@n[1]})";
+   put "    Y<$Y> ({@n[2]})";
+   put "  sum<$sum> ({@n[3]})";
+
+   put " Y - X - delta = {$Y - $X - $delta}";
+   put " Y + X - sum   = {$Y + $X - $sum}";
+}
+
+sub lowest-difference-superpentagonals {
+   my ($delta, $n-delta) = 0, 0;
+   $n-delta = 1018;
+   $delta = $n-delta * (3 * $n-delta - 1) / 2;
+   my @upper;
+   loop {
+      $delta += 3 * $n-delta++ + 1;
+      print "\r$n-delta ($delta)";
+      return @upper if @upper && @upper[0] <= $delta;
+
+      my $max-n-X = (($delta - 1) / 3).Int;
+      my $X = $delta;
+      for $n-delta ^.. $max-n-X -> $n-X {
+         $X += 3 * $n-X - 2;
+         my $Y = $X + $delta;
+         invert-pentagonal($Y) or next;
+
+         my $sum = $Y + $X;
+         return [$delta, $X, $Y, $sum] if invert-pentagonal($sum);
+
+         $sum = $Y + $delta;
+         next unless invert-pentagonal($sum);
+         @upper = $X, $delta, $Y, $sum if (! @upper) || $X < @upper[0];
+         put "  current candidate {@upper}";
+      }
+   }
+}
+
+sub invert-pentagonal ($P) {
+   my $maybe-square = 1 + 24 * $P;
+   my $root = $maybe-square.sqrt.Int;
+   return unless $root * $root == $maybe-square;
+   return unless ++$root %% 6;
+   return $root / 6;
+}