Merge pull request #5527 from Util/branch-for-challenge-147

Add Raku and Perl solutions for #147 by Bruce Gray.

5 files changed, 136 insertions, 25 deletions

diff --git a/challenge-147/bruce-gray/README b/challenge-147/bruce-gray/README
index 6511220e4d..7acad0424d 100644
--- a/challenge-147/bruce-gray/README
+++ b/challenge-147/bruce-gray/README
@@ -1,33 +1,25 @@
-Solutions by Bruce Gray.
+Solutions by Bruce Gray for https://theweeklychallenge.org/blog/perl-weekly-challenge-147/
 
-For ch-2, the Perl and Raku programs can take rationals on the command-line for experimentation,
-or will run their test suites if invoked without arguments.
+NOTE: Both Task#2 solutions deliberately avoid the need for is_pentagon_number(),
+[as per quadratic transformation of `n(3n-1)/2 = P`
+to `sqrt(24P + 1) must be 5(mod 6)` and `24P + 1 must be a perfect square`]
+, just for fun.
 
 Sample runs:
-$ perl perl/ch-1.pl 
-    104743
+$ perl perl/ch-1.pl
+    2 3 5 7 13 17 23 37 43 47 53 67 73 83 97 103 107 113 137 167
+    2 3 5 7 13 17 23 37 43 47 53 67 73 83 97 113 137 167 173 197
 
 $ raku raku/ch-1.raku
-    104743
+    2 3 5 7 13 17 23 37 43 47 53 67 73 83 97 103 107 113 137 167
+    2 3 5 7 13 17 23 37 43 47 53 67 73 83 97 113 137 167 173 197
 
-$ perl perl/ch-2.pl 4817/5410
-    4817/5410 has CW parent,grandparent of: 4817/593,4224/593
+$ perl perl/ch-2.pl 
+    7042750 5482660
 
-$ raku raku/ch-2.raku 4817/5410
-    (4817/593 4224/593)
+$ time raku raku/ch-2.raku
+    7042750 5482660
 
