Merge pull request #8733 from PerlMonk-Athanasius/branch-for-challenge-235

Perl & Raku solutions to Tasks 1 & 2 for Week 235

4 files changed, 701 insertions, 0 deletions

diff --git a/challenge-235/athanasius/perl/ch-1.pl b/challenge-235/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..2095542316
--- /dev/null
+++ b/challenge-235/athanasius/perl/ch-1.pl
@@ -0,0 +1,196 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 235
+=========================
+
+TASK #1
+-------
+*Remove One*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of integers.
+
+Write a script to find out if removing ONLY one integer makes it strictly in-
+creasing order.
+
+Example 1
+
+  Input: @ints = (0, 2, 9, 4, 6)
+  Output: true
+
+  Removing ONLY 9 in the given array makes it strictly increasing order.
+
+Example 2
+
+  Input: @ints = (5, 1, 3, 2)
+  Output: false
+
+Example 3
+
+  Input: @ints = (2, 2, 3)
+  Output: true
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumptions
+-----------
+1. The input list must contain at least 2 integers.
+2. If more than one solution is possible, the highest number is selected for the
+   VERBOSE output.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If $VERBOSE is set to a true value (the default), and the output is true, the
+   value of the integer to be removed is also displayed.
+
+=cut
+#===============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $VERBOSE => 1;
+const my $USAGE   =>
+"Usage:
+  perl $0 [<ints> ...]
+  perl $0
+
+    [<ints> ...]    A list of 2 or more integers\n";
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 235, Task #1: Remove One (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my $ints = parse_command_line();
+
+        printf "Input:  \@ints = (%s)\n", join ', ', @$ints;
+
+        my $to_remove = remove_one( $ints );
+
+        printf "Output: %s\n", defined $to_remove ? 'True' : 'False';
+
+        print "\nInteger to remove: $to_remove\n"
+            if $VERBOSE && defined $to_remove;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub remove_one
+#-------------------------------------------------------------------------------
+{
+    my ($ints) = @_;
+
+    return $ints->[ -1 ] if scalar @$ints == 2 || is_ordered( $ints );
+
+    for my $i (0 .. $#$ints)
+    {
+        my $to_remove =  $ints->[ $i ];
+        my @sublist   = @$ints[ 0 .. $i - 1, $i + 1 .. $#$ints ];
+
+        return $to_remove if is_ordered( \@sublist );
+    }
+
+    return undef;
+}
+
+#-------------------------------------------------------------------------------
+sub is_ordered
+#-------------------------------------------------------------------------------
+{
+    my ($ints) = @_;
+
+    for my $i (0 .. $#$ints - 1)
+    {
+        return 0 if $ints->[ $i ] >= $ints->[ $i + 1 ];
+    }
+
+    return 1;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    scalar @ARGV > 1       or error( 'Too few arguments in the input list' );
+
+    / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] )
+        for @ARGV;
+
+    return \@ARGV;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $ints_str, $exp_str) = split / \| /x, $line;
+
+        for ($test_name, $ints_str, $exp_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @ints      = split / \s+ /x, $ints_str;
+        my $to_remove = remove_one( \@ints );
+        my $expected  = $exp_str eq '' ? undef : $exp_str;
+
+        is $to_remove, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1| 0  2 9 4 6| 9
+Example 2| 5  1 3 2  |
+Example 3| 2  2 3    | 2
+Min list |-1 -1      |-1
+Ordered  |-1  0 1 2 3| 3
diff --git a/challenge-235/athanasius/perl/ch-2.pl b/challenge-235/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..b1ecd4c762
--- /dev/null
+++ b/challenge-235/athanasius/perl/ch-2.pl
@@ -0,0 +1,157 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 235
+=========================
+
+TASK #2
+-------
+*Duplicate Zeros*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of integers.
+
+Write a script to duplicate each occurrence of ZERO in the given array and shift
+the remaining to the right but make sure the size of array remain the same.
+
+Example 1
+
+  Input: @ints = (1, 0, 2, 3, 0, 4, 5, 0)
+  Output: (1, 0, 0, 2, 3, 0, 0, 4)
+
+Example 2
+
+  Input: @ints = (1, 2, 3)
+  Output: (1, 2, 3)
+
+Example 3
+
+  Input: @ints = (0, 3, 0, 4, 5)
+  Output: (0, 0, 3, 0, 0)
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=cut
+#===============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $VERBOSE => 1;
+const my $USAGE   =>
+"Usage:
+  perl $0 [<ints> ...]
+  perl $0
+
+    [<ints> ...]    A non-empty list of integers\n";
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 235, Task #2: Duplicate Zeros (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my @ints = @ARGV;
+
+        / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] )
+            for @ints;
+
+        printf "Input:  \@ints = (%s)\n", join ', ', @ints;
+
+        my $dups = duplicate_zeros( \@ints );
+
+        printf "Output: \@dups = (%s)\n", join ', ', @$dups;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub duplicate_zeros
+#-------------------------------------------------------------------------------
+{
+    my ($ints) = @_;
+    my  @dups;
+
+    for my $n (@$ints)
+    {
+        push @dups, $n;
+        push @dups, 0 if $n == 0;
+    }
+
+    return [ @dups[ 0 .. $#$ints ] ];
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $int_str, $exp_str) = split / \| /x, $line;
+
+        for ($test_name, $int_str, $exp_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @ints = split / \s+ /x, $int_str;
+        my @exp  = split / \s+ /x, $exp_str;
+        my $dups = duplicate_zeros( \@ints );
+
+        is_deeply $dups, \@exp, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1| 1 0  2  3 0 4 5 0| 1 0 0  2  3 0 0 4
+Example 2| 1 2  3           | 1 2 3
+Example 3| 0 3  0  4 5      | 0 0 3  0  0
+Singleton| 0                | 0
+Negatives|-3 0 -2 -1 0      |-3 0 0 -2 -1
diff --git a/challenge-235/athanasius/raku/ch-1.raku b/challenge-235/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..9d1babaa29
--- /dev/null
+++ b/challenge-235/athanasius/raku/ch-1.raku
@@ -0,0 +1,188 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 235
+=========================
+
+TASK #1
+-------
+*Remove One*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of integers.
+
+Write a script to find out if removing ONLY one integer makes it strictly in-
+creasing order.
+
+Example 1
+
+  Input: @ints = (0, 2, 9, 4, 6)
+  Output: true
+
+  Removing ONLY 9 in the given array makes it strictly increasing order.
+
+Example 2
+
+  Input: @ints = (5, 1, 3, 2)
+  Output: false
+
+Example 3
+
+  Input: @ints = (2, 2, 3)
+  Output: true
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumptions
+-----------
+1. The input list must contain at least 2 integers.
+2. If more than one solution is possible, the highest number is selected for the
+   VERBOSE output.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If the first element in the input list is negative, it must be preceded by
+   "--" to distinguish it from a command-line flag.
+3. If VERBOSE is set to True (the default), and the output is True, the value of
+   the integer to be removed is also displayed.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+my Bool constant VERBOSE = True;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 235, Task #1: Remove One (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    *@ints where { .elems > 1 && .all ~~ Int:D } #= A list of 2 or more integers
+)
+#===============================================================================
+{
+    "Input:  \@ints = (%s)\n".printf: @ints.join: ', ';
+
+    my Int $to-remove = remove-one( @ints );
+
+    "Output: %s\n".printf: $to-remove.defined ?? 'True' !! 'False';
+
+    "\nInteger to remove: $to-remove".put if VERBOSE && $to-remove.defined;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub remove-one( List:D[Int:D] $ints where { .elems > 1 } --> Int:D )
+#-------------------------------------------------------------------------------
+{
+    return $ints[ *-1 ] if $ints.elems == 2 || is-ordered( $ints );
+
+    for 0 .. $ints.end -> UInt $i
+    {
+        my Int $to-remove = $ints[ $i ];
+        my Int @sublist   = $ints[ |(0 ..^ $i), |($i ^.. $ints.end) ];
+
+        return $to-remove if is-ordered( @sublist );
+    }
+
+    return Nil;
+}
+
+#-------------------------------------------------------------------------------
+sub is-ordered( List:D[Int:D] $ints --> Bool:D )
+#-------------------------------------------------------------------------------
+{
+    for 0 .. $ints.end - 1 -> UInt $i
+    {
+        return False if $ints[ $i ] >= $ints[ $i + 1 ];
+    }
+
+    return True;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $ints-str, $exp-str) = $line.split: / \| /;
+
+        for     $test-name, $ints-str, $exp-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Int @ints      = $ints-str.split( / \s+ / ).map: { .Int };
+        my Int $to-remove = remove-one( @ints );
+        my Int $expected  = $exp-str.chars == 0 ?? Nil !! $exp-str.Int;
+
+        is $to-remove, $expected, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error( Str:D $message )
+#-------------------------------------------------------------------------------
+{
+    "ERROR: $message".put;
+
+    USAGE();
+
+    exit 0;
+}
+
+#-------------------------------------------------------------------------------
+sub USAGE()
+#-------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+#-------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1| 0  2 9 4 6| 9
+        Example 2| 5  1 3 2  |
+        Example 3| 2  2 3    | 2
+        Min list |-1 -1      |-1
+        Ordered  |-1  0 1 2 3| 3
+        END
+}
+
+################################################################################
diff --git a/challenge-235/athanasius/raku/ch-2.raku b/challenge-235/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..ca74514699
--- /dev/null
+++ b/challenge-235/athanasius/raku/ch-2.raku
@@ -0,0 +1,160 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 235
+=========================
+
+TASK #2
+-------
+*Duplicate Zeros*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of integers.
+
+Write a script to duplicate each occurrence of ZERO in the given array and shift
+the remaining to the right but make sure the size of array remain the same.
+
+Example 1
+
+  Input: @ints = (1, 0, 2, 3, 0, 4, 5, 0)
+  Output: (1, 0, 0, 2, 3, 0, 0, 4)
+
+Example 2
+
+  Input: @ints = (1, 2, 3)
+  Output: (1, 2, 3)
+
+Example 3
+
+  Input: @ints = (0, 3, 0, 4, 5)
+  Output: (0, 0, 3, 0, 0)
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If the first element in the input list is negative, it must be preceded by
+   "--" to distinguish it from a command-line flag.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 235, Task #2: Duplicate Zeros (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    *@ints where { .elems > 0 && .all ~~ Int:D } #= A non-empty list of integers
+)
+#===============================================================================
+{
+    "Input:  \@ints = (%s)\n".printf: @ints.join: ', ';
+
+    my Int @dups = duplicate-zeros( @ints );
+
+    "Output: \@dups = (%s)\n".printf: @dups.join: ', ';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub duplicate-zeros( List:D[Int:D] $ints --> List:D[Int:D] )
+#-------------------------------------------------------------------------------
+{
+    my Int @dups;
+
+    for @$ints -> Int $n
+    {
+        @dups.push: $n;
+        @dups.push: 0 if $n == 0;
+    }
+
+    return @dups[ 0 .. $ints.end ];
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $int-str, $exp-str) = $line.split: / \| /;
+
+        for     $test-name, $int-str, $exp-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Int @ints = $int-str.split( / \s+ / ).map: { .Int };
+        my Int @exp  = $exp-str.split( / \s+ / ).map: { .Int };
+        my Int @dups = duplicate-zeros( @ints );
+
+        is-deeply @dups, @exp, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error( Str:D $message )
+#-------------------------------------------------------------------------------
+{
+    "ERROR: $message".put;
+
+    USAGE();
+
+    exit 0;
+}
+
+#-------------------------------------------------------------------------------
+sub USAGE()
+#-------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+#-------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1| 1 0  2  3 0 4 5 0| 1 0 0  2  3 0 0 4
+        Example 2| 1 2  3           | 1 2 3
+        Example 3| 0 3  0  4 5      | 0 0 3  0  0
+        Singleton| 0                | 0
+        Negatives|-3 0 -2 -1 0      |-3 0 0 -2 -1
+        END
+}
+
+################################################################################