diff options
| -rw-r--r-- | challenge-273/matthias-muth/README.md | 233 | ||||
| -rw-r--r-- | challenge-273/matthias-muth/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-273/matthias-muth/perl/ch-1.pl | 33 | ||||
| -rwxr-xr-x | challenge-273/matthias-muth/perl/ch-2.pl | 26 |
4 files changed, 169 insertions, 124 deletions
diff --git a/challenge-273/matthias-muth/README.md b/challenge-273/matthias-muth/README.md index b6be3e1c69..2ac802b1c1 100644 --- a/challenge-273/matthias-muth/README.md +++ b/challenge-273/matthias-muth/README.md @@ -1,157 +1,142 @@ -# A Half Liner and a Full One +# Percentages and the 'BnoA' Regex -**Challenge 272 solutions in Perl by Matthias Muth** +**Challenge 273 solutions in Perl by Matthias Muth** -## Task 1: Defang IP Address +## Task 1: Percentage of Character -> You are given a valid IPv4 address.<br/> -> Write a script to return the defanged version of the given IP address.<br/> -> A defanged IP address replaces every period “.” with “[.]".<br/> +> You are given a string, \$str and a character \$char.<br/> +> Write a script to return the percentage, nearest whole, of given character in the given string.<br/> > <br/> > Example 1<br/> -> Input: \$ip = "1.1.1.1"<br/> -> Output: "1[.]1[.]1[.]1"<br/> +> Input: \$str = "perl", \$char = "e"<br/> +> Output: 25<br/> > <br/> > Example 2<br/> -> Input: \$ip = "255.101.1.0"<br/> -> Output: "255[.]101[.]1[.]0"<br/> +> Input: \$str = "java", \$char = "a"<br/> +> Output: 50<br/> +> <br/> +> Example 3<br/> +> Input: \$str = "python", \$char = "m"<br/> +> Output: 0<br/> +> <br/> +> Example 4<br/> +> Input: \$str = "ada", \$char = "a"<br/> +> Output: 67<br/> +> <br/> +> Example 5<br/> +> Input: \$str = "ballerina", \$char = "l"<br/> +> Output: 22<br/> +> <br/> +> Example 6<br/> +> Input: \$str = "analitik", \$char = "k"<br/> +> Output: 13<br/> + +We need the number of times that the `$char` character appears in the `$str` string. +So let's count character frequencies. Just like we always do: + +```perl +my %freq; +++$freq{$_} + for split "", $str; +``` -This task offers a good opportunity to demonstrate the `r` flag of the `s/<PATTERN>/<REPLACEMENT>/<FLAGS>` -regex substitution operator. +The percentage that we need is the number of `$char` characters +divided by the total number of characters in `$str`. +We need to be careful about the character not being present at all, +in which case `$freq{ $char }` is `undef`. +I guess every Perl programmer likes Perl's 'Logical Defined-Or' operator! :-) -In fact it's the only thing we need to solve this task! + ```perl + ( $freq{ $char } // 0 ) / length( $str ) + ``` -The `r` flag has been around since Perl version 5.14, so since 2011.<br/> -It causes the `s///` operator to *not* change the string that is operating on, as it normally does, -but ***r**eturn* the resulting string with the substitutions made.<br/> -It makes things easier a lot of times. +For rounding towards the nearest integer, there are at least these three ways to go: -In this case, all we need to do is to replace every single dot -(we surely won't forget to use a backslash for escaping its special meaning!) -by the string `[.]` -(no escaping needed in the replacement pattern).<br/> -We also use the `g` flag to do a **g**lobal replacement of all the dots we find. +- `use POSIX qw( round );` -I would call this a 'half liner': + Loading the `POSIX` module seems like a big overhead + for just rounding a floating point number.<br/> + So let's look for something else. + +- `printf( "%.0f", <number> )` + + This is the solution that is suggested by the [Perl FAQ](https://perldoc.perl.org/perlfaq4#Does-Perl-have-a-round()-function%3F-What-about-ceil()-and-floor()%3F-Trig-functions%3F).<br/> + Looks much better, but there's still a lot of work behind the scenes + for a simple operation on a number.<br/> + I would not use it if performance is an issue. + +- `int( <number> + 0.5 )` + + Very simple, very basic. This is the rounding I got taught in school.<br/> + It's my favorite solution *but only if* it is not for any financial or banking application. + Check in the [Perl FAQ](https://perldoc.perl.org/perlfaq4#Does-Perl-have-a-round()-function%3F-What-about-ceil()-and-floor()%3F-Trig-functions%3F) again to see why. + +Putting it all together: ```perl use v5.36; -sub defang_ip_address( $ip ) { - return $ip =~ s/\./[.]/gr; +sub percentage_of_character( $str, $char ) { + my %freq; + ++$freq{$_} + for split "", $str; + return int( 100 * ( $freq{$char} // 0 ) / length( $str ) + 0.5 ); } ``` -## Task 2: String Score +## Task 2: B After A > You are given a string, \$str.<br/> -> Write a script to return the score of the given string.<br/> -> The score of a string is defined as the sum of the absolute difference between the ASCII values of adjacent characters.<br/> +> Write a script to return true if there is at least one b, and no a appears after the first b.<br/> +> <br/> +> Example 1<br/> +> Input: \$str = "aabb"<br/> +> Output: true<br/> +> <br/> +> Example 2<br/> +> Input: \$str = "abab"<br/> +> Output: false<br/> +> <br/> +> Example 3<br/> +> Input: \$str = "aaa"<br/> +> Output: false<br/> > <br/> +> Example 4<br/> +> Input: \$str = "bbb"<br/> +> Output: true<br/> -> **Example 1** +What a great task for demonstrating how simple things can be with regular expressions! -> Input: \$str = "hello"<br/> -> Output: 13<br/> -> ASCII values of characters:<br/> -> h = 104<br/> -> e = 101<br/> -> l = 108<br/> -> l = 108<br/> -> o = 111<br/> -> Score => |104 - 101| + |101 - 108| + |108 - 108| + |108 - 111|<br/> -> => 3 + 7 + 0 + 3<br/> -> => 13<br/> -> <br/> +We need at least one `b`: -> **Example 2** - -> Input: \$str = "perl"<br/> -> Output: 30<br/> -> ASCII values of characters:<br/> -> p = 112<br/> -> e = 101<br/> -> r = 114<br/> -> l = 108<br/> -> Score => |112 - 101| + |101 - 114| + |114 - 108|<br/> -> => 11 + 13 + 6<br/> -> => 30<br/> - -> **Example 3** - -> Input: \$str = "raku"<br/> -> Output: 37<br/> -> ASCII values of characters:<br/> -> r = 114<br/> -> a = 97<br/> -> k = 107<br/> -> u = 117<br/> -> Score => |114 - 97| + |97 - 107| + |107 - 117|<br/> -> => 17 + 10 + 10<br/> -> => 37<br/> - -Let's split up this task into small parts of what we need to do: - -* We need to split up the string into a list of characters: - - `my @characters = split "", $str;` - -* We need to get the ASCII value of characters. - - That's easy, there is the `ord` function for this. - -* We need to compute 'the absolute difference between the ASCII values of two characters'. - - This will look like `abs( ord( $a ) - ord( $b ) )` if we have the two characters in `$a` and `$b`. - -* We need to get the differences between all *adjacent* characters. - - Now we could do this in a loop.<br/> - We would use indexes from 0 to the second but last, or from 1 to the last, - because we need to compare two elements in each iteration, with indexes `i` and `i + 1` (or `i` and `i - 1`). - - That could look like this: - - ```perl - my $sum = 0; - for ( 0 .. $#characters - 1 ) { - $sum += abs( ord( $characters[$_] ) - ord( $characters[ $_ + 1 ] ) ); - } - ``` - - Instead of the loop, we could also use `map` to get the values, and sum everything up using `sum` from `List::Util`: - ```perl - my $sum = sum( - map abs( ord( $characters[$_] ) - ord( $characters[ $_ + 1 ] ) ), - 0 .. $#characters - 1 - ); - ``` - - But there is an even simpler solution! - - We can use the `slide` function from `List::MoreUtils`, - which does exactly what we need: - loop over adjacent elements of a list. - - This reduces our code drastically: - - ```perl - my $sum = sum( slide { abs( ord( $a ) - ord( $b ) ) } @characters ); - ``` - -Now that we have all the parts, and we don't need a loop, -we can even put everything together into one single statement, -which results in this final version: +```perl +/b/ +``` + +But we need to make sure it's the *first* `b`. +So there must be no other `b` before the one we are looking for.<br/> +Let's use the `x` flag to keep it more readable: ```perl -use v5.36; +/^ [^b]* b /x +``` -use List::Util qw( sum ); -use List::MoreUtils qw( slide ); +Next, we need to check that there is no `a` after that `b` until we reach the end of the string. -sub string_score( $str ) { - return sum( slide { abs( ord( $a ) - ord( $b ) ) } split "", $str ); +```perl +/^ [^b]* b [^a]* $/x +``` + +And putting it all together: + +```perl +use v5.36; + +sub b_after_a( $str ) { + return $str =~ /^ [^b]* b [^a]* $/x; } ``` +That's all we need! + #### **Thank you for the challenge!** diff --git a/challenge-273/matthias-muth/blog.txt b/challenge-273/matthias-muth/blog.txt new file mode 100644 index 0000000000..2abf1237f2 --- /dev/null +++ b/challenge-273/matthias-muth/blog.txt @@ -0,0 +1 @@ +https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-273/challenge-273/matthias-muth#readme diff --git a/challenge-273/matthias-muth/perl/ch-1.pl b/challenge-273/matthias-muth/perl/ch-1.pl new file mode 100755 index 0000000000..e0b074797a --- /dev/null +++ b/challenge-273/matthias-muth/perl/ch-1.pl @@ -0,0 +1,33 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 273 Task 1: Percentage of Character +# +# Perl solution by Matthias Muth. +# + +use v5.36; + +sub percentage_of_character( $str, $char ) { + my %freq; + ++$freq{$_} + for split "", $str; + return int( 100 * ( $freq{$char} // 0 ) / length( $str ) + 0.5 ); +} + +use Test2::V0 qw( -no_srand ); +is percentage_of_character( "perl", "e" ), 25, + 'Example 1: percentage_of_character( "perl", "e" ) == 25'; +is percentage_of_character( "java", "a" ), 50, + 'Example 2: percentage_of_character( "java", "a" ) == 50'; +is percentage_of_character( "python", "m" ), 0, + 'Example 3: percentage_of_character( "python", "m" ) == 0'; +is percentage_of_character( "ada", "a" ), 67, + 'Example 4: percentage_of_character( "ada", "a" ) == 67'; +is percentage_of_character( "ballerina", "l" ), 22, + 'Example 5: percentage_of_character( "ballerina", "l" ) == 22'; +is percentage_of_character( "analitik", "k" ), 13, + 'Example 6: percentage_of_character( "analitik", "k" ) == 13'; +done_testing; diff --git a/challenge-273/matthias-muth/perl/ch-2.pl b/challenge-273/matthias-muth/perl/ch-2.pl new file mode 100755 index 0000000000..d67c41572e --- /dev/null +++ b/challenge-273/matthias-muth/perl/ch-2.pl @@ -0,0 +1,26 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 273 Task 2: B After A +# +# Perl solution by Matthias Muth. +# + +use v5.36; + +sub b_after_a( $str ) { + return $str =~ /^ [^b]* b [^a]* $/x; +} + +use Test2::V0 qw( -no_srand ); +ok b_after_a( "aabb" ), + 'Example 1: b_after_a( "aabb" ) is true'; +ok ! b_after_a( "abab" ), + 'Example 2: b_after_a( "abab" ) is false'; +ok ! b_after_a( "aaa" ), + 'Example 3: b_after_a( "aaa" ) is false'; +ok b_after_a( "bbb" ), + 'Example 4: b_after_a( "bbb" ) is true'; +done_testing; |