Challenge 330 Task 1 and 2 solutions in Perl by Matthias Muth

4 files changed, 116 insertions, 109 deletions

diff --git a/challenge-330/matthias-muth/README.md b/challenge-330/matthias-muth/README.md
index ca17029e10..7ca569fa15 100644
--- a/challenge-330/matthias-muth/README.md
+++ b/challenge-330/matthias-muth/README.md
@@ -1,164 +1,113 @@
-# Counter-Nice
+# Capitalizing on Regular Expressions 
 
-**Challenge 329 solutions in Perl by Matthias Muth**
+**Challenge 330 solutions in Perl by Matthias Muth**
 
-## Task 1: Counter Integers
+## Task 1: Clear Digits
 
 > You are given a string containing only lower case English letters and digits.<br/>
-> Write a script to replace every non-digit character with a space and then return all the distinct integers left.
+> Write a script to remove all digits by removing the first digit and the closest non-digit character to its left.
 >
 > **Example 1**
 >
 > ```text
-> Input: $str = "the1weekly2challenge2"
-> Output: 1, 2
+> Input: $str = "cab12"
+> Output: "c"
 >
-> 2 is appeared twice, so we count it one only.
+> Round 1: remove "1" then "b" => "ca2"
+> Round 2: remove "2" then "a" => "c"
 >```
 > 
 >**Example 2**
 > 
 >```text
-> Input: $str = "go21od1lu5c7k"
-> Output: 21, 1, 5, 7
+> Input: $str = "xy99"
+> Output: ""
+> 
+>Round 1: remove "9" then "y" => "x9"
+> Round 2: remove "9" then "x" => ""
 > ```
 >
 > **Example 3**
 >
 > ```text
->Input: $str = "4p3e2r1l"
-> Output: 4, 3, 2, 1
+>Input: $str = "pa1erl"
+> Output: "perl"
 > ```
 
-Instead of *removing all non-digits* from the string, I will *extract all digits* instead, which will produce the same result.<br/>Using a regular expression like `/(\d+)/g` even helps to turn the sequences of digits into a list of numbers.
+Seems we need to remove pairs of non-digit and digit characters, repeatedly.
+
+Not a big deal for regular expressions.<br/>
+A substitution operator will do the removing, and as the result of that substitution indicates whether a replacement was found or not, it can serve as a loop condition, too.
 
-The examples suggest that the found numbers need to be returned in their original order, which is what we already have. We only need to remove duplicate entries, which a call to `uniq` does without changing the order.
+As there is nothing else to be done, the loop will consist of the loop condition only, with an empty body. I like to put a comment into empty loops to make it obvious for the reader.
 
-So with the help of `util`, the solution is a one-liner:
+That
 
 ```perl
 use v5.36;
-use List::Util qw( uniq );
 
-sub counter_integers( $str ) {
-    return uniq $str =~ /(\d+)/g;
+sub clear_digits( $str ) {
+    while ( $str =~ s/[a-z]\d// ) {
+        # Everything is in the loop condition.
+    }
+    return $str;
 }
+
 ```
 
-## Task 2: Nice String
+## Task 2: Title Capital
 
