Merge pull request #10186 from boblied/w271

Week 271 solutions from Bob Lied

3 files changed, 104 insertions, 3 deletions

diff --git a/challenge-271/bob-lied/README b/challenge-271/bob-lied/README
index 546c6eeb9a..968a88eea0 100644
--- a/challenge-271/bob-lied/README
+++ b/challenge-271/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 269 by Bob Lied
+Solutions to weekly challenge 271 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-269/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-269/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-271/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-271/bob-lied
diff --git a/challenge-271/bob-lied/perl/ch-1.pl b/challenge-271/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..f913ef7243
--- /dev/null
+++ b/challenge-271/bob-lied/perl/ch-1.pl
@@ -0,0 +1,56 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2024, Bob Lied
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge 271 Task 1 Maximum Ones
+#=============================================================================
+# You are given a m x n binary matrix.
+# Write a script to return the row number containing maximum ones,
+# in case of more than one rows then return smallest row number.
+# Example 1 Input: $matrix = [ [0, 1], [1, 0], ]
+#           Output: 1
+#   Row 1 and Row 2 have the same number of ones, so return row 1.
+# Example 2 Input: $matrix = [ [0, 0, 0], [1, 0, 1], ]
+#           Output: 2
+# Example 3 Input: $matrix = [ [0, 0], [1, 1], [0, 0], ]
+#           Output: 2
+#=============================================================================
+
+use v5.38;
+
+use List::Util qw/sum/;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub maxOnes($matrix)
+{
+    my $most = 0;
+    my $mostRow = 0;
+    for my $row ( 0 .. $matrix->$#* )
+    {
+        my $count = sum $matrix->[$row]->@*;
+        if ( $count > $most )
+        {
+            $most = $count;
+            $mostRow = $row+1;
+        }
+    }
+    return $mostRow;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( maxOnes([ [0,1], [1,0] ]), 1, "Example 1");
+    is( maxOnes([ [0,0,0], [1,0,1] ]), 2, "Example 2");
+    is( maxOnes([ [0,0],[1,1],[0,0] ]), 2, "Example 3");
+
+    done_testing;
+}
diff --git a/challenge-271/bob-lied/perl/ch-2.pl b/challenge-271/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..394bdbc736
--- /dev/null
+++ b/challenge-271/bob-lied/perl/ch-2.pl
@@ -0,0 +1,45 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2024, Bob Lied
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge 271 Task 2 Sort by 1 Bits
+#=============================================================================
+# You are give an array of integers, @ints.
+# Write a script to sort the integers in ascending order by the number
+# of 1 bits in their binary representation. In case more than one integers
+# have the same number of 1 bits then sort them in ascending order.
+# Example 1 Input: @ints = (0, 1, 2, 3, 4, 5, 6, 7, 8)
+#           Output: (0, 1, 2, 4, 8, 3, 5, 6, 7)
+# Example 2 Input: @ints = (1024, 512, 256, 128, 64)
+#           Output: (64, 128, 256, 512, 1024)
+#=============================================================================
+
+use v5.38;
+
+use builtin qw/true false/; no warnings "experimental::builtin";
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+say "(", join(", ", sortBy1Bits(@ARGV)->@*), ")";
+
+sub sortBy1Bits(@ints)
+{
+    my @bits = map { (my $b = sprintf("%b", $ints[$_])) =~ tr/1/1/ } 0 .. $#ints;
+    return [ @ints[ sort { $bits[$a] <=> $bits[$b] || $ints[$a] <=> $ints[$b] } 0 .. $#ints ] ];
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( sortBy1Bits(0, 1, 2, 3, 4, 5, 6, 7, 8), [ 0,1,2,4,8,3,5,6,7 ], "Example 1");
+    is( sortBy1Bits(1024, 512, 256, 128, 64  ), [64,128,256,512,1024], "Example 2");
+
+    done_testing;
+}