Perl Weekly Challenge: Week 289
Challenge 1:
Third Maximum
You are given an array of integers,
@ints.Write a script to find the third distinct maximum in the given array. If third maximum doesn’t exist then return the maximum number.
Example 1
Input: @ints = (5, 6, 4, 1)
Output: 4
The first distinct maximum is 6.
The second distinct maximum is 5.
The third distinct maximum is 4.
Example 2
Input: @ints = (4, 5)
Output: 5
In the given array, the third maximum doesn't exist therefore returns the maximum.
Example 3
Input: @ints = (1, 2, 2, 3)
Output: 1
The first distinct maximum is 3.
The second distinct maximum is 2.
The third distinct maximum is 1.
A Raku one-liner.
my @a = @*ARGS.sort.unique; say @a[*-3] // @a[*-1];
The array is input as the scripts' command-line arguments. These are .sort()ed and
duplicates are removed with .unique(). The result is assigned to a new array @a because I couldn't figure
out how to do the whole solution in one step. The second step is to say() the third element from the end of @a (i.e. the third maximum.) or if it doesn't exist (i.e that element is not defined,) the last element. The defined-or operator // makes the comparison.
Perl doesn't have .unique() so we supply our own like this:
sub unique(@list) {
my %elems;
for (@list) {
$elems{$_}++;
}
return (keys %elems);
}
It makes every element in the input list a key in the hash with the number of times it occurs, its' value. Returning the keys of this hash gives you the unique elements.
Now the rest of the script is just like Raku albeit split over two lines.
my @a = sort { $a <=> $b } unique(@ARGV);
say $a[-3] // $a[-1];
Unlike Raku, we have provide an explicit function to sort() to get the elements sorted numerically in the order
we want.
Challenge 2:
Contiguous Block
An Internet legend dating back to at least 2001 goes something like this:
Aoccdrnig to a rscheearch at Cmabrigde Uinervtisy, it deosn’t mttaer in waht oredr the ltteers in a wrod are, the olny iprmoetnt tihng is taht the frist and lsat ltteer be at the rghit pclae. The rset can be a toatl mses and you can sitll raed it wouthit porbelm. Tihs is bcuseae the huamn mnid deos not raed ervey lteter by istlef, but the wrod as a wlohe.
This supposed Cambridge research is unfortunately an urban legend. However, the effect has been studied. For example—and with a title that probably made the journal’s editor a little nervous—Raeding wrods with jubmled lettres: there is a cost by Rayner, White, et. al. looked at reading speed and comprehension of jumbled text.
Your task is to write a program that takes English text as its input and outputs a jumbled version as follows:
- The first and last letter of every word must stay the same
- The remaining letters in the word are scrambled in a random order (if that happens to be the original order, that is OK).
- Whitespace, punctuation, and capitalization must stay the same
- The order of words does not change, only the letters inside the word So, for example, “Perl” could become “Prel”, or stay as “Perl,” but it could not become “Pelr” or “lreP”.
I don’t know if this effect has been studied in other languages besides English, but please consider sharing your results if you try!
A one-liner once again.
@*ARGS[0].subst(/(\w)(\w+)(\w)/, { $0 ~ $1.comb.pick(*).join ~ $2 }, :g).say
We take the first command line argument and make substitutions to it using the subst() method. Its' first argument is a regular expression which matches every instance of three groups: a word character, a group of one or more word characters, and a final word character. This is so rules 1 and 3 in the spec can be followed. The third argument to .subst() is the :g or global adverb which applies the regular expression to every word in the string. The second argument is the substitution. The second match group is split into a list of
characters with .comb() which is then scrambled with .pick(*) and ,join()ed up again. The first and third groups (i.e. the first and final characters in the word) are appended to it. This procedure is done to every word
in the string and the result is output with .say().
Perl doesn't have .pick(*) so I decided to turn to shuffle() from the List::Util module. This requires adding use List::Util qw/ shuffle /; to the top of the script.
With that, it works pretty much the same as the Raku version.
$str =~ s/(\w)(\w+)(\w)/$1 . (join q{}, (shuffle split q{}, $2)) . $3/ge;
say $str;
Some syntactic differences are we are using the s/// operator rather than a method; match groups begin
from $1 rather than $0 and using code in the substitution requires the e adverb.