Week 343 solutions

3 files changed, 238 insertions, 3 deletions

diff --git a/challenge-343/bob-lied/README.md b/challenge-343/bob-lied/README.md
index 98b149c185..9ef043028b 100644
--- a/challenge-343/bob-lied/README.md
+++ b/challenge-343/bob-lied/README.md
@@ -1,5 +1,5 @@
-# Solutions to weekly challenge 342 by Bob Lied
+# Solutions to weekly challenge 343 by Bob Lied
 
-## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-342/)
-## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-342/bob-lied)
+## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-343/)
+## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-343/bob-lied)
 [Blog](https://dev.to/boblied/pwc-342-balance-4eh4)
diff --git a/challenge-343/bob-lied/perl/ch-1.pl b/challenge-343/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..8bfdbe2e76
--- /dev/null
+++ b/challenge-343/bob-lied/perl/ch-1.pl
@@ -0,0 +1,73 @@
+#!/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 343 Task 1  Zero Friend
+#=============================================================================
+# You are given a list of numbers.
+# Find the number that is closest to zero and return its distance to zero.
+# Example 1 Input: @nums = (4, 2, -1, 3, -2)
+#           Output: 1
+# Example 2 Input: @nums = (-5, 5, -3, 3, -1, 1)
+#           Output: 1
+# Example 3 Input: @ums = (7, -3, 0, 2, -8)
+#           Output: 0
+# Example 4 Input: @nums = (-2, -5, -1, -8)
+#           Output: 1
+# Example 5 Input: @nums = (-2, 2, -4, 4, -1, 1)
+#           Output: 1
+#=============================================================================
+
+use v5.42;
+
+
+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 zeroFriend(@ARGV);
+
+#=============================================================================
+sub zeroFriend(@num)
+{
+    use List::Util qw/min/;
+    return min map { abs($_) } @num;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( zeroFriend( 4, 2, -1, 3, -2    ) , 1, "Example 1");
+    is( zeroFriend( -5, 5, -3, 3, -1, 1) , 1, "Example 2");
+    is( zeroFriend( 7, -3, 0, 2, -8    ) , 0, "Example 3");
+    is( zeroFriend( -2, -5, -1, -8     ) , 1, "Example 4");
+    is( zeroFriend( -2, 2, -4, 4, -1, 1) , 1, "Example 5");
+    is( zeroFriend( -3, -7, 100, 1.5   ) , 1.5, "Something other than 1 or 0");
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    cmpthese($repeat, {
+            label => sub { },
+        });
+}
diff --git a/challenge-343/bob-lied/perl/ch-2.pl b/challenge-343/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..fc413251b4
--- /dev/null
+++ b/challenge-343/bob-lied/perl/ch-2.pl
@@ -0,0 +1,162 @@
+#!/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 343 Task 2  Champion Team
+#=============================================================================
+# You have n teams in a tournament. A matrix grid tells you which team is
+# stronger between any two teams:
+# If grid[i][j] == 1, then team i is stronger than team j
+# If grid[i][j] == 0, then team j is stronger than team i
+# Find the champion team - the one with most wins, or if there is no single
+# such team, the strongest of the teams with most wins. (You may assume
+# that there is a definite answer.)
+#
+# Example 1 Input: @grid = ( [0, 1, 1],
+#                            [0, 0, 1],
+#                            [0, 0, 0],)
+#           Output: Team 0
+#   [0, 1, 1] => Team 0 beats Team 1 and Team 2
+#   [0, 0, 1] => Team 1 beats Team 2
+#   [0, 0, 0] => Team 2 loses to all
+#
+# Example 2 Input: @grid = ( [0, 1, 0, 0],
+#                            [0, 0, 0, 0],
+#                            [1, 1, 0, 0],
+#                            [1, 1, 1, 0],)
+#           Output: Team 3
+#   [0, 1, 0, 0] => Team 0 beats only Team 1
+#   [0, 0, 0, 0] => Team 1 loses to all
+#   [1, 1, 0, 0] => Team 2 beats Team 0 and Team 1
+#   [1, 1, 1, 0] => Team 3 beats everyone
+#
+# Example 3 Input: @grid = ( [0, 1, 0, 1],
+#                            [0, 0, 1, 1],
+#                            [1, 0, 0, 0],
+#                            [0, 0, 1, 0],)
+#           Output: Team 0
+#   [0, 1, 0, 1] => Team 0 beats teams 1 and 3
+#   [0, 0, 1, 1] => Team 1 beats teams 2 and 3
+#   [1, 0, 0, 0] => Team 2 beats team 0
+#   [0, 0, 1, 0] => Team 3 beats team 2
+#   Of the teams with 2 wins, Team 0 beats team 1.
+#
+# Example 4 Input: @grid = ( [0, 1, 1],
+#                            [0, 0, 0],
+#                            [0, 1, 0],)
+#           Output: Team 0
+#   [0, 1, 1] => Team 0 beats Team 1 and Team 2
+#   [0, 0, 0] => Team 1 loses to Team 2
+#   [0, 1, 0] => Team 2 beats Team 1 but loses to Team 0
+#
+# Example 5 Input: @grid = ( [0, 0, 0, 0, 0],
+#                            [1, 0, 0, 0, 0],
+#                            [1, 1, 0, 1, 1],
+#                            [1, 1, 0, 0, 0],
+#                            [1, 1, 0, 1, 0],)
+#           Output: Team 2
+#   [0, 0, 0, 0, 0] => Team 0 loses to all
+#   [1, 0, 0, 0, 0] => Team 1 beats only Team 0
+#   [1, 1, 0, 1, 1] => Team 2 beats everyone except self
+#   [1, 1, 0, 0, 0] => Team 3 loses to Team 2
+#   [1, 1, 0, 1, 0] => Team 4 loses to Team 2
+#=============================================================================
+
+use v5.42;
+
+
+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;
+
+# Supply rows as comma lists, example:
+# perl ch-1.pl  0,1,1  0,0,1  0,0,0
+my @GRID = map { [ split(',', $_) ] } @ARGV;
+say join " ", map { !defined($_) ? "NONE" : $_ } champion(@GRID);
+
+#=============================================================================
+sub champion(@grid)
+{
+    use List::Util qw/max sum any/;
+    use List::MoreUtils qw/indexes/;
+
+    my @strength = map { sum($_->@*) } @grid;
+    my $maxStrength = max @strength;
+    my @strongest = indexes { $_ == $maxStrength } @strength;
+
+    # Eliminate losers
+    #
+    #my @champ;
+    #for my $team1 ( @strongest )
+    #{
+    #    next if any { $grid[$_][$team1] } @strongest ;
+    #    push @champ, $team1;
+    #}
+    #
+
+    # For a possible tie, choose the smallest
+    #my @champ = grep { my $t = $_; ! any { $grid[$_][$t]} @strongest } @strongest;
+    #return $champ[0];
+
+    return (grep { my $t = $_; ! any { $grid[$_][$t]} @strongest } @strongest)[0];
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    my @case = (
+        { case => "Example 1", expect => 0,
+          input => [ [0,1,1], [0,0,1], [0,0,0] ]
+        } ,
+        { case => "Example 2", expect => 3,
+          input => [ [0,1,0,0], [0,0,0,0], [1,1,0,0], [1,1,1,0] ],
+        } ,
+        { case => "Example 3", expect => 0,
+          input => [ [0,1,0,1], [0,0,1,1], [1,0,0,0], [0,0,1,0] ]
+        } ,
+        { case => "Example 4", expect => 0,
+          input => [ [0,1,1], [0,0,0], [0,1,0] ]
+        } ,
+        { case => "Example 5", expect => 2,
+          input => [ [0,0,0,0,0], [1,0,0,0,0], [1,1,0,1,1], [1,1,0,0,0], [1,1,0,1,0]  ]
+        } ,
+        { case => "Rock paper scissors", expect => undef,
+          input => [ [0,0,1], [1,0,0], [0,1,0] ]
+        } ,
+        { case => "Tied ", expect => 1,
+          input => [ [0,0,0,0,0,0], [0,0,0,0,1,1], [0,0,0,0,0,0], [0,0,1,1,0,0], [0,0,0,0,0], [0,0,0,0,0,0]  ]
+        } ,
+    );
+
+    for ( @case )
+    {
+        is( champion( $_->{input}->@* ), $_->{expect}, $_->{case});
+    }
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    cmpthese($repeat, {
+            label => sub { },
+        });
+}