Perl Weekly Challenge: Week 231
Challenge 1:
Min Max
You are given an array of distinct integers.
Write a script to find all elements that is neither minimum nor maximum. Return -1 if you can’t.
Example 1
Input: @ints = (3, 2, 1, 4)
Output: (3, 2)
The minimum is 1 and maximum is 4 in the given array. So (3, 2) is neither min nor max.
Example 2
Input: @ints = (3, 1)
Output: -1
Example 3
Input: @ints = (2, 1, 3)
Output: (2)
The minimum is 1 and maximum is 3 in the given array. So 2 is neither min nor max.
This task is made considerably simpler by the fact that the integers are distinct. Both Raku and Perl support the concept of "array slices" so we can just numerically sort the input and leave out the first (minimum) and last (maximum) elements. In Raku it would look like this:
@*ARGS.sort[1..*-2].join(q{, }).say
However there are two things to note; given the input from example 1, the code above prints 2, 3 not 3, 2. In other words it
does not preserve the original order of elements. Secondly, given the input from example 2, it just prints a blank line rather
than -1 as the spec requires. So I came up with this slightly more verbose but still one line solution:
say @*ARGS.grep({$_ != @*ARGS.min && $_ != @*ARGS.max}).join(q{, })||-1
This time, .grep() is used to get all but the .min() and .max() elements which preserves the list order. Should the list be
empty, the || at the end ensures -1 is printed instead.
The Perl version rather stretches the definition of one-liner and will not help the reputation of this language as "line noise" but it works.
@a=sort{$a<=>$b}@ARGV;$min=$a[0];$max=$a[-1];$_=join q{, },grep{$_!=$min&&$_!=$max}@ARGV;say length?$_:-1
First a sorted version of the input is assigned to @a. This is used to find the minimum and maximum elements of the array.
Next, the minimum and maximum are removed from the (unsorted) input with grep(). Unfortunately it seems that say() in Perl does
not assign a false value to empty strings so I couldn't use the || trick from the Raku version. Instead the joined list of elements is assigned to $_ and length() is used to determine if it is empty or not. If it isn't -1 is printed as in Raku.
Challenge 2:
Senior Citizens
You are given a list of passenger details in the form “9999999999A1122”, where 9 denotes the phone number, A the sex, 1 the age and 2 the seat number.
Write a script to return the count of all senior citizens (age >= 60).
Example 1
Input: @list = ("7868190130M7522","5303914400F9211","9273338290F4010")
Ouput: 2
The age of the passengers in the given list are 75, 92 and 40.
So we have only 2 senior citizens.
Example 2
Input: @list = ("1313579440F2036","2921522980M5644")
Ouput: 0
As I am still more comfortable with Perl regular expressions than Raku ones, I'll show the Perl solution first.
say scalar grep {$_>=60} map {/.{11}(..)/} @ARGV
The input is transformed via map() and a regular expression. The first 10 characters of each input string are the phone number and the 11th is sex. We are not interested in these so the first part of the regular expression .{11} just skips over them.
The next two characters are interesting—the age so we extract them with (..). The rest of the input string (the seat number) is also not interesting. Now we have a list of ages. grep() is used filter out the ones which are 60 or above then scalar() is used to count how many over-60s we found and say() prints the result.
The Raku version looks like this:
@*ARGS.map({/.**11(..)/;$0}).grep({$_>=60}).elems.say
The key differences to note are that the general quantifier operator is ** not {} and references to capture groups start from
$0 not $1.