diff options
| -rw-r--r-- | challenge-331/matthias-muth/README.md | 263 | ||||
| -rw-r--r-- | challenge-331/matthias-muth/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-331/matthias-muth/perl/ch-1.pl | 28 | ||||
| -rwxr-xr-x | challenge-331/matthias-muth/perl/ch-2.pl | 55 |
4 files changed, 288 insertions, 59 deletions
diff --git a/challenge-331/matthias-muth/README.md b/challenge-331/matthias-muth/README.md index 7ca569fa15..3fc0ddbb23 100644 --- a/challenge-331/matthias-muth/README.md +++ b/challenge-331/matthias-muth/README.md @@ -1,113 +1,258 @@ -# Capitalizing on Regular Expressions +# Buddy's Last Word -**Challenge 330 solutions in Perl by Matthias Muth** +**Challenge 331 solutions in Perl by Matthias Muth** -## Task 1: Clear Digits +## Task 1: Last Word -> You are given a string containing only lower case English letters and digits.<br/> -> Write a script to remove all digits by removing the first digit and the closest non-digit character to its left. +> You are given a string.<br/> +> Write a script to find the length of last word in the given string. > > **Example 1** > > ```text -> Input: $str = "cab12" -> Output: "c" -> -> Round 1: remove "1" then "b" => "ca2" -> Round 2: remove "2" then "a" => "c" +> Input: $str = "The Weekly Challenge" +> Output: 9 >``` > >**Example 2** > >```text -> Input: $str = "xy99" -> Output: "" -> ->Round 1: remove "9" then "y" => "x9" -> Round 2: remove "9" then "x" => "" +> Input: $str = " Hello World " +> Output: 5 > ``` > > **Example 3** > > ```text ->Input: $str = "pa1erl" -> Output: "perl" +>Input: $str = "Let's begin the fun" +> Output: 3 > ``` -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. - -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. +This looks so complicated, and it is so easy...<br/> +We let -That +```perl + split " ", $str +``` +do the separation into words. +The good thing is that with `" "` as a separator parameter, +`split` ignores leading and trailing whitespace, so the +```perl + " Hello World " +``` +example still results in `( "Hello", "world" )`.<br/> +Then we take the last word of the resulting word list, like +```perl + ( split " ", $str )[-1] +``` +If we didn't find any words at all, the list will be empty, +and the `(...)[-1]` will return `undef`.<br/> +We can use the `//` *defined or* operator to turn that `undef` +into an empty string, +so that we can use the `length` function on what we have: +```perl + length( ( split " ", $str )[-1] // "" ) +``` +This makes the solution a one-liner: ```perl use v5.36; -sub clear_digits( $str ) { - while ( $str =~ s/[a-z]\d// ) { - # Everything is in the loop condition. - } - return $str; +sub last_word_length( $str ) { + return length( ( split " ", $str )[-1] // "" ); } - ``` -## Task 2: Title Capital +## Task 2: Buddy Strings -> 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. +> You are given two strings, source and target.<br/> +> Write a script to find out if the given strings are Buddy Strings.<br/> +> If swapping of a letter in one string make them same as the other then they are `Buddy Strings`. > > **Example 1** > > ```text -> Input: $str = "PERL IS gREAT" -> Output: "Perl is Great" -> ``` +> Input: $source = "fuck" +> $target = "fcuk" +> Output: true > -> **Example 2** -> -> ```text -> Input: $str = "THE weekly challenge" -> Output: "The Weekly Challenge" +> The swapping of 'u' with 'c' makes it buddy strings. +>``` +> +>**Example 2** +> +>```text +> Input: $source = "love" +> $target = "love" +> Output: false > ``` > > **Example 3** > > ```text -> Input: $str = "YoU ARE A stAR" -> Output: "You Are a Star" +>Input: $source = "fodo" +> $target = "food" +> Output: true +> ``` +> +>**Example 4** +> +>```text +> Input: $source = "feed" +> $target = "feed" +> Output: true > ``` -The second task, too, is easily solved with a regular expression. +This one is a bit more tricky, and I deal with it step by step. + +##### First step: Check correct length. + +If the `$source` and `$target` strings have different lengths, +it will never be possible to transform one into the other +by flipping characters, so I return `false` in that case: + +```perl + return false + unless length( $source ) == length( $target ); +``` +I then can safely assume that the strings *do* have the same length +in the rest of the code. + +##### Second step: Find differing pairs +I compare the strings character by character, +by first creating pairs of characters at the same position, +and then selecting only those where the two characters are not the same. +Example: +```text +$source: f o o d +$target: f o d o +@pairs: ( [ "f", "f" ], [ "o", "o" ], [ "o", "d" ], [ "d", "o" ] ) +@diff_pairs: ( [ "o", "d" ], [ "d", "o" ] ) +``` +I use the well-known `split //, STRING` +for turning the strings into lists of characters, +and I put both lists into anonymous arrays. +For creating pairs from those arrays, +I use `zip` (from `List::Util`), +which combines elements from the array-refs given as parameters +into short arrays for each position. +Next, I `grep` through the pairs, +selecting only those where the two characters differ: +```perl + my @pairs = zip [ split "", $source ], [ split "", $target ]; + my @diff_pairs = grep $_->[0] ne $_->[1], @pairs; +``` -Here, I use three capture buffers: +##### Third step: Recognize Buddy Strings -* 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*)`. +Strings are *Buddy Strings* if we can swap two letters in one string +and get the other string. +This is only possible if: -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. +* there are exactly two differing pairs, + and their letters are the same, only in different order<br/> + ('Standard Buddies'), -The second and third captures will always be lowercased for the result. +or (as per Example 4): -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. +* the strings are completely equal, + but there is at least one letter that is contained at least twice, + so that we can swap the letter with itself<br/> + ('Equal Buddies'). -So here we go: +##### Standard Buddies + +The first criteria translates into this: +```perl + return true + if @diff_pairs == 2 + && $diff_pairs[0][0] eq $diff_pairs[1][1] + && $diff_pairs[0][1] eq $diff_pairs[1][0]; +``` +If this didn't find us any 'Standard Buddies', we check for 'Equal Buddies'. + +##### Equal Buddies + +The strings have to be equal, +but instead of comparing the two strings letter by letter, +there's a shortcut: +we have already compiled a list of differing pairs, +so having *no* differing pairs is the same as the strings being equal: +```perl + return false + unless @diff_pairs == 0; +``` + +For checking whether there is a character that is contained at least twice, +the 'elegant' solution would use a self-referencing regular expression: +```perl + $source =~ /(.).*\g1/; +``` +(We can restrict ourselves to one of the two strings, +because they are equal.)<br/> +So the final return could actually look like this: +```perl + return @diff_pairs == 0 && $source =~ /(.).*\g1/; +``` + +But as usual, I am a bit concerned about the quadratic runtime behavior +of this regular expression for very long strings +(which of course we don't have in the examples!). +The regex engine must walk through the rest of the string +for every single character, +and then backtrack and do the same for the next one, +resulting in a maximum of ${n(n+1)}\over{2}$ comparisons. + +So I resort to a linear approach, +remembering which letters the string contains +and returning `true` the moment a letter is found +that has already been seen: + +```perl + return false + unless @diff_pairs == 0; + my %seen; + for ( split "", $source ) { + return true + if $seen{$_}++; + } + return false; +``` + +The complete solution: ```perl use v5.36; +use builtin qw( true false ); +use List::Util qw( zip ); + +sub buddy_strings( $source, $target ) { + # Check for equal lengths. + return false + unless length( $source ) == length( $target ); + + # Extract pairs of differing characters. + my @pairs = zip [ split "", $source ], [ split "", $target ]; + my @diff_pairs = grep $_->[0] ne $_->[1], @pairs; -sub title_capital( $str ) { - return $str =~ s<(\w)(\w?)(\w*)>{ - ( $3 ? uc $1 : lc $1 ) . lc "$2$3" - }egr; + # Detect 'Standard' Buddies. + return true + if @diff_pairs == 2 + && $diff_pairs[0][0] eq $diff_pairs[1][1] + && $diff_pairs[0][1] eq $diff_pairs[1][0]; + + # Detect 'Equal' Buddies containing at least one repeated character. + return false + unless @diff_pairs == 0; + my %seen; + for ( split "", $source ) { + return true + if $seen{$_}++; + } + return false; } ``` +Nice challenge! + #### **Thank you for the challenge!** diff --git a/challenge-331/matthias-muth/blog.txt b/challenge-331/matthias-muth/blog.txt new file mode 100644 index 0000000000..8fdc3bfb39 --- /dev/null +++ b/challenge-331/matthias-muth/blog.txt @@ -0,0 +1 @@ +https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-331/challenge-331/matthias-muth#readme diff --git a/challenge-331/matthias-muth/perl/ch-1.pl b/challenge-331/matthias-muth/perl/ch-1.pl new file mode 100755 index 0000000000..adcb8c2513 --- /dev/null +++ b/challenge-331/matthias-muth/perl/ch-1.pl @@ -0,0 +1,28 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 331 Task 1: Last Word +# +# Perl solution by Matthias Muth. +# + +use v5.36; + +sub last_word_length( $str ) { + return length( ( split " ", $str )[-1] // "" ); +} + +use Test2::V0 qw( -no_srand ); + +is last_word_length( "The Weekly Challenge" ), 9, + 'Example 1: last_word_length( "The Weekly Challenge" ) == 9'; +is last_word_length( " Hello World " ), 5, + 'Example 2: last_word_length( " Hello World " ) == 5'; +is last_word_length( "Let" ), 3, + 'Example 3: last_word_length( "Let" ) == 3'; +is last_word_length( "" ), 0, + 'Test 1: last_word_length( "" ) == 0'; + +done_testing; diff --git a/challenge-331/matthias-muth/perl/ch-2.pl b/challenge-331/matthias-muth/perl/ch-2.pl new file mode 100755 index 0000000000..53f3a6142b --- /dev/null +++ b/challenge-331/matthias-muth/perl/ch-2.pl @@ -0,0 +1,55 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 331 Task 2: Buddy Strings +# +# Perl solution by Matthias Muth. +# + +use v5.36; +use builtin qw( true false ); + +use List::Util qw( zip ); + +sub buddy_strings( $source, $target ) { + # Check for equal lengths. + return false + unless length( $source ) == length( $target ); + + # Extract pairs of differing characters. + my @pairs = zip [ split "", $source ], [ split "", $target ]; + my @diff_pairs = grep $_->[0] ne $_->[1], @pairs; + + # Detect 'Standard' Buddies. + return true + if @diff_pairs == 2 + && $diff_pairs[0][0] eq $diff_pairs[1][1] + && $diff_pairs[0][1] eq $diff_pairs[1][0]; + + # Detect 'Equal' Buddies containing at least one repeated character. + return false + unless @diff_pairs == 0; + my %seen; + for ( split "", $source ) { + return true + if $seen{$_}++; + } + return false; +} + +use Test2::V0 qw( -no_srand ); + +is buddy_strings( "fuck", "fcuk" ), T, + 'Example 1: buddy_strings( "fuck", "fcuk" ) is true'; +is buddy_strings( "love", "love" ), F, + 'Example 2: buddy_strings( "love", "love" ) is false'; +is buddy_strings( "fodo", "food" ), T, + 'Example 3: buddy_strings( "fodo", "food" ) is true'; +is buddy_strings( "feed", "feed" ), T, + 'Example 4: buddy_strings( "feed", "feed" ) is true'; +is buddy_strings( "", "" ), F, + 'Test 1: buddy_strings( "", "" ) is false'; + +done_testing; |