diff options
| -rw-r--r-- | challenge-205/matthias-muth/README.md | 184 | ||||
| -rwxr-xr-x | challenge-205/matthias-muth/ch-1-pre-5.25.1.pl | 32 | ||||
| -rwxr-xr-x | challenge-205/matthias-muth/ch-1.pl | 28 | ||||
| -rwxr-xr-x | challenge-205/matthias-muth/ch-2.pl | 43 |
4 files changed, 227 insertions, 60 deletions
diff --git a/challenge-205/matthias-muth/README.md b/challenge-205/matthias-muth/README.md index d88872a1d0..46a1b56108 100644 --- a/challenge-205/matthias-muth/README.md +++ b/challenge-205/matthias-muth/README.md @@ -1,79 +1,143 @@ -## Task 1: Monotonic Array +# Uniq anyone? +**Challenge 205 solutions in Perl by Matthias Muth** -Given an array of integers, the script is supposed to find out if the given -array is Monotonic, and print 1 if it is, and 0 otherwise. +## Task 1: Third Highest -My solution uses List::Util's `reduce` function, once to check for -monotone increasing and once for monotone decreasing. +> You are given an array of integers.<br/> +Write a script to find out the _Third Highest_ if found otherwise return the maximum. -In `reduce`, the code block is executed first for the first two elements of the -parameter list, then for its result and the third element, and so on for all -elements. -The idea is to pass on a kind of _status_ to the next code block execution -to indicate whether so far, all numbers have been monotone increasing -(or decreasing in the other call) or whether there was a mismatch. -That's easy -- we pass `undef` as a result once the chain is broken, -and once we have an `undef` we keep it until the end. -If all is still good, we pass the current value for comparison -with the next element in the next round. +Thinking about a solution I start at the end:<br/> +I imagine simply getting the result from the ordered list of input values -- just take the third value, and it there isn't any, take the first. So sort and return -- easy! -This looks like this: +But what if there are values that exist several times in the array? Actually we need to do a Unix style ``sort | uniq`` instead of just ``sort``. + +I recommend brian d foy's very nice article _How can I remove duplicate elements from a list or array?_ in the [Perl FAQ](https://perldoc.perl.org/perlfaq4#How-can-I-remove-duplicate-elements-from-a-list-or-array?). +These are his suggestions: + +* Use a hash. Like for example: +```perl +my %hash = map { $_, 1 } @array; +# or a hash slice: @hash{ @array } = (); +# or a foreach: $hash{$_} = 1 foreach ( @array ); + +my @unique = keys %hash; +``` + +The problem with this is that elements are returned in random order, completely unsorted. This means we would _first_ need to do the `unique` step, and _then_ the `sort`. +But now I want to know how to do a better `uniq`! + +* Try the `uniq` function in ``List::MoreUtils``. + +It's a pity that that module is not part of the core perl distribution, and I don't want to ask people to install CPAN modules just for getting the third highest of 3 or 4 numbers. :-) + +* Use a hash for remembering those elements that we have seen already. In the short version: + +```perl +my %seen = (); +my @unique = grep { ! $seen{ $_ }++ } @array; +``` +This keeps the order of elements intact, it only removes those that we already have.<br/> +This looks good! + +### But `uniq` is in `List::Util` now! + +As I was gathering ideas for other solutions using the `reduce` or `reductions` functions +from `List::Util` +(which *is* a core module!), +I stumbled over the `uniq` function in the [`List::Util` documentation](https://perldoc.perl.org/List::Util#uniq)! + +`Uniq` has been in `List::Util` since its version 1.44 (see [here](https://metacpan.org/dist/Scalar-List-Utils/changes)), which is part of perl version 5.25.1 (according to `$ corelist List::Util 1.44`), which was released on 2016-05-20 (using `$ corelist -r 5.25.1`). + +So for more current versions of perl the solution can look like this: + +```perl +use v5.25.1; +use strict; +use warnings; + +use List::Util qw( uniq ); + +sub third_highest { + my @a = uniq reverse sort @_; + return @a >= 3 ? $a[2] : $a[0]; +} +``` + +For older perl versions, we still can use this: + +```perl +use strict; +use warnings; + +sub uniq { + my %seen; + return grep { ! $seen{$_}++ } @_; +} + +sub third_highest { + my @a = uniq reverse sort @_; + return @a >= 3 ? $a[2] : $a[0]; +} +``` + +Great to have learned something from this challenge! + +## Task 2: Maximum XOR + +>You are given an array of integers.<br/> +>Write a script to find the highest value obtained by XORing any two distinct members of the array. + +'*XORing any two distinct members of the array*' we can do by XORing the first element with all others following it, then the second one with the ones following that one, and and so on until we have done it for all elements. +For every element, we do not need to XOR it with the elements preceding it, because those values we already have (using the fact that XOR is a commutative operation, so `( $a[$i] ^ $a[$j] )` is the same as `( $a[$j] ^ $a[$i] )` ). +And actually we don't need to take care of the last element in the list, because it has no successors to XOR with. + +So a straightforward solution looks like this: ```perl -sub monotonic { - return 1 - if reduce { ( defined $a && $a <= $b ) ? $b : undef } @_ - or reduce { ( defined $a && $a >= $b ) ? $b : undef } @_; - return 0; +sub max_xor { + my @all_xors; + for my $i ( 0 .. ( $#_ - 1 ) ) { + for my $j ( $i..$#_ ) { + push @all_xors, $_[$i] ^ $_[$j]; + } + }; + return max( @all_xors ); } ``` -I know that we waste some runtime by walking through all elements even once -we have found a mismatch, but I really like the conciseness of this solution -(it might be just for me personally, but I find it 'elegant'). +Ok. Very boring. -## Task 2: Reshape matrix +But we can replace the inner loop by a `map` call, to push all XOR results of one element in one operation. Like so: -Given a matrix ( _m_ x _n_ ) and two integers (_r_ and _c_), the script shall -reshape the given matrix in form ( _r_ x _c_ ) with the original values of the -given matrix. If it can’t reshape it shall print 0. +```perl +sub max_xor_2 { + my @all_xors; + for my $i ( 0..$#_ ) { + push @all_xors, map $_[$i] ^ $_[$_], $i..$#_; + }; + return max( @all_xors ); +} +``` -My approach is to create one linear array that contains all the elements of the -original matrix. Then assign the first _c_ elements to a new row of the -resulting matrix, while deleting them from the linear array. -The `slice`function offers itself -perfectly for doing ths in one step. -Repeat until the linear array is used up. +I haven't measured the run time for this, but I guess that the `map` call is quite a bit more efficient than writing out the `for` loop explicitly. +But how can we also get rid of the outer `for` loop? -This will result in a nice matrix only when we have exactly _r_ x _c_ elements, -so we check this condition first. +The problem is that it is not easy to do nested `map` calls in perl. +There is only one `$_` variable, and it is the one of the inner `map`. +That is why we still need the `$i` as a loop variable, to use it within the `map` code block. -Using _signatures_, this function does the job: +But sometimes we are lucky, in that we can 'encapsulate' the `map` call and get rid of the need for the inner `$_`. +Here, we can turn it into a one-line function: ```perl -sub reshape( $matrix, $r, $c ) { - my @all_elements = map @$_, @$matrix; - return undef - unless @all_elements == $r * $c; - my $reshaped = []; - push @$reshaped, [ splice @all_elements, 0, $c, () ] - while @all_elements; - return $reshaped; +sub xor_slice { return map $_[0] ^ $_, @_[1..$#_] } +sub max_xor3 { + return max( map xor_slice( @_[$_..$#_] ), 0 .. ( $#_ - 1 ) ); } ``` -Note that the function returns `undef` on failure. It is left up to the -caller to transform this into `0` for output. -I found this a better style, keeping the implementation part more -'Perl'ish and also making it easier to interpret the result for the caller. -Good to have everything output-related in just one place then. - -I have put a description of the examples into the script's _\_\_DATA\_\__ -section in a nice, readable form, together with their expected output. -The rest of the script reads the examples, runs one loop for -the example output and then another for running the test cases using -_Test::More_. -Perl has been my favorite language for doing this type of -'free-text-to-data-structures' transformation for a long time. - -It was fun to take part in the challenge! +No `for` loop anymore! +More efficient, I guess, and less boring! ;-) + + +**Thank you for the challenge!** diff --git a/challenge-205/matthias-muth/ch-1-pre-5.25.1.pl b/challenge-205/matthias-muth/ch-1-pre-5.25.1.pl new file mode 100755 index 0000000000..8256956f23 --- /dev/null +++ b/challenge-205/matthias-muth/ch-1-pre-5.25.1.pl @@ -0,0 +1,32 @@ +#!/usr/bin/env perl + +use v5.10; +use strict; +use warnings; + +sub uniq { + my %seen; + return grep { ! $seen{$_}++ } @_; +} + +sub third_highest { + my @a = uniq reverse sort @_; + return @a >= 3 ? $a[2] : $a[0]; +} + +use Test::More; + +my @tests = ( + [ [], undef ], + [ [ 6 ], 6 ], + [ [ 5, 3, 4 ], 3 ], + [ [ 5, 6 ], 6 ], + [ [ 5, 4, 4, 3 ], 3 ], +); + +for ( @tests ) { + is third_highest( @{$_->[0]} ), $_->[1], + "third_highest( @{$_->[0]} ) == " . ( $_->[1] // "undef" ); +} + +done_testing; diff --git a/challenge-205/matthias-muth/ch-1.pl b/challenge-205/matthias-muth/ch-1.pl new file mode 100755 index 0000000000..3f689d8773 --- /dev/null +++ b/challenge-205/matthias-muth/ch-1.pl @@ -0,0 +1,28 @@ +#!/usr/bin/env perl + +use v5.25.1; +use strict; +use warnings; + +use List::Util qw( uniq ); + +sub third_highest { + my @a = uniq reverse sort @_; + return @a >= 3 ? $a[2] : $a[0]; +} + +use Test::More; + +my @tests = ( + [ [], undef ], + [ [ 6 ], 6 ], + [ [ 5, 3, 4 ], 3 ], + [ [ 5, 6 ], 6 ], + [ [ 5, 4, 4, 3 ], 3 ], +); + +is third_highest( @{$_->[0]} ), $_->[1], + "third_highest( @{$_->[0]} ) == " . ( $_->[1] // "undef" ) + for @tests; + +done_testing; diff --git a/challenge-205/matthias-muth/ch-2.pl b/challenge-205/matthias-muth/ch-2.pl new file mode 100755 index 0000000000..b09d7e5aae --- /dev/null +++ b/challenge-205/matthias-muth/ch-2.pl @@ -0,0 +1,43 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +use List::Util qw( max ); + +sub max_xor { + my @all_xors; + for my $i ( 0 .. ( $#_ - 1 ) ) { + for my $j ( $i..$#_ ) { + push @all_xors, $_[$i] ^ $_[$j]; + } + }; + return max( @all_xors ); +} + +sub max_xor_2 { + my @all_xors; + for my $i ( 0..$#_ ) { + push @all_xors, map $_[$i] ^ $_[$_], $i..$#_; + }; + return max( @all_xors ); +} + +sub xor_slice { return map $_[0] ^ $_, @_[1..$#_] } +sub max_xor3 { + return max( map xor_slice( @_[$_..$#_] ), 0 .. ( $#_ - 1 ) ); +} + +use Test::More; + +my @tests = ( + [ [1,2,3,4,5,6,7], 7 ], + [ [2,4,1,3], 7 ], + [ [10,5,7,12,8], 15 ], +); + +is max_xor3( @{$_->[0]} ), $_->[1], + "third_highest( @{$_->[0]} ) == " . ( $_->[1] // "undef" ) + for @tests; + +done_testing; |