Merge pull request #9897 from boblied/w264

Week 264 solutions from Bob Lied

3 files changed, 132 insertions, 3 deletions

diff --git a/challenge-264/bob-lied/README b/challenge-264/bob-lied/README
index 68da599a9d..3267f8159b 100644
--- a/challenge-264/bob-lied/README
+++ b/challenge-264/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 263 by Bob Lied
+Solutions to weekly challenge 264 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-263/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-263/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-264/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-264/bob-lied
diff --git a/challenge-264/bob-lied/perl/ch-1.pl b/challenge-264/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..b546576c2b
--- /dev/null
+++ b/challenge-264/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 264 Task 1 Greatest English Letter
+#=============================================================================
+# You are given a string, $str, made up of only alphabetic characters
+# [a..zA..Z].  Write a script to return the greatest english letter in
+# the given string.  A letter is greatest if it occurs as lower and upper
+# case. Also letter ‘b’ is greater than ‘a’ if ‘b’ appears after ‘a’ in
+# the English alphabet.
+# Example 1 Input: $str = 'PeRlwEeKLy'
+#           Output: L
+#   There are two letters E and L that appears as lower and upper.
+#   The letter L appears after E, so the L is the greatest english letter.
+# Example 2 Input: $str = 'ChaLlenge'
+#           Output: L
+# Example 3 Input: $str = 'The'
+#           Output: ''
+#=============================================================================
+
+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 gle($str)
+{
+    use List::Util qw/first/;
+
+    # Put all lower case letters before upper, in reverse order
+    my @rts = sort { $b cmp $a } split(//, $str);
+
+    # Return the first lower case character that also has an upper
+    while ( defined(my $char = shift @rts) )
+    {
+        return uc($char) if $char eq lc($char) && first { $_ eq uc($char) } @rts;
+    }
+    return '';
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( gle("PeRlwEeKLy"), 'L', "Example 1");
+    is( gle("ChaLlenge" ), 'L', "Example 2");
+    is( gle("The"       ),  '', "Example 3");
+
+    done_testing;
+}
diff --git a/challenge-264/bob-lied/perl/ch-2.pl b/challenge-264/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..d6204d4558
--- /dev/null
+++ b/challenge-264/bob-lied/perl/ch-2.pl
@@ -0,0 +1,70 @@
+#!/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 264 Task 2 Target Array
+#=============================================================================
+# You are given two arrays of integers, @source and @indices.
+# The @indices can only contains integers 0 <= i < size of @source.
+# Write a script to create target array by insert at index $indices[i]
+# the value $source[i].
+# Example 1 Input: @source  = (0, 1, 2, 3, 4)
+#                  @indices = (0, 1, 2, 2, 1)
+#           Output: (0, 4, 1, 3, 2)
+#   @source  @indices  @target
+#   0        0         (0)
+#   1        1         (0, 1)
+#   2        2         (0, 1, 2)
+#   3        2         (0, 1, 3, 2)
+#   4        1         (0, 4, 1, 3, 2)
+#
+# Example 2 Input: @source  = (1, 2, 3, 4, 0)
+#                  @indices = (0, 1, 2, 3, 0)
+#           Output: (0, 1, 2, 3, 4)
+#   @source  @indices  @target
+#   1        0         (1)
+#   2        1         (1, 2)
+#   3        2         (1, 2, 3)
+#   4        3         (1, 2, 3, 4)
+#   0        0         (0, 1, 2, 3, 4)
+#
+# Example 3 Input: @source  = (1)
+#                  @indices = (0)
+#           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;
+
+sub targArr($source, $indices)
+{
+    my @target = ();
+    for my $i ( 0 .. $indices->$#* )
+    {
+        splice(@target, $indices->[$i], 0, $source->[$i]);
+        say "$i\t$source->[$i]\t$indices->[$i],(@target)" if $Verbose;
+    }
+    return \@target;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( targArr([0,1,2,3,4],[0,1,2,2,1]), [0,4,1,3,2], "Example 1");
+
+    is( targArr([1,2,3,4,0],[0,1,2,3,0]), [0,1,2,3,4], "Example 2");
+
+    is( targArr([1],[0]), [1], "Example 3");
+
+    done_testing;
+}