diff options
| -rw-r--r-- | challenge-348/matthias-muth/README.md | 325 | ||||
| -rw-r--r-- | challenge-348/matthias-muth/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-348/matthias-muth/perl/ch-1.pl | 34 | ||||
| -rwxr-xr-x | challenge-348/matthias-muth/perl/ch-2.pl | 38 |
4 files changed, 184 insertions, 214 deletions
diff --git a/challenge-348/matthias-muth/README.md b/challenge-348/matthias-muth/README.md index 33532eafeb..f822622e2e 100644 --- a/challenge-348/matthias-muth/README.md +++ b/challenge-348/matthias-muth/README.md @@ -1,282 +1,179 @@ -# Leave a Date and a Number, and I'll Get Back to You +# Get Those Strings and Times Covered -**Challenge 347 solutions in Perl by Matthias Muth** +**Challenge 348 solutions in Perl by Matthias Muth** -## Task 1: Format Date +## Task 1: String Alike -> You are given a date in the form: 10th Nov 2025.<br/> -> Write a script to format the given date in the form: 2025-11-10 using the set below.<br/> -> @DAYS = ("1st", "2nd", "3rd", ....., "30th", "31st")<br/> -> @MONTHS = ("Jan", "Feb", "Mar", ....., "Nov", "Dec")<br/> -> @YEARS = (1900..2100) +> You are given a string of even length.<br/> +> Write a script to find if the given string split into two halves of equal lengths and they both have same number of vowels. > > **Example 1** > > ```text -> Input: $str = "1st Jan 2025" -> Output: "2025-01-01" +> Input: $str = "textbook" +> Output: false +> +> 1st half: "text" (1 vowel) +> 2nd half: "book" (2 vowels) > ``` > > **Example 2** > > ```text -> Input: $str = "22nd Feb 2025" -> Output: "2025-02-22" +> Input: $str = "book" +> Output: true +> +> 1st half: "bo" (1 vowel) +> 2nd half: "ok" (1 vowel) > ``` > > **Example 3** > > ```text -> Input: $str = "15th Apr 2025" -> Output: "2025-04-15" +> Input: $str = "AbCdEfGh" +> Output: true +> +> 1st half: "AbCd" (1 vowel) +> 2nd half: "EfGh" (1 vowel) > ``` > > **Example 4** > > ```text -> Input: $str = "23rd Oct 2025" -> Output: "2025-10-23" +> Input: $str = "rhythmmyth" +> Output: false +> +> 1st half: "rhyth" (0 vowel) +> 2nd half: "mmyth" (0 vowel) > ``` > > **Example 5** > > ```text -> Input: $str = "31st Dec 2025" -> Output: "2025-12-31" +> Input: $str = "UmpireeAudio" +> Output: false +> +> 1st half: "Umpire" (3 vowels) +> 2nd half: "eAudio" (5 vowels) > ``` -I have three versions: - -#### The Quick-and-Dirty Fair-Weather Version - -If I am sure that all the dates that will ever be passed in are correctly formatted, this is my short solution: +The fastest way to count the occurrences of a fixed set of characters in a string in Perl probably is this: ```perl -use v5.36; -use Time::Piece; - -sub format_date_q_a_d( $str ) { - $str =~ s/st|nd|rd|th//; - my $t = Time::Piece->strptime( $str, "%d %b %Y" ); - return $t->strftime( "%Y-%m-%d" ); -} + tr/<characters to count>// ``` -Assuming that nothing can go wrong (but we know it will!), this is what it does: - -* Remove any known suffixes from the day numbers. -* Let `strptime` from `Time::Piece` do the work of translating the date from text into a date-and-time object. -* Then do the inverse, and format the date as we need it, using the object's `strftime` method. - -Very easy, very short, very readable. - -But what happens when the date is not recognized by `strptime`?<br/>It's really bad, but `strptime` will make our program abort! - -#### The 'Strict' and Safe Version - -Letting the program abort when there is an unrecognizable date is not acceptable. -There need to be some checks to avoid it. - -Let's be really strict and accept only correctly formatted dates. These are the checks: - -1. The ordinal suffixes have to match the numbers, like `1st`, `2nd`, `3rd` or `4th`.<br/> - A date like `5st Nov 2025` is invalid.<br/> - The way to do that is to remove only suffixes that are preceded by the matching digit: - - ```perl - $str =~ s/ (?<=1)st | (?<=2)nd | (?<=3)rd | (?<=\d)th //x; - ``` +This is mentioned explicitly in [perldoc](https://perldoc.perl.org/perlop#tr/SEARCHLIST/REPLACEMENTLIST/cdsr): -2. `strptime` will abort even for correctly formatted dates in some cases, such as '31st Dec 1899'.<br/>To catch these exceptions, I use the `try`/`catch` syntax, enabled with `use feature 'try'`: - - ```perl - my $t = do { - try { Time::Piece->strptime( $str, "%d %b %Y" ) } - catch( $e ) { undef } - }; - ``` - - This results in `$t` being undefined if `strptime` had any problems. Anything not properly recognized by `strptime` will be marked as an invalid date. - -3. `strptime` refuses dates prior to the year 1900, but accepts dates beyond the year 2100.<br/> - We have to check and refuse those explicitly. - -4. For a date of `29th Feb` in a leap year, `strptime` returns an object with the correct date.<br/>For `29th Feb` in non-leap years, however, it returns an object containing the 1st of March. Seems the checks for day numbers are not strict enough in `strptime` (a date of `30th Feb` will be refused!).<br/>So we have to check and refuse `29th Feb` in non-leap years explicitly as well.<br/>But instead of implementing a complete leap year calculation here, I take a shortcut:<br/>I reformat the object as a date string in the same format as the original string. Then I compare the two (with the ordinal suffix in the original string removed, but a `0` prepended if the day number is only one digit). - If they are not the same, `strptime` must have worked outside of the specification, and the date will be refused as invalid. - -```perl -sub format_date_strict( $str ) { - $str =~ s/ (?<=1)st | (?<=2)nd | (?<=3)rd | (?<=\d)th //x; - my $t = do { - try { Time::Piece->strptime( $str, "%d %b %Y" ) } - catch( $e ) { undef } - }; - return - $t && ( 1900 <= $t->year <= 2100 ) - && $t->strftime( "%d %b %Y" ) eq $str =~ s/^\d\s/0$&/r - ? $t->strftime( "%Y-%m-%d" ) - : "<invalid date>"; -} -``` - -Much better. - -But now I was wondering whether it would be too complicated to build the while solution myself... - -#### The Home-Brewed Solution - -For building all the translations and boundary checks ourselves, we need some lists and lookup tables.<br/> -We will need to look up the month number for the month's short name. Of course, using a hash is the proven solution for this. Instead of writing out all the indexes (month numbers), I let the program do that work and start with a list of month short names: - -```perl - my @month_names = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec ); -``` +> ``` +> tr/*SEARCHLIST*/*REPLACEMENTLIST*/cdsr +> ``` +> +> [...]<br/> +> An empty *REPLACEMENTLIST* is useful for counting characters in a class [...] -The lookup hash can then be generated, having in mind that an array start with index 0, but the first month has month number 1: +For this solution, I apply `tr` to the left and right parts, with upper case and lower case vowels as the *SEARCHLIST*. I use `map` to map the two parts to their respective number of vowels. -```perl - my %months = map { ( $month_names[$_] => $_ + 1 ) } keys @month_names; -``` +For the returned result, the two counts have to be equal. And at least one of them (it doesn't matter which one, as they are equal) has to be greater than zero. -We also need the list of days per month (the entry at index 0 has to be there, but can be ignored.<br/>The exceptions for leap days in February will be dealt with later: +This is my solution: ```perl - my @days_per_month = qw( 0 31 29 31 30 31 30 31 31 30 31 30 31 ); -``` - -The rest of the task is very similar to the previous solution, only the call to `strptime` is replaced by a regular expression for extracting day, month short name and year, followed by a lookup of the month number. - -Two additional checks are brought into place: - -* checking the day number against the number of days in the given month, -* and checking that we are not on `29th Feb`, or if we are, it is a valid leap year. - -Concluding the home-brewed solution: - -```perl -sub format_date_own( $str ) { - my @month_names = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec ); - my %months = map { ( $month_names[$_] => $_ + 1 ) } keys @month_names; - my @days_per_month = qw( 0 31 29 31 30 31 30 31 31 30 31 30 31 ); +use v5.36; - $str =~ s/ (?<=1)st | (?<=2)nd | (?<=3)rd | (?<=\d)th //x; - my ( $day, $month_name, $year ) = $str =~ /^(\d{1,2}) (...) (\d{4})$/; - my $month = $month_name && $months{$month_name}; - return - $year && ( 1900 <= $year <= 2100 ) - && $month && $day <= $days_per_month[$month] - && ( $month != 2 || $day != 29 - || ( $year % 4 == 0 && $year % 100 != 0 || $year % 1000 == 0 ) ) - ? sprintf( "%d-%02d-%02d", $year, $month, $day ) - : "<invalid date>"; +sub string_alike( $str ) { + my $half_length = length( $str ) / 2; + my ( $n_1, $n_2 ) = map tr/aeiouAEIOU//, + substr( $str, 0, $half_length ), + substr( $str, $half_length ); + return $n_1 > 0 && $n_2 == $n_1; } ``` -#### Testing Them All - -I have added quite a few additional test cases to the examples from the task description. - -For the Fair-Weather solution, all tests that have 'strict' in their name are run, but marked as 'To Do', to not count them as failures when they actually fail. - -These are all the tests. The implementation for running them (with `Test2::V0`) can be seen in the code. - -```perl -my @tests = ( - [ 'Example 1', '1st Jan 2025', '2025-01-01' ], - [ 'Example 2', '22nd Feb 2025', '2025-02-22' ], - [ 'Example 3', '15th Apr 2025', '2025-04-15' ], - [ 'Example 4', '23rd Oct 2025', '2025-10-23' ], - [ 'Example 5', '31st Dec 2025', '2025-12-31' ], - [ 'Strict Test 1 (boundaries)', '1st Jan 1900', '1900-01-01' ], - [ 'Strict Test 2 (boundaries)', '31st Dec 2100', '2100-12-31' ], - [ 'Strict test 3 (out of range)', '31st Dec 1899', '<invalid date>' ], - [ 'Strict test 4 (out of range)', '1st Jan 2101', '<invalid date>' ], - [ 'Strict test 5 (leap day)', '29th Feb 2000', '2000-02-29' ], - [ 'Strict test 6 (leap day)', '29th Feb 2004', '2004-02-29' ], - [ 'Strict test 7 (non-existing leap day)', '29th Feb 1900', '<invalid date>' ], - [ 'Strict test 8 (non-existing leap day)', '29th Feb 2001', '<invalid date>' ], - [ 'Strict test 9 (non-existing leap day)', '29th Feb 2100', '<invalid date>' ], - [ 'Strict test 10 (empty string)', '', '<invalid date>' ], - [ 'Strict test 11 (random non-date string', 'xxx', '<invalid date>' ], - [ 'Strict test 12 (invalid suffix)', '5st Dec 2025', '<invalid date>' ], - [ 'Strict test 13 (invalid lower case)', '1st jan 1970', '<invalid date>' ], - [ 'Strict test 14 (non-existing)', '35th Dec 2025', '<invalid date>' ], - [ 'Strict test 15 (non-existing)', '29th Feb 1900', '<invalid date>' ], - [ 'Strict test 16 (non-existing)', '29th Feb 2001', '<invalid date>' ], - [ 'Strict test 17 (non-existing)', '29th Feb 2100', '<invalid date>' ], -); -``` - - +## Task 2: Co[n]vert Time -## Task 2: Format Phone Number - -> You are given a phone number as a string containing digits, space and dash only.<br/> -> Write a script to format the given phone number using the below rules:<br/> -> 1. Removing all spaces and dashes<br/> -> 2. Grouping digits into blocks of length 3 from left to right<br/> -> 3. Handling the final digits (4 or fewer) specially:<br/> -> - 2 digits: one block of length 2<br/> -> - 3 digits: one block of length 3<br/> -> - 4 digits: two blocks of length 2<br/> -> 4. Joining all blocks with dashes -> +> You are given two strings, \$source and \$target, containing time in 24-hour time form.<br/> +> Write a script to convert the source into target by performing one of the following operations: +> +> ```text +> 1. Add 1 minute +> 2. Add 5 minutes +> 3. Add 15 minutes +> 4. Add 60 minutes +>``` +> +>Find the total operations needed to get to the target. +> > **Example 1** -> +> > ```text -> Input: $phone = "1-23-45-6" -> Output: "123-456" +>Input: $source = "02:30" +> $target = "02:45" +> Output: 1 +>Just one operation i.e. "Add 15 minutes". > ``` > > **Example 2** -> +> > ```text -> Input: $phone = "1234" -> Output: "12-34" -> ``` -> -> **Example 3** -> +> Input: $source = "11:55" +> $target = "12:15" +> Output: 2 +> Two operations i.e. "Add 15 minutes" followed by "Add 5 minutes". +>``` +> +>**Example 3** +> > ```text -> Input: $phone = "12 345-6789" -> Output: "123-456-789" +> Input: $source = "09:00" +> $target = "13:00" +>Output: 4 +> Four operations of "Add 60 minutes". > ``` > > **Example 4** > > ```text -> Input: $phone = "123 4567" -> Output: "123-45-67" -> ``` -> -> **Example 5** -> -> ```text -> Input: $phone = "123 456-78" -> Output: "123-456-78" +> Input: $source = "23:45" +> $target = "00:30" +> Output: 3 +>Three operations of "Add 15 minutes". > ``` +> +>**Example 5** +> +>```text +> Input: $source = "14:20" +> $target = "15:25" +> Output: 2 +> Two operations, one "Add 60 minutes" and one "Add 5 minutes" +>``` + +First we need to find the time difference between `$source` and `$target`, in minutes. For converting the time strings into a number of minutes, I use a regular expression of `/^(\d+):(\d+)/`, after which `$1` and `$2` contain the hour and the minute, respectively. The time in minutes then obviously is `( $1 * 60 ) + $2`. I use a `map` call to convert both `$source` and `$target` into `$source_min` and `$target_min`. -I start with removing all non-digit characters from the string, and then I collect groups of 3 digits, but also allowing for only 2 or 1 digit when we reach the end. +The time difference in minutes `$diff` then is `$target_min - $source_min`. If getting to the target time means crossing midnight, the difference will be negative. The easy way to deal with that is to just use the modulo operator with one whole day's number of minutes, like so: ` % ( 24 * 60 )`. This will turn a negative difference into the correct positive value. -If the last group has 3 or 2 digits, we can leave the groups as they are. Only if the last group has only one digit we need to 'borrow' the last digit from the previous group and prepend it to the one in the last group, so that we end up with two groups of 2 digits each. +For determining the number `$n` of operations needed, I use a `for` loop.<br/>With `$_` containing the operation values of `60`, `15` and `5` (in this descending order), the number of possible operations is `int( $diff / $_ )`. This number is added to the total number of operations in `$n`. -It's nice that we can easily access the last group with `$groups[-1]` and the second but last with `$groups[-2]`. And it also is nice and easy that we can remove the last character of the last group with<br/> -`substr( $groups[-1], -1, 1, "" )`<br/> -and directly put it in front of the second but last group with<br/>`substr( $groups[-2], 0, 0, ... )`. +Next, `$diff` needs to be diminished by the total value that these operations represent. Applying all operations with the value of `$_` at once means we reduce `$diff` to what is left, which we can do by just applying `$diff %= $_`. -So here we go: +I excluded the operation with the value of `1` from the loop, because obviously the number of operations with value `1` to cover what is left in `$diff` is the value of `$diff` itself, no divisions or modulo computations needed. The value of the remaining `$diff` can just be added to `$n` for the final result. + +Putting it together: ```perl use v5.36; -sub format_phone_number( $phone ) { - for ( $phone ) { - s/\D//g; - my @groups = /(..?.?)/g; - substr( $groups[-1], 0, 0, substr( $groups[-2], -1, 1, "" ) ) - if length( $groups[-1] ) == 1; - return join "-", @groups; - } +sub convert_time( $source, $target ) { + my ( $source_min, $target_min ) = + map { /(\d+):(\d+)/; ( $1 * 60 + $2 ) } $source, $target; + my $diff = ( $target_min - $source_min ) % ( 24 * 60 ); + my $n = 0; + for ( 60, 15, 5 ) { + $n += int( $diff / $_ ); + $diff %= $_; + }; + return $n + $diff; } ``` diff --git a/challenge-348/matthias-muth/blog.txt b/challenge-348/matthias-muth/blog.txt new file mode 100644 index 0000000000..34fa1b1957 --- /dev/null +++ b/challenge-348/matthias-muth/blog.txt @@ -0,0 +1 @@ +https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-348/challenge-348/matthias-muth#readme diff --git a/challenge-348/matthias-muth/perl/ch-1.pl b/challenge-348/matthias-muth/perl/ch-1.pl new file mode 100755 index 0000000000..26caf9dd99 --- /dev/null +++ b/challenge-348/matthias-muth/perl/ch-1.pl @@ -0,0 +1,34 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 348 Task 1: String Alike +# +# Perl solution by Matthias Muth. +# + +use v5.36; + +sub string_alike( $str ) { + my $half_length = length( $str ) / 2; + my ( $n_1, $n_2 ) = map tr/aeiouAEIOU//, + substr( $str, 0, $half_length ), + substr( $str, $half_length ); + return $n_1 > 0 && $n_2 == $n_1; +} + +use Test2::V0 qw( -no_srand ); + +is string_alike( "textbook" ), F, + 'Example 1: string_alike( "textbook" ) is false'; +is string_alike( "book" ), T, + 'Example 2: string_alike( "book" ) is true'; +is string_alike( "AbCdEfGh" ), T, + 'Example 3: string_alike( "AbCdEfGh" ) is true'; +is string_alike( "rhythmmyth" ), F, + 'Example 4: string_alike( "rhythmmyth" ) is false'; +is string_alike( "UmpireeAudio" ), F, + 'Example 5: string_alike( "UmpireeAudio" ) is false'; + +done_testing; diff --git a/challenge-348/matthias-muth/perl/ch-2.pl b/challenge-348/matthias-muth/perl/ch-2.pl new file mode 100755 index 0000000000..8536abeded --- /dev/null +++ b/challenge-348/matthias-muth/perl/ch-2.pl @@ -0,0 +1,38 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 348 Task 2: Co[n]vert Time +# +# Perl solution by Matthias Muth. +# + +use v5.36; + +sub convert_time( $source, $target ) { + my ( $source_min, $target_min ) = + map { /(\d+):(\d+)/; ( $1 * 60 + $2 ) } $source, $target; + my $diff = ( $target_min - $source_min ) % ( 24 * 60 ); + my $n = 0; + for ( 60, 15, 5 ) { + $n += int( $diff / $_ ); + $diff %= $_; + }; + return $n + $diff; +} + +use Test2::V0 qw( -no_srand ); + +is convert_time( "02:30", "02:45" ), 1, + 'Example 1: convert_time( "02:30", "02:45" ) == 1'; +is convert_time( "11:55", "12:15" ), 2, + 'Example 2: convert_time( "11:55", "12:15" ) == 2'; +is convert_time( "09:00", "13:00" ), 4, + 'Example 3: convert_time( "09:00", "13:00" ) == 4'; +is convert_time( "23:45", "00:30" ), 3, + 'Example 4: convert_time( "23:45", "00:30" ) == 3'; +is convert_time( "14:20", "15:25" ), 2, + 'Example 5: convert_time( "14:20", "15:25" ) == 2'; + +done_testing; |