Merge pull request #9545 from boblied/w255

Week 255 solutions and blog reference from Bob Lied

4 files changed, 156 insertions, 3 deletions

diff --git a/challenge-255/bob-lied/README b/challenge-255/bob-lied/README
index 648108e446..4d6564a676 100644
--- a/challenge-255/bob-lied/README
+++ b/challenge-255/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 254 by Bob Lied
+Solutions to weekly challenge 255 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-254/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-254/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-255/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-255/bob-lied
diff --git a/challenge-255/bob-lied/blog.txt b/challenge-255/bob-lied/blog.txt
new file mode 100644
index 0000000000..f01adf61c0
--- /dev/null
+++ b/challenge-255/bob-lied/blog.txt
@@ -0,0 +1 @@
+https://dev.to/boblied/pwc-255-odd-character-cordoctahedra-and-the-most-most-most-frequent-word-word-22fl
diff --git a/challenge-255/bob-lied/perl/ch-1.pl b/challenge-255/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..d44240fed2
--- /dev/null
+++ b/challenge-255/bob-lied/perl/ch-1.pl
@@ -0,0 +1,88 @@
+#!/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 255 Task 1 Odd Character
+#=============================================================================
+# You are given two strings, $s and $t. The string $t is generated using
+# the shuffled characters of the string $s with an additional character.
+# Write a script to find the additional character in the string $t.
+# Example 1 Input: $s = "Perl" $t = "Preel" Output: "e"
+# Example 2 Input: $s = "Weekly" $t = "Weeakly" Output: "a"
+# Example 3 Input: $s = "Box" $t = "Boxy" Output: "y"
+#=============================================================================
+
+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 oddChar(@ARGV[0, 1]);
+
+sub oddChar($s, $t)
+{
+    my %freq;
+    $freq{$_}++ for split(//, $s);
+    $freq{$_}-- for split(//, $t);
+
+    my @remain = grep { $freq{$_} != 0 } keys %freq;
+    if ( @remain > 1 )
+    {
+        die "Too many differences $s => $t, [@remain]"
+    }
+    elsif ( @remain == 0 )
+    {
+        die "No difference between $s and $t"
+    }
+    elsif ( $freq{$remain[0]} != -1 )
+    {
+        die "Not exactly one diff for @remain"
+    }
+    return $remain[0];
+}
+
+sub oddChar2($s, $t)
+{
+    die qq("$t" has wrong length compared to "$s")
+        if length($t) != length($s)+1;
+
+    for my $c ( split(//, $t) )
+    {
+        if ( ( my $i = index($s, $c) ) < 0 )
+        {
+            return $c;
+        }
+        else
+        {
+            substr($s, $i, 1) = "";
+        }
+    }
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( oddChar("Perl",   "Preel"),   "e", "Example 1");
+    is( oddChar("Weekly", "Weeakly"), "a", "Example 2");
+    is( oddChar("Box",    "Boxy"),    "y", "Example 3");
+
+    like(
+        dies { oddChar("xyzzy","xyzzy") }, qr/No difference/,
+        "Dies if no difference");
+    like(
+        dies { oddChar("xyzzy","plover") }, qr/Too many/,
+        "Dies if too many differences");
+    like(
+        dies { oddChar("xyzzy","xyzzyAA") }, qr/exactly one/,
+        "Dies if more than one of diff");
+
+    done_testing;
+}
diff --git a/challenge-255/bob-lied/perl/ch-2.pl b/challenge-255/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..9041ba03be
--- /dev/null
+++ b/challenge-255/bob-lied/perl/ch-2.pl
@@ -0,0 +1,64 @@
+#!/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 255 Task 2 Most Frequent Word
+#=============================================================================
+# You are given a paragraph $p and a banned word $w.
+# Write a script to return the most frequent word that is not banned.
+# Example 1
+#   Input: $p = "Joe hit a ball, the hit ball flew far after it was hit."
+#          $w = "hit"
+#   Output: "ball"
+#   The banned word "hit" occurs 3 times.
+#   The other word "ball" occurs 2 times.
+# Example 2
+#   Input: $p = "Perl and Raku belong to the same family.
+#                Perl is the most popular language in the weekly challenge."
+#          $w = "the"
+#   Output: "Perl"
+#   The banned word "the" occurs 3 times.
+#   The other word "Perl" occurs 2 times.
+#=============================================================================
+
+use v5.38;
+
+use builtin qw/true false/; no warnings "experimental::builtin";
+
+use Getopt::Long;
+my $Banned = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "banned:s" => \$Banned);
+exit(!runTest()) if $DoTest;
+
+say mfw( join("  ", @ARGV), $Banned);
+
+sub mfw($p, $w)
+{
+    my %freq;
+    $freq{$_}++ for ( split(" ", $p =~ s/[[:punct:]]+/ /gr) );
+    delete $freq{$w};
+    return (sort { $freq{$b} <=> $freq{$a} } keys %freq)[0];
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    my $text;
+
+    $text = <<E_N_D;
+Joe hit a ball, the hit ball flew far after it was hit.
+E_N_D
+    is( mfw($text, "hit"), "ball", "Example 1");
+
+    $text = <<E_N_D;
+Perl and Raku belong to the same family.
+Perl is the most popular language in the weekly challenge.
+E_N_D
+    is( mfw($text, "the"), "Perl", "Example 2");
+
+    done_testing;
+}