Merge pull request #10645 from MatthiasMuth/muthm-282

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

4 files changed, 111 insertions, 116 deletions

diff --git a/challenge-282/matthias-muth/README.md b/challenge-282/matthias-muth/README.md
index cfb75e9edc..74507d0c53 100644
--- a/challenge-282/matthias-muth/README.md
+++ b/challenge-282/matthias-muth/README.md
@@ -1,149 +1,84 @@
-# Knights of Class
+# Power to the Regex!
 
-**Challenge 281 solutions in Perl by Matthias Muth**
+**Challenge 282 solutions in Perl by Matthias Muth**
 
-## Task 1: Check Color
+For this week's tasks, both of my solutions are one line of code, using **regular expressions only**!
 
-> You are given coordinates, a string that represents the coordinates of a square of the chessboard as shown below:<br/>
-> <br/>
-> Write a script to return true if the square is light, and false if the square is dark.<br/>
+## Task 1: Good Integer
+
+> You are given a positive integer, \$int, having 3 or more digits.<br/>
+> Write a script to return the Good Integer in the given integer or -1 if none found.<br/>
+> A good integer is exactly three consecutive matching digits.<br/>
 > <br/>
 > Example 1<br/>
-> Input: \$coordinates = "d3"<br/>
-> Output: true<br/>
+> Input: \$int = 12344456<br/>
+> Output: "444"<br/>
 > <br/>
 > Example 2<br/>
-> Input: \$coordinates = "g5"<br/>
-> Output: false<br/>
+> Input: \$int = 1233334<br/>
+> Output: -1<br/>
 > <br/>
 > Example 3<br/>
-> Input: \$coordinates = "e6"<br/>
-> Output: true<br/>
+> Input: \$int = 10020003<br/>
+> Output: "000"<br/>
 
-Interpreting column names '`a`' to '`z`' as numbers from 1 to 8,
-the lower left square ('`a1`') has the column/row coordinates `(1,1)`.  The sum of these two coordinate values is 2, and the square is a dark one.
+Let's start with a regex that finds three same digits in a row. Not so difficult, capturing the first one and using a backreference to it to match the second and third one. I am using relative references for capture groups here (like `\g{-1}`), because as we will see we will need to use more than one capture group, and knowing myself, renumbering often leads to errors.
 
-It is easy to see that *all* dark squares have a coordinate sum that is even, because whenever you add 1 to any of the coordinates, making the sum odd, you end up on a light square, and adding (or subtracting) another 1 brings you to a dark square again.
+```perl
+sub good_integer( $int ) {
+    return $int =~ / (\d)\g{-1}\g{-1} /x // -1;
+}
+```
 
-So we only have to add the row and column coordinates, and check whether the result is odd.
+This works for Examples 1 and 3, but it considers Example 2 to contain a Good Integer `'333'`, while actually it isn't, because the `'3333'` does not contain 'exactly three' matching digits. 
 
-Now I made it simple, by just summing up the *ASCII character values* of the two letters of the field coordinates (`'a'` and `'1'` for that example).
+So we need to make sure that the digit *before* our group of three is different, and also that the *next* digit *after* the three is different.
 
-`'a'` to `'h'` have ASCII values of `0x61` to `0x68`. The lower four bits contain the corresponding coordinate values from 1 to 8.
-The same is valid for the digits characters `'1'` to `'8'`, whose ASCII values are `0x31` to `0x38`.
+Checking that the digit *after* our group is different can easily be done with a *negative lookahead*: `(?!\g{-1})`. This will work at the end of the string, too, since we surely won't find our digit there, so the negative lookahead passes.
 
-So if I sum up the ASCII values of the characters `'a'` and `'1'` and divide by 2, it is the same as if I added the numerical coordinates 1 and 1 and divided by 2.
+But can we do the same to check for a different digit *before* our group, using a *negative lookbehind*?<br/>Actually we cant.<br/>We would need to first capture the first digit. Then, as we are now standing *behind* the first digit, we would need to use a negative lookbehind for *two* digits, one that is *not* the one we just captured, and then the one that we  
+
+* 
 
