Merge pull request #4638 from PerlMonk-Athanasius/branch-for-challenge-123

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

4 files changed, 642 insertions, 0 deletions

diff --git a/challenge-123/athanasius/perl/ch-1.pl b/challenge-123/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..6e1d3aadbb
--- /dev/null
+++ b/challenge-123/athanasius/perl/ch-1.pl
@@ -0,0 +1,169 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 123
+=========================
+
+TASK #1
+-------
+*Ugly Numbers*
+
+Submitted by: Mohammad S Anwar
+
+You are given an integer $n >= 1.
+
+Write a script to find the $nth element of Ugly Numbers.
+
+        Ugly numbers are those number whose prime factors are 2, 3 or 5. For
+        example, the first 10 Ugly Numbers are 1, 2, 3, 4, 5, 6, 8, 9, 10, 12.
+
+Example
+
+ Input: $n = 7
+ Output: 8
+
+ Input: $n = 10
+ Output: 12
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Definition and Algorithm
+------------------------
+So-called "ugly numbers", more correctly 5-smooth, regular, or Hamming numbers,
+are positive integers of the form:
+
+    2^i × 3^j × 5^k     where i, j, k are integers ≥ 0
+
+The set H of all Hamming numbers can be defined inductively:
+    (1) 1 ∊ H                                                [Base case]
+    (2) (∀n)(n ∊ H → (2n ∊ H ∧ 3n ∊ H ∧ 5n ∊ H))             [Inductive clause]
+    (3) H is the intersection of all sets satisfying (1) and (2)
+                                                             [Extremal  clause]
+
+This gives a straightforward method for producing the set of Hamming numbers:
+
+    Let H = { 1 }
+    Repeat:
+      For each element h of H not previously processed, add 2h, 3h, and 5h to H
+
+The drawback of this method is that it generates Hamming numbers out of order,
+and adds duplicates:
+
+    Correct (sorted) order: 1, 2, 3, 4, 5, 6,  8, 9, 10, 12 ...
+    Generated order:        1, 2, 3, 5, 4, 6, 10, 6,  9, 15, 8, 12, 20 ...
+
+This can be remedied by filtering candidate values of h as follows:
+ (a) ensure that the next h is always the *smallest* of the remaining (unused)
+     Hamming numbers generated so far; and
+ (b) remember the last value of h, and discard the next candidate if it's a
+     duplicate
+The order in which h values are *selected* for processing is the correct (i.e.,
+sorted) order of the Hamming numbers.
+
+In the implementation below, the CPAN module Array::Heap is used to store the
+pool of Hamming numbers generated so far (i.e., the candidate values of h).
+Because heap elements are stored in priority order (the smallest value has the
+highest priority), the pop_heap() function  always returns the smallest
+candidate, thereby satisfying condition (a).
+
+References
+----------
+Mark Jason Dominus, "Infinite lists in Perl",
+    https://perl.plover.com/Stream/stream.html (28 July, 2021)
+
+N. J. A. Sloane, editor, The On-Line Encyclopedia of Integer Sequences,
+    "A051037  5-smooth numbers, i.e., numbers whose prime divisors are all <=
+     5.", https://oeis.org/A051037 (28 July, 2021)
+
+Wikipedia, "Regular Number",
+    https://en.wikipedia.org/wiki/Regular_number (28 July, 2021)
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Array::Heap;
+use Const::Fast;
+use Regexp::Common qw( number );
+
+const my $USAGE =>
+"Usage:
+  perl $0 <n>
+
+    <n>    A non-zero positive integer\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 123, Task #1: Ugly Numbers (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $n = parse_command_line();
+
+    print "Input:  \$n = $n\n";
+
+    my @heap   = 1;
+    my $last_h = 0;
+    my $count  = 0;
+    my $hamming;
+
+    while ($count++ < $n)
+    {
+        do
+        {
+            $hamming = pop_heap @heap;
+
+        } while ($hamming == $last_h);                     # Discard duplicates
+
+        $last_h = $hamming;
+
+        push_heap @heap, $_ * $hamming for 2, 3, 5;
+    }
+
+    printf "Output: %d\n", $hamming;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+       $args == 1 or error( "Expected 1 command line argument, found $args" );
+
+    my $n = $ARGV[ 0 ] + 0;    # Normalize
+
+       $n =~ / ^ $RE{num}{int} $ /x
+                  or error( qq["$n" is not a valid integer] );
+
+       $n >= 1    or error( qq["$n" is too small] );
+
+    return $n;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-123/athanasius/perl/ch-2.pl b/challenge-123/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..de87da5368
--- /dev/null
+++ b/challenge-123/athanasius/perl/ch-2.pl
@@ -0,0 +1,178 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 123
+=========================
+
+TASK #2
+-------
+*Square Points*
+
+Submitted by: Mohammad S Anwar
+
+You are given coordinates of four points i.e. (x1, y1), (x2, y2), (x3, y3) and
+(x4, y4).
+
+Write a script to find out if the given four points form a square.
+
+Example
+
+ Input: x1 = 10, y1 = 20
+        x2 = 20, y2 = 20
+        x3 = 20, y3 = 10
+        x4 = 10, y4 = 10
+ Output: 1 as the given coordinates form a square.
+
+ Input: x1 = 12, y1 = 24
+        x2 = 16, y2 = 10
+        x3 = 20, y3 = 12
+        x4 = 18, y4 = 16
+ Output: 0 as the given coordinates doesn't form a square.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Assumptions
+-----------
+(1) A square must have non-zero area, so four identical points do not form a
+    square
+(2) The requirement "find out if the given four points form a square" means
+    "determine whether the quadrilateral having these four points as its four
+    *corners* is a square"
+
+Algorithm
+---------
+A square has 4 sides of identical length, but a quadrilateral with 4 sides of
+identical length is a rhombus, not necessarily a square. For it to be a square,
+its interior angles must be all equal (viz., right angles).
+
+However, measuring angles is a more complex task than measuring lengths, so the
+method adopted below makes use of the additional property that the interior
+diagonals joining opposite corners of a square are equal, and each is √2 times
+the length of any exterior side.
+
+Distances between points on the Cartesian plane are calculated using the
+Pythagorean theorem.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+
+const my $EPSILON => 1e-9;
+const my $USAGE   =>
+"Usage:
+  perl $0 [<coords> ...]
+
+    [<coords> ...]    Cartesian coordinates x1, y1, x2, y2, x3, y3, x4, y4\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 123, Task #2: Square Points (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my @coords = parse_command_line();
+
+    print 'Input:  x1 = ' . $coords[ 0 ] . ', y1 = ' . $coords[ 1 ] . "\n" .
+          '        x2 = ' . $coords[ 2 ] . ', y2 = ' . $coords[ 3 ] . "\n" .
+          '        x3 = ' . $coords[ 4 ] . ', y3 = ' . $coords[ 5 ] . "\n" .
+          '        x4 = ' . $coords[ 6 ] . ', y4 = ' . $coords[ 7 ] . "\n";
+
+    my @dists;
+
+    # Let the 4 points be a, b, c, d; here we calculate the 6 distances ab, ac,
+    # ad, bc, bd, cd
+
+    for my $slice ( [ 0 .. 3 ], [ 0, 1, 4, 5 ], [ 0, 1, 6, 7 ],
+                    [ 2 .. 5 ], [ 2, 3, 6, 7 ], [ 4   ..   7 ] )
+    {
+        push @dists, distance( @coords[ @$slice ] );
+    }
+
+    # If the 4 given points do describe a square, then sorting the distances in
+    # ascending numerical order ensures that the first 4 array elements are the
+    # lengths of the exterior sides and the last two are the lengths of the
+    # interior diagonals
+
+    @dists = sort { $a <=> $b } @dists;
+
+    # Strictly, only 1 of the final 2 tests is needed; the second is provided
+    # as a sanity check
+
+    my $is_square = !equals( $dists[ 0 ], 0           ) &&
+                     equals( $dists[ 0 ], $dists[ 1 ] ) &&
+                     equals( $dists[ 1 ], $dists[ 2 ] ) &&
+                     equals( $dists[ 2 ], $dists[ 3 ] ) &&
+                     equals( $dists[ 4 ], $dists[ 5 ] ) &&
+                     equals( $dists[ 4 ], $dists[ 0 ] * sqrt( 2 ) );
+
+    printf "Output: %d\n", $is_square ? 1 : 0;
+}
+
+#------------------------------------------------------------------------------
+sub distance
+#------------------------------------------------------------------------------
+{
+    my ($x1, $y1, $x2, $y2) = @_;
+
+    # Apply the Pythagorean theorem
+
+    return sqrt( ($x2 - $x1) ** 2 + ($y2 - $y1) ** 2 );
+}
+
+#------------------------------------------------------------------------------
+sub equals
+#------------------------------------------------------------------------------
+{
+    my ($x, $y) = @_;
+
+    # Determine equality between real (i.e., floating point) numbers
+
+    return abs( $x - $y ) < $EPSILON;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+       $args == 8 or error( "Expected 8 command line arguments, found $args" );
+
+    for (@ARGV)
+    {
+        / ^ $RE{num}{real} $ /x
+                  or error( qq["$_" is not a valid number] );
+    }
+
+    return @ARGV;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-123/athanasius/raku/ch-1.raku b/challenge-123/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..2f43f02c1d
--- /dev/null
+++ b/challenge-123/athanasius/raku/ch-1.raku
@@ -0,0 +1,144 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 123
+=========================
+
+TASK #1
+-------
+*Ugly Numbers*
+
+Submitted by: Mohammad S Anwar
+
+You are given an integer $n >= 1.
+
+Write a script to find the $nth element of Ugly Numbers.
+
+        Ugly numbers are those number whose prime factors are 2, 3 or 5. For
+        example, the first 10 Ugly Numbers are 1, 2, 3, 4, 5, 6, 8, 9, 10, 12.
+
+Example
+
+ Input: $n = 7
+ Output: 8
+
+ Input: $n = 10
+ Output: 12
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Definition and Algorithm
+------------------------
+So-called "ugly numbers", more correctly 5-smooth, regular, or Hamming numbers,
+are positive integers of the form:
+
+    2^i × 3^j × 5^k     where i, j, k are integers ≥ 0
+
+The set H of all Hamming numbers can be defined inductively:
+    (1) 1 ∊ H                                                [Base case]
+    (2) (∀n)(n ∊ H → (2n ∊ H ∧ 3n ∊ H ∧ 5n ∊ H))             [Inductive clause]
+    (3) H is the intersection of all sets satisfying (1) and (2)
+                                                             [Extremal  clause]
+
+This gives a straightforward method for producing the set of Hamming numbers:
+
+    Let H = { 1 }
+    Repeat:
+      For each element h of H not previously processed, add 2h, 3h, and 5h to H
+
+The drawback of this method is that it generates Hamming numbers out of order,
+and adds duplicates:
+
+    Correct (sorted) order: 1, 2, 3, 4, 5, 6,  8, 9, 10, 12 ...
+    Generated order:        1, 2, 3, 5, 4, 6, 10, 6,  9, 15, 8, 12, 20 ...
+
+This can be remedied by filtering candidate values of h as follows:
+ (a) ensure that the next h is always the *smallest* of the remaining (unused)
+     Hamming numbers generated so far; and
+ (b) remember the last value of h, and discard the next candidate if it's a
+     duplicate
+The order in which h values are *selected* for processing is the correct (i.e.,
+sorted) order of the Hamming numbers.
+
+In the implementation below, the Heap module from https://modules.raku.org/ is
+used to store the pool of Hamming numbers generated so far (i.e., the candidate
+values of h). Because heap elements are stored in priority order (the smallest
+value has the highest priority), the pop_heap() function  always returns the
+smallest candidate, thereby satisfying condition (a).
+
+References
+----------
+Mark Jason Dominus, "Infinite lists in Perl",
+    https://perl.plover.com/Stream/stream.html (28 July, 2021)
+
+N. J. A. Sloane, editor, The On-Line Encyclopedia of Integer Sequences,
+    "A051037  5-smooth numbers, i.e., numbers whose prime divisors are all <=
+     5.", https://oeis.org/A051037 (28 July, 2021)
+
+Wikipedia, "Regular Number",
+    https://en.wikipedia.org/wiki/Regular_number (28 July, 2021)
+
+=end comment
+#==============================================================================
+
+use Heap;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 123, Task #1: Ugly Numbers (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    UInt:D $n where { $n >= 1 }                  #= A non-zero positive integer
+)
+#==============================================================================
+{
+    "Input:  \$n = $n".put;
+
+    my Heap $heap  .= new: 1;
+    my UInt $last-h = 0;
+    my UInt $count  = 0;
+    my UInt $hamming;
+
+    while $count++ < $n
+    {
+        repeat
+        {
+            $hamming = $heap.pop;
+
+        } while $hamming == $last-h;                       # Discard duplicates
+
+        $last-h = $hamming;
+
+        $heap.push: $_ * $hamming for 2, 3, 5;
+    }
+
+    "Output: $hamming".put;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-123/athanasius/raku/ch-2.raku b/challenge-123/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..7d2c7c1645
--- /dev/null
+++ b/challenge-123/athanasius/raku/ch-2.raku
@@ -0,0 +1,151 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 123
+=========================
+
+TASK #2
+-------
+*Square Points*
+
+Submitted by: Mohammad S Anwar
+
+You are given coordinates of four points i.e. (x1, y1), (x2, y2), (x3, y3) and
+(x4, y4).
+
+Write a script to find out if the given four points form a square.
+
+Example
+
+ Input: x1 = 10, y1 = 20
+        x2 = 20, y2 = 20
+        x3 = 20, y3 = 10
+        x4 = 10, y4 = 10
+ Output: 1 as the given coordinates form a square.
+
+ Input: x1 = 12, y1 = 24
+        x2 = 16, y2 = 10
+        x3 = 20, y3 = 12
+        x4 = 18, y4 = 16
+ Output: 0 as the given coordinates doesn't form a square.
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Assumptions
+-----------
+(1) A square must have non-zero area, so four identical points do not form a
+    square
+(2) The requirement "find out if the given four points form a square" means
+    "determine whether the quadrilateral having these four points as its four
+    *corners* is a square"
+
+Algorithm
+---------
+A square has 4 sides of identical length, but a quadrilateral with 4 sides of
+identical length is a rhombus, not necessarily a square. For it to be a square,
+its interior angles must be all equal (viz., right angles).
+
+However, measuring angles is a more complex task than measuring lengths, so the
+method adopted below makes use of the additional property that the interior
+diagonals joining opposite corners of a square are equal, and each is √2 times
+the length of any exterior side.
+
+Distances between points on the Cartesian plane are calculated using the
+Pythagorean theorem.
+
+=end comment
+#==============================================================================
+
+my Real constant $EPSILON = 1e-9;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 123, Task #2: Square Points (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    #| Cartesian coordinates x1, y1, x2, y2, x3, y3, x4, y4
+
+    *@coords where { @coords.elems == 8 && .all ~~ Real:D }
+)
+#==============================================================================
+{
+    ("Input:  x1 = @coords[ 0 ], y1 = @coords[ 1 ]\n" ~
+     "        x2 = @coords[ 2 ], y2 = @coords[ 3 ]\n" ~
+     "        x3 = @coords[ 4 ], y3 = @coords[ 5 ]\n" ~
+     "        x4 = @coords[ 6 ], y4 = @coords[ 7 ]").put;
+
+    my Real @dists;
+
+    # Let the 4 points be a, b, c, d; here we calculate the 6 distances ab, ac,
+    # ad, bc, bd, cd
+
+    for [ 0 .. 3 ], [ 0, 1, 4, 5 ], [ 0, 1, 6, 7 ],
+        [ 2 .. 5 ], [ 2, 3, 6, 7 ], [ 4   ..   7 ] -> List $slice
+    {
+        @dists.push: distance( |@coords[ |$slice ] );
+    }
+
+    # If the 4 given points do describe a square, then sorting the distances in
+    # ascending numerical order ensures that the first 4 array elements are the
+    # lengths of the exterior sides and the last two are the lengths of the
+    # interior diagonals
+
+    @dists .= sort;
+
+    # Strictly, only 1 of the final 2 tests is needed; the second is provided
+    # as a sanity check
+
+    my Bool $is-square = !equals( @dists[ 0 ], 0           ) &&
+                          equals( @dists[ 0 ], @dists[ 1 ] ) &&
+                          equals( @dists[ 1 ], @dists[ 2 ] ) &&
+                          equals( @dists[ 2 ], @dists[ 3 ] ) &&
+                          equals( @dists[ 4 ], @dists[ 5 ] ) &&
+                          equals( @dists[ 4 ], @dists[ 0 ] * sqrt( 2 ) );
+
+    "Output: %d\n".printf: $is-square ?? 1 !! 0;
+}
+
+#------------------------------------------------------------------------------
+sub distance( Real:D $x1, Real:D $y1, Real:D $x2, Real:D $y2 --> Real:D )
+#------------------------------------------------------------------------------
+{
+    # Apply the Pythagorean theorem
+
+    return sqrt( ($x2 - $x1) ** 2 + ($y2 - $y1) ** 2 );
+}
+
+#------------------------------------------------------------------------------
+sub equals( Real:D $x, Real:D $y --> Bool:D )
+#------------------------------------------------------------------------------
+{
+    # Determine equality between real (i.e., floating point) numbers
+
+    return abs( $x - $y ) < $EPSILON;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################