Merge pull request #10102 from boblied/w269

Week 269 solutions from Bob Lied

4 files changed, 150 insertions, 3 deletions

diff --git a/challenge-269/bob-lied/README b/challenge-269/bob-lied/README
index 8e57c28d35..546c6eeb9a 100644
--- a/challenge-269/bob-lied/README
+++ b/challenge-269/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 268 by Bob Lied
+Solutions to weekly challenge 269 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-268/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-268/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-269/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-269/bob-lied
diff --git a/challenge-269/bob-lied/blog.txt b/challenge-269/bob-lied/blog.txt
new file mode 100644
index 0000000000..19c83abd6f
--- /dev/null
+++ b/challenge-269/bob-lied/blog.txt
@@ -0,0 +1 @@
+https://dev.to/boblied/pwc-269-two-of-us-distributing-elements-54m
diff --git a/challenge-269/bob-lied/perl/ch-1.pl b/challenge-269/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..23117b6093
--- /dev/null
+++ b/challenge-269/bob-lied/perl/ch-1.pl
@@ -0,0 +1,59 @@
+#!/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 269 Task 1 Bitwise OR
+#=============================================================================
+# You are given an array of positive integers, @ints.
+# Write a script to find out if it is possible to select two or more
+# elements of the given array such that the bitwise OR of the selected
+# elements has atlest one trailing zero in its binary representation.
+# Example 1 Input: @ints = (1, 2, 3, 4, 5)
+#           Output: true
+#   We pick 2 and 4; 2|4 = 6; has a trailing zero --> true.
+# Example 2 Input: @ints = (2, 3, 8, 16)
+#           Output: true
+# Example 3 Input: @ints = (1, 2, 5, 7, 9)
+#           Output: false
+#=============================================================================
+
+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;
+
+sub task1(@ints)
+{
+    return false unless @ints;
+    return !($ints[0] & 1) if scalar(@ints) == 1;
+
+    my $evenCount = 0;
+    while ( defined(my $n = shift @ints) )
+    {
+        return true if (($n & 1) == 0) && ++$evenCount > 1;
+    }
+    return false;
+}
+
+sub runTest
+{
+    use Test2::V0;
+use builtin qw/true false/; no warnings "experimental::builtin";
+
+    is( task1(1,2,3,4,5),  true, "Example 1");
+    is( task1(2,3,8,16),   true, "Example 2");
+    is( task1(1,2,5,7,9), false, "Example 3");
+    is( task1(4),          true, "One even number");
+    is( task1(5),         false, "One odd number");
+    is( task1(),          false, "Empty list");
+
+    done_testing;
+}
diff --git a/challenge-269/bob-lied/perl/ch-2.pl b/challenge-269/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..4947e3f515
--- /dev/null
+++ b/challenge-269/bob-lied/perl/ch-2.pl
@@ -0,0 +1,87 @@
+#!/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 269 Task 2 Distribute Elements
+#=============================================================================
+# You are given an array of distinct integers, @ints.
+# Write a script to distribute the elements as described below:
+# 1) Put the 1st element of the given array to a new array @arr1.
+# 2) Put the 2nd element of the given array to a new array @arr2.
+# Once you have one element in each arrays, @arr1 and @arr2,
+# then follow the rule below:
+#
+# If the last element of the array @arr1 is greater than the last
+# element of the array @arr2, then add the first element of the
+# given array to @arr1 otherwise to the array @arr2.
+# 
+# When done distribution, return the concatenated arrays. @arr1 and @arr2.
+#
+# Example 1 Input: @ints = (2, 1, 3, 4, 5)
+#           Output: (2, 3, 4, 5, 1)
+#   1st operation: Add 1 to @arr1 = (2)
+#   2nd operation: Add 2 to @arr2 = (1)
+#   3rd operation: last element of @arr1 > the last element of @arr2,
+#                  add 3 to @arr1 = (2, 3).
+#   4th operation: last element of @arr1 > the last element of @arr2,
+#                  add 4 to @arr1 = (2, 3, 4)
+#   5th operation: Finally, the last element of @arr1 is again greater
+#   than the last element of @arr2, add 5 to @arr1 = (2, 3, 4, 5)
+#   Mow we have two arrays: @arr1 = (2, 3, 4, 5), @arr2 = (1)
+#   Concatenate the two arrays and return the final array: (2, 3, 4, 5, 1).
+#
+# Example 2 Input: @ints = (3, 2, 4)
+#           Output: (3, 4, 2)
+#   1st operation: Add 1 to @arr1 = (3)
+#   2nd operation: Add 2 to @arr2 = (2)
+#   3rd operation: , add 4 to @arr1 = (3, 4).
+#   Mow we have two arrays: @arr1 = (3, 4) @arr2 = (2)
+#   Concatenate the two arrays and return the final array: (3, 4, 2).
+#
+# Example 3 Input: @ints = (5, 4, 3 ,8)
+#           Output: (5, 3, 4, 8)
+#   1st operation: Add 1 to @arr1 = (5)
+#   2nd operation: Add 2 to @arr2 = (4)
+#   3rd operation: add 3 to @arr1 = (5, 3).
+#   4th operation: add 8 to @arr2 = (4, 8)
+#   Now we have two arrays: @arr1 = (5, 3) @arr2 = (4, 8)
+#   Concatenate the two arrays and return the final array: (5, 3, 4, 8).
+#=============================================================================
+
+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(", ", distElem(@ARGV)->@*), ")";
+
+sub distElem(@ints)
+{
+    my @arr = ( [ (shift @ints) // () ], [ (shift @ints) // () ] );
+
+    push @{$arr[ ( $arr[0][-1] <= $arr[1][-1] ) ]}, $_ for @ints;
+
+    return [ $arr[0]->@*, $arr[1]->@* ];
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( distElem(2,1,3,4,5), [2,3,4,5,1], "Example 1");
+    is( distElem(3,2,4    ), [3,4,2]    , "Example 2");
+    is( distElem(5,4,3,8  ), [5,3,4,8]  , "Example 3");
+
+    is( distElem(5,4      ), [5,4    ]  , "Two elements");
+    is( distElem(5        ), [5      ]  , "One element");
+    is( distElem(         ), [       ]  , "Zero element");
+
+    done_testing;
+}