Merge pull request #8960 from PerlMonk-Athanasius/branch-for-challenge-240

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

4 files changed, 631 insertions, 0 deletions

diff --git a/challenge-240/athanasius/perl/ch-1.pl b/challenge-240/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..e5c4f82adc
--- /dev/null
+++ b/challenge-240/athanasius/perl/ch-1.pl
@@ -0,0 +1,155 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 240
+=========================
+
+TASK #1
+-------
+*Acronym*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of strings and a check string.
+
+Write a script to find out if the check string is the acronym of the words in
+the given array.
+
+Example 1
+
+  Input: @str = ("Perl", "Python", "Pascal")
+         $chk = "ppp"
+  Output: true
+
+Example 2
+
+  Input: @str = ("Perl", "Raku")
+         $chk = "rp"
+  Output: false
+
+Example 3
+
+  Input: @str = ("Oracle", "Awk", "C")
+         $chk = "oac"
+  Output: true
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=cut
+#===============================================================================
+
+use v5.32.1;
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+use Test::More;
+
+const my $USAGE =>
+"Usage:
+  perl $0 [--chk=<Str>] [<str> ...]
+  perl $0
+
+    --chk=<Str>    Check string
+    [<str> ...]    A list of strings\n";
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 240, Task #1: Acronym (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my $chk;
+
+        GetOptions( 'chk=s' => \$chk )
+            or error( 'Invalid command line argument' );
+
+        defined $chk
+            or error( 'The check string is missing from the input' );
+
+        my @str = @ARGV;
+
+        printf qq[Input:  \@str = (%s)\n], join ', ', map { qq["$_"] } @str;
+        print  qq[        \$chk =  "$chk"\n];
+
+        printf qq[Output: %s\n], is_acronym( \@str, $chk ) ? 'true' : 'false';
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub is_acronym
+#-------------------------------------------------------------------------------
+{
+    my ($str, $chk) = @_;
+    my  $acronym    = join '', map { substr $_, 0, 1 } @$str;
+
+    return lc $acronym eq lc $chk;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $strs, $chk, $expected) = split / \| /x, $line;
+
+        for ($test_name, $strs, $chk, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @str    = split / \s+ /x, $strs;
+        my $result = is_acronym( \@str, $chk ) ? 'true' : 'false';
+
+        is $result, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|Perl   Python Pascal|ppp|true
+Example 2|Perl   Raku         |rp |false
+Example 3|Oracle Awk C        |oac|true
diff --git a/challenge-240/athanasius/perl/ch-2.pl b/challenge-240/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..06e666bd09
--- /dev/null
+++ b/challenge-240/athanasius/perl/ch-2.pl
@@ -0,0 +1,161 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 240
+=========================
+
+TASK #2
+-------
+*Build Array*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of integers.
+
+Write a script to create an array such that new[i] = old[old[i]] where 0 <= i <
+new.length.
+
+Example 1
+
+  Input: @int = (0, 2, 1, 5, 3, 4)
+  Output: (0, 1, 2, 4, 5, 3)
+
+Example 2
+
+  Input: @int = (5, 0, 1, 2, 3, 4)
+  Output: (4, 5, 0, 1, 2, 3)
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumptions
+-----------
+1. All values in the input list are unsigned integers. 
+2. For each i in the range 0 <= i < new.length, if j = old[i] is not in the same
+   range (i.e., if j > new.length), then new[i] is undefined, which is displayed
+   as "X" in the output list.
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=cut
+#===============================================================================
+
+use v5.32.1;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $UNDEF => 'X';
+const my $USAGE =>
+"Usage:
+  perl $0 [<int> ...]
+  perl $0
+
+    [<int> ...]    A non-empty list of non-negative integers\n";
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 240, Task #2: Build Array (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my @int = @ARGV;
+
+        for (@int)
+        {
+            / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] );
+            $_ >= 0                or error( qq["$_" is negative] );
+        }
+
+        printf "Input:  \@int = (%s)\n", join ', ', @int;
+
+        my @new = build_array( \@int );
+
+        printf "Output:        (%s)\n",  join ', ', map { $_ // $UNDEF } @new;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub build_array
+#-------------------------------------------------------------------------------
+{
+    my ($int) = @_;
+    my  @new  = (undef) x scalar @$int;
+
+    for my $i (0 .. $#$int)
+    {
+        my $j = $int->[ $i ];
+
+        $new[ $i ] = $int->[ $j ] if $j <= $#$int;
+    }
+
+    return @new;
+}
+
+#-------------------------------------------------------------------------------
+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 @int = split / \s+ /x, $int_str;
+        my @exp = split / \s+ /x, $exp_str;
+        my @new = map { $_ // $UNDEF } build_array( \@int );
+
+        is_deeply \@new, \@exp, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|0 2 1 5 3 4|0 1 2 4 5 3
+Example 2|5 0 1 2 3 4|4 5 0 1 2 3
+Undefined|1 7 2      |7 X 2
diff --git a/challenge-240/athanasius/raku/ch-1.raku b/challenge-240/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..e389864219
--- /dev/null
+++ b/challenge-240/athanasius/raku/ch-1.raku
@@ -0,0 +1,152 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 240
+=========================
+
+TASK #1
+-------
+*Acronym*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of strings and a check string.
+
+Write a script to find out if the check string is the acronym of the words in
+the given array.
+
+Example 1
+
+  Input: @str = ("Perl", "Python", "Pascal")
+         $chk = "ppp"
+  Output: true
+
+Example 2
+
+  Input: @str = ("Perl", "Raku")
+         $chk = "rp"
+  Output: false
+
+Example 3
+
+  Input: @str = ("Oracle", "Awk", "C")
+         $chk = "oac"
+  Output: true
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 240, Task #1: Acronym (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D :$chk,                                 #= Check string
+          *@str where { .all ~~ Str:D }          #= A list of strings
+)
+#===============================================================================
+{
+    qq[Input:  \@str = (%s)\n].printf: @str.map( { qq["$_"] } ).join: ', ';
+    qq[        \$chk =  "$chk"].put;
+
+    qq[Output: %s\n].printf: is-acronym( @str, $chk ) ?? 'true' !! 'false';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub is-acronym( List:D[Str:D] $str, Str:D $chk --> Bool:D )
+#-------------------------------------------------------------------------------
+{
+    my Str $acronym = $str.map( { .substr: 0, 1 } ).join: '';
+
+    return $acronym.lc eq $chk.lc;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $strs, $chk, $expected) = $line.split: / \| /;
+
+        for     $test-name, $strs, $chk, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Str @str    = $strs.split: / \s+ /;
+        my Str $result = is-acronym( @str, $chk ) ?? 'true' !! 'false';
+
+        is $result, $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|Perl   Python Pascal|ppp|true
+        Example 2|Perl   Raku         |rp |false
+        Example 3|Oracle Awk C        |oac|true
+        END
+}
+
+################################################################################
diff --git a/challenge-240/athanasius/raku/ch-2.raku b/challenge-240/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..59d5ae4f8f
--- /dev/null
+++ b/challenge-240/athanasius/raku/ch-2.raku
@@ -0,0 +1,163 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 240
+=========================
+
+TASK #2
+-------
+*Build Array*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of integers.
+
+Write a script to create an array such that new[i] = old[old[i]] where 0 <= i <
+new.length.
+
+Example 1
+
+  Input: @int = (0, 2, 1, 5, 3, 4)
+  Output: (0, 1, 2, 4, 5, 3)
+
+Example 2
+
+  Input: @int = (5, 0, 1, 2, 3, 4)
+  Output: (4, 5, 0, 1, 2, 3)
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumptions
+-----------
+1. All values in the input list are unsigned integers. 
+2. For each i in the range 0 <= i < new.length, if j = old[i] is not in the same
+   range (i.e., if j > new.length), then new[i] is undefined, which is displayed
+   as "X" in the output list.
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+my Str constant UNDEF = 'X';
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 240, Task #2: Build Array (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| A non-empty list of non-negative integers
+
+    *@int where { .elems > 0 && .all ~~ UInt:D }
+)
+#===============================================================================
+{
+    "Input:  \@int = (%s)\n".printf: @int.join: ', ';
+
+    my UInt @new = build-array( @int );
+
+    "Output:        (%s)\n"\.printf: @new.map( { $_ // UNDEF } ).join: ', ';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub build-array( List:D[UInt:D] $int --> List:D[UInt:D] )
+#-------------------------------------------------------------------------------
+{
+    my UInt @new = Nil xx $int.elems;
+
+    for 0 .. $int.end -> UInt $i
+    {
+        my UInt $j = $int[ $i ];
+
+        @new[ $i ] = $int[ $j ] if $j <= $int.end;
+    }
+
+    return @new;
+}
+
+#-------------------------------------------------------------------------------
+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 UInt @int = $int-str.split( / \s+ / ).map: { .Int };
+        my Str  @exp = $exp-str.split: / \s+ /;
+        my Str  @new = build-array( @int ).map: { .defined ?? "$_" !! UNDEF };
+
+        is-deeply @new, @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|0 2 1 5 3 4|0 1 2 4 5 3
+        Example 2|5 0 1 2 3 4|4 5 0 1 2 3
+        Undefined|1 7 2      |7 X 2
+        END
+}
+
+################################################################################