Merge pull request #5523 from PerlMonk-Athanasius/branch-for-challenge-147

Perl & Raku solutions to Tasks 1 & 2 of the Weekly Challenge 147

4 files changed, 557 insertions, 0 deletions

diff --git a/challenge-147/athanasius/perl/ch-1.pl b/challenge-147/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..279c6db9d4
--- /dev/null
+++ b/challenge-147/athanasius/perl/ch-1.pl
@@ -0,0 +1,140 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 147
+=========================
+
+TASK #1
+-------
+*Truncatable Prime*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate first 20 left-truncatable prime numbers in base 10.
+
+    In number theory, a left-truncatable prime is a prime number which, in a
+    given base, contains no 0, and if the leading left digit is successively
+    removed, then all resulting numbers are primes.
+
+Example
+
+ 9137 is one such left-truncatable prime since 9137, 137, 37 and 7 are all
+ prime numbers.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Algorithm
+---------
+The smallest left-truncatable primes [1] (hereafter LTPs) are the single-digit
+primes: 2, 3, 5, and 7. For all positive integers of 2 or more digits, we con-
+sider the last (i.e., the least significant) digit:
+  - 0 digits are not allowed;
+  - numbers ending in 1, 4, 6, 8, or 9 are not prime when left-truncated to a
+    single digit (note: 1 is neither prime nor composite);
+  - numbers ending in 2 or 5 are divisible by 2 or 5, respectively, and so are
+    composite.
+Therefore, all LTPs of 2 or more digits must end in either 3 or 7.
+
+The algorithm *constructs* a longer LTP by adding a single digit to the left of
+a shorter, already-known LTP (for convenience, I call this a "base"). If the
+result of this concatenation is itself a prime number, the constructed number
+is a new LTP. The algorithm proceeds until either the required number of LTPs
+have been found, or there are no more bases available on which to build. [2]
+
+References
+----------
+[1] The Online Encyclopedia of Integer Sequences (https://oeis.org/A024785):
+    "A024785  Left-truncatable primes: every suffix is prime and no digits are
+     zero.
+                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"
+
+[2] From the COMMENTS section in [1]:
+    "Last term is a(4260) = 357686312646216567629137"
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+
+const my $TARGET => 20;
+const my $USAGE  => "Usage:\n  perl $0\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 147, Task #1: Truncatable Prime (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+       $args == 0 or die "ERROR: Expected 0 command line arguments, found " .
+                         "$args\n$USAGE";
+
+    my @ltps  = (2, 5);
+    my @bases = (3, 7);
+    my $count = scalar @ltps + scalar @bases;
+
+    while ($count < $TARGET && scalar @bases > 0)
+    {
+        my @new;
+
+        OUTER_FOR:
+        for my $i (1 .. 9)
+        {
+            for my $base (@bases)
+            {
+                my $p = $i . $base;
+
+                if (is_prime( $p ))
+                {
+                    push @new, $p;
+                    last OUTER_FOR unless ++$count < $TARGET;
+                }
+            }
+        }
+
+        push @ltps, @bases;
+        @bases = @new;
+    }
+
+    printf "The first %d left-truncatable prime numbers in base 10:\n%s\n",
+            $TARGET, join ', ', sort { $a <=> $b } @ltps, @bases;
+}
+
+#------------------------------------------------------------------------------
+sub is_prime
+#------------------------------------------------------------------------------
+{
+    my ($n) = @_;
+
+    for my $i (2 .. int sqrt $n)
+    {
+        return 0 if $n % $i == 0;
+    }
+
+    return 1;
+}
+
+###############################################################################
diff --git a/challenge-147/athanasius/perl/ch-2.pl b/challenge-147/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..7b4e1765c3
--- /dev/null
+++ b/challenge-147/athanasius/perl/ch-2.pl
@@ -0,0 +1,148 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 147
+=========================
+
+TASK #2
+-------
+*Pentagon Numbers*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to find the first pair of Pentagon Numbers whose sum and differ-
+ence are also a Pentagon Number.
+
+    Pentagon numbers can be defined as P(n) = n(3n - 1)/2.
+
+Example
+
+ 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.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Discussion
+----------
+Consider a pair J of Pentagon Numbers: J = (P(x), P(y)). If x = y, the differ-
+ence P(x) - P(y) = 0, which is not a Pentagon Number. So we require x ≠ y. For
+convenience, we specify x < y. Now consider a second pair K = (P(z), P(w))
+where z < w. What is required to determine whether J < K?
+
+If x < z AND y < w, it is clear that J < K. But if x < z and y > w, J is
+neither greater than nor less than K. In fact, pairs of Pentagon Numbers form a
+partially ordered set with a product ordering [1]. Therefore, the term "first
+pair" is not well-defined.
+
+For the purposes of this Task I assume that Pentagon Number pairs are ordered,
+firstly, by the second (i.e., the larger) of the two Pentagon Numbers, and,
+secondly, by the first (smaller) Pentagon Number. This assumption simplifies
+the search algorithm since the upper search bound is always known up front.
+
+The minimum value required for $MAX_PENT was found by trial and error.
+
+Reference
+---------
+[1] https://en.wikipedia.org/wiki/Product_order
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+
+const my $MAX_PENT => 2_400;
+const my $USAGE    => "Usage:\n  perl $0\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 147, Task #2: Pentagon Numbers (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    parse_command_line();
+
+    print "The first pair of Pentagon Numbers whose\n",
+          "sum and difference are also Pentagon Numbers:\n\n";
+
+    my ($pent_h, $pent_a) = populate_pentagonals();            # Hash and array
+
+    L_OUTER:
+    for my $i (1 .. $#$pent_a)
+    {
+        my $pi = $pent_a->[  $i ];
+        my $ni = $pent_h->{ $pi };
+
+        for my $j (0 .. $i - 1)
+        {
+            my $pj  = $pent_a->[  $j ];
+            my $nj  = $pent_h->{ $pj };
+            my $sum = $pi + $pj;
+
+            if (exists $pent_h->{ $sum })
+            {
+                my $diff = abs( $pi - $pj );
+
+                if (exists $pent_h->{ $diff })
+                {
+                    printf "P(%d) + P(%d) =  %d + %d  = %d = P(%d)\n" .
+                           "P(%d) - P(%d) = |%d - %d| = %d = P(%d)\n",
+                            $nj, $ni, $pj, $pi, $sum,  $pent_h->{ $sum  },
+                            $nj, $ni, $pj, $pi, $diff, $pent_h->{ $diff };
+
+                    last L_OUTER;
+                }
+            }
+        }
+    }
+}
+
+#------------------------------------------------------------------------------
+sub populate_pentagonals
+#------------------------------------------------------------------------------
+{
+    my %pent_hash;
+
+    for my $n (1 .. $MAX_PENT)
+    {
+        my $p = $n * (3 * $n - 1) / 2;
+
+        $pent_hash{ $p } = $n;
+    }
+
+    my @pent_array = sort { $a <=> $b } keys %pent_hash;
+
+    return (\%pent_hash, \@pent_array);
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+       $args == 0 or die "ERROR: Expected 0 command line arguments, found " .
+                         "$args\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-147/athanasius/raku/ch-1.raku b/challenge-147/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..25ad3a234b
--- /dev/null
+++ b/challenge-147/athanasius/raku/ch-1.raku
@@ -0,0 +1,127 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 147
+=========================
+
+TASK #1
+-------
+*Truncatable Prime*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate first 20 left-truncatable prime numbers in base 10.
+
+    In number theory, a left-truncatable prime is a prime number which, in a
+    given base, contains no 0, and if the leading left digit is successively
+    removed, then all resulting numbers are primes.
+
+Example
+
+ 9137 is one such left-truncatable prime since 9137, 137, 37 and 7 are all
+ prime numbers.
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Algorithm
+---------
+The smallest left-truncatable primes [1] (hereafter LTPs) are the single-digit
+primes: 2, 3, 5, and 7. For all positive integers of 2 or more digits, we con-
+sider the last (i.e., the least significant) digit:
+  - 0 digits are not allowed;
+  - numbers ending in 1, 4, 6, 8, or 9 are not prime when left-truncated to a
+    single digit (note: 1 is neither prime nor composite);
+  - numbers ending in 2 or 5 are divisible by 2 or 5, respectively, and so are
+    composite.
+Therefore, all LTPs of 2 or more digits must end in either 3 or 7.
+
+The algorithm *constructs* a longer LTP by adding a single digit to the left of
+a shorter, already-known LTP (for convenience, I call this a "base"). If the
+result of this concatenation is itself a prime number, the constructed number
+is a new LTP. The algorithm proceeds until either the required number of LTPs
+have been found, or there are no more bases available on which to build. [2]
+
+References
+----------
+[1] The Online Encyclopedia of Integer Sequences (https://oeis.org/A024785):
+    "A024785  Left-truncatable primes: every suffix is prime and no digits are
+     zero.
+                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"
+
+[2] From the COMMENTS section in [1]:
+    "Last term is a(4260) = 357686312646216567629137"
+
+=end comment
+#==============================================================================
+
+my UInt constant $TARGET = 20;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 147, Task #1: Truncatable Prime (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN()
+#==============================================================================
+{
+    my UInt @ltps  = 2, 5;
+    my UInt @bases = 3, 7;
+    my UInt $count = @ltps.elems + @bases.elems;
+
+    while $count < $TARGET && @bases.elems > 0
+    {
+        my UInt @new;
+
+        OUTER-FOR:
+        for 1 .. 9 -> UInt $i
+        {
+            for @bases -> UInt $base
+            {
+                my UInt $p = ($i ~ $base).Int;
+
+                if $p.is-prime
+                {
+                    @new.push: $p;
+                    last OUTER-FOR unless ++$count < $TARGET;
+                }
+            }
+        }
+
+        @ltps.push: |@bases;
+        @bases = @new;
+    }
+
+    "The first %d left-truncatable prime numbers in base 10:\n%s\n".printf:
+        $TARGET, (|@ltps, |@bases).sort.join: ', ';
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-147/athanasius/raku/ch-2.raku b/challenge-147/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..0bbda41f05
--- /dev/null
+++ b/challenge-147/athanasius/raku/ch-2.raku
@@ -0,0 +1,142 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 147
+=========================
+
+TASK #2
+-------
+*Pentagon Numbers*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to find the first pair of Pentagon Numbers whose sum and differ-
+ence are also a Pentagon Number.
+
+    Pentagon numbers can be defined as P(n) = n(3n - 1)/2.
+
+Example
+
+ 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.
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Discussion
+----------
+Consider a pair J of Pentagon Numbers: J = (P(x), P(y)). If x = y, the differ-
+ence P(x) - P(y) = 0, which is not a Pentagon Number. So we require x ≠ y. For
+convenience, we specify x < y. Now consider a second pair K = (P(z), P(w))
+where z < w. What is required to determine whether J < K?
+
+If x < z AND y < w, it is clear that J < K. But if x < z and y > w, J is
+neither greater than nor less than K. In fact, pairs of Pentagon Numbers form a
+partially ordered set with a product ordering [1]. Therefore, the term "first
+pair" is not well-defined.
+
+For the purposes of this Task I assume that Pentagon Number pairs are ordered,
+firstly, by the second (i.e., the larger) of the two Pentagon Numbers, and,
+secondly, by the first (smaller) Pentagon Number. This assumption simplifies
+the search algorithm since the upper search bound is always known up front.
+
+The minimum value required for $MAX-PENT was found by trial and error.
+
+Reference
+---------
+[1] https://en.wikipedia.org/wiki/Product_order
+
+=end comment
+#==============================================================================
+
+my UInt constant $MAX-PENT = 2_400;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 147, Task #2: Pentagon Numbers (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN()
+#==============================================================================
+{
+    ("The first pair of Pentagon Numbers whose\n" ~
+     "sum and difference are also Pentagon Numbers:\n").put;
+
+    my UInt %pent-h = populate-pentagonals();
+    my UInt @pent-a = %pent-h.keys.map( { .Int } ).sort;
+
+    # Type-checking has been removed from the code below to speed up execution
+
+    L-OUTER1:
+    for 1 .. @pent-a.end -> $i
+    {
+        my $pi = @pent-a[  $i ];
+        my $ni = %pent-h{ $pi };
+
+        for 0 .. $i - 1 -> $j
+        {
+            my $pj  = @pent-a[  $j ];
+            my $nj  = %pent-h{ $pj };
+            my $sum = $pi + $pj;
+
+            if %pent-h{ $sum }:exists
+            {
+                my $diff = abs( $pi - $pj );
+
+                if %pent-h{ $diff }:exists
+                {
+                    ("P(%d) + P(%d) =  %d + %d  = %d = P(%d)\n" ~
+                     "P(%d) - P(%d) = |%d - %d| = %d = P(%d)\n").printf:
+                      $nj, $ni, $pj, $pi, $sum,  %pent-h{ $sum  },
+                      $nj, $ni, $pj, $pi, $diff, %pent-h{ $diff };
+
+                    last L-OUTER1;
+                }
+            }
+        }
+    }
+}
+
+#------------------------------------------------------------------------------
+sub populate-pentagonals( --> Hash[UInt] )
+#------------------------------------------------------------------------------
+{
+    my UInt %pent-hash;
+
+    for 1 .. $MAX-PENT -> UInt $n
+    {
+        my UInt $p = ($n * (3 * $n - 1) / 2).Int;
+
+        %pent-hash{ $p } = $n;
+    }
+
+    return %pent-hash;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################