aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Muth <matthias.muth@gmx.de>2024-09-20 00:11:01 +0200
committerMatthias Muth <matthias.muth@gmx.de>2024-09-20 00:11:01 +0200
commit32d7c9b2d7e0280d3c3364e430953bc0398220ab (patch)
treef5da66278ac086acedb2ffb8c1afdef5875edee0
parent46687ac6d2c5d604e72f4aaae1473c452cb45128 (diff)
downloadperlweeklychallenge-club-32d7c9b2d7e0280d3c3364e430953bc0398220ab.tar.gz
perlweeklychallenge-club-32d7c9b2d7e0280d3c3364e430953bc0398220ab.tar.bz2
perlweeklychallenge-club-32d7c9b2d7e0280d3c3364e430953bc0398220ab.zip
Challenge 287 Task 1 and 2 solutions in Perl by Matthias Muth
-rw-r--r--challenge-287/matthias-muth/README.md505
-rw-r--r--challenge-287/matthias-muth/blog.txt1
-rwxr-xr-xchallenge-287/matthias-muth/perl/ch-1.pl127
-rwxr-xr-xchallenge-287/matthias-muth/perl/ch-2.pl38
4 files changed, 455 insertions, 216 deletions
diff --git a/challenge-287/matthias-muth/README.md b/challenge-287/matthias-muth/README.md
index 99bf1d0c8f..301144a02d 100644
--- a/challenge-287/matthias-muth/README.md
+++ b/challenge-287/matthias-muth/README.md
@@ -1,267 +1,340 @@
-# The Random Spammer Testing Game
-
-**Challenge 286 solutions in Perl by Matthias Muth**
-
-#### Highlights:
-
-* How to check probabilities of random output using `Test2::V0`.<br/>(Spoiler alert: it's more effort than implementing the solution! But it's worth it!).
-* Recent Perl's `builtin 'indexes'` comes in handy for knowing where we are when we walk through an array.
-
-## Task 1: Self Spammer
-
-> Write a program which outputs one word of its own script / source code at random. A word is anything between whitespace, including symbols.<br/>
-> <br/>
+# About Passwords, Birds, and Common Regexes
+
+**Challenge 287 solutions in Perl by Matthias Muth**
+
+## Task 1: Strong Password
+
+> You are given a string, $str.<br/>
+> Write a program to return the minimum number of steps required to make the given string very strong password. If it is already strong then return 0.<br/>
+> Criteria:<br/>
+> - It must have at least 6 characters.<br/>
+> - It must contains at least one lowercase letter, at least one upper case letter and at least one digit.<br/>
+> - It shouldn't contain 3 repeating characters in a row.<br/>
+>
+> Following can be considered as one step:<br/>
+> - Insert one character<br/>
+> - Delete one character<br/>
+> - Replace one character with another<br/>
+>
> Example 1<br/>
-> If the source code contains a line such as: 'open my $fh, "<", "ch-1.pl" or die;'<br/>
-> then the program would output each of the words { open, my, $fh,, "<",, "ch-1.pl", or, die; }<br/>
-> (along with other words in the source) with some positive probability.<br/>
+> Input: \$str = "a"<br/>
+> Output: 5<br/>
> <br/>
> Example 2<br/>
-> Technically 'print(" hello ");' is *not* an example program, because it does not<br/>
-> assign positive probability to the other two words in the script.<br/>
-> It will never display print(" or ");<br/>
+> Input: \$str = "aB2"<br/>
+> Output: 3<br/>
> <br/>
> Example 3<br/>
-> An empty script is one trivial solution, and here is another:<br/>
-> echo "42" > ch-1.pl && perl -p -e '' ch-1.pl<br/>
+> Input: \$str = "PaaSW0rd"<br/>
+> Output: 0<br/>
+> <br/>
+> Example 4<br/>
+> Input: \$str = "Paaasw0rd"<br/>
+> Output: 1<br/>
+> <br/>
+> Example 5<br/>
+> Input: \$str = "aaaaa"<br/>
+> Output: 3<br/>
-#### Implementation
+#### Dealing with short passwords
-My solution is based on these details:
+If the password is too short, there is no other way than inserting characters up to the required length.
-* The `$0` variable contains the file path of the Perl script that is currently running.
-* The common Perl idiom for 'slurping' a file into a single string (localizing the `@ARGV` array and the `$/` 'input record separator' variable in a `do { }` block, setting them to a file name and to `undef`, respectively, and using the magical `<>` 'diamond operator' to return the whole file content):<br/>
- `my $text = do { local ( @ARGV, $/ ) = $file; <> };`
-* Using `split` with a string containing a single space character as the first parameter (as opposed to a PATTERN),<br/>
- `split " ", $text;`<br/>
- separates text into chunks using *any amount* of whitespace (not just that single space) as a separator.<br/>
-* Using `$array[ rand( @array ) ]` returns a random entry from an array with equal probability.
+Example 2 is a test case for this:<br/>
+ `aB2` => 3 (like insert `X`, `Y`, `Z` to get `aB1XYZ` )<br/>
+but also:<br/>
+ `""` => 6 (like `aB1cde`).
-Combining all this, my solution subroutine contains only two lines of real code:
+#### Dealing with missing categories
-```perl
-use v5.36;
+For every category (digits, upper case or lower case letters) that we don't find, we can choose to *insert* a new character or to *replace* an existing one.
-sub self_spammer() {
+We will see later that both operations have their use, in different cases.
- # 'Slurp' the whole source file, and split it into words.
- my @all_words = split " ", do { local ( @ARGV, $/ ) = $0; <> };
+We can use some extra test cases for this:<br/>
+ `abcABC` => 1 (e.g. *insert* `1` to get `abcABC1`, or *replace* `b` by `1` to get `a1cABC`)<br/>
+ `abcdef` => 2 (e.g. *insert* `1` and `A` to get `abcdef1A`, or *replace* `b` by `1` and `c` by `A` to get `a1Adef`)<br/>
- # Return a random word.
- return $all_words[ rand( @all_words ) ];
-}
-```
+#### Dealing with repeating characters (like 'aaaaa')
+
+The third criteria says that the password '*shouldn't contain 3 repeating characters in a row*'.<br/>
+If we find a sequence that is longer, there are three ways to modify it to comply with the rule:
+
+* *Insert* a different character into the sequence after every second character.<br/>
+ This will split the sequence into chunks of two, separated by the new characters:<br/>
+ `aaaaaa => aaiaaiaa` (2 *insert*s for a sequence of 6)<br/>
+ `aaaaaaaaa => aaiaaiaaiaaia` (**4 *inserts*** for a sequence of 9)<br/>
+* *Replace* every third character by a different one.<br/>
+ This also splits it into chunks of 2, but it is more efficient.
+ Each replaced character 'consumes' one character of the sequence and thus reduces the amount of work still left to do:<br/>
+ `aaaaaa => aaraar` (2 replacements for a sequence of 6)<br/>
+ `aaaaaaaaa => aaraaraar` (**3 *replacements*** for a sequence of 9)<br/>
-#### Testing
+* *Delete* all characters in excess of the first 2.<br/>
+ Deleting characters is a dangerous thing, and it is inefficient:<br/>
+ Dangerous, because it also reduces the overall length of the password,
+ and in the end we might be violating the 'at least 6 characters' criteria.<br/>
+ Inefficient, because each *deletion* only takes care of exactly one excess character,
+ whereas at the same time, *replacing* one character at the right spot 'neutralizes' three of them:<br/>
+ `aaaaaa => aa` (4 *deletions* for a sequence of 6)<br/>
+ `aaaaaaaaa => aa` (**7 *deletions*** for a sequence of 9)<br/>
+ So we better do not consider 'delete' operations at all.
-Normally, my solution source file contains the subroutine implementing the solution, and one test for each example from the task description, written using `Test2::V0` (which is a core module now! Hooray!).
+Some more examples:
-For this task, the tests have to look differently.<br/>As the subroutine returns a random word from the source file, we cannot just test for a given expected result.<br/>
-Instead, we should test that '*the program outputs each of the words in the source with some positive probability*'.
+| sequence length | example sequence | *insert* result | *replace* result | *insert* operations needed | *replace* operations needed |
+| :-------------: | :--------------- | :------------------ | :--------------- | :------------------------: | :-------------------------: |
+| 6 | `aaaaaa` | `aabaabaa` | `aabaab` | 2 | 2 |
+| 7 | `aaaaaaa` | `aabaabaaba` | `aabaaba` | 3 | **2** |
+| 9 | `aaaaaaaaa` | `aabaabaabaaba` | `aabaabaab` | 4 | **3** |
+| 12 | `aaaaaaaaaaaa` | `aabaabaabaabaabaa` | `aaXaaXaaXaaX` | 5 | **4** |
-How can we do that?
+These examples show that for dealing with longer sequences, *replacing* characters is more efficient than *inserting* characters.<br/>
+This leads us to some more test cases:<br/>
+ `aaa1B` => 1 (e.g. *replacing* one `a` by `b` to get `aab1B`)<br/> `aaaa1B` => 1 (e.g. *replacing* one `a` by `b` to get `aaba1B`)<br/> `aaaaa1B` => 1 (e.g. *replacing* one `a` by `b` to get `aabaa1B`)<br/> `aaaaaa1B` => 2 (e.g. *replacing* 2 times `a` by `b` to get `aabaab1B`)<br/> `aaaaaaa1B` => 2 (e.g. *replacing* 2 times `a` by `b` to get `aabaaba1B`)<br/> `aaaaaaaa1B` => 2 (e.g. *replacing* 2 times `a` by `b` to get `aabaabaa1B`)<br/>
+ `aaaaaaaaaaaa1B` => 4 (e.g. *replacing* 4 times `a` by `b` to get `aabaabaabaab1B`)
-With a high enough number of calls,
-each word of the source file should be returned at least once.
-So our testing can be set up like this:
+#### Up to three birds with one shot!
-* Determine all the words in the source file, because in the end, we want to see them all.<br/>(This can be implemented very similarly to what is done in the solution procedure, reading the source file and splitting into words, but this time we use `uniq` to get each different word only once.)
-
-* Repeatedly call the `self_spammer()` function to get a random word.<br/>Collect them until we have received as many different words
- as we have determined to be contained in the file.
-
-* Stop the repetition when we hit a reasonably chosen limit for the number of calls, so that we won't loop forever if anything goes wrong.
-
-* Use a `Test2::V0` comparison function (actually: the very versatile `is`) to compare the list of words that we received
- to the list of words that we know to be in the file. In particular, we do a *set* comparison using a `bag()` with `item()`s and `end()`.
+It turns out that if we are lucky, by *inserting* one character we can solve three problems at the same time:
-If this test succeeds, we will have received every different word at least once, which proves that there is a greater-than-zero probability for each word to be returned by our function.
+* make the password longer,
+* add a missing category by choosing the character to be from that category,
+* shorten a long repeated-character sequence by inserting the character to split off two characters of the sequence.
-This is the testing section:
+In this example, one operation solves all three shortcomings, which makes it another good test case:<br/>
+`aaaBc` => 1 (e.g. by *inserting * one digit at the right place, like `aa1aBc`).<br/>
+
+#### And another two birds with another shot...
+
+Similarly, we also can solve *two* problems at the same time by *replacing* one character:
+
+* add a missing category by choosing the character to be from that category,
+* shorten a long repeating character sequence by choosing a 'third' character to be replaced, which will 'neutralize' the two characters preceding it.
+
+For example (and yet another test case):<br/>
+ `aaaabC` => `aa1aabC` => 1 change only for solving two shortcomings.
+
+
+#### Solution structure
+
+For our solution this means that we can proceed as follows:
+
+1. We determine how many *inserts* are needed
+ for reaching the **minimum password length**.<br/>
+ Every *insert* is counted as a cost for our final result
+ (the number of operations needed).<br/>
+ In addition, we keep a separate counter for the inserted characters,
+ which we will decrement when we use them 'for more birds'
+ (to add categories or to split up long sequences).
+
+2. For each **missing category**,
+ we first use one of the characters inserted in step 1
+ for adding that category.<br/>
+ This causes *no additional cost*,
+ as long as we have any of those characters left.
+
+3. If we *still* are missing categories,
+ we *replace* existing characters of another category
+ by a character of the respective missing category.<br/>
+ Every character to be replaced is counted as a cost.<br/>
+ We don't care to choose *which* characters to be replaced here,
+ because we might choose good positions later,
+ when we try to split long repeating sequences.<br/>
+ For this, we also keep another counter for the replaced characters.<br/>
+ The reason why we prefer replacing to inserting here is that later on,
+ *replaced* characters might serve better than *inserted* ones.
+
+4. For every **long repeating character sequence** that we find,
+ we do this:
+
+ Position any *replacement* characters from the previous step
+ on every third character of the sequence,
+ each one 'neutralizing' *three* characters of the repetition,
+ until we have used all the *replacement* characters, or the sequence is fully neutralized.<br/>
+ There's *no additional cost* for this.
+
+ If there are no *replaced* characters available any more,
+ position any *inserted* characters from step 1
+ after every second character of the sequence,
+ neutralizing two characters of the sequence.<br/>
+ Even if using the *inserted* characters is less efficient than using replacements, these here come for free, because we've paid for them already. Now they can be used with *no additional cost*.
+
+ For the rest of the sequence,
+ we *replace* every third characters within the sequence to split it up further.<br/>
+ These replacements count for the cost, though.
+
+5. We return the cost that we have determined.
+
+Here are some more 'combination' test cases:<br/>
+
+ `aaaacccc` => 2 (like `aa1accBc)
+ (replacing one `a` by a digit,<br/>
+ and one `c` by an upper case character.<br/>
+ and two `b`s by anything else but a `b`).<br/>
+ `aaaaaabbbbbb` => 4 (like `aa1aaXbbYbbY`),<br/>
+ (replacing one `a` by a digit,<br/>
+ another `a` by an upper case character,<br/>
+ and two `b`s by anything else but a `b`).<br/>
+ `aaacc` => 2 (e.g. `aa1ccX`).<br/>
+
+And this is my solution:
```perl
-use Test2::V0;
-use List::Util qw( uniq );
-
-# Determine all *different* words in the source file
-# (very similar to how we did before...).
-my @word_list = uniq split " ", do { local ( @ARGV, $/ ) = $0; <> };
-
-# Repeatedly call the solution function to get random words,
-# collecting them until we have as many different words as we know are
-# contained in the file,
-# or until we hit a number of calls limit
-# (so that we won't loop forever if anything goes wrong).
-my ( $n_calls, $max_n_calls ) = ( 0, 10000 );
-my %found;
-$found{ self_spammer() } = 1
- until scalar %found == scalar @word_list
- || ++$n_calls >= $max_n_calls;
-
-note "$n_calls calls";
-note "found ", scalar %found,
- " of ", scalar @word_list, " different words in file";
-
-is [ keys %found ],
- bag {
- item( $_ )
- for @word_list;
- end();
- },
- "all words were found at least once, and no unexpected words were found";
-
-done_testing;
-```
+use v5.36;
+
+use List::Util qw( sum min );
+
+use constant MIN_PASSWORD_LENGTH => 6;
-A test run might result in this output (the number of calls will vary from run to run!):
+sub strong_password( $str ) {
+ # Make pattern matches easier to write.
+ $_ = $str;
-```bash
-# 1461 calls
-# found 151 of 151 different words in file
-ok 1 - all words were found at least once, and no unexpected words were found
-1..1
+ my ( $cost, $available_inserted, $available_replaced ) = ( 0, 0, 0 );
+
+ # 1: Do *inserts* for bringing the password up to length.
+ if ( length() < MIN_PASSWORD_LENGTH ) {
+ $available_inserted = MIN_PASSWORD_LENGTH - length();
+ $cost += $available_inserted;
+ }
+
+ # 2: Use the inserted characters to add missing categories
+ # (*no additional cost!*),
+ my $n_missing_categories = sum( ! /\d/, ! /[a-z]/, ! /[A-Z]/ );
+ if ( $n_missing_categories && $available_inserted ) {
+ my $n_to_use = min( $n_missing_categories, $available_inserted );
+ $n_missing_categories -= $n_to_use;
+ }
+
+ # 3: If there still are categories missing,
+ # we *replace* existing characters.
+ if ( $n_missing_categories ) {
+ $available_replaced = $n_missing_categories;
+ $cost += $available_replaced;
+ }
+
+ # 4: Deal with long repeating sequences (3 or more same characters).
+ while ( /(.)\1\1\1*/g ) {
+ my $sequence_length = length( $& );
+ while ( $sequence_length > 2 && $available_replaced ) {
+ $sequence_length -= 3;
+ --$available_replaced;
+ }
+ while ( $sequence_length > 2 && $available_inserted ) {
+ $sequence_length -= 2;
+ --$available_inserted;
+ }
+ while ( $sequence_length > 2 ) {
+ $sequence_length -= 3;
+ ++$cost;
+ }
+ }
+ return $cost;
+}
+```
+
+The [`ch-1.pl`](https:perl/ch-1.pl) file also contains switchable debugging output, and all the test cases. This is its output:
+
+```terminal
+ok 1 - Example 1: strong_password( "a" ) == 5
+ok 2 - Example 2: strong_password( "aB2" ) == 3
+ok 3 - Example 3: strong_password( "PaaSW0rd" ) == 0
+ok 4 - Example 4: strong_password( "Paaasw0rd" ) == 1
+ok 5 - Example 5: strong_password( "aaaaa" ) == 2 (like "aa1aaB")
+ok 6 - Extra 1: strong_password( "" ) == 6 (like "1aBcde")
+ok 7 - Extra 2: strong_password( "abcABC" ) == 1 (like "a1cABC")
+ok 8 - Extra 3: strong_password( "abcdef" ) == 2 (like "a1Adef")
+ok 9 - Extra 4: strong_password( "aaa1B" ) == 1 (like "aab1B")
+ok 10 - Extra 5: strong_password( "aaaa1B" ) == 1 (like "aaba1B")
+ok 11 - Extra 6: strong_password( "aaaaa1B" ) == 1 (like "aabaa1B")
+ok 12 - Extra 7: strong_password( "aaaaaa1B" ) == 2 (like "aabaab1B")
+ok 13 - Extra 8: strong_password( "aaaaaaa1B" ) == 2 (like "aabaaba1B")
+ok 14 - Extra 9: strong_password( "aaaaaaaa1B" ) == 2 (like "aabaabaa1B")
+ok 15 - Extra 10: strong_password( "aaaaaaaaaaaa1B" ) == 4 (like "aabaabaabaab1B")
+ok 16 - Extra 11: strong_password( "aaaBc" ) == 1 (like "aa1aBc")
+ok 17 - Extra 12: strong_password( "aaaabC" ) == 1 (like "aa1aabC")
+ok 18 - Extra 13: strong_password( "aaaacccc" ) == 2 (like "aa1accBc")
+ok 19 - Extra 14: strong_password( "aaaaaabbbbbb" ) == 4 (like "aa1aaXbbYbbY")
+ok 20 - Extra 15: strong_password( "aaacc" ) == 2 (like "aa1ccX")
+1..20
```
-As often, here the effort for testing is larger than the effort for the implementation.<br/>
-But it feels good to have a well tested challenge solution!
+It has never been easier to create good passwords! :wink::joy:
-## Task 2: Order Game
+## Task 2: Valid Number
-> You are given an array of integers, @ints, whose length is a power of 2.<br/>
-> Write a script to play the order game (min and max) and return the last element.<br/>
+> You are given a string, $str.<br/>
+> Write a script to find if it is a valid number.<br/>
+> Conditions for a valid number:<br/>
+>
+> - An integer number followed by an optional exponent.<br/>
+> - A decimal number followed by an optional exponent.<br/>
+> - An integer number is defined with an optional sign '-' or '+' followed by digits.<br/>
+> <br/>
+> Decimal Number:<br/>
+> A decimal number is defined with an optional sign '-' or '+' followed by one of the following definitions:<br/>
+> - Digits followed by a dot '.'.<br/>
+> - Digits followed by a dot '.' followed by digits.<br/>
+> - A dot '.' followed by digits.<br/>
+> <br/>
+> Exponent:<br/>
+> An exponent is defined with an exponent notation 'e' or 'E' followed by an integer number.<br/>
+> <br/>
> <br/>
> Example 1<br/>
-> Input: @ints = (2, 1, 4, 5, 6, 3, 0, 2)<br/>
-> Output: 1<br/>
-> Operation 1:<br/>
-> min(2, 1) = 1<br/>
-> max(4, 5) = 5<br/>
-> min(6, 3) = 3<br/>
-> max(0, 2) = 2<br/>
-> Operation 2:<br/>
-> min(1, 5) = 1<br/>
-> max(3, 2) = 3<br/>
-> Operation 3:<br/>
-> min(1, 3) = 1<br/>
+> Input: $str = "1"<br/>
+> Output: true<br/>
> <br/>
> Example 2<br/>
-> Input: @ints = (0, 5, 3, 2)<br/>
-> Output: 0<br/>
-> Operation 1:<br/>
-> min(0, 5) = 0<br/>
-> max(3, 2) = 3<br/>
-> Operation 2:<br/>
-> min(0, 3) = 0<br/>
+> Input: $str = "a"<br/>
+> Output: false<br/>
> <br/>
> Example 3<br/>
-> Input: @ints = (9, 2, 1, 4, 5, 6, 0, 7, 3, 1, 3, 5, 7, 9, 0, 8)<br/>
-> Output: 2<br/>
-> Operation 1:<br/>
-> min(9, 2) = 2<br/>
-> max(1, 4) = 4<br/>
-> min(5, 6) = 5<br/>
-> max(0, 7) = 7<br/>
-> min(3, 1) = 1<br/>
-> max(3, 5) = 5<br/>
-> min(7, 9) = 7<br/>
-> max(0, 8) = 8<br/>
-> Operation 2:<br/>
-> min(2, 4) = 2<br/>
-> max(5, 7) = 7<br/>
-> min(1, 5) = 1<br/>
-> max(7, 8) = 8<br/>
-> Operation 3:<br/>
-> min(2, 7) = 2<br/>
-> max(1, 8) = 8<br/>
-> Operation 4:<br/>
-> min(2, 8) = 2<br/>
-
-#### Approach
-
-I follow the suggestion given by the example descriptions:
-
-* Walk through the array and take the minimums and the maximums of pairs of numbers.<br/>
- This reduces the array to half its size.
-* Execute this operation repeatedly, until there is only one final number left.
-
-#### Implementation
-
-As we walk through pairs of numbers from the array, we need to decide whether we shall take the minimum or the maximum of each pair. If we give each pair an index number, we can use `min()` on pairs with even indexes, and `max()` on pairs with odd indexes.<br/>So let's first split the array into pairs, and enumerate the pairs.
-
-Similar to Python's nice `enumerate()` iterator, Perl now has the `indexed` 'builtin' function, which does something very similar (it has been available since Perl 5.36 as an 'experimental' feature, and 'stable' with Perl 5.40).
-
-So let's first create pairs, using the `pairs` function from `List::Util`, then enumerate them using `indexed`.<br/>For the `@ints` array from Example 1 `( 2, 1, 4, 5, 6, 3, 0, 2 )`,<br/>
- `indexed pairs @ints`<br/>
-results in this:<br/>
- `( 0, [ 2, 1 ], 1, [ 4, 5 ], 2, [ 6, 3 ], 3, [ 0, 2 ] )`.
-
-Now lets use `pairs` again:<br/>
- `pairs indexed pairs @ints`<br/>
-to get this sequence:<br/>
- `[ 0, [ 2, 1 ] ],`<br/>
- `[ 1, [ 4, 5 ] ],`<br/>
- `[ 2, [ 6, 3 ] ],`<br/>
- `[ 3, [ 0, 2 ] ]`.
-
-With this, it is easy to do the 'min-max-halve-the-array' operation:
-
-```perl
- @ints = map {
- my ( $index, $pair ) = $_->@*;
- $index % 2 == 0
- ? min( $pair->@* )
- : max( $pair->@* );
- } pairs indexed pairs @ints;
-```
+> Input: $str = "."<br/>
+> Output: false<br/>
+> <br/>
+> Example 4<br/>
+> Input: $str = "1.2e4.2"<br/>
+> Output: false<br/>
+> <br/>
+> Example 5<br/>
+> Input: $str = "-1."<br/>
+> Output: true<br/>
+> <br/>
+> Example 6<br/>
+> Input: $str = "+1E-8"<br/>
+> Output: true<br/>
+> <br/>
+> Example 7<br/>
+> Input: $str = ".44"<br/>
+> Output: true<br/>
-Repeating it until we have reduced the array to one single element, this is my solution:
+Probably the easiest way to solve this is to use the `Regexp::Common` CPAN module:
```perl
use v5.36;
-use List::Util qw( pairs min max );
-use builtin 'indexed';
-no warnings 'experimental::builtin';
-
-sub order_game( @ints ) {
- while ( @ints > 1 ) {
- @ints = map {
- my ( $index, $pair ) = $_->@*;
- $index % 2 == 0
- ? min( $pair->@* )
- : max( $pair->@* );
- } pairs indexed pairs @ints;
- }
- return $ints[0];
+use Regexp::Common;
+
+sub valid_number( $str ) {
+ return $str =~ /^$RE{num}{real}$/;
}
```
+This works well for all examples.
-#### Testing
-
-The testing section looks a bit simpler here:
-
+If you don't want to use a module, this regular expression might be used instead:
```perl
-use Test2::V0 qw( -no_srand );
-is order_game( 2, 1, 4, 5, 6, 3, 0, 2 ), 1,
- 'Example 1: order_game( 2, 1, 4, 5, 6, 3, 0, 2 ) == 1';
-is order_game( 0, 5, 3, 2 ), 0,
- 'Example 2: order_game( 0, 5, 3, 2 ) == 0';
-is order_game( 9, 2, 1, 4, 5, 6, 0, 7, 3, 1, 3, 5, 7, 9, 0, 8 ), 2,
- 'Example 3: order_game( 9, 2, 1, 4, 5, 6, 0, 7, 3, 1, 3, 5, 7, 9, 0, 8 ) == 2';
-done_testing;
-```
-
-Resulting in this reassuring output:
+use v5.36;
-```text
-ok 1 - Example 1: order_game( 2, 1, 4, 5, 6, 3, 0, 2 ) == 1
-ok 2 - Example 2: order_game( 0, 5, 3, 2 ) == 0
-ok 3 - Example 3: order_game( 9, 2, 1, 4, 5, 6, 0, 7, 3, 1, 3, 5, 7, 9, 0, 8 ) == 2
-1..3
+sub valid_number( $str ) {
+ return
+ $str =~ /^ [+-]? (?: \.\d+ | \d+(?:\.\d*)? ) (?: [Ee] [+-]? \d+ )? $/xa;
+}
```
-
+Nothing really special about it, except maybe the `a` modifier, which is used to make sure that no other Unicode characters with a 'digit' property match `\d`. Basically this makes `\d` equivalent to `[0-9]`, which is the safer most of the time.
#### **Thank you for the challenge!**
diff --git a/challenge-287/matthias-muth/blog.txt b/challenge-287/matthias-muth/blog.txt
new file mode 100644
index 0000000000..ad1c31189f
--- /dev/null
+++ b/challenge-287/matthias-muth/blog.txt
@@ -0,0 +1 @@
+https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-287/challenge-287/matthias-muth#readme
diff --git a/challenge-287/matthias-muth/perl/ch-1.pl b/challenge-287/matthias-muth/perl/ch-1.pl
new file mode 100755
index 0000000000..c1d702eca8
--- /dev/null
+++ b/challenge-287/matthias-muth/perl/ch-1.pl
@@ -0,0 +1,127 @@
+#!/usr/bin/env perl
+#
+# The Weekly Challenge - Perl & Raku
+# (https://theweeklychallenge.org)
+#
+# Challenge 287 Task 1: Strong Password
+#
+# Perl solution by Matthias Muth.
+#
+
+use v5.36;
+
+use List::Util qw( sum min );
+
+our $verbose = 0;
+sub vsay( @args ) { say @args if $verbose }
+
+use constant MIN_PASSWORD_LENGTH => 6;
+
+sub strong_password( $str ) {
+ vsay "strong_password( $str )";
+
+ # Make pattern matches easier to write.
+ $_ = $str;
+
+ my ( $cost, $available_inserted, $available_replaced ) = ( 0, 0, 0 );
+
+ # 1: Do *inserts* for bringing the password up to length.
+ vsay " password length: ", length();
+ if ( length() < MIN_PASSWORD_LENGTH ) {
+ $available_inserted = MIN_PASSWORD_LENGTH - length();
+ $cost += $available_inserted;
+ vsay " insert $available_inserted for password length";
+ vsay " cost is at $cost";
+ }
+
+ # 2: Use the inserted characters to add missing categories
+ # (*no additional cost!*),
+ my $n_missing_categories = sum( ! /\d/, ! /[a-z]/, ! /[A-Z]/ );
+ vsay " $n_missing_categories missing categories";
+ if ( $n_missing_categories && $available_inserted ) {
+ my $n_to_use = min( $n_missing_categories, $available_inserted );
+ $n_missing_categories -= $n_to_use;
+ vsay " used $n_to_use inserts for missing categories";
+ }
+
+ # 3: If there still are categories missing,
+ # we *replace* existing characters.
+ if ( $n_missing_categories ) {
+ $available_replaced = $n_missing_categories;
+ $cost += $available_replaced;
+ vsay " replace $available_replaced for categories";
+ vsay " cost is at $cost";
+ }
+
+ # 4: Deal with long repeating sequences (3 or more same characters).
+ while ( /(.)\1\1\1*/g ) {
+ my $sequence_length = length( $& );
+ vsay " sequence '$&', length $sequence_length";
+ while ( $sequence_length > 2 && $available_replaced ) {
+ vsay " use replace in sequence";
+ $sequence_length -= 3;
+ --$available_replaced;
+ }
+ while ( $sequence_length > 2 && $available_inserted ) {
+ vsay " use insert in sequence";
+ $sequence_length -= 2;
+ --$available_inserted;
+ }
+ while ( $sequence_length > 2 ) {
+ vsay " replace in sequence";
+ vsay " cost is at $cost";
+ $sequence_length -= 3;
+ ++$cost;
+ }
+ }
+ return $cost;
+}
+
+use Test2::V0 qw( -no_srand );
+is strong_password( "a" ), 5,
+ 'Example 1: strong_password( "a" ) == 5';
+is strong_password( "aB2" ), 3,
+ 'Example 2: strong_password( "aB2" ) == 3';
+is strong_password( "PaaSW0rd" ), 0,
+ 'Example 3: strong_password( "PaaSW0rd" ) == 0';
+is strong_password( "Paaasw0rd" ), 1,
+ 'Example 4: strong_password( "Paaasw0rd" ) == 1';
+is strong_password( "aaaaa" ), 2,
+ 'Example 5: strong_password( "aaaaa" ) == 2 (like "aa1aaB")';
+
+is strong_password( "" ), 6,
+ 'Extra 1: strong_password( "" ) == 6 (like "1aBcde")';
+
+is strong_password( "abcABC" ), 1,
+ 'Extra 2: strong_password( "abcABC" ) == 1 (like "a1cABC")';
+is strong_password( "abcdef" ), 2,
+ 'Extra 3: strong_password( "abcdef" ) == 2 (like "a1Adef")';
+
+is strong_password( "aaa1B" ), 1,
+ 'Extra 4: strong_password( "aaa1B" ) == 1 (like "aab1B")';
+is strong_password( "aaaa1B" ), 1,
+ 'Extra 5: strong_password( "aaaa1B" ) == 1 (like "aaba1B")';
+is strong_password( "aaaaa1B" ), 1,
+ 'Extra 6: strong_password( "aaaaa1B" ) == 1 (like "aabaa1B")';
+is strong_password( "aaaaaa1B" ), 2,
+ 'Extra 7: strong_password( "aaaaaa1B" ) == 2 (like "aabaab1B")';
+is strong_password( "aaaaaaa1B" ), 2,
+ 'Extra 8: strong_password( "aaaaaaa1B" ) == 2 (like "aabaaba1B")';
+is strong_password( "aaaaaaaa1B" ), 2,
+ 'Extra 9: strong_password( "aaaaaaaa1B" ) == 2 (like "aabaabaa1B")';
+is strong_password( "aaaaaaaaaaaa1B" ), 4,
+ 'Extra 10: strong_password( "aaaaaaaaaaaa1B" ) == 4 (like "aabaabaabaab1B")';
+
+is strong_password( "aaaBc" ), 1,
+ 'Extra 11: strong_password( "aaaBc" ) == 1 (like "aa1aBc")';
+is strong_password( "aaaabC" ), 1,
+ 'Extra 12: strong_password( "aaaabC" ) == 1 (like "aa1aabC")';
+
+is strong_password( "aaaacccc" ), 2,
+ 'Extra 13: strong_password( "aaaacccc" ) == 2 (like "aa1accBc")';
+is strong_password( "aaaaaabbbbbb" ), 4,
+ 'Extra 14: strong_password( "aaaaaabbbbbb" ) == 4 (like "aa1aaXbbYbbY")';
+is strong_password( "aaacc" ), 2,
+ 'Extra 15: strong_password( "aaacc" ) == 2 (like "aa1ccX")';
+
+done_testing;
diff --git a/challenge-287/matthias-muth/perl/ch-2.pl b/challenge-287/matthias-muth/perl/ch-2.pl
new file mode 100755
index 0000000000..ed9a331159
--- /dev/null
+++ b/challenge-287/matthias-muth/perl/ch-2.pl
@@ -0,0 +1,38 @@
+#!/usr/bin/env perl
+#
+# The Weekly Challenge - Perl & Raku
+# (https://theweeklychallenge.org)
+#
+# Challenge 287 Task 2: Valid Number
+#
+# Perl solution by Matthias Muth.
+#
+
+use v5.36;
+
+sub valid_number( $str ) {
+ return $str =~ /^ [+-]? (?: \.\d+ | \d+(?:\.\d*)? ) (?: [Ee] [+-]? \d+ )? $/xa;
+}
+
+use Regexp::Common;
+
+sub Xvalid_number( $str ) {
+ return $str =~ /^$RE{num}{real}$/;
+}
+
+use Test2::V0 qw( -no_srand );
+ok valid_number( 1 ),
+ 'Example 1: valid_number( 1 ) is true';
+ok ! valid_number( "a" ),
+ 'Example 2: valid_number( "a" ) is false';
+ok ! valid_number( "." ),
+ 'Example 3: valid_number( "." ) is false';
+ok ! valid_number( "1.2e4.2" ),
+ 'Example 4: valid_number( "1.2e4.2" ) is false';
+ok valid_number( "-1." ),
+ 'Example 5: valid_number( "-1." ) is true';
+ok valid_number( "+1E-8" ),
+ 'Example 6: valid_number( "+1E-8" ) is true';
+ok valid_number( ".44" ),
+ 'Example 7: valid_number( ".44" ) is true';
+done_testing;