Merge pull request #2 from boblied/w275

Week 275 solutions from Bob Lied

3 files changed, 146 insertions, 3 deletions

diff --git a/challenge-275/bob-lied/README b/challenge-275/bob-lied/README
index f308a5c62c..c6ba3198ae 100644
--- a/challenge-275/bob-lied/README
+++ b/challenge-275/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 274 by Bob Lied
+Solutions to weekly challenge 275 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-274/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-274/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-275/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-275/bob-lied
diff --git a/challenge-275/bob-lied/perl/ch-1.pl b/challenge-275/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..fef05b2694
--- /dev/null
+++ b/challenge-275/bob-lied/perl/ch-1.pl
@@ -0,0 +1,81 @@
+#!/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 275 Task 1 Broken Keys
+#=============================================================================
+# You are given a sentence, $sentence and list of broken keys @keys.
+# Write a script to find out how many words can be typed fully.
+# Example 1 Input: $sentence = "Perl Weekly Challenge", @keys = ('l', 'a')
+#           Output: 0
+#   Every word requires one of the broken keys.
+# Example 2 Input: $sentence = "Perl and Raku", @keys = ('a')
+#           Output: 1
+#   Only Perl since the other word two words contain 'a' and can't be typed.
+# Example 3 Input: $sentence = "Well done Team PWC", @keys = ('l', 'o')
+#           Output: 2
+# Example 4 Input: $sentence = "The joys of polyglottism", @keys = ('T')
+#           Output: 2
+#=============================================================================
+
+use v5.40;
+
+use Getopt::Long;
+my $DoTest  = false;
+my $Benchmark = 0;
+
+GetOptions("test" => \$DoTest, "benchmark:i" => \$Benchmark);
+exit(!runTest()) if $DoTest;
+exit( runBenchmark($Benchmark) ) if $Benchmark;
+
+say brokenKeys(@ARGV);
+
+sub brokenKeys($sentence, @keys)
+{
+    my @s = split(/\W+/, $sentence);
+    for my $broken ( @keys )
+    {
+        @s = grep !/$broken/i, @s;
+    }
+    return scalar(@s);
+}
+
+sub bk($sentence, @keys)
+{
+    # my $re = '^[^' . join("", @keys) . ']*$';
+    # return scalar grep /$re/i, split(/\W+/, $sentence);
+    # my $re = '[' . join("", @keys) . ']';
+    my $re;
+    { local $, = ''; $re = qq([@keys]); }
+    my @s = split(/\W+/, $sentence);
+    return scalar(@s) - ( grep /$re/i, @s );
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( brokenKeys("Perl Weekly Challenge",    'l', 'a'), 0, "Example 1");
+    is( brokenKeys("Perl and Raku",            'a'     ), 1, "Example 2");
+    is( brokenKeys("Well done Team PWC",       'l', 'o'), 2, "Example 3");
+    is( brokenKeys("The joys of polyglottism", 'T'     ), 2, "Example 4");
+
+    is( bk("Perl Weekly Challenge",    'l', 'a'), 0, "Example 1 bk");
+    is( bk("Perl and Raku",            'a'     ), 1, "Example 2 bk");
+    is( bk("Well done Team PWC",       'l', 'o'), 2, "Example 3 bk");
+    is( bk("The joys of polyglottism", 'T'     ), 2, "Example 4 bk");
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+    my $sentence = "It's eighty degrees and I'm down on my knees in Brooklyn";
+
+    cmpthese($repeat, {
+            re   => sub { bk($sentence, qw(f a w z y) ) },
+            loop => sub { brokenKeys($sentence, qw(f a w z y) ) },
+        });
+}
diff --git a/challenge-275/bob-lied/perl/ch-2.pl b/challenge-275/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..97019a077f
--- /dev/null
+++ b/challenge-275/bob-lied/perl/ch-2.pl
@@ -0,0 +1,62 @@
+#!/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 275 Task 2 Replace Digits
+#=============================================================================
+# You are given an alphanumeric string, $str, where each character is
+# either a letter or a digit.
+# Write a script to replace each digit in the given string with the
+# value of the previous letter plus (digit) places.
+# Example 1 Input: $str = 'a1c1e1'
+#           Ouput: 'abcdef'
+#   shift('a', 1) => 'b' shift('c', 1) => 'd' shift('e', 1) => 'f'
+# Example 2 Input: $str = 'a1b2c3d4'
+#           Output: 'abbdcfdh'
+#   shift('a', 1) => 'b' shift('b', 2) => 'd'
+#   shift('c', 3) => 'f' shift('d', 4) => 'h'
+# Example 3 Input: $str = 'b2b'
+#           Output: 'bdb'
+# Example 4 Input: $str = 'a16z'
+#           Output: 'abgz'
+#=============================================================================
+
+use v5.40;
+
+
+use Getopt::Long;
+my $DoTest  = false;
+my $Benchmark = 0;
+
+GetOptions("test" => \$DoTest);
+exit(!runTest()) if $DoTest;
+
+# Must not begin with a digit
+say replaceDigits($_) for map { s/^[0-9]*//ir } @ARGV;
+
+sub replaceDigits($str)
+{
+    my @s = split("", $str);
+    my $letter = my $result = shift @s;
+
+    while ( defined(my $next = shift @s) )
+    {
+        if ( $next =~ m/[^0-9]/i ) { $result .= ($letter = $next) }
+        else { $result .= chr(ord($letter) + $next); }
+    }
+    return $result;
+}
+
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( replaceDigits("a1c1e1"  ), "abcdef"  , "Example 1");
+    is( replaceDigits("a1b2c3d4"), "abbdcfdh", "Example 2");
+    is( replaceDigits("b2b"     ), "bdb"     , "Example 3");
+    is( replaceDigits("a16z"    ), "abgz"    , "Example 4");
+
+    done_testing;
+}