diff options
| -rw-r--r-- | challenge-341/matthias-muth/README.md | 164 | ||||
| -rw-r--r-- | challenge-341/matthias-muth/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-341/matthias-muth/perl/ch-1.pl | 38 | ||||
| -rwxr-xr-x | challenge-341/matthias-muth/perl/ch-2.pl | 30 |
4 files changed, 157 insertions, 76 deletions
diff --git a/challenge-341/matthias-muth/README.md b/challenge-341/matthias-muth/README.md index 14c02e60f8..428c554463 100644 --- a/challenge-341/matthias-muth/README.md +++ b/challenge-341/matthias-muth/README.md @@ -1,155 +1,167 @@ -# Two Times Two Lines +# (Pre-)Fix what is Broken -**Challenge 340 solutions in Perl by Matthias Muth** +**Challenge 341 solutions in Perl by Matthias Muth** -## Task 1: Duplicate Removals +## Task 1: Broken Keyboard -> You are given a string, $str, consisting of lowercase English letters.<br/> -> Write a script to return the final string after all duplicate removals have been made. Repeat duplicate removals on the given string until we no longer can.<br/> -> A duplicate removal consists of choosing two adjacent and equal letters and removing them. +> You are given a string containing English letters only and also you are given broken keys.<br/> +> Write a script to return the total words in the given sentence can be typed completely. > > **Example 1** > > ```text -> Input: $str = 'abbaca' -> Output: 'ca' +> Input: $str = 'Hello World', @keys = ('d') +> Output: 1 > -> Step 1: Remove 'bb' => 'aaca' -> Step 2: Remove 'aa' => 'ca' +> With broken key 'd', we can only type the word 'Hello'. > ``` > > **Example 2** > > ```text -> Input: $str = 'azxxzy' -> Output: 'ay' -> -> Step 1: Remove 'xx' => 'azzy' -> Step 2: Remove 'zz' => 'ay' +> Input: $str = 'apple banana cherry', @keys = ('a', 'e') +> Output: 0 > ``` > > **Example 3** > > ```text -> Input: $str = 'aaaaaaaa' -> Output: '' +> Input: $str = 'Coding is fun', @keys = () +> Output: 3 > -> Step 1: Remove 'aa' => 'aaaaaa' -> Step 2: Remove 'aa' => 'aaaa' -> Step 3: Remove 'aa' => 'aa' -> Step 4: Remove 'aa' => '' +> No keys broken. > ``` > > **Example 4** > > ```text -> Input: $str = 'aabccba' -> Output: 'a' -> -> Step 1: Remove 'aa' => 'bccba' -> Step 2: Remove 'cc' => 'bba' -> Step 3: Remove 'bb' => 'a' +> Input: $str = 'The Weekly Challenge', @keys = ('a','b') +> Output: 3 > ``` > > **Example 5** > > ```text -> Input: $str = 'abcddcba' -> Output: '' -> -> Step 1: Remove 'dd' => 'abccba' -> Step 2: Remove 'cc' => 'abba' -> Step 3: Remove 'bb' => 'aa' -> Step 4: Remove 'aa' => '' +> Input: $str = 'Perl and Python', @keys = ('p') +> Output: 1 > ``` -Of course I will use regular expressions for this one, particularly because the 'repeated something' detection feels almost like a common idiom meanwhile (at least for me). It uses a capture group `(...)`, and a _backreference_ to that capture buffer. I typically use a _relative_ reference, such a `\g{-1}` for the last capture group preceding the reference, in order to not getting confused by the capture buffers numbers when there could be changes to the regex later. +Perl's regular expressions help to find a concise solution for this task.<br/>But the main goal for me this time isn't shortness, it's readability. -The substitution needs to be done repetitively, but a simple `/g` _global_ option is not enough, because some sequences to be removed only appear once other sequences have been removed. In this case, putting a `while` loop around the substitution does the trick. +This could have been my short solution: + +```perl +sub broken_keyboard_short_and_ugly( $str, $keys ) { + scalar grep ! $keys->@* || ! /[$keys->@*]/i, split " ", $str; +} +``` -The loop body itself can be empty because the substitution both does the work and determines the end criteria. I choose a `do {} while ...` loop, because I think it is the best way to make it obvious that the loop body is empty. (If I used a `while ( ... ) { ... }` loop instead, I would probably put a comment into the loop body to guide the reader. But this would need three lines of code instead of only one.) +(Assuming `use v5.36` or whatever you prefer for having `strict`, `warnings`, and `feature signatures`.) -I still use the `/g` option to catch as many occurrences as possible in one substitution, to minimize the number of times the loop iterates. +Don't worry, there's no need to dive into it to see what it does. I will explain later for those who are curious. -After all the substitutions are done, I just return what is left of the `$str` string. +Here is my 'real' solution.<br/> +This one is much clearer, I hope: ```perl use v5.36; -sub duplicate_removals( $str ) { - do {} while $str =~ s/(.)\g-1//g; - return $str; +sub broken_keyboard( $str, $keys ) { + my @words = split " ", $str; + return scalar @words + if ! $keys->@*; + my $keys_concat = join "", $keys->@*; + return scalar grep ! /[$keys_concat]/i, @words; } ``` -Nice and concise. +The concept is the same, only that this code can almost be read as its own description in English: + +* + Split up the input string into words, using any amount of whitespace as separator<br/>(the `" "` special case for the `split` separator does that perfectly):<br/> + ` my @words = split " ", $str;` +* Return the full number of words if there are no broken keys.<br/> + ` return scalar @words`<br/>` if ! $keys->@*;` +* Build a string with the concatenated broken key characters<br/>(we will see in the next step what that will be used for):<br/> + ` my $keys_concat = join "", $keys->@*;` +* Return the count of words that do not(!) match a regular expression with a bracketed character class containing all broken keys, ignoring upper or lower case.<br/> + ` return scalar grep ! /[$keys_concat]/i, @words;`<br/> + (`grep` in scalar context returns the number of hits instead of the hits themselves.) + +There are chances that even I will understand what I wrote when I stumble over this code in a year or so... + +But just for the curious, here is what the 'short' version does.<br/>Basically the same thing just mapped into one single statement, but with a fews pitfalls: + +* For keeping the code short, the `grep` condition contains both cases of having broken keys or not.<br/>It is assumed that any word is a hit if there are no keys (`! $keys->@*`) or -- if there are -- the word does not match the regular expression containing the character class with the list of broken keys.<br/>Clearly, there is a runtime punishment for this. The check whether we have any broken keys is repeated for every word. +* Watch out: In the regular expression, the *array* is interpolated into the character class (not a string, as in the other solution).<br/>This results in all array elements being put in, separated by space characters. Similar to using `"$keys->@*"` in double quoted strings.<br/>But that means that our character class also contains space characters. So actually we are not only looking for broken keys in the words, but also for space characters!<br/> + Good that we know there cannot be any... + +So to understand the code fully, the reader also has to understand these specialties. Any changes to the code can be surprising... -## Task 2: Ascending Numbers +This is why I didn't use my shortest solution for this task.<br/>I hope you agree. -> You are given a string, $str, is a list of tokens separated by a single space. Every token is either a positive number consisting of digits 0-9 with no leading zeros, or a word consisting of lowercase English letters.<br/> -> Write a script to check if all the numbers in the given string are strictly increasing from left to right. +## Task 2: Reverse Prefix + +> You are given a string, \$str and a character in the given string, \$char.<br/> +> Write a script to reverse the prefix upto the first occurrence of the given \$char in the given string \$str and return the new string. > > **Example 1** > > ```text -> Input: $str = "The cat has 3 kittens 7 toys 10 beds" -> Output: true -> -> Numbers 3, 7, 10 - strictly increasing. +> Input: $str = "programming", $char = "g" +> Output: "gorpmming" +> +> Reverse of prefix "prog" is "gorp". > ``` > > **Example 2** > > ```text -> Input: $str = 'Alice bought 5 apples 2 oranges 9 bananas' -> Output: false +> Input: $str = "hello", $char = "h" +> Output: "hello" > ``` > > **Example 3** > > ```text -> Input: $str = 'I ran 1 mile 2 days 3 weeks 4 months' -> Output: true +> Input: $str = "abcdefghij", $char = "h" +> Output: "hgfedcbaj" > ``` > > **Example 4** > > ```text -> Input: $str = 'Bob has 10 cars 10 bikes' -> Output: false +> Input: $str = "reverse", $char = "s" +> Output: "srevere" > ``` > > **Example 5** > > ```text -> Input: $str = 'Zero is 0 one is 1 two is 2' -> Output: true +> Input: $str = "perl", $char = "r" +> Output: "repl" > ``` -Another use case for regular expressions.<br/> -This time, for extracting all numbers from the input string: +Now this is the task where I fully promote a short solution!<br/> +A single regular expression substitution is all that is needed: ```perl - my @numbers = $str =~ /(\d+)/g; -``` - -Then, I translate the sentence 'all numbers have to be strictly greater that their respective predecessor' into this Perl statement, using `all` from `List::Util`: +use v5.36; -```perl - all { $numbers[$_] > $numbers[ $_ - 1 ] } 1..$#numbers +sub reverse_prefix( $str, $char ) { + return $str =~ s<^.*?$char>{ reverse $& }er; +} ``` -The result is the return value, so I end up with a typical Perl two-liner: +Explanation? -```perl -use v5.36; -use List::Util qw( all ); +Everything from the beginning of the string up to and including the first `$char` character is matched:<br/>` /^.*?$char/`<br/>The 'everything' match is 'non-greedy' (`.*?`), so that it stops when the first `$char` is found. -sub ascending_numbers( $str ) { - my @numbers = $str =~ /(\d+)/g; - return all { $numbers[$_] > $numbers[ $_ - 1 ] } 1..$#numbers; -} +The replacement for the prefix is generated with `reverse $&`. That's why the substitution part is an evaluated expression (code), using the `/e` flag.<br/>It's a habit of mine to put the code part into curly brackets when I use the `/e` flag, to make it more visible.<br/> +I then use a pair of angle brackets for the first part. -``` +The `/r` flag returns the resulting string (instead of the number of matches found).<br/>That's the subroutine's return value, and that's all. + + This is Perl. Not everything short is bad! -#### **Thank you for the challenge!** +**Thank you for the challenge!** diff --git a/challenge-341/matthias-muth/blog.txt b/challenge-341/matthias-muth/blog.txt new file mode 100644 index 0000000000..f6c74fc3a4 --- /dev/null +++ b/challenge-341/matthias-muth/blog.txt @@ -0,0 +1 @@ +https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-341/challenge-341/matthias-muth#readme diff --git a/challenge-341/matthias-muth/perl/ch-1.pl b/challenge-341/matthias-muth/perl/ch-1.pl new file mode 100755 index 0000000000..65f4e7ad41 --- /dev/null +++ b/challenge-341/matthias-muth/perl/ch-1.pl @@ -0,0 +1,38 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 341 Task 1: Broken Keyboard +# +# Perl solution by Matthias Muth. +# + +use v5.36; + +sub broken_keyboard_short_and_ugly( $str, $keys ) { + scalar grep ! $keys->@* || ! /[$keys->@*]/i, split " ", $str; +} + +sub broken_keyboard( $str, $keys ) { + my @words = split " ", $str; + return scalar @words + if ! $keys->@*; + my $keys_concat = join "", $keys->@*; + return scalar grep ! /[$keys_concat]/i, @words; +} + +use Test2::V0 qw( -no_srand ); + +is broken_keyboard( "Hello World", ["d"] ), 1, + 'Example 1: broken_keyboard( "Hello World", ["d"] ) == 1'; +is broken_keyboard( "apple banana cherry", ["a", "e"] ), 0, + 'Example 2: broken_keyboard( "apple banana cherry", ["a", "e"] ) == 0'; +is broken_keyboard( "Coding is fun", [] ), 3, + 'Example 3: broken_keyboard( "Coding is fun", [] ) == 3'; +is broken_keyboard( "The Weekly Challenge", ["a", "b"] ), 2, + 'Example 4: broken_keyboard( "The Weekly Challenge", ["a", "b"] ) == 2'; +is broken_keyboard( "Perl and Python", ["p"] ), 1, + 'Example 5: broken_keyboard( "Perl and Python", ["p"] ) == 1'; + +done_testing; diff --git a/challenge-341/matthias-muth/perl/ch-2.pl b/challenge-341/matthias-muth/perl/ch-2.pl new file mode 100755 index 0000000000..b81400ee04 --- /dev/null +++ b/challenge-341/matthias-muth/perl/ch-2.pl @@ -0,0 +1,30 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 341 Task 2: Reverse Prefix +# +# Perl solution by Matthias Muth. +# + +use v5.36; + +sub reverse_prefix( $str, $char ) { + return $str =~ s<^.*?$char>{ reverse $& }er; +} + +use Test2::V0 qw( -no_srand ); + +is reverse_prefix( "programming", "g" ), "gorpramming", + 'Example 1: reverse_prefix( "programming", "g" ) == "gorpramming"'; +is reverse_prefix( "hello", "h" ), "hello", + 'Example 2: reverse_prefix( "hello", "h" ) == "hello"'; +is reverse_prefix( "abcdefghij", "h" ), "hgfedcbaij", + 'Example 3: reverse_prefix( "abcdefghij", "h" ) == "hgfedcbaij"'; +is reverse_prefix( "reverse", "s" ), "srevere", + 'Example 4: reverse_prefix( "reverse", "s" ) == "srevere"'; +is reverse_prefix( "perl", "r" ), "repl", + 'Example 5: reverse_prefix( "perl", "r" ) == "repl"'; + +done_testing; |