Merge pull request #2320 from PerlMonk-Athanasius/branch-for-challenge-078

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

4 files changed, 631 insertions, 0 deletions

diff --git a/challenge-078/athanasius/perl/ch-1.pl b/challenge-078/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..d2243cd116
--- /dev/null
+++ b/challenge-078/athanasius/perl/ch-1.pl
@@ -0,0 +1,133 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 078
+=========================
+
+Task #1
+-------
+*Leader Element*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array @A containing distinct integers.
+
+Write a script to find all leader elements in the array @A. Print (0) if none
+found.
+
+        An element is leader if it is greater than all the elements to its
+        right side.
+
+Example 1:
+
+ Input: @A = (9, 10, 7, 5, 6, 1)
+ Output: (10, 7, 6, 1)
+
+Example 2:
+
+ Input: @A = (3, 4, 5)
+ Output: (5)
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Note
+----
+
+If @A contains a single element only, that element is (trivially) "greater than
+all the elements to its right side." The array @A is specified to contain
+"distinct integers." Since 0 is an integer, a correct solution could be:
+
+ Input: @A = (0)
+ Output: (0)
+
+But an empty array is still an array, and therefore a legal input. Further, an
+empty array is the only input for which no leader element can be found. Since
+an output of (0) [as specified in the Task] would be identical to the output
+for @A = (0), as explained above, I have departed from the specification and
+output:
+
+ Input: @A = ()
+ Output: ()
+
+in this case.
+
+=cut
+#==============================================================================
+
+                                    # Exports:
+use strict;
+use warnings;
+use Const::Fast;                    # const()
+use List::Util     qw( uniqint );
+use Regexp::Common qw( number );    # %RE{num}
+
+#------------------------------------------------------------------------------
+# Constant
+#------------------------------------------------------------------------------
+
+const my $USAGE =>
+"Usage:
+  perl $0 [<A> ...]
+
+    [<A> ...]    A list of distinct integers\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 078, Task #1: Leader Element (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my @A = parse_command_line();
+
+    printf "Input: \@A = (%s)\n", join(', ', @A);
+
+    my @leaders;
+
+    OUTER_FOR: for my $i (0 .. $#A)
+    {
+        for my $j ($i + 1 .. $#A)
+        {
+            next OUTER_FOR unless $A[$i] > $A[$j];
+        }
+
+        push @leaders, $A[$i];
+    }
+
+    printf "Output:     (%s)\n", join(', ', @leaders);
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my @A = @ARGV;
+
+    for (@A)
+    {
+        / \A $RE{num}{int} \z /x or die "ERROR: Non-integer found\n$USAGE";
+    }
+
+    my @subset = uniqint @A;
+
+    scalar @subset == scalar @A  or die "ERROR: Duplicate(s) found\n$USAGE";
+
+    return @A;
+}
+
+###############################################################################
diff --git a/challenge-078/athanasius/perl/ch-2.pl b/challenge-078/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..9384fde38c
--- /dev/null
+++ b/challenge-078/athanasius/perl/ch-2.pl
@@ -0,0 +1,205 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 078
+=========================
+
+Task #2
+-------
+*Left Rotation*
+
+Submitted by: Mohammad S Anwar
+
+You are given array @A containing positive numbers and @B containing one or
+more indices from the array @A.
+
+Write a script to left rotate @A so that the number at the first index of @B
+becomes the first element in the array. Similary, left rotate @A again so that
+the number at the second index of @B becomes the first element in the array.
+
+Example 1:
+
+ Input:
+     @A = (10 20 30 40 50)
+     @B = (3 4)
+
+Explanation:
+
+ a) We left rotate the 3rd index element (40) in the @A to make it 0th index
+    member in the array.
+         [40 50 10 20 30]
+
+ b) We left rotate the 4th index element (50) in the @A to make it 0th index
+    member in the array.
+         [50 10 20 30 40]
+
+ Output:
+     [40 50 10 20 30]
+     [50 10 20 30 40]
+
+Example 2:
+
+ Input:
+     @A = (7 4 2 6 3)
+     @B = (1 3 4)
+
+Explanation:
+
+ a) We left rotate the 1st index element (4) in the @A to make it 0th index
+    member in the array.
+         [4 2 6 3 7]
+
+ b) We left rotate the 3rd index element (6) in the @A to make it 0th index
+    member in the array.
+         [6 3 7 4 2]
+
+ c) We left rotate the 4th index element (3) in the @A to make it 0th index
+    member in the array.
+         [3 7 4 2 6]
+
+ Output:
+     [4 2 6 3 7]
+     [6 3 7 4 2]
+     [3 7 4 2 6]
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+                                    # Exports:
+use strict;
+use warnings;
+use Const::Fast;                    # const()
+use Getopt::Long;                   # GetOptions()
+use Regexp::Common qw( number );    # %RE{num}
+
+#------------------------------------------------------------------------------
+# Constant
+#------------------------------------------------------------------------------
+
+const my $USAGE =>
+"Usage:
+  perl $0 [-A <Str>] [-B <Str>]
+
+    -A <Str>    A whitespace-separated array of positive integers
+    -B <Str>    A whitespace-separated array of indices into array A\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 078, Task #2: Left Rotation (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my ($A,   $B) = parse_command_line();
+    my  @A_orig   = @$A;
+    my  @B        = @$B;
+
+    print  "Input:\n";
+    printf "    \@A = (%s)\n",   join ' ', @A_orig;
+    printf "    \@B = (%s)\n\n", join ' ', @B;
+
+    print  "Output:\n";
+
+    for my $b (@B)
+    {
+        my @A = @A_orig;
+
+        # Rotate the array by slicing @A into 2 parts:
+        #
+        #   (1) from the element at index $b to the end of the array
+        #   (2) from the initial (i.e., zeroth) element to the element
+        #       immediately before index $b
+        #
+        # and joining the slices
+
+        @A = @A[$b .. $#A, 0 .. $b - 1];
+
+        printf "    [%s]\n", join ' ', @A;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my ($A, $B);
+
+    GetOptions
+    (
+        'A=s' => \$A,
+        'B=s' => \$B,
+    )                  or error('Invalid command line arguments');
+
+    defined $A         or error('A is missing');
+    defined $B         or error('B is missing');
+    scalar  @ARGV == 0 or error('Extra command line arguments found');
+
+    my @A = parse_A($A);
+    my @B = parse_B($B, $#A);
+
+    return (\@A, \@B);
+}
+
+#------------------------------------------------------------------------------
+sub parse_A
+#------------------------------------------------------------------------------
+{
+    my ($A) = @_;
+    my  @A;
+
+    for my $s (split / \s+ /x, $A)
+    {
+        next if $s eq '';         # Ignore leading or trailing whitespace
+
+        $s =~ /\A$RE{num}{int}\z/ or error("Non-integer '$s' in \@A");
+        $s >  0                   or error("Non-positive integer '$s' in \@A");
+
+        push @A, $s;
+    }
+
+    return @A;
+}
+
+#------------------------------------------------------------------------------
+sub parse_B
+#------------------------------------------------------------------------------
+{
+    my ($B, $max) = @_;
+    my  @B;
+
+    for my $s (split / \s+ /x, $B)
+    {
+        next if $s eq '';         # Ignore leading or trailing whitespace
+
+        $s =~ /\A$RE{num}{int}\z/
+                    or error("Non-integer '$s' in \@B");
+        $s >= 0     or error("Index $s out of range in \@B (must be >= 0)");
+        $s <= $max  or error("Index $s out of range in \@B (must be <= $max)");
+
+        push @B, $s;
+    }
+
+    return @B;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-078/athanasius/raku/ch-1.raku b/challenge-078/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..c06dcc805b
--- /dev/null
+++ b/challenge-078/athanasius/raku/ch-1.raku
@@ -0,0 +1,110 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 078
+=========================
+
+Task #1
+-------
+*Leader Element*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array @A containing distinct integers.
+
+Write a script to find all leader elements in the array @A. Print (0) if none
+found.
+
+        An element is leader if it is greater than all the elements to its
+        right side.
+
+Example 1:
+
+ Input: @A = (9, 10, 7, 5, 6, 1)
+ Output: (10, 7, 6, 1)
+
+Example 2:
+
+ Input: @A = (3, 4, 5)
+ Output: (5)
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Note
+----
+
+If @A contains a single element only, that element is (trivially) "greater than
+all the elements to its right side." The array @A is specified to contain
+"distinct integers." Since 0 is an integer, a correct solution could be:
+
+ Input: @A = (0)
+ Output: (0)
+
+But an empty array is still an array, and therefore a legal input. Further, an
+empty array is the only input for which no leader element can be found. Since
+an output of (0) [as specified in the Task] would be identical to the output
+for @A = (0), as explained above, I have departed from the specification and
+output:
+
+ Input: @A = ()
+ Output: ()
+
+in this case.
+
+=end comment
+#==============================================================================
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 078, Task #1: Leader Element (Raku)\n".put;
+}
+
+##=============================================================================
+sub MAIN
+(
+    #| A list of distinct integers
+
+    *@A where { .all ~~ Int:D && .repeated.elems == 0 }
+)
+##=============================================================================
+{
+    "Input: \@A = (%s)\n".printf: @A.join: ', ';
+
+    my Int @leaders;
+
+    OUTER-FOR: for 0 .. @A.end -> UInt $i
+    {
+        for $i + 1 .. @A.end -> UInt $j
+        {
+            next OUTER-FOR unless @A[$i] > @A[$j];
+        }
+
+        @leaders.push: @A[$i];
+    }
+
+    "Output:     (%s)\n".printf: @leaders.join: ', ';
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+###############################################################################
diff --git a/challenge-078/athanasius/raku/ch-2.raku b/challenge-078/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..e0f697d547
--- /dev/null
+++ b/challenge-078/athanasius/raku/ch-2.raku
@@ -0,0 +1,183 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 078
+=========================
+
+Task #2
+-------
+*Left Rotation*
+
+Submitted by: Mohammad S Anwar
+
+You are given array @A containing positive numbers and @B containing one or
+more indices from the array @A.
+
+Write a script to left rotate @A so that the number at the first index of @B
+becomes the first element in the array. Similary, left rotate @A again so that
+the number at the second index of @B becomes the first element in the array.
+
+Example 1:
+
+ Input:
+     @A = (10 20 30 40 50)
+     @B = (3 4)
+
+Explanation:
+
+ a) We left rotate the 3rd index element (40) in the @A to make it 0th index
+    member in the array.
+         [40 50 10 20 30]
+
+ b) We left rotate the 4th index element (50) in the @A to make it 0th index
+    member in the array.
+         [50 10 20 30 40]
+
+ Output:
+     [40 50 10 20 30]
+     [50 10 20 30 40]
+
+Example 2:
+
+ Input:
+     @A = (7 4 2 6 3)
+     @B = (1 3 4)
+
+Explanation:
+
+ a) We left rotate the 1st index element (4) in the @A to make it 0th index
+    member in the array.
+         [4 2 6 3 7]
+
+ b) We left rotate the 3rd index element (6) in the @A to make it 0th index
+    member in the array.
+         [6 3 7 4 2]
+
+ c) We left rotate the 4th index element (3) in the @A to make it 0th index
+    member in the array.
+         [3 7 4 2 6]
+
+ Output:
+     [4 2 6 3 7]
+     [6 3 7 4 2]
+     [3 7 4 2 6]
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 078, Task #2: Left Rotation (Raku)\n".put;
+}
+
+##=============================================================================
+sub MAIN
+(
+    Str:D :$A,          #= A whitespace-separated array of positive integers
+    Str:D :$B,          #= A whitespace-separated array of indices into array A
+)
+##=============================================================================
+{
+    my UInt @A-orig = parse-A($A);
+    my UInt @B      = parse-B($B, @A-orig.end);
+
+    'Input:'.put;
+
+    "    \@A = (%s)\n"  .printf: @A-orig.join: ' ';
+    "    \@B = (%s)\n\n".printf: @B     .join: ' ';
+
+    'Output:'.put;
+
+    for @B -> UInt $b
+    {
+        my UInt @A = @A-orig;
+
+        # Raku's built-in rotate() method:
+        #
+        #     multi method rotate(List:D: Int:D $n = 1 --> List:D)
+        #
+        # "Returns the list rotated by $n elements" - i.e., left-rotated, which
+        # makes it ideal for solving this Task
+
+        @A = @A.rotate($b);
+
+        "    [%s]\n".printf: @A.join: ' ';
+    }
+}
+
+#------------------------------------------------------------------------------
+sub parse-A( Str:D $A --> Array:D[UInt:D] )
+#------------------------------------------------------------------------------
+{
+    my UInt @A;
+
+    for $A.split: / \s+ /, :skip-empty -> Str $a
+    {
+        my Str $v = val($a);
+
+        $v.^name eq 'IntStr' or error("Non-integer '$a' in \@A");
+
+        my Int $i = $v.Int;
+
+        $i > 0               or error("Non-positive '$i' in \@A");
+
+        @A.push: $i;
+    }
+
+    return @A;
+}
+
+#------------------------------------------------------------------------------
+sub parse-B( Str:D $B, UInt:D $max --> Array:D[UInt:D] )
+#------------------------------------------------------------------------------
+{
+    my UInt @B;
+
+    for $B.split: / \s+ /, :skip-empty -> Str $b
+    {
+        my Str $v = val($b);
+
+        $v.^name eq 'IntStr'
+                    or error("Non-integer '$b' in \@B");
+
+        my Int $i = $v.Int;
+
+        $i >= 0     or error("Index $i out of range in \@B (must be >= 0)");
+        $i <= $max  or error("Index $i out of range in \@B (must be <= $max)");
+
+        @B.push: $i;
+    }
+
+    return @B;
+}
+
+#------------------------------------------------------------------------------
+sub error( Str:D $message )
+#------------------------------------------------------------------------------
+{
+    "ERROR: $message".put;
+
+    USAGE();
+
+    exit;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+###############################################################################