-> You are given a string made up of lower and upper case English letters only.<br/>
-> Write a script to return the longest substring of the give string which is nice. A string is nice if, for every letter of the alphabet that the string contains, it appears both in uppercase and lowercase.
+> You are given a string made up of one or more words separated by a single space.<br/>
+> Write a script to capitalise the given title. If the word length is 1 or 2 then convert the word to lowercase otherwise make the first character uppercase and remaining lowercase.
 >
 > **Example 1**
 >
 > ```text
-> Input: $str = "YaaAho"
-> Output: "aaA"
->```
-> 
->**Example 2**
-> 
->```text
-> Input: $str = "cC"
-> Output: "cC"
+> Input: $str = "PERL IS gREAT"
+> Output: "Perl is Great"
+> ```
+>
+> **Example 2**
+>
+> ```text
+> Input: $str = "THE weekly challenge"
+> Output: "The Weekly Challenge"
 > ```
 >
 > **Example 3**
 >
 > ```text
->Input: $str = "A"
-> Output: ""
-> 
-> No nice string found.
->```
-
-This one is a little bit more tricky.<br/>Let's 'divide and conquer':
-
-1. We need to walk through all possible substrings of at least length 2.<br/>This means using a double loop, one for all possible starting positions, and the second one for all possible strings starting there, with varying lengths.<br/>
-   I could not find any way to shortcut this, so I will use it even though its runtime behavior is more or less quadratic, which I dislike.
-2. We need to find a maximum length substring.<br/>I will use a variable `$longest_nice` for that, initialized with the empty string (`""`) and updated from every substring that is longer *and* is a 'nice' string.
-3. We need to decide whether a substring is a 'nice' string.<br/>For clarity, I will put this into a separate function `is_nice_string`.
-
-Let's first concentrate on the implementation of that `is_nice_string` functon.
-
-The task description says that a string is nice if '*for every letter of the alphabet that the string contains, it appears both in uppercase and lowercase*'. This does not require that any upper and lower case versions of the same character are next to each other, they can be anywhere in the string. For example: `"abcABC"` is as 'nice' a string as is `"aAbBcCa"`.
+> Input: $str = "YoU ARE A stAR"
+> Output: "You Are a Star"
+> ```
 
-My solution is to create two strings:
+The second task, too, is easily solved with a regular expression.
 
-* Extract all lowercase letters,
-* remove duplicates,
-* sort them alphabetically,
-* and concatenate them into a 'normalized' string of the lowercase letters.
+Here, I use three capture buffers:
 
-* Then do the same for the uppercase letters.
+* one for the first letter, which might have to be put into lower or uppercase  depending on the length of the word: `(\w)`
+* one for a possible second character: `(\w?)`
+* and one for the (possibly empty) rest of the word, from the third character to the end: `(\w*)`.
 
+The third capture has a special role:<br/>
+If it is empty, the whole word is only one or two characters long, and the first letter needs to be lowercase.<br/>
+If it is non-empty, we need to uppercase the first letter.
 
-I put these two strings into `$lower` and `$upper`.
+The second and third captures will always be lowercased for the result.
 
-For example, the string `"YaaAho"` turns into the strings `"aho"` (lowercase) and `"AY"` (uppercase).<br/>`"aaAbBa"` turns into `"ab"` and `"AB"`.
+My whole solution consists of a single substitution, with a `/e` option to evaluate the substitution part as an expression, a `/g` option to repeat the substitution as often as possible, and a `/r`  option to return the resulting final string instead of the number of substitutions done.<br/>
+When I use the `/e` option, I put the expression into a pair of curly brackets, to give an optical hint that this is 'code' to be evaluated. I then use angle brackets for the pattern part.
 
-Now, a string is a 'nice string' if the two resulting strings are the same, just in opposite case.<br/>
-This can be checked with a simple comparison of `uc( $lower ) eq $upper`, which results in this implementation of `is_nice_string`:<br/>
+So here we go: 
 
 ```perl
 use v5.36;
