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

4 files changed, 249 insertions, 105 deletions

diff --git a/challenge-328/matthias-muth/README.md b/challenge-328/matthias-muth/README.md
index 212a34d1b8..e96c711ee4 100644
--- a/challenge-328/matthias-muth/README.md
+++ b/challenge-328/matthias-muth/README.md
@@ -1,164 +1,222 @@
-# Missing and Mad
+# Regexes Replacing All Good Strings?
 
-**Challenge 327 solutions in Perl by Matthias Muth**
+**Challenge 328 solutions in Perl by Matthias Muth**
 
-## Task 1: Missing Integers
+## Task 1: Replace all ?
 
-> You are given an array of n integers.<br/>
-> Write a script to find all the missing integers in the range 1..n in the given array.
+> You are given a string containing only lower case English letters and ?.<br/>
+> Write a script to replace all ? in the given string so that the string doesn’t contain consecutive repeating characters.
 >
 > **Example 1**
 >
 > ```text
-> Input: @ints = (1, 2, 1, 3, 2, 5)
-> Output: (4, 6)
->
-> The given array has 6 elements.
-> So we are looking for integers in the range 1..6 in the given array.
-> The missing integers: (4, 6)
->```
-> 
->**Example 2**
+> Input: $str = "a?z"
+> Output: "abz"
 > 
->```text
-> Input: @ints = (1, 1, 1)
-> Output: (2, 3)
+> There can be many strings, one of them is "abz".
+> The choices are 'a' to 'z' but we can't use either 'a' or 'z' to replace the '?'.
+> ```
+>
+> **Example 2**
+>
+> ```text
+> Input: $str = "pe?k"
+> Output: "peak"
 > ```
 >
 > **Example 3**
 >
 > ```text
->Input: @ints = (2, 2, 1)
-> Output: (3)
+> Input: $str = "gra?te"
+> Output: "grabte"
 > ```
 
-Checking whether an integer is *missing* is the same
-as checking whether it *exists*, but with a negative result.<br/>
-For checking whether an integer *exists*,
-I use an '*existence hash*'. And this is my standard way of creating one:
+It would be strange *not* to think of regular expressions
+when a task is to replace parts of a string
+with something else.<br/>
+So regex it is!
+
+Let's first have a look at the replacement character.<br/>
+I will replace all question marks with the letter `'a'`,
+except if one of the letters to the left or right of the question mark
+already is an `'a'`.<br/>
+In that case, I will use `'b'` as the replacement.<br/>
+If the question mark's neighbors are
+both an `'a'` and a `'b'` (or a `'b'` and an `'a'`),
+I will use a `'c'`.<br/>
+This should avoid all possible cases of 'consecutive repeating characters'.<br/>
+With `$left` and `$right` being the left and right neighbors, respectively,
+a possible formula to determine the correct replacement is as follows.
+It minimizes the number of comparisons that need to be done: 
 
 ```perl
-    my %exists = map { ( $_ => 1 ) } @ints;
+            $left eq "a"    ? ( $right eq "b" ? "c" : "b" )
+            : $right eq "a" ? ( $left eq "b" ? "c" : "b" ) : "a";
 ```
 