-This makes my solution very short: Split the coordinate string into characters, map them to their ASCII value (using `ord` with the default `$_` parameter), add them together (using `List::Util`'s `sum` function), and use the modulo operator (`%`) to get the remainder. If it is `1`, it's a light square, so we can directly use the remainder as a truth value.
 
 
-```perl
-use v5.36;
-use List::Util qw( sum );
 
-sub check_color( $coordinates ) {
-    return sum( map ord, split "", $coordinates ) % 2;
+
+```perl
+sub good_integer() {
+    ...;
 }
 ```
 
-## Task 2: Knight’s Move
+## Task 2: Changing Keys
 
-> A Knight in chess can move from its current position to any square two rows or columns plus one column or row away. So in the diagram below, if it starts a S, it can move to any of the squares marked E.<br/>
-> Write a script which takes a starting position and an ending position and calculates the least number of moves required.<br/>
-> <br/>
+> You are given an alphabetic string, \$str, as typed by user.<br/>
+> Write a script to find the number of times user had to change the key to type the given string. Changing key is defined as using a key different from the last used key. The shift and caps lock keys won’t be counted.<br/>
 > <br/>
 > Example 1<br/>
-> Input: \$start = 'g2', \$end = 'a8'<br/>
-> Ouput: 4<br/>
-> g2 -> e3 -> d5 -> c7 -> a8<br/>
+> Input: \$str = 'pPeERrLl'<br/>
+> Ouput: 3<br/>
+> p -> P : 0 key change<br/>
+> P -> e : 1 key change<br/>
+> e -> E : 0 key change<br/>
+> E -> R : 1 key change<br/>
+> R -> r : 0 key change<br/>
+> r -> L : 1 key change<br/>
+> L -> l : 0 key change<br/>
 > <br/>
 > Example 2<br/>
-> Input: \$start = 'g2', \$end = 'h2'<br/>
-> Ouput: 3<br/>
-> g2 -> e3 -> f1 -> h2<br/>
-
-I was positively surprised by this week's second task, because it requires a more complex algorithmic approach than usual. Great challenge!
-
-##### Approach
-
-My solution is based on trying to build something like a 'distance map'.
-
-The knight's initial position has distance 0 (no move needed).<br/>
-From there, there are up to eight squares that can be reached with one move. Those will be marked with distance 1.<br/>
-Next, I'll try the eight possible moves from each of those squares having distance 1, and wherever I find a square that is not yet marked with a distance, I do so with the distance of 2.<br/>And so on...
-
-Actually this is a **breadth-first-search** (BFS) algorithm.<br/>Each time a square is marked with a distance, that square's position is put on a queue for the next round. As soon as we are about to mark the end position with its distance, we can stop the process and directly return that distance as the result.
-
-##### Implementation
-
-I love to use and show off 'modern' Perl features, and I am happy that this task offers itself to be implemented using the **class** feature. 
-
-The 'modern' features in my solution include:
-
-- *class* (introduced in Perl 5.38),
-- *signatures* (available since Perl 5.20, 10 years ago, and standard since Perl 5.36),
-- *for_list* (available since Perl 5.36),
-- *chained comparisons* (available since Perl 5.32).
-
-So there is a `class Knight`, and it contains a `field $start` that has to be handed into the constructor when an object is created.
-
-Then there is a method `method n_moves( $end )` that computes the number of moves needed to reach the `$end` position.
-This method implements the BFS algorithm as described above.
-It uses a hash to store the distance map, with the square coordinates (like `'a1'`) as the leys.
-
-And there is one class method `sub knight_neighbors( $from )`
-that returns the list of positions
-that can be reached from the `$from` position in one knight's move.
-It is used as a helper for the `n_moves` BFS algorithm.
-It uses a list of column and row distances `@deltas` for the eight possible neighbor positions.
-The coordinates that are returned are in `'a1'` notation.
-The conversion to get a column number from a column letter to do the coordinate computing,
-and vice versa to get back a `'a1'` type coordinate
-is done using the ASCII character value of the column character.  
+> Input: \$str = 'rRr'<br/>
+> Ouput: 0<br/>
+> <br/>
+> Example 3<br/>
+> Input: \$str = 'GoO'<br/>
+> Ouput: 1<br/>
 
-This is the whole solution, which includes the `Knight` class and the function `knight_s_move( $start, $end )` that can be called with the example input.
+Lorem ipsum dolor sit amet...
 
 ```perl
-use v5.38;
-use feature 'class';
-no warnings 'experimental::class';
-no warnings 'experimental::for_list';
-
-class Knight {
-    field $start :param;
-
-    my @deltas = qw( -2 -1 -2 +1 -1 -2 -1 +2 +1 -2 +1 +2 +2 -1 +2 +1 );
-    sub knight_neighbors( $from ) {
-        my ( $a_to_h, $row ) = split "", $from;
-        my $col = ord( $a_to_h ) - ord( 'a' ) + 1;
-        my @neighbors;
-        for my ( $dc, $dr ) ( @deltas ) {
-            if ( 1 <= $col + $dc <= 8 && 1 <= $row +$dr <= 8 ) {
-                my $square = chr( ord( $a_to_h ) + $dc ) . ( $row + $dr );
-                push @neighbors, $square;
-            }
-        }
-        return @neighbors;
-    }
-
-    method n_moves( $end ) {
-        my %distances = ( $start => 0 );
-        my @queue = ( $start );
-        while ( my $square = shift @queue ) {
-            for my $next ( knight_neighbors( $square ) ) {
-                next
-                    if exists $distances{$next};
-                return $distances{$square} + 1
-                    if $next eq $end;
-                $distances{$next} = $distances{$square} + 1;
-                push @queue, $next;
-            }
-        }
-    }
-}
-
-sub knight_s_move( $start, $end ) {
-    return Knight->new( start => $start )->n_moves( $end );
+sub changing_keys() {
+    ...;
 }
 ```
 
diff --git a/challenge-282/matthias-muth/blog.txt b/challenge-282/matthias-muth/blog.txt
new file mode 100644
index 0000000000..b9ef798a44
--- /dev/null
+++ b/challenge-282/matthias-muth/blog.txt
@@ -0,0 +1 @@
+https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-282/challenge-282/matthias-muth#readme
diff --git a/challenge-282/matthias-muth/perl/ch-1.pl b/challenge-282/matthias-muth/perl/ch-1.pl
new file mode 100755
index 0000000000..fccdcaa6be
--- /dev/null
+++ b/challenge-282/matthias-muth/perl/ch-1.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 282 Task 1: Good Integer
+#
+#       Perl solution by Matthias Muth.
+#
+
+use v5.36;
+
+sub good_integer_1( $int ) {
+    return $int =~ / (.)\g{-1}\g{-1} /x ? $& : -1;
+}
+
+sub good_integer( $int ) {
+    return $int =~ / (?: ^ | (.)(?!\g{-1}) ) ( (.)\g{-1}\g{-1} ) (?!\g{-1}) /x ? $2 : -1;
+}
+
+use Test2::V0 qw( -no_srand );
+
+my $sub_name = "good_integer";
+for my $sub ( sort grep /^${sub_name}/, keys %:: ) {
+    note "Testing $sub:";
+
+    no strict 'refs';
+    is $sub->( 12344456 ), 444,
+        'Example 1: good_integer( 12344456 ) == 444';
+    is $sub->( 1233334 ), -1,
+        'Example 2: good_integer( 1233334 ) == -1';
+    is $sub->( 10020003 ), "000",
+        'Example 3: good_integer( 10020003 ) == "000"';
+}
+done_testing;
diff --git a/challenge-282/matthias-muth/perl/ch-2.pl b/challenge-282/matthias-muth/perl/ch-2.pl
new file mode 100755
index 0000000000..da0a03c4c6
--- /dev/null
+++ b/challenge-282/matthias-muth/perl/ch-2.pl
@@ -0,0 +1,24 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 282 Task 2: Changing Keys
+#
+#       Perl solution by Matthias Muth.
+#
+
+use v5.36;
+
+sub changing_keys( $str ) {
+    return scalar( () = $str =~ /(.)(?=.)(?=.)(?!\g1)/ig );
+}
+
+use Test2::V0 qw( -no_srand );
+is changing_keys( "pPeERrLl" ), 3,
+    'Example 1: changing_keys( "pPeERrLl" ) == 3';
+is changing_keys( "rRr" ), 0,
+    'Example 2: changing_keys( "rRr" ) == 0';
+is changing_keys( "GoO" ), 1,
+    'Example 3: changing_keys( "GoO" ) == 1';
+done_testing;