Merge pull request #12138 from PerlMonk-Athanasius/branch-for-challenge-324

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

4 files changed, 753 insertions, 0 deletions

diff --git a/challenge-324/athanasius/perl/ch-1.pl b/challenge-324/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..f49255645c
--- /dev/null
+++ b/challenge-324/athanasius/perl/ch-1.pl
@@ -0,0 +1,218 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 324
+=========================
+
+TASK #1
+-------
+*2D Array*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers and two integers $r amd $c.
+
+Write a script to create two dimension array having $r rows and $c columns using
+the given array.
+
+Example 1
+
+  Input: @ints = (1, 2, 3, 4), $r = 2, $c = 2
+  Output: ([1, 2], [3, 4])
+
+Example 2
+
+  Input: @ints = (1, 2, 3), $r = 1, $c = 3
+  Output: ([1, 2, 3])
+
+Example 3
+
+  Input: @ints = (1, 2, 3, 4), $r = 4, $c = 1
+  Output: ([1], [2], [3], [4])
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumptions
+-----------
+1. Array dimensions $r and $c are non-zero, unsigned integers.
+2. The input integers must exactly fit into the $r by $c array; i.e., |@ints| =
+   $r * $c.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The desired number of rows and columns are entered as named arguments on the
+   command-line, followed by the elements to be used in populating the array.
+3. If the input elements contain negative integers, the first negative integer
+   must be preceded by "--" to signal that it is not a command-line flag.
+
+=cut
+#===============================================================================
+
+use v5.32;         # 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 [-r] [-c] [<ints> ...]
+  perl $0
+
+    -r              Number of rows    (integer > 0)
+    -c              Number of columns (integer > 0)
+    [<ints> ...]    Array elements    (1+ integers)
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 324, Task #1: 2D Array (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc >  2)
+    {
+        my ($r, $c, $ints) = parse_command_line();
+
+        printf "Input:  \@ints = (%s), \$r = %d, \$c = %d\n",
+                join( ', ', @$ints ), $r, $c;
+
+        my $two_dim = make_array( $ints, $r, $c );
+
+        printf "Output: (%s)\n", 
+                join ', ', map { '[' . join( ', ', @$_ ) . ']' } @$two_dim;
+    }
+    else
+    {
+        error( "Expected 0 or 3+ command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub make_array
+#-------------------------------------------------------------------------------
+{
+    my ($ints, $r, $c) = @_;
+
+    scalar @$ints == $r * $c
+        or die "Mismatch between array dimensions and number of elements\n";
+
+    my @two_dim;
+    my @row = $ints->[ 0 ];
+
+    for my $i (1 .. $#$ints)
+    {
+        if ($i % $c == 0)
+        {
+            push @two_dim, [ @row ];
+
+            @row = $ints->[ $i ];
+        }
+        else
+        {
+            push @row, $ints->[ $i ];
+        }
+    }
+
+    push @two_dim, [ @row ];
+
+    return \@two_dim;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    my ($r, $c);
+
+    GetOptions
+    (
+        'r=i' => \$r,
+        'c=i' => \$c,
+
+    ) or error( 'Invalid command-line argument(s)' );
+
+    / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] )
+        for $r, $c, @ARGV;
+
+    $_ > 0                 or error( "$_ is not positive" )
+        for $r, $c;
+
+    scalar @ARGV == $r * $c
+        or error( 'Mismatch between array dimensions and number of elements' );
+
+    return ($r, $c, \@ARGV);
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $int_str, $r, $c, $exp_str) = split / \| /x, $line;
+
+        for ($test_name, $int_str, $r, $c, $exp_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @ints    = split / \s+ /x, $int_str;
+        my $two_dim = make_array( \@ints, $r, $c );
+        my @expected;
+
+        for my $row (split / \; /x, $exp_str)
+        {
+            push @expected, [ grep { / \d /x } split / \s+ /x, $row ];
+        }
+
+        is_deeply \@expected, $two_dim, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|1 2 3 4|2|2|1  2; 3 4
+Example 2|1 2 3  |1|3|1  2  3
+Example 3|1 2 3 4|4|1|1; 2; 3; 4
diff --git a/challenge-324/athanasius/perl/ch-2.pl b/challenge-324/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..c1a6997c98
--- /dev/null
+++ b/challenge-324/athanasius/perl/ch-2.pl
@@ -0,0 +1,179 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 324
+=========================
+
+TASK #2
+-------
+*Total XOR*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers.
+
+Write a script to return the sum of total XOR for every subset of given array.
+
+Example 1
+
+  Input: @ints = (1, 3)
+  Output: 6
+
+  Subset [1],    total XOR = 1
+  Subset [3],    total XOR = 3
+  Subset [1, 3], total XOR => 1 XOR 3 => 2
+
+  Sum of total XOR => 1 + 3 + 2 => 6
+
+Example 2
+
+  Input: @ints = (5, 1, 6)
+  Output: 28
+
+  Subset [5],       total XOR = 5
+  Subset [1],       total XOR = 1
+  Subset [6],       total XOR = 6
+  Subset [5, 1],    total XOR => 5 XOR 1 => 4
+  Subset [5, 6],    total XOR => 5 XOR 6 => 3
+  Subset [1, 6],    total XOR => 1 XOR 6 => 7
+  Subset [5, 1, 6], total XOR => 5 XOR 1 XOR 6 => 2
+
+  Sum of total XOR => 5 + 1 + 6 + 4 + 3 + 7 + 2 => 28
+
+Example 3
+
+  Input: @ints = (3, 4, 5, 6, 7, 8)
+  Output: 480
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumption
+----------
+The input integers are unsigned.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A non-empty list of unsigned integers is entered on the command-line.
+
+=cut
+#===============================================================================
+
+use v5.32;            # Enables strictures
+use warnings;
+use Const::Fast;
+use List::Util        qw( reduce  );
+use Math::Prime::Util qw( forcomb );
+use Regexp::Common    qw( number  );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 [<ints> ...]
+  perl $0
+
+    [<ints> ...]    A non-empty list of unsigned integers
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 324, Task #2: Total XOR (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my @ints = @ARGV;
+
+        for (@ints)
+        {
+            / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] );
+            $_ >= 0                or error( "$_ is negative" );
+        }
+
+        printf "Input:  \@ints = (%s)\n", join ', ', @ints;
+
+        my $sum = find_total_xor( \@ints );
+
+        print  "Output: $sum\n";
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_total_xor
+#-------------------------------------------------------------------------------
+{
+    my ($ints) = @_;
+    my  $sum   = 0;
+
+    forcomb
+    {
+        $sum  += reduce { $a ^ $b } 0, (@$ints)[ @_ ];
+
+    } @$ints;
+
+    return $sum;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $ints_str, $expected) = split / \| /x, $line;
+
+        for ($test_name, $ints_str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @ints = split / \s+ /x, $ints_str;
+        my $sum  = find_total_xor( \@ints );
+
+        is $sum, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|1 3        |  6
+Example 2|5 1 6      | 28
+Example 3|3 4 5 6 7 8|480
diff --git a/challenge-324/athanasius/raku/ch-1.raku b/challenge-324/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..3c968a003f
--- /dev/null
+++ b/challenge-324/athanasius/raku/ch-1.raku
@@ -0,0 +1,191 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 324
+=========================
+
+TASK #1
+-------
+*2D Array*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers and two integers $r amd $c.
+
+Write a script to create two dimension array having $r rows and $c columns using
+the given array.
+
+Example 1
+
+  Input: @ints = (1, 2, 3, 4), $r = 2, $c = 2
+  Output: ([1, 2], [3, 4])
+
+Example 2
+
+  Input: @ints = (1, 2, 3), $r = 1, $c = 3
+  Output: ([1, 2, 3])
+
+Example 3
+
+  Input: @ints = (1, 2, 3, 4), $r = 4, $c = 1
+  Output: ([1], [2], [3], [4])
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumptions
+-----------
+1. Array dimensions $r and $c are non-zero, unsigned integers.
+2. The input integers must exactly fit into the $r by $c array; i.e., |@ints| =
+   $r * $c.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The desired number of rows and columns are entered as named arguments on the
+   command-line, followed by the elements to be used in populating the array.
+3. If the first element is a negative integer, it must be preceded by "--" to
+   signal that it is not a command-line flag.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+subset Pos of Int where * > 0;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 324, Task #1: 2D Array (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Pos:D :$r,                #= Number of rows    (integer > 0)
+    Pos:D :$c,                #= Number of columns (integer > 0)
+
+    #| Array elements (1+ integers)
+
+    *@ints where { .elems > 0 && .all ~~ Int:D && @ints.elems == $r * $c }
+)
+#===============================================================================
+{
+    "Input:  \@ints = (%s), \$r = %d, \$c = %d\n".printf:
+        @ints.join( ', ' ), $r, $c;
+
+    my Array[Int] @two-dim = make-array( @ints, $r, $c );
+
+    "Output: (%s)\n".printf: @two-dim.map( { '[' ~ .join( ', ' ) ~ ']' } )
+                                     .join: ', ';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub make-array
+(
+    List:D[Int:D] $ints,
+    Pos:D         $r,
+    Pos:D         $c
+--> List:D[List:D[Int:D]]
+)
+#-------------------------------------------------------------------------------
+{
+    $ints.elems == $r * $c
+        or die 'Mismatch between array dimensions and number of elements';
+
+    my Array[Int] @two-dim;
+    my Int        @row = +$ints[ 0 ];
+
+    for 1 .. $ints.end -> UInt $i
+    {
+        if $i %% $c
+        {
+            @two-dim.push: @row.clone;
+
+            @row = +$ints[ $i ];
+        }
+        else
+        {
+            @row.push: +$ints[ $i ];
+        }
+    }
+
+    @two-dim.push: @row;
+
+    return @two-dim;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $int-str, $r, $c, $exp-str) = $line.split: / \| /;
+
+        for     $test-name, $int-str, $r, $c, $exp-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Int        @ints    = $int-str.split( / \s+ /, :skip-empty )
+                                         .map: { .Int };
+        my Array[Int] @two-dim = make-array( @ints, $r.Int, $c.Int );
+        my Array[Int] @expected;
+
+        for $exp-str.split: / \; /, :skip-empty
+        {
+            @expected.push: Array[Int].new: .split( / \s+ /, :skip-empty )
+                                            .map: { .Int };
+        }
+
+        is-deeply @expected, @two-dim, $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 2 3 4|2|2|1  2; 3 4
+        Example 2|1 2 3  |1|3|1  2  3
+        Example 3|1 2 3 4|4|1|1; 2; 3; 4
+        END
+}
+
+################################################################################
diff --git a/challenge-324/athanasius/raku/ch-2.raku b/challenge-324/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..b6228a4d65
--- /dev/null
+++ b/challenge-324/athanasius/raku/ch-2.raku
@@ -0,0 +1,165 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 324
+=========================
+
+TASK #2
+-------
+*Total XOR*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers.
+
+Write a script to return the sum of total XOR for every subset of given array.
+
+Example 1
+
+  Input: @ints = (1, 3)
+  Output: 6
+
+  Subset [1],    total XOR = 1
+  Subset [3],    total XOR = 3
+  Subset [1, 3], total XOR => 1 XOR 3 => 2
+
+  Sum of total XOR => 1 + 3 + 2 => 6
+
+Example 2
+
+  Input: @ints = (5, 1, 6)
+  Output: 28
+
+  Subset [5],       total XOR = 5
+  Subset [1],       total XOR = 1
+  Subset [6],       total XOR = 6
+  Subset [5, 1],    total XOR => 5 XOR 1 => 4
+  Subset [5, 6],    total XOR => 5 XOR 6 => 3
+  Subset [1, 6],    total XOR => 1 XOR 6 => 7
+  Subset [5, 1, 6], total XOR => 5 XOR 1 XOR 6 => 2
+
+  Sum of total XOR => 5 + 1 + 6 + 4 + 3 + 7 + 2 => 28
+
+Example 3
+
+  Input: @ints = (3, 4, 5, 6, 7, 8)
+  Output: 480
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumption
+----------
+The input integers are unsigned.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A non-empty list of unsigned integers is entered on the command-line.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 324, Task #2: Total XOR (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| A non-empty list of unsigned integers
+
+    *@ints where { .elems > 0 && .all ~~ UInt:D }
+)
+#===============================================================================
+{
+    "Input:  \@ints = (%s)\n".printf: @ints.join: ', ';
+
+    my UInt $sum = find-total-xor( @ints );
+
+    "Output: $sum".put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-total-xor( List:D[UInt:D] $ints --> UInt:D )
+#-------------------------------------------------------------------------------
+{
+    my UInt $sum = 0;
+
+    for $ints.combinations
+    {
+        $sum += [+^] $_;
+    }
+
+    return $sum;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $ints-str, $expected) = $line.split: / \| /;
+
+        for     $test-name, $ints-str, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my UInt @ints = $ints-str.split( / \s+ /, :skip-empty ).map: { .Int };
+        my UInt $sum  = find-total-xor( @ints );
+
+        is $sum, $expected.Int, $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 3        |  6
+        Example 2|5 1 6      | 28
+        Example 3|3 4 5 6 7 8|480
+        END
+}
+
+################################################################################