Merge pull request #10465 from boblied/w278

Week 278 solutions from Bob Lied

3 files changed, 165 insertions, 3 deletions

diff --git a/challenge-278/bob-lied/README b/challenge-278/bob-lied/README
index 280b5bfa87..7b659a4ba1 100644
--- a/challenge-278/bob-lied/README
+++ b/challenge-278/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 277 by Bob Lied
+Solutions to weekly challenge 278 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-277/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-277/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-278/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-278/bob-lied
diff --git a/challenge-278/bob-lied/perl/ch-1.pl b/challenge-278/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..c7661d24db
--- /dev/null
+++ b/challenge-278/bob-lied/perl/ch-1.pl
@@ -0,0 +1,67 @@
+#!/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 278 Task 1 Sort String
+#=============================================================================
+# You are given a shuffle string, $str.
+# Write a script to return the sorted string.
+# A string is shuffled by appending word position to each word.
+# Example 1 Input: $str = "and2 Raku3 cousins5 Perl1 are4"
+#           Output: "Perl and Raku are cousins"
+# Example 2 Input: $str = "guest6 Python1 most4 the3 popular5 is2 language7"
+#           Output: "Python is the most popular guest language"
+# Example 3 Input: $str = "Challenge3 The1 Weekly2"
+#           Output: "The Weekly Challenge"
+#=============================================================================
+
+use v5.40;
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest  = false;
+my $Benchmark = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark);
+exit(!runTest()) if $DoTest;
+exit( runBenchmark($Benchmark) ) if $Benchmark;
+
+say sortString($_) for @ARGV;
+
+sub sortString($str)
+{
+    my @sentence;
+    for ( split(' ', $str) )
+    {
+        my ($word, $place) = m/(\D*)(\d+)/;
+        say "$_: [$place]=$word" if $Verbose;
+        $sentence[$place // 0] = $word;
+    }
+    shift @sentence; # 0 not expected to be used
+    return join(" ", @sentence);
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( sortString("and2 Raku3 cousins5 Perl1 are4"),
+                   "Perl and Raku are cousins", "Example 1");
+    is( sortString("guest6 Python1 most4 the3 popular5 is2 language7"),
+                   "Python is the most popular guest language", "Example 2");
+    is( sortString("Challenge3 The1 Weekly2"),
+                   "The Weekly Challenge", "Example 3");
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    cmpthese($repeat, {
+            label => sub { },
+        });
+}
+
diff --git a/challenge-278/bob-lied/perl/ch-2.pl b/challenge-278/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..d4c58aaa2c
--- /dev/null
+++ b/challenge-278/bob-lied/perl/ch-2.pl
@@ -0,0 +1,95 @@
+#!/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 278 Task 2 Reverse Word
+#=============================================================================
+# You are given a word, $word and a character, $char.
+# Write a script to replace the substring up to and including $char with
+# its characters sorted alphabetically. If the $char doesn’t exist then
+# DON'T do anything.
+# Example 1 Input: $str = "challenge", $char = "e"
+#           Ouput: "acehllnge"
+# Example 2 Input: $str = "programming", $char = "a"
+#           Ouput: "agoprrmming"
+# Example 3 Input: $str = "champion", $char = "b"
+#           Ouput: "champion"
+#=============================================================================
+
+use v5.40;
+
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest  = false;
+my $Benchmark = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark);
+exit(!runTest()) if $DoTest;
+exit( runBenchmark($Benchmark) ) if $Benchmark;
+
+say reverseWord($_) for @ARGV;
+
+sub reverseWord($word, $char)
+{
+    my $p = index($word, $char);
+    my $front = join('', sort split(//, substr($word, 0, $p+1)));
+    my $back  = substr($word, $p+1);
+    return "$front$back";
+}
+
+sub rw2($word, $char)
+{
+    my ($front, $back) = $word =~ m/(.*?$char)(.*$)/;
+    return ( join('', sort split(//, ($front//'')) ) . ($back//$word) );
+}
+
+sub rw3($word, $char)
+{
+    my @front;
+    my $back;
+    my @letter = split('', $word);
+    while ( defined(my $c = shift @letter) )
+    {
+        push @front, $c;
+        if ( $c eq $char )
+        {
+            $back = join('', @letter);
+            last;
+        }
+    }
+
+    return ( ! $back ? $word : (join('', sort @front)) . $back );
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( reverseWord("challenge", "e"),   "acehllnge",    "Example 1");
+    is( reverseWord("programming", "a"), "agoprrmming",  "Example 2");
+    is( reverseWord("champion", "b"),    "champion",     "Example 3");
+
+    is( rw2("challenge", "e"),   "acehllnge",    "Example 1 rw2");
+    is( rw2("programming", "a"), "agoprrmming",  "Example 2 rw2");
+    is( rw2("champion", "b"),    "champion",     "Example 3 rw2");
+
+    is( rw3("challenge", "e"),   "acehllnge",    "Example 1 rw3");
+    is( rw3("programming", "a"), "agoprrmming",  "Example 2 rw3");
+    is( rw3("champion", "b"),    "champion",     "Example 3 rw3");
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    cmpthese($repeat, {
+            rev_index => sub { reverseWord("programming", "a") },
+            rev_re    => sub { rw2("programming", "a") },
+            rev_stack => sub { rw3("programming", "a") },
+        });
+}
+