-use List::Util qw( uniq );
-
-sub is_nice_string( $str ) {
-    my $lower = join "", sort +( uniq $str =~ /([a-z])/g );
-    my $upper = join "", sort +( uniq $str =~ /([A-Z])/g );
-    return uc( $lower ) eq $upper;
-}
-```
-
-Note that I put those parentheses with a plus sign `+( ... )` around the `uniq` calls. This is a Perl language construct that is not needed very often, but which is very useful *when* it's needed.
-
-If I just wrote `sort uniq $str =~ ...`, it would lead to a misinterpretation of `uniq` as being the comparison function for `sort`.  That won't work at all.
-
-Putting the result of the  `uniq` call into `+(...)` parentheses shows the parser that the parentheses are used as the start of an expression (a *list* expression in that case), and not the start of the `sort` parameter list. The parser thus knows that the first parameter to `sort` is this list, and not a code block or a subroutine reference. No confusion anymore.
-
-Apparently, the parser also doesn't get confused if *both* parameter sets, of `sort` and of `uniq`, are put in parentheses, like `sort( uniq( $str =~ ... ) )`. I actually cannot explain exactly why this doesn't work without the `sort` parameter list parentheses.
-
-Both cases rely on the fact that the implicit (default) sorting order is using an alphanumeric comparison. So maybe it's also a good idea to just make this explicit: `sort { $a cmp $b } uniq $str =~ ...`.
-
-To summarize (no, I'm not ChatGPT!):
 
-```perl
-    sort uniq $str =~ /([a-z])/g        # doesn't work!
-    sort +( uniq $str =~ /([a-z])/g )   # ok.
-    sort( uniq( $str =~ /([a-z])/g ) )  # ok.  
-    sort { $a cmp $b } uniq $str =~ /([a-z])/g    # maybe the best, fully explicit.
-```
-
-The main subroutine then is rather straightforward. It contains an 'outer' loop for the starting position of possible substrings, and the 'inner' loop for checking all substrings of increasing length that start at that position, and remembering the longest 'nice' string found.
-
-Yet, I have built in some shortcuts to avoid checking any substrings that are shorter than our current `$longest_nice` string and thus cannot at all be candidates for the longest nice string:
-
-* Add a `$min_length` variable to hold the minimum length for any future substring to possibly become a `$longest_nice` string,
-* end the outer loop when no substrings with a minimum length of `$min_length` can be extracted anymore,
-* only extract substrings starting with a minimum length of `$min_length` in the inner loop,
-* don't forget to update `$min_length` whenever a longer `$longest_nice` string is found.
-
-The main subroutine then looks like this, concluding my solution:
-
-```perl
-sub longest_nice_substring( $str ) {
-    my ( $start, $longest_nice, $min_length ) = ( 0, "", 2 );
-    while ( $start + $min_length <= length( $str ) ) {
-        for my $len ( $min_length .. length( $str ) - $start ) {
-            my $substr = substr( $str, $start, $len );
-            if ( is_nice_string( $substr )  {
-                $longest_nice = $substr;
-                $min_length = length( $longest_nice ) + 1;
-            }
-        }
-        ++$start;
-    }
-    return $longest_nice;
+sub title_capital( $str ) {
+    return $str =~ s<(\w)(\w?)(\w*)>{
+        ( $3 ? uc $1 : lc $1 ) . lc "$2$3"
+    }egr;
 }
 ```
 
-Exercise done, lessons learned!
-
 #### **Thank you for the challenge!**
diff --git a/challenge-330/matthias-muth/blog.txt b/challenge-330/matthias-muth/blog.txt
new file mode 100644
index 0000000000..8d1db79ca6
--- /dev/null
+++ b/challenge-330/matthias-muth/blog.txt
@@ -0,0 +1 @@
+https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-330/challenge-330/matthias-muth#readme
diff --git a/challenge-330/matthias-muth/perl/ch-1.pl b/challenge-330/matthias-muth/perl/ch-1.pl
new file mode 100755
index 0000000000..c1dee78c12
--- /dev/null
+++ b/challenge-330/matthias-muth/perl/ch-1.pl
@@ -0,0 +1,29 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 330 Task 1: Clear Digits
+#
+#       Perl solution by Matthias Muth.
+#
+
+use v5.36;
+
+sub clear_digits( $str ) {
+    while ( $str =~ s/[a-z]\d// ) {
+        # Everything is in the loop condition.
+    }
+    return $str;
+}
+
+use Test2::V0 qw( -no_srand );
+
+is clear_digits( "cab12" ), "c",
+    'Example 1: clear_digits( "cab12" ) == "c"';
+is clear_digits( "xy99" ), "",
+    'Example 2: clear_digits( "xy99" ) == ""';
+is clear_digits( "pa1erl" ), "perl",
+    'Example 3: clear_digits( "pa1erl" ) == "perl"';
+
+done_testing;
diff --git a/challenge-330/matthias-muth/perl/ch-2.pl b/challenge-330/matthias-muth/perl/ch-2.pl
new file mode 100755
index 0000000000..a19c04a155
--- /dev/null
+++ b/challenge-330/matthias-muth/perl/ch-2.pl
@@ -0,0 +1,28 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 330 Task 2: Title Capital
+#
+#       Perl solution by Matthias Muth.
+#
+
+use v5.36;
+
+sub title_capital( $str ) {
+    return $str =~ s<(\w)(\w?)(\w*)>{
+        ( $3 ? uc $1 : lc $1 ) . lc "$2$3"
+    }egr;
+}
+
+use Test2::V0 qw( -no_srand );
+
+is title_capital( "PERL IS gREAT" ), "Perl is Great",
+    'Example 1: title_capital( "PERL IS gREAT" ) == "Perl is Great"';
+is title_capital( "THE weekly challenge" ), "The Weekly Challenge",
+    'Example 2: title_capital( "THE weekly challenge" ) == "The Weekly Challenge"';
+is title_capital( "YoU ARE A stAR" ), "You Are a Star",
+    'Example 3: title_capital( "YoU ARE A stAR" ) == "You Are a Star"';
+
+done_testing;