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

4 files changed, 814 insertions, 0 deletions

diff --git a/challenge-263/athanasius/perl/ch-1.pl b/challenge-263/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..b14c9f23a2
--- /dev/null
+++ b/challenge-263/athanasius/perl/ch-1.pl
@@ -0,0 +1,189 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 263
+=========================
+
+TASK #1
+-------
+*Target Index*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints and a target element $k.
+
+Write a script to return the list of indices in the sorted array where the
+element is same as the given target element.
+
+Example 1
+
+  Input: @ints = (1, 5, 3, 2, 4, 2), $k = 2
+  Output: (1, 2)
+
+  Sorted array: (1, 2, 2, 3, 4, 5)
+  Target indices: (1, 2) as $ints[1] = 2 and $k[2] = 2
+
+Example 2
+
+  Input: @ints = (1, 2, 4, 3, 5), $k = 6
+  Output: ()
+
+  No element in the given array matching the given target.
+
+Example 3
+
+  Input: @ints = (5, 3, 2, 4, 2, 1), $k = 4
+  Output: (4)
+
+  Sorted array: (1, 2, 2, 3, 4, 5)
+  Target index: (4) as $ints[4] = 4
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The divisor $k is given on the command-line as a named argument, followed by
+   a (possibly empty) unnamed list of integers.
+3. If any integer in the list (i.e., following $k) on the command-line is
+   negative, the first such integer must be preceded by "--" to indicate that
+   what follows does not contain command-line flags.
+
+=cut
+#===============================================================================
+
+use v5.32.1;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 [-k[=Int]] [<ints> ...]
+  perl $0
+
+    -k[=Int]        The target element
+    [<ints> ...]    A list of integers
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 263, Task #1: Target Index (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my ($ints, $k) = parse_command_line();
+
+        printf "Input:  \@ints = (%s), \$k = %d\n", join( ', ', @$ints ), $k;
+
+        my $indices = find_target_indices( $ints, $k );
+
+        printf "Output: (%s)\n", join ', ', @$indices;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_target_indices
+#-------------------------------------------------------------------------------
+{
+    my ($ints, $k) = @_;
+    my  @sorted    = sort { $a <=> $b } @$ints;
+    my  @indices;
+
+    for my $i (0 .. $#sorted)
+    {
+        push @indices, $i if $sorted[ $i ] == $k;
+    }
+
+    return \@indices;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    my $k;
+
+    GetOptions
+    (
+        'k=i' => \$k,
+    )                          or error( 'Invalid command line argument(s)' );
+
+    defined $k                 or error( '$k is missing' );
+
+    for (@ARGV, $k)
+    {
+        / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] );
+    }
+
+    return (\@ARGV, $k);
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $ints_str, $k, $expected_str) = split / \| /x, $line;
+
+        for ($test_name, $ints_str, $k, $expected_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @ints     = split / \s+ /x, $ints_str;
+        my @expected = split / \s+ /x, $expected_str;
+        my $indices  = find_target_indices( \@ints, $k );
+
+        is_deeply $indices, \@expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1| 1  5  3 2 4  2| 2|1 2
+Example 2| 1  2  4 3 5   | 6|
+Example 3| 5  3  2 4 2  1| 4|4
+Negatives|-1 -2 -3 0 4 -3|-3|0 1
diff --git a/challenge-263/athanasius/perl/ch-2.pl b/challenge-263/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..356dcfca17
--- /dev/null
+++ b/challenge-263/athanasius/perl/ch-2.pl
@@ -0,0 +1,240 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 263
+=========================
+
+TASK #2
+-------
+*Merge Items*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given two 2-D array of positive integers, $items1 and $items2 where
+element is pair of (item_id, item_quantity).
+
+Write a script to return the merged items.
+
+Example 1
+
+  Input: $items1 = [ [1,1], [2,1], [3,2] ]
+         $items2 = [ [2,2], [1,3] ]
+  Output: [ [1,4], [2,3], [3,2] ]
+
+  Item id (1) appears 2 times: [1,1] and [1,3]. Merged item now (1,4)
+  Item id (2) appears 2 times: [2,1] and [2,2]. Merged item now (2,3)
+  Item id (3) appears 1 time: [3,2]
+
+Example 2
+
+  Input: $items1 = [ [1,2], [2,3], [1,3], [3,2] ]
+         $items2 = [ [3,1], [1,3] ]
+  Output: [ [1,8], [2,3], [3,3] ]
+
+Example 3
+
+  Input: $items1 = [ [1,1], [2,2], [3,3] ]
+         $items2 = [ [2,3], [2,4] ]
+  Output: [ [1,1], [2,9], [3,3] ]
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumption
+----------
+The "positive" integers include zero.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The 2-D lists $items1 and $items2 are entered as named-argument strings on
+   the command-line.
+ - Each string comprises items (pairs of positive integers) separated by white-
+   space.
+ - Within each item pair, item_id and item_quantity are separated by a single
+   comma (no whitespace).
+
+=cut
+#===============================================================================
+
+use v5.32.1;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 [--items1=<Str>] [--items2=<Str>]
+  perl $0
+
+    --items1=<Str>    1st space-separated list of comma-separated UInt pairs
+    --items2=<Str>    2nd space-separated list of comma-separated UInt pairs
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 263, Task #2: Merge Items (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my ($items1, $items2) = parse_command_line();
+
+        printf "Input: \$items1 = %s\n", display_items( $items1 );
+        printf "       \$items2 = %s\n", display_items( $items2 );
+
+        my $merged = merge_items( $items1, $items2 );
+
+        printf "Output: merged = %s\n",  display_items( $merged );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub merge_items
+#-------------------------------------------------------------------------------
+{
+    my ($items1, $items2) = @_;
+    my  %quantity;
+
+    for my $p (@$items1, @$items2)
+    {
+        $quantity{ $p->[ 0 ] } += $p->[ 1 ];
+    }
+
+    my @merged_items;
+
+    for my $id (sort { $a <=> $b } keys %quantity)
+    {
+        push @merged_items, [ $id, $quantity{ $id } ];
+    }
+
+    return \@merged_items;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    my ($items1_str, $items2_str);
+
+    GetOptions
+    (
+        'items1=s' => \$items1_str,
+        'items2=s' => \$items2_str
+    
+    ) or error( 'Invalid command-line arguments' );
+
+    defined $items1_str or error( 'Missing items1' );
+    defined $items2_str or error( 'Missing items2' );
+    scalar  @ARGV == 0  or error( 'Extra command-line arguments' );
+
+    my $items1 = parse_items_list( $items1_str );
+    my $items2 = parse_items_list( $items2_str );
+
+    return ($items1, $items2);
+}
+
+#-------------------------------------------------------------------------------
+sub parse_items_list
+#-------------------------------------------------------------------------------
+{
+    my ($items_str) = @_;
+    my  @items;
+    my  @item_strs  = split / \s+ /x, $items_str; 
+
+    for my $item_str (@item_strs)
+    {
+        my  ($id, $quantity) = $item_str =~ / ^ ([^,]+) \, ([^,]+) $ /x
+                    or error( qq[Malformed item pair "$item_str"] );
+
+        for ($id, $quantity)
+        {
+            / ^ $RE{num}{int} $ /x
+                    or error( qq["$_" is not a valid integer] );
+
+            $_ >= 0 or error( qq["$_" is not a positive integer] );
+        }
+
+        push @items, [ $id, $quantity ];
+    }
+
+    return \@items;
+}
+
+#-------------------------------------------------------------------------------
+sub display_items
+#-------------------------------------------------------------------------------
+{
+    my ($items) = @_;
+
+    return sprintf '[ %s ]',
+                    join ', ', map { sprintf '[%s]', join ',', @$_ } @$items;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $items1_str, $items2_str, $expected_str) =
+             split / \| /x, $line;
+
+        for ($test_name, $items1_str, $items2_str, $expected_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $items1   = parse_items_list( $items1_str );
+        my $items2   = parse_items_list( $items2_str );
+        my $expected = parse_items_list( $expected_str );
+        my $merged   = merge_items( $items1, $items2 );
+
+        is_deeply $merged, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|1,1 2,1 3,2    |2,2 1,3|1,4 2,3 3,2
+Example 2|1,2 2,3 1,3 3,2|3,1 1,3|1,8 2,3 3,3
+Example 3|1,1 2,2 3,3    |2,3 2,4|1,1 2,9 3,3
diff --git a/challenge-263/athanasius/raku/ch-1.raku b/challenge-263/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..9eb65b2774
--- /dev/null
+++ b/challenge-263/athanasius/raku/ch-1.raku
@@ -0,0 +1,160 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 263
+=========================
+
+TASK #1
+-------
+*Target Index*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints and a target element $k.
+
+Write a script to return the list of indices in the sorted array where the
+element is same as the given target element.
+
+Example 1
+
+  Input: @ints = (1, 5, 3, 2, 4, 2), $k = 2
+  Output: (1, 2)
+
+  Sorted array: (1, 2, 2, 3, 4, 5)
+  Target indices: (1, 2) as $ints[1] = 2 and $k[2] = 2
+
+Example 2
+
+  Input: @ints = (1, 2, 4, 3, 5), $k = 6
+  Output: ()
+
+  No element in the given array matching the given target.
+
+Example 3
+
+  Input: @ints = (5, 3, 2, 4, 2, 1), $k = 4
+  Output: (4)
+
+  Sorted array: (1, 2, 2, 3, 4, 5)
+  Target index: (4) as $ints[4] = 4
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The divisor $k is given on the command-line as a named argument, followed by
+   a (possibly empty) unnamed list of integers.
+3. If the first integer in the list (i.e., following $k) on the command-line is
+   negative, it must be preceded by "--" to indicate that it is not a command-
+   line flag.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 263, Task #1: Target Index (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Int:D :$k,                                   #= The target element
+          *@ints where { .all ~~ Int:D }         #= A list of integers
+)
+#===============================================================================
+{
+    "Input:  \@ints = (%s), \$k = %d\n".printf: @ints.join( ', ' ), $k;
+
+    my UInt @indices = find-target-indices( @ints, $k );
+
+    "Output: (%s)\n".printf: @indices.join: ', ';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-target-indices( List:D[Int:D] $ints, Int:D $k --> List:D[UInt:D] )
+#-------------------------------------------------------------------------------
+{
+    my UInt @indices;
+    my Int  @sorted = $ints.sort;
+
+    for 0 .. @sorted.end -> UInt $i
+    {
+        @indices.push: $i if @sorted[ $i ] == $k;
+    }
+
+    return @indices;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $ints-str, $k-str, $expd-str) = $line.split: / \| /;
+
+        for     $test-name, $ints-str, $k-str, $expd-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Int  @ints = $ints-str.split( / \s+ /, :skip-empty ).map: { .Int };
+        my UInt @expd = $expd-str.split( / \s+ /, :skip-empty ).map: { .Int };
+        my UInt @inds = find-target-indices( @ints, $k-str.Int );
+
+        is-deeply @inds, @expd, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+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  5  3 2 4  2| 2|1 2
+        Example 2| 1  2  4 3 5   | 6|
+        Example 3| 5  3  2 4 2  1| 4|4
+        Negatives|-1 -2 -3 0 4 -3|-3|0 1
+        END
+}
+
+################################################################################
diff --git a/challenge-263/athanasius/raku/ch-2.raku b/challenge-263/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..90c7b6a745
--- /dev/null
+++ b/challenge-263/athanasius/raku/ch-2.raku
@@ -0,0 +1,225 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 263
+=========================
+
+TASK #2
+-------
+*Merge Items*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given two 2-D array of positive integers, $items1 and $items2 where
+element is pair of (item_id, item_quantity).
+
+Write a script to return the merged items.
+
+Example 1
+
+  Input: $items1 = [ [1,1], [2,1], [3,2] ]
+         $items2 = [ [2,2], [1,3] ]
+  Output: [ [1,4], [2,3], [3,2] ]
+
+  Item id (1) appears 2 times: [1,1] and [1,3]. Merged item now (1,4)
+  Item id (2) appears 2 times: [2,1] and [2,2]. Merged item now (2,3)
+  Item id (3) appears 1 time: [3,2]
+
+Example 2
+
+  Input: $items1 = [ [1,2], [2,3], [1,3], [3,2] ]
+         $items2 = [ [3,1], [1,3] ]
+  Output: [ [1,8], [2,3], [3,3] ]
+
+Example 3
+
+  Input: $items1 = [ [1,1], [2,2], [3,3] ]
+         $items2 = [ [2,3], [2,4] ]
+  Output: [ [1,1], [2,9], [3,3] ]
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumption
+----------
+The "positive" integers include zero.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The 2-D lists $items1 and $items2 are entered as named-argument strings on
+   the command-line.
+ - Each string comprises items (pairs of positive integers) separated by white-
+   space.
+ - Within each item pair, item_id and item_quantity are separated by a single
+   comma (no whitespace).
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 263, Task #2: Merge Items (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D :$items1,    #= 1st space-separated list of comma-separated UInt pairs
+    Str:D :$items2     #= 2nd space-separated list of comma-separated UInt pairs
+)
+#===============================================================================
+{
+    my Pair @items1 = parse-items-list( $items1 );
+    my Pair @items2 = parse-items-list( $items2 );
+
+    "Input: \$items1 = %s\n".printf: display-items( @items1 );
+    "       \$items2 = %s\n".printf: display-items( @items2 );
+
+    my Pair @merged = merge-items( @items1, @items2 );
+
+    "Output: merged = %s\n"\.printf: display-items( @merged );
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub merge-items
+(
+    List:D[Pair:D] $items1,
+    List:D[Pair:D] $items2
+--> List:D[Pair:D]
+)
+#-------------------------------------------------------------------------------
+{
+    my UInt %quantity{UInt};
+
+    for |$items1, |$items2 -> Pair $p
+    {
+        %quantity{ $p.key } += $p.value;
+    }
+
+    my Pair @merged-items;
+
+    for %quantity.keys.sort -> UInt $id
+    {
+        @merged-items.push: $id => %quantity{ $id };
+    }
+
+    return @merged-items;
+}
+
+#-------------------------------------------------------------------------------
+sub parse-items-list( Str:D $items-str --> List:D[Pair:D] )
+#-------------------------------------------------------------------------------
+{
+    my Pair @items;
+    my Str  @item-strs = $items-str.split: / \s+ /, :skip-empty;
+
+    for @item-strs -> Str $item-str
+    {
+        $item-str ~~ / ^ (<-[,]>+) \, (<-[,]>+) $ /
+                       or error( qq[Malformed item pair "$item-str"] );
+
+        my Str ($id, $quantity) = ~$0, ~$1;
+
+        for $id, $quantity
+        {
+            +$_ ~~ Int or error( qq["$_" is not a valid integer] );
+            +$_ >= 0   or error( qq["$_" is not a positive integer] );
+        }
+
+        @items.push: $id.Int => $quantity.Int;
+    }
+
+    return @items;
+}
+
+#-------------------------------------------------------------------------------
+sub display-items( List:D[Pair:D] $items --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    return '[ %s ]'.sprintf:
+        $items.map( { '[%s]'.sprintf: .kv.join: ',' } ).join: ', ';
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $items1-str, $items2-str, $expected-str) =
+                $line.split: / \| /;
+
+        for     $test-name, $items1-str, $items2-str, $expected-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Pair @items1   = parse-items-list( $items1-str );
+        my Pair @items2   = parse-items-list( $items2-str );
+        my Pair @expected = parse-items-list( $expected-str );
+        my Pair @merged   = merge-items( @items1, @items2 );
+
+        is-deeply @merged, @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|1,1 2,1 3,2    |2,2 1,3|1,4 2,3 3,2
+        Example 2|1,2 2,3 1,3 3,2|3,1 1,3|1,8 2,3 3,3
+        Example 3|1,1 2,2 3,3    |2,3 2,4|1,1 2,9 3,3
+        END
+}
+
+################################################################################