diff options
| -rw-r--r-- | challenge-279/matthias-muth/README.md | 151 | ||||
| -rw-r--r-- | challenge-279/matthias-muth/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-279/matthias-muth/perl/ch-1.pl | 60 | ||||
| -rwxr-xr-x | challenge-279/matthias-muth/perl/ch-2.pl | 31 |
4 files changed, 239 insertions, 4 deletions
diff --git a/challenge-279/matthias-muth/README.md b/challenge-279/matthias-muth/README.md index 7c0dfe3387..5df0c1440c 100644 --- a/challenge-279/matthias-muth/README.md +++ b/challenge-279/matthias-muth/README.md @@ -1,5 +1,148 @@ -**Challenge 277 solutions in Perl by Matthias Muth** -<br/> -(no blog post this time...) +# More Weight for Examples! -**Thank you for the challenge!** +**Challenge 279 solutions in Perl by Matthias Muth** + +## Task 1: Sort Letters + +> You are given two arrays, @letters and @weights.<br/> +> Write a script to sort the given array @letters based on the @weights.<br/> +> <br/> +> Example 1<br/> +> Input: @letters = ('R', 'E', 'P', 'L')<br/> +> @weights = (3, 2, 1, 4)<br/> +> Output: PERL<br/> +> <br/> +> Example 2<br/> +> Input: @letters = ('A', 'U', 'R', 'K')<br/> +> @weights = (2, 4, 1, 3)<br/> +> Output: RAKU<br/> +> <br/> +> Example 3<br/> +> Input: @letters = ('O', 'H', 'Y', 'N', 'P', 'T')<br/> +> @weights = (5, 4, 2, 6, 1, 3)<br/> +> Output: PYTHON<br/> + +Probably the most efficient way to solve this task is *not* to use sort, +but to directly assign letters to their positions in the result string. +This works for all the examples, +because in these examples, the `@weights` are very regular: + +- they can be mapped one-by-one to result positions, +- no weight appears twice, +- the weights cover all positions completely. + +Actually, at least for the examples, `@weights` should be called `@positions` +(minding that they are one-based, not zero-based). + +So here's the simple version, to cover the examples.<br/> +We need to initialize the result string to have the correct length, +because we will assign letters to positions in random order. + +```perl +use v5.36; + +sub sort_letters_1( $letters, $weights ) { + my $result = " " x $letters->@*; + substr $result, $weights->[$_] - 1, 1, $letters->[$_] + for 0..$letters->$#*; + return $result; +} +``` + + + +**What if the weights were not as regular as they are in the examples?** + +We should consider cases where weights do *not* map one-by-one to positions.<br/> +Let's put some 'heavier weights' in, and consider this additional example: + +> Example 4<br/> +> Input: @letters = ('R', 'E', 'P', 'L')<br/> +> @weights = (3333, 2222, 1111, 3333)<br/> +> Output: PERL<br/> + + Here: + +* the lowest weight is not 1, +* weights are not consecutive (they contain gaps), +* same weight values are used more than once for different letters<br/>(behavior is not defined in this case, but we should do something useful), + +* the weight values are not necessarily small integers<br/>(which can cause memory problems when we incautiously map weight values to string positions or array indexes). + +So what do we do? + +My ideas are these: + +* Use the weight values as hash keys instead of string positions or array indexes to store where any letter is going to be put.<br/> + This addresses both the 'not consecutive' and the 'no small integers' issues. + We can have a weight of 6548632 without running out of bounds as we would with a string or an array. +* Store a *list* of letters with each 'weight' hash key.<br/>This deals with the case of multiple letters having the same weight value. + Every hash entry will contain an array-ref to a list of all letters having that weight. + +I'm also happy to highlight the `for_list` Perl feature +that was added in Perl 5.36 for iterating over multiple values at a time. +Especially its use together with the `mesh` function from `List::Util` +makes some things simple and nice.<br/> +Where normally I would have to iterate over `0..$#array`, +I can avoid this here, as well as the use of `$_` in the loop.<br/> +Certainly less 'perlish', but easy for the eyes! + +To get the result string from the hash, we sort the hash keys (numerically!) +and concatenate all letters from their entries in order.<br/> +Like this: + +```perl +use v5.36; +no warnings 'experimental::for_list'; +use List::Util qw( mesh ); + +sub sort_letters( $letters, $weights ) { + my %buckets; + for my ( $letter, $weight ) ( mesh $letters, $weights ) { + push $buckets{$weight}->@*, $letter; + } + return join "", map $buckets{$_}->@*, sort { $a <=> $b } keys %buckets; +} +``` + + + +## Task 2: Split String + +> You are given a string, \$str.<br/> +> Write a script to split the given string into two containing exactly same number of vowels and return true if you can otherwise false.<br/> +> <br/> +> Example 1<br/> +> Input: \$str = "perl"<br/> +> Ouput: false<br/> +> <br/> +> Example 2<br/> +> Input: \$str = "book"<br/> +> Ouput: true<br/> +> Two possible strings "bo" and "ok" containing exactly one vowel each.<br/> +> <br/> +> Example 3<br/> +> Input: \$str = "good morning"<br/> +> Ouput: true<br/> +> Two possible strings "good " and "morning" containing two vowels each or "good m" and "orning" containing two vowels each.<br/> + +Actually the task assignment 'split the given string into two containing exactly same number of vowels' can be completely ignored. The result is never used. It's like a piece of 'dead code' that never gets executed and that can be removed. + +The only information we need to return is whether *we can* split the string into two such pieces! + +We can do so if and only if we can split up the string's *vowels* into two equal pieces.<br/> +Which means we need an even number of vowels. + +Ok, then let's count the vowels! +And the rest is easy... + +```perl +use v5.36; + +sub split_string( $str ) { + my @vowels = $str =~ /[aeiou]/ig; + return scalar @vowels % 2 == 0; +} +``` + +#### **Thank you for the challenge!** diff --git a/challenge-279/matthias-muth/blog.txt b/challenge-279/matthias-muth/blog.txt new file mode 100644 index 0000000000..d10c3f00f1 --- /dev/null +++ b/challenge-279/matthias-muth/blog.txt @@ -0,0 +1 @@ +https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-279/challenge-279/matthias-muth#readme diff --git a/challenge-279/matthias-muth/perl/ch-1.pl b/challenge-279/matthias-muth/perl/ch-1.pl new file mode 100755 index 0000000000..938a5e0f3d --- /dev/null +++ b/challenge-279/matthias-muth/perl/ch-1.pl @@ -0,0 +1,60 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 279 Task 1: Sort Letters +# +# Perl solution by Matthias Muth. +# + +use v5.36; +no warnings 'experimental::for_list'; + +use List::Util qw( mesh ); + +sub sort_letters_1( $letters, $weights ) { + my @ordered_letters; + for my ( $letter, $weight ) ( mesh $letters, $weights ) { + # Ordered letters are 0-based, while weights are 1-based. + $ordered_letters[ $weight - 1 ] = $letter; + } + return join "", @ordered_letters; +} + +sub sort_letters_2( $letters, $weights ) { + my $result = " " x $letters->@*; + for my ( $letter, $weight ) ( mesh $letters, $weights ) { + # Letter positions are 0-based, while weights are 1-based. + substr $result, $weight - 1, 1, $letter; + } + return $result; +} + +sub sort_letters_3( $letters, $weights ) { + # Note that weights are 1-based, while letter positions are 0-based. + my $result = " " x $letters->@*; + substr $result, $weights->[$_] - 1, 1, $letters->[$_] + for 0..$letters->$#*; + return $result; +} + +sub sort_letters( $letters, $weights ) { + my %buckets; + for my ( $letter, $weight ) ( mesh $letters, $weights ) { + push $buckets{$weight}->@*, $letter; + } + return join "", map $buckets{$_}->@*, sort { $a <=> $b } keys %buckets; +} + + +use Test2::V0 qw( -no_srand ); +is sort_letters( ["R", "E", "P", "L"], [3, 2, 1, 4] ), "PERL", + 'Example 1: sort_letters( ["R", "E", "P", "L"], [3, 2, 1, 4] ) == "PERL"'; +is sort_letters( ["A", "U", "R", "K"], [2, 4, 1, 3] ), "RAKU", + 'Example 2: sort_letters( ["A", "U", "R", "K"], [2, 4, 1, 3] ) == "RAKU"'; +is sort_letters( ["O", "H", "Y", "N", "P", "T"], [5, 4, 2, 6, 1, 3] ), "PYTHON", + 'Example 3: sort_letters( ["O", "H", "Y", "N", "P", "T"], [5, 4, 2, 6, 1, 3] ) == "PYTHON"'; +is sort_letters( ["R", "E", "P", "L"], [33, 22, 11, 33] ), "PERL", + 'Test 1: sort_letters( ["R", "E", "P", "L"], [33, 22, 11, 33] ) == "PERL"'; +done_testing; diff --git a/challenge-279/matthias-muth/perl/ch-2.pl b/challenge-279/matthias-muth/perl/ch-2.pl new file mode 100755 index 0000000000..b651ff125c --- /dev/null +++ b/challenge-279/matthias-muth/perl/ch-2.pl @@ -0,0 +1,31 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 279 Task 2: Split String +# +# Perl solution by Matthias Muth. +# + +use v5.36; + +use Data::Dump qw( pp ); + +sub split_string( $str ) { + # say pp scalar( () = $str =~ /[aeiou]/ig ) % 2 == 0; + # say pp [ $str =~ /[aeiou]/ig ]->@* % 2 == 0; + # say pp $str =~ tr/aeiouAEIOU/aeiouAEIOU/ % 2 == 0; + + my @vowels = $str =~ /[aeiou]/ig; + return scalar @vowels % 2 == 0; +} + +use Test2::V0 qw( -no_srand ); +ok ! split_string( "perl" ), + 'Example 1: split_string( "perl" ) is false'; +ok split_string( "book" ), + 'Example 2: split_string( "book" ) is true'; +ok split_string( "good morning" ), + 'Example 3: split_string( "good morning" ) is true'; +done_testing; |
