Merge pull request #9680 from boblied/w258

Week 258 solutions from Bob Lied

4 files changed, 120 insertions, 3 deletions

diff --git a/challenge-258/bob-lied/README b/challenge-258/bob-lied/README
index b01628e413..ebf80a337a 100644
--- a/challenge-258/bob-lied/README
+++ b/challenge-258/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 257 by Bob Lied
+Solutions to weekly challenge 258 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-257/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-257/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-258/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-258/bob-lied
diff --git a/challenge-258/bob-lied/blog.txt b/challenge-258/bob-lied/blog.txt
new file mode 100644
index 0000000000..fbe997cd60
--- /dev/null
+++ b/challenge-258/bob-lied/blog.txt
@@ -0,0 +1 @@
+https://dev.to/boblied/pwc-258-how-do-i-sum-thee-let-me-count-the-ones-27l3
diff --git a/challenge-258/bob-lied/perl/ch-1.pl b/challenge-258/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..f3cde7a3a4
--- /dev/null
+++ b/challenge-258/bob-lied/perl/ch-1.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-1.pl Perl Weekly Challenge 258 Task 1 Count Even Digits Number
+#=============================================================================
+# You are given a array of positive integers, @ints.
+# Write a script to find out how many integers have even number of digits.
+# Example 1 Input: @ints = (10, 1, 111, 24, 1000)
+#           Output: 3
+# Example 2 Input: @ints = (111, 1, 11111)
+#           Output: 0
+# Example 3 Input: @ints = (2, 8, 1024, 256)
+#           Output: 1
+#=============================================================================
+
+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 cedn( map { s/[^0-9]//gr } @ARGV);
+
+sub cedn(@ints)
+{
+    return scalar grep { length($_) % 2 == 0 }  @ints;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is(cedn(10, 1, 111, 24, 1000), 3, "Example 1");
+    is(cedn(111, 1, 11111),        0, "Example 2");
+    is(cedn(2, 8, 1024, 256),      1, "Example 3");
+
+    done_testing;
+}
diff --git a/challenge-258/bob-lied/perl/ch-2.pl b/challenge-258/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..ff86c6e2c7
--- /dev/null
+++ b/challenge-258/bob-lied/perl/ch-2.pl
@@ -0,0 +1,71 @@
+#!/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 258 Task 2 Sum of Values
+#=============================================================================
+# You are given an array of integers, @int and an integer $k.
+# Write a script to find the sum of values whose index binary
+# representation has exactly $k number of 1-bit set.
+# Example 1 Input: @ints = (2, 5, 9, 11, 3), $k = 1
+#           Output: 17
+#   Binary representation of index 0 = 0
+#   Binary representation of index 1 = 1
+#   Binary representation of index 2 = 10
+#   Binary representation of index 3 = 11
+#   Binary representation of index 4 = 100
+#   So the indices 1, 2 and 4 have total one 1-bit sets.
+#   Therefore the sum, $ints[1] + $ints[2] + $ints[4] = 17
+# Example 2 Input: @ints = (2, 5, 9, 11, 3), $k = 2
+#           Output: 11
+# Example 3 Input: @ints = (2, 5, 9, 11, 3), $k = 0
+#           Output: 2
+#=============================================================================
+
+use v5.38;
+
+use builtin qw/true false/; no warnings "experimental::builtin";
+
+use Getopt::Long;
+my $K = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "k:i" => \$K);
+exit(!runTest()) if $DoTest;
+
+say sumOfVal($K, @ARGV);
+
+sub hasKones($k, $n)
+{
+    return ( sprintf("%b", $n) =~ tr/1/1/) == $k;
+}
+
+sub sumOfVal($k, @ints)
+{
+    use List::Util qw/sum0/;
+
+    return sum0( @ints[ grep { hasKones($k, $_) } 0 .. $#ints ] );
+}
+
+sub runTest
+{
+    use Test2::V0;
+    use builtin qw/true false/; no warnings "experimental::builtin";
+
+    is( hasKones(1, 0), false, "k ones 1 0");
+    is( hasKones(1, 4), true,  "k ones 1 4");
+    is( hasKones(2, 5), true,  "k ones 2 5");
+    is( hasKones(1, 6), false, "k ones 1 6");
+    is( hasKones(2, 6), true,  "k ones 2 6");
+    is( hasKones(2, 7), false, "k ones 2 7");
+    is( hasKones(1, 8), true,  "k ones 1 8");
+    is( hasKones(2, 8), false, "k ones s 8");
+    is( hasKones(3, 8), false, "k ones 3 8");
+
+    is( sumOfVal(1, (2,5,9,11,3)), 17, "Example 1");
+    is( sumOfVal(2, (2,5,9,11,3)), 11, "Example 2");
+    is( sumOfVal(0, (2,5,9,11,3)),  2, "Example 3");
+
+    done_testing;
+}