-I can now check the numbers from `1` to `@ints`
-(which in scalar context is the number of elements in `@ints`) 
-for having an entry (or, more precisely, having *no* entry)
-in the *existence hash*.<br/>
-Letting `grep` do that work and directly returning the result
-gives us this two-lines-of-code solution: 
+The plan is to use the `s///` substitution operator
+to find each question mark
+and replace it with the correct replacement character.
+Since we have a formula,
+it is best to use a `/e` *execute* option for the substitution,
+which allows us to use a piece of code
+(containing the above formula) to compute the replacement.
+I like to put code pieces into curly brackets when I use the `/e` option,
+so it will be more like a `s[...]{...}/e` substitution.
+The `[` and `]` are not for starting a character class,
+but the most practical way to to delimit the matching pattern
+with delimiter pairs. 
+
+Now let's construct the regular expression for that 'matching' part.<br/>
+We need to find a question mark, plus its neighbors on the left and right.
+I will therefore use `\?` as the pattern,
+and a *look-behind* for the left neighbor
+and a *look-ahead* for the right neighbor.
+Both shall match *any* single character,
+but I will *capture* them for use in the formula.
+
+I then add some `|` alternatives.
+One for getting an empty match for the left neighbor
+when the question mark appears directly at the beginning of the string,
+and similarly one for getting an empty match for the right neighbor
+when the question mark is at the end.
+
+I add the `/x` option to allow for visually structuring of the matching pattern,
+and the `/g` option to perform all substitutions at once.
+
+Since all work  is completed after that statement is executed,
+I also add the `/r` option to directly return the resulting string.
+
+This is the complete substitution statement:
+
+``` perl
+    $str =~
+        s[ (?<=(^|.)) \? (?=(.|$)) ] {
+            my ( $left, $right ) = ( $1, $2 );
+            $left eq "a"    ? ( $right eq "b" ? "c" : "b" )
+            : $right eq "a" ? ( $left eq "b"  ? "c" : "b" ) : "a";
+        }xegr;
+```
 
-```perl
-use v5.36;
+The only small problem with that is that that look-behind pattern
+`(?<=(^|.))` causes a warning:
+
+```text
+Variable length positive lookbehind with capturing is experimental in regex: [...]
+```
 
-sub missing_integers( @ints ) {
-    my %exists = map { ( $_ => 1 ) } @ints;
-    return grep ! $exists{$_}, 1..@ints;
+But it works perfectly for all tests and examples,
+so when your have at least Perl 5.30
+(in which variable length look-behinds were first implemented),
+just switching off that warning should be OK.<br/>
+That's what I do for my complete solution:
+
+```perl
+use v5.30;
+use feature 'signatures';
+no warnings 'experimental::signatures';
+
+sub replace_all_questionmarks( $str ) {
+    no warnings 'experimental::vlb';
+    $str =~
+        s[ (?<=(^|.)) \? (?=(.|$)) ] {
+            my ( $left, $right ) = ( $1, $2 );
+            $left eq "a"    ? ( $right eq "b" ? "c" : "b" )
+            : $right eq "a" ? ( $left eq "b"  ? "c" : "b" ) : "a";
+        }xegr;
 }
 ```
 
-## Task 2: MAD
 
-> You are given an array of distinct integers.<br/>
-> Write a script to find all pairs of elements with minimum absolute difference (MAD) of any two elements.
+## Task 2: Good String
+
+> You are given a string made up of lower and upper case English letters only.<br/>
+> Write a script to return the good string of the given string. A string is called good string if it doesn’t have two adjacent same characters, one in upper case and other is lower case.
 >
 > **Example 1**
 >
 > ```text
-> Input: @ints = (4, 1, 2, 3)
-> Output: [1,2], [2,3], [3,4]
->
-> The minimum absolute difference is 1.
-> Pairs with MAD: [1,2], [2,3], [3,4]
->
+> Input: $str = "WeEeekly"
+> Output: "Weekly"
+> 
+> We can remove either, "eE" or "Ee" to make it good.
 > ```
 >
 > **Example 2**
 >
 > ```text
-> Input: @ints = (1, 3, 7, 11, 15)
-> Output: [1,3]
->
+> Input: $str = "abBAdD"
+> Output: ""
+> 
+> We remove "bB" first: "aAdD"
+> Then we remove "aA": "dD"
+> Finally remove "dD".
 > ```
 >
 > **Example 3**
 >
 > ```text
