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

(Full code on Github.)

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

(Full code on Github.)

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

(Full code on Github.)

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:


(Full code on Github.)

The key differences to note are that the general quantifier operator is ** not {} and references to capture groups start from $0 not $1.