Merge pull request #12148 from boblied/w324

Week 324 solutions from Bob Lied

3 files changed, 198 insertions, 3 deletions

diff --git a/challenge-324/bob-lied/README.md b/challenge-324/bob-lied/README.md
index 0552741691..8fc48e8055 100644
--- a/challenge-324/bob-lied/README.md
+++ b/challenge-324/bob-lied/README.md
@@ -1,4 +1,4 @@
-# Solutions to weekly challenge 323 by Bob Lied
+# Solutions to weekly challenge 324 by Bob Lied
 
-## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-323/)
-## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-323/bob-lied)
+## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-324/)
+## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-324/bob-lied)
diff --git a/challenge-324/bob-lied/perl/ch-1.pl b/challenge-324/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..e19d38017b
--- /dev/null
+++ b/challenge-324/bob-lied/perl/ch-1.pl
@@ -0,0 +1,107 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2025, Bob Lied
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge 324 Task 1  2D Array
+#=============================================================================
+# 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])
+#=============================================================================
+
+use v5.40;
+
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest  = false;
+
+my $Row;
+my $Col;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose,
+           "row:i" => \$Row, "col:i" => \$Col);
+my $logger;
+{
+    use Log::Log4perl qw(:easy);
+    Log::Log4perl->easy_init({ level => ($Verbose ? $DEBUG : $INFO ),
+            layout => "%d{HH:mm:ss.SSS} %p{1} %m%n" });
+    $logger = Log::Log4perl->get_logger();
+}
+#=============================================================================
+
+exit(!runTest()) if $DoTest;
+
+unless ( $Row && $Col && @ARGV )
+{
+    $logger->error("Usage: $0 -r ROW -c COL a b c d...");
+    exit(1);
+}
+
+sub show($array)
+{
+    my $s = join(',', map { '['.join(',', $_->@*).']' } $array->@*);
+    return "($s)";
+}
+
+my $Array;
+try {
+    $Array = makeArray($Row, $Col, @ARGV);
+}
+catch ( $err )
+{
+    say $logger->error($err);
+    exit 1;
+}
+#use Data::Dumper; $Data::Dumper::Indent = 0; $Data::Dumper::Terse = 1;
+#say Dumper($Array);
+say show($Array);
+
+#=============================================================================
+sub makeArray($r, $c, @ints)
+{
+    my @array;
+    if ( $r * $c != @ints )
+    {
+        die "Size error $r X $c (". $r*$c .") != ". scalar(@ints);
+    }
+    while ( @ints )
+    {
+        push @array, [ splice(@ints, 0, $c) ];
+    }
+    return \@array;
+}
+
+sub ma2($r, $c, @ints)
+{
+    use List::MoreUtils qw/natatime/;
+    my @array;
+    my @row;
+    my $iterator = natatime $c, @ints;
+    push @array, [ @row ] while ( @row = $iterator->() );
+    return \@array;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( makeArray(2,2, 1,2,3,4), [[1,2],[3,4]    ], "Example 1");
+    is( makeArray(1,3, 1,2,3  ), [[1,2,3]        ], "Example 2");
+    is( makeArray(4,1, 1,2,3,4), [[1],[2],[3],[4]], "Example 3");
+
+    like( dies { makeArray(7,3, 2,4,6) }, qr/Size error/, "Wrong dimensions");
+
+    is( ma2(2,2, 1,2,3,4), [[1,2],[3,4]    ], "Example 1");
+    is( ma2(1,3, 1,2,3  ), [[1,2,3]        ], "Example 2");
+    is( ma2(4,1, 1,2,3,4), [[1],[2],[3],[4]], "Example 3");
+
+    done_testing;
+}
diff --git a/challenge-324/bob-lied/perl/ch-2.pl b/challenge-324/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..19a812e39e
--- /dev/null
+++ b/challenge-324/bob-lied/perl/ch-2.pl
@@ -0,0 +1,88 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2025, Bob Lied
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge 324 Task Total XOR
+#=============================================================================
+# 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
+#=============================================================================
+
+use v5.40;
+
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest  = false;
+my $Benchmark = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark);
+my $logger;
+{
+    use Log::Log4perl qw(:easy);
+    Log::Log4perl->easy_init({ level => ($Verbose ? $DEBUG : $INFO ),
+            layout => "%d{HH:mm:ss.SSS} %p{1} %m%n" });
+    $logger = Log::Log4perl->get_logger();
+}
+#=============================================================================
+
+exit(!runTest()) if $DoTest;
+exit( runBenchmark($Benchmark) ) if $Benchmark;
+
+say totalXOR(@ARGV);
+
+#=============================================================================
+sub totalXOR(@ints)
+{
+    use Algorithm::Combinatorics  qw/subsets/;
+    use List::Util qw/reduce/;
+
+    my $sum = 0;
+    for my $subset ( subsets(\@ints) )
+    {
+        $sum += ( reduce { $a ^ $b } $subset->@* ) // 0;
+    }
+    return $sum;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( totalXOR(        1,3),   6, "Example 1");
+    is( totalXOR(      5,1,6),  28, "Example 2");
+    is( totalXOR(3,4,5,6,7,8), 480, "Example 3");
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    cmpthese($repeat, {
+            label => sub { },
+        });
+}