-> Input: @ints = (1, 5, 3, 8)
-> Output: [1,3], [3,5]
+> Input: $str = "abc"
+> Output: "abc"
 > ```
 
-It is very tempting to read '*find all pairs*' and immediately start thinking about combinatorics and how go through 'all pairs'.
+Using regular expressions *again*!
 
-But that is not necessary.
+For this task, as we may have overlapping patterns,
+we can not just do all substitutions at once using the `/g` option.
+Instead, we need a 'real' loop.
 
-The 'minimum absolute difference' will always be between two numbers that are next to each other. So let's first sort the numbers:
+But the loop body can be empty,
+because the substitution itself does the job *and* delivers
+the ending condition for the loop.
 
-```perl
-    @ints = sort { $a <=> $b } @ints;
-```
+How do we construct the regular expression here?<br/>
+We need something that fulfills both criteria:
+The *same character*, but in *different case*.
 
-Now it quite easy to find the 'minimum absolute difference',
-because it has to be one of the differences between two neighboring numbers.<br/>
-So if we now produce the list of all differences
-between any two *neighboring* numbers
-(for all numbers except for the last one),
-the 'MAD' then will be the minimum of those differences.<br/>
-We don't need to use `abs()`, because the numbers are already sorted,
-so the second one is always greater than or equal to the first one,
-and thus the difference is always non-negative.
+For the *same character* criteria,
+we can use the idiomatic *backreference* technique,
+capturing a character,
+then referencing what we captured using `\g{-1}` for example.
+But I do not know any way of using a backreference and saying that it has to be in a different case at the same time.
 
-I chose to put the differences into a separate array for clearness,
-and also because I will use the them in the next step:
+But what we can do is to make sure that the *different case* criteria
+is already fulfilled  when we capture the first letter.
+We can use a *lookahead* to make sure that the following letter is in different case
+*without knowing what the letter actually is*.
+For any lower case letter that we capture,
+we can use a *lookahead* to ascertain that the next letter is in uppercase,
+and vice versa for uppercase letters.<br/>
+Like this, for example:
 
 ```perl
