Week 226, solutions

3 files changed, 121 insertions, 3 deletions

diff --git a/challenge-226/bob-lied/README b/challenge-226/bob-lied/README
index 552c202c4f..fb8ad62bfa 100644
--- a/challenge-226/bob-lied/README
+++ b/challenge-226/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 225 by Bob Lied
+Solutions to weekly challenge 226 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-225/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-222/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-226/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-226/bob-lied
diff --git a/challenge-226/bob-lied/perl/ch-1.pl b/challenge-226/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..c84d2d1e07
--- /dev/null
+++ b/challenge-226/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:
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge Week 226 Task 1 Shuffle String 
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given a string and an array of indices of same length as string.
+# Write a script to return the string after re-arranging the indices in the
+# correct order.
+# Example 1 Input: $string = 'lacelengh', @indices = (3,2,0,5,4,8,6,7,1)
+#           Output: 'challenge'
+# Example 2 Input: $string = 'rulepark', @indices = (4,7,3,1,0,5,2,6)
+#           Output: 'perlraku'
+#
+##########
+# The mapping provided by the array of indices is that for each index i in
+# @indices, the output at position i comes from input[ $indices[i] ].
+# In example one, the 3 at position 0 means that the 0th position of the
+# output comes from the 3rd position of the input (i.e, the first 'l' in
+# 'challenge' [3] comes from the first 'l' in 'lacelengh' [0]).
+#=============================================================================
+
+use v5.36;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub shuffleString($str, @indices)
+{
+    my @result;
+
+    # Literal mapping of indices in a loop
+    # my @s = split(//, $str);
+    # while ( my ($inIndex, $outIndex) = each @indices )
+    # {
+    #     $result[$outIndex] = $s[$inIndex]
+    # }
+
+    # Shorter, using array slice
+    @result[@indices] = split(//, $str);
+
+    return join("", @result);
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( shuffleString("lacelengh", 3,2,0,5,4,8,6,7,1 ), 'challenge', "Example 1");
+    is( shuffleString("rulepark",  4,7,3,1,0,5,2,6 ),   'perlraku',  "Example 2");
+
+    done_testing;
+}
+
diff --git a/challenge-226/bob-lied/perl/ch-2.pl b/challenge-226/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..e4a2af98d8
--- /dev/null
+++ b/challenge-226/bob-lied/perl/ch-2.pl
@@ -0,0 +1,59 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge Task 2 Zero Array 
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given an array of non-negative integers, @ints.
+# Write a script to return the minimum number of operations to make every
+# element equal zero.
+# In each operation, you are required to pick a positive number less than or
+# equal to the smallest element in the array, then subtract that from each
+# positive element in the array.
+# Example 1: Input: @ints = (1, 5, 0, 3, 5)
+#           Output: 3
+#   operation 1: pick 1 => (0, 4, 0, 2, 4)
+#   operation 2: pick 2 => (0, 2, 0, 0, 2)
+#   operation 3: pick 2 => (0, 0, 0, 0, 0)
+# Example 2: Input: @ints = (0)
+#           Output: 0
+# Example 3: Input: @ints = (2, 1, 4, 0, 3)
+#           Output: 4
+#   operation 1: pick 1 => (1, 0, 3, 0, 2)
+#   operation 2: pick 1 => (0, 0, 2, 0, 1)
+#   operation 3: pick 1 => (0, 0, 1, 0, 0)
+#   operation 4: pick 1 => (0, 0, 0, 0, 0)
+##########
+# The best move at each turn will be to remove (all copies of) the minimum,
+# so the answer will be the number of unique non-zero elements.
+#=============================================================================
+
+use v5.36;
+
+use List::Util qw/uniq/;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+say zeroArray(@ARGV);
+
+sub zeroArray(@ints)
+{
+    return scalar(grep { $_ != 0 } uniq @ints);
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( zeroArray(1,5,0,3,5), 3, "Example 1");
+    is( zeroArray(0),         0, "Example 2");
+    is( zeroArray(2,1,4,0,3), 4, "Example 3");
+
+    done_testing;
+}