-$ prove perl/ch-2.pl
-    perl/ch-2.pl .. ok       
-    All tests successful.
-    Files=1, Tests=202,  0 wallclock secs ( 0.04 usr  0.01 sys +  0.09 cusr  0.01 csys =  0.15 CPU)
-    Result: PASS
-
-$ prove -e raku raku/ch-2.raku
-    raku/ch-2.raku .. ok       
-    All tests successful.
-    Files=1, Tests=202,  3 wallclock secs ( 0.05 usr  0.00 sys +  2.72 cusr  0.13 csys =  2.90 CPU)
-    Result: PASS
-
-$ perl -MMath::PlanePath::RationalsTree -wE 'my $CW = Math::PlanePath::RationalsTree->new( tree_type => "CW" ); say join "/", $CW->n_to_xy( $CW->tree_n_parent( $CW->xy_to_n(@ARGV) ) );' 4817 5410
-    4817/593
-    (Fleshed out in ch-2_via_module.pl)
+    real	0m2.432s
+    user	0m2.534s
+    sys 	0m0.067s
diff --git a/challenge-147/bruce-gray/perl/ch-1.pl b/challenge-147/bruce-gray/perl/ch-1.pl
new file mode 100644
index 0000000000..4239628cbc
--- /dev/null
+++ b/challenge-147/bruce-gray/perl/ch-1.pl
@@ -0,0 +1,44 @@
+use Modern::Perl;
+use experimental qw<signatures>;
+use List::Util   qw<first>;
+use ntheory      qw<is_prime>;
+
+# "Left-truncatable prime" is not fully defined by the task; are leading zeros valid?
+# e.g. 103 -> 03 -> 3 ; all are prime, but is `03` considered a "number"?
+# OEIS has separate pages for each definition:
+#   http://oeis.org/A033664 2, 3, 5, 7, 13, 17, 23, 37, 43, 47, 53, 67, 73, 83, 97, 103, 107, 113, ...
+#   http://oeis.org/A024785 2, 3, 5, 7, 13, 17, 23, 37, 43, 47, 53, 67, 73, 83, 97,           113, ...
+# Since one definition is more easily written as a filter,
+# and the other definition is best written as a generator, I have both below.
+
+sub is_left_truncatable_prime ( $N ) {
+    my @starting_positions = 0 .. length($N)-1;
+    my @substrings = map   { substr $N, $_ } @starting_positions;
+    my $non_prime  = first { ! is_prime $_ } @substrings;
+    return ! defined $non_prime;
+}
+my @LTP_A033664;
+{
+    my $i = 0;
+    while (@LTP_A033664 < 20) {
+        push @LTP_A033664, $i if is_left_truncatable_prime($i);
+        $i++;
+    }
+}
+
+sub LTP_A024785 ( $n ) {
+    state @cache;
+    state @current_gen;
+    @current_gen = (2, 3, 5, 7) if not @current_gen;
+
+    while (@cache <= $n) {
+        push @cache, @current_gen;
+        my @next_gen = map  { my $d = $_; map { "$d$_" } @current_gen } (1..9);
+        @current_gen = grep { is_prime($_) } @next_gen;
+    }
+    return $cache[$n];
+}
+
+
+say join ' ',      @LTP_A033664;
+say join ' ', map { LTP_A024785($_) } 0..19;
diff --git a/challenge-147/bruce-gray/perl/ch-2.pl b/challenge-147/bruce-gray/perl/ch-2.pl
new file mode 100644
index 0000000000..929726a349
--- /dev/null
+++ b/challenge-147/bruce-gray/perl/ch-2.pl
@@ -0,0 +1,27 @@
+use Modern::Perl;
+use experimental qw<signatures>;
+
+# Where A,B,C,D are all pentagonal numbers:
+# B + C == A      ,  B - C == D     Original problem statement in task 
+#     C == A - B  ,  B - C == D     Rearranged as two differences
+#     C == A - B  ,  B-(A-B)==D     Rearranged as two differences(C,D), expressed only in A,B
+# So, if we find any two pentagonal numbers A,B where A-B is pentagonal and B-(A-B) is pentagonal,
+# then we have a solution. The desired numbers will be the inner two: (B,C)
+sub find_first_plus_and_minus_pentagon_numbers ( ) {
+    my @pents;
+    my %p;
+    for ( my $i = 1 ; ; $i++ ) {
+        my $A = $i * (3*$i - 1) / 2; # Pentagon number
+
+        for my $B (@pents) {
+            my $D = $A - $B;
+            my $C = $B - $D;
+            return $B, $C if $p{$C} and $p{$D};
+        }
+
+        $p{$A} = 1; 
+        push @pents, $A;
+    }
+}
+
+say join ' ', find_first_plus_and_minus_pentagon_numbers();
diff --git a/challenge-147/bruce-gray/raku/ch-1.raku b/challenge-147/bruce-gray/raku/ch-1.raku
new file mode 100644
index 0000000000..f01b478b4e
--- /dev/null
+++ b/challenge-147/bruce-gray/raku/ch-1.raku
@@ -0,0 +1,27 @@
+# "Left-truncatable prime" is not fully defined by the task; are leading zeros valid?
+# e.g. 103 -> 03 -> 3 ; all are prime, but is `03` considered a "number"?
+# OEIS has separate pages for each definition:
+#   http://oeis.org/A033664 2, 3, 5, 7, 13, 17, 23, 37, 43, 47, 53, 67, 73, 83, 97, 103, 107, 113, ...
+#   http://oeis.org/A024785 2, 3, 5, 7, 13, 17, 23, 37, 43, 47, 53, 67, 73, 83, 97,           113, ...
+# Since one definition is more easily written as a filter,
+# and the other definition is best written as a generator, I have both below.
+
+
+sub is-left-truncatable-prime ( UInt \N --> Bool ) {
+    return (0 ..^ N.chars)          # Starting positions of substrings
+        .map(  { N.substr($_) })    # All left-truncated substrings
+        .first({ .is-prime.not })   # Find the first non-prime
+        .defined.not;               # If no non-prime found, then True
+}
+constant @LTP_A033664 = grep &is-left-truncatable-prime, ^Inf;
+
+
+my @LTP_A024785 = lazy gather loop {
+    state @current_gen = grep &is-prime, ^10;
+    .take for @current_gen;
+    @current_gen = grep &is-prime, ((1..9) X~ @current_gen);
+}
+
+
+put @LTP_A033664.head(20);
+put @LTP_A024785.head(20);
diff --git a/challenge-147/bruce-gray/raku/ch-2.raku b/challenge-147/bruce-gray/raku/ch-2.raku
new file mode 100644
index 0000000000..4981950348
--- /dev/null
+++ b/challenge-147/bruce-gray/raku/ch-2.raku
@@ -0,0 +1,21 @@
+# Where A,B,C,D are all pentagonal numbers:
+# B + C == A      ,  B - C == D     Original problem statement in task 
+#     C == A - B  ,  B - C == D     Rearranged as two differences
+#     C == A - B  ,  B-(A-B)==D     Rearranged as two differences(C,D), expressed only in A,B
+# So, if we find any two pentagonal numbers A,B where A-B is pentagonal and B-(A-B) is pentagonal,
+# then we have a solution. The desired numbers will be the inner two: (B,C)
+sub find-first-plus-and-minus-pentagon_numbers ( ) {
+    constant @pents = map ->\n { n *(3*n - 1) div 2 }, 1..*;
+
+    my %p;
+    for @pents.kv -> \i, \A {
+        %p{A} = 1;
+
+        for @pents.head(i) -> \B {
+            my \D = A - B;
+            my \C = B - D;
+            return B, C if %p{C} and %p{D};
+        }
+    }
+}
+put find-first-plus-and-minus-pentagon_numbers();