-    my @diffs = map $ints[ $_ + 1 ] - $ints[$_], 0..( $#ints - 1 );
-    my $min_diff = min( @diffs );    
+    / ( [a-z](?=[A-Z]) | [A-Z](?=[a-z]) ) /x
 ```
 
-Now that we have the 'MAD' (in `$min_diff`),
-we need to extract all pairs of numbers
-whose difference is equal to that 'MAD' .<br/>
-We can use `grep` on the indexes of the `@diff` array
-to find all entries that fulfill this condition.
+Now we have captured a lower case letter
+of which we know that that is followed by an uppercase letter,
+or an uppercase letter
+of which we know that it is followed by a lowercase letter.<br/>
+Note that for sure we *must not* give a `/i` (*ignore case*) option for this to work.
 
-As each of the indexes found also corresponds to
-the position of the two numbers in the sorted array,
-we can extract those two numbers
-and put them into an anonymous array (letting `map` do that).
-We can then directly return the resulting list.
+Now we need to make sure that the two letters are the same
+*when case is ignored*.<br/>
+But didn't we just said we *cannot* ignore case, for the capture to work?<br/>
+Yes, we did, but we can do it anyway:
+the magic spell is  `(?i)`.<br/>
+It switches on the *ignore case* option for the rest of the pattern,
+so in our case, for matching the backreference.
 
-Maybe it's easier to understand just reading the code:
+So here we go, with a nice short regex solution:
 
 ```perl
-    return
-        map [ @ints[ $_, $_ + 1 ] ],
-            grep $diffs[$_] == $min_diff,
-                keys @diffs;
-```
-
-This completes my solution:
-
-```perl
-use v5.36;
-use List::Util qw( min );
-
-sub mad( @ints ) {
-    @ints = sort { $a <=> $b } @ints;
-    my @diffs = map $ints[ $_ + 1 ] - $ints[$_], 0..( $#ints - 1 );
-    my $min_diff = min @diffs;
-    return
-        map [ @ints[ $_, $_ + 1 ] ],
-            grep $diffs[$_] == $min_diff,
-                keys @diffs;
+sub good_string( $str ) {
+    while ( $str =~ s/( [a-z](?=[A-Z]) | [A-Z](?=[a-z]) ) (?i)\1 //x ) {
+        # Everything is in the loop condition.
+    }
+    return $str;
 }
 ```
 
-If we had compared every number to every other, we would have needed $\frac{n  (n+1)}{2}$
-iterations for computing and comparing that number of differences, resulting in an $O(n^2)$ runtime complexity.
-
-This solution's runtime complexity is determined by the
-`sort` operation, and there are only $(n-1)$  differences computed and compared, so the runtime complexity is $O(n \log n)$ .<br/>Glad that we can find MAD pairs in really large lists of numbers now...! :wink::smile:
 
 #### **Thank you for the challenge!**
-
diff --git a/challenge-328/matthias-muth/blog.txt b/challenge-328/matthias-muth/blog.txt
new file mode 100644
index 0000000000..4fe9684c03
--- /dev/null
+++ b/challenge-328/matthias-muth/blog.txt
@@ -0,0 +1 @@
+https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-328/challenge-328/matthias-muth#readme
diff --git a/challenge-328/matthias-muth/perl/ch-1.pl b/challenge-328/matthias-muth/perl/ch-1.pl
new file mode 100755
index 0000000000..d0a3fd1720
--- /dev/null
+++ b/challenge-328/matthias-muth/perl/ch-1.pl
@@ -0,0 +1,56 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 328 Task 1: Replace all ?
+#
+#       Perl solution by Matthias Muth.
+#
+
+use v5.30;
+use feature 'signatures';
+no warnings 'experimental::signatures';
+
+sub replace_all_questionmarks( $str ) {
+    # Looking for a '?', capturing a one-character look-behind in $1
+    # and a one-character look-ahead in $2 (both possibly empty,
+    # but always defined).
+    # Pity that the capture of (^|.) within the look-behind results in an
+    # 'experimental' warning because of its variable length.
+    # Resolved this by switching off the warning.
+    no warnings 'experimental';
+    $str =~
+        s[ (?<=(^|.)) \? (?=(.|$)) ] {
+            my ( $left, $right ) = ( $1, $2 );
+            $left eq "a"    ? ( $right eq "b" ? "c" : "b" )
+            : $right eq "a" ? ( $left eq "b"  ? "c" : "b" ) : "a";
+        }xegr;
+}
+
+use Test2::V0 qw( -no_srand );
+
+my @tests = (
+    [ "Test 0:", "", "" ],
+    [ "Test 1:", "?", "a" ],
+    [ "Test 2:", "a?", "ab" ],
+    [ "Test 3:", "b?", "ba" ],
+    [ "Test 4:", "c?", "ca" ],
+    [ "Test 5:", "?a", "ba" ],
+    [ "Test 6:", "?b", "ab" ],
+    [ "Test 7:", "?c", "ac" ],
+    [ "Test 8:", "a?a a?b a?x", "aba acb abx" ],
+    [ "Test 9:", "b?a b?b b?x", "bca bab bax" ],
+    [ "Test 10:", "x?a x?b x?x", "xba xab xax" ],
+    [ "Example 1:", "a?z", "abz" ],
+    [ "Example 2:", "pe?k", "peak" ],
+    [ "Example 3:", "gra?te", "grabte" ],
+);
+
+for ( @tests ) {
+    my ( $descr, $input, $expected ) = $_->@*;
+    $descr .= " replace_all_questionmarks( '$input' ) is '$expected'";
+    is replace_all_questionmarks( $input ), $expected, $descr;
+}
+
+done_testing;
diff --git a/challenge-328/matthias-muth/perl/ch-2.pl b/challenge-328/matthias-muth/perl/ch-2.pl
new file mode 100755
index 0000000000..fef0c5a466
--- /dev/null
+++ b/challenge-328/matthias-muth/perl/ch-2.pl
@@ -0,0 +1,29 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 328 Task 2: Good String
+#
+#       Perl solution by Matthias Muth.
+#
+
+use v5.36;
+
+    sub good_string( $str ) {
+        while ( $str =~ s/( [a-z](?=[A-Z]) | [A-Z](?=[a-z]) ) (?i)\1 //x ) {
+            # Everything is in the loop condition.
+        }
+        return $str;
+    }
+
+use Test2::V0 qw( -no_srand );
+
+is good_string( "WeEeekly" ), "Weekly",
+    'Example 1: good_string( "WeEeekly" ) == "Weekly"';
+is good_string( "abBAdD" ), "",
+    'Example 2: good_string( "abBAdD" ) == ""';
+is good_string( "abc" ), "abc",
+    'Example 3: good_string( "abc" ) == "abc"';
+
+done_testing;