Another week, another Perl Weekly Challenge!
Task 1: Min Max
Submitted by: Mohammad S Anwar
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.
I’m taking some liberties with this one; it says to return -1 if there aren’t elements in the input array that are neither the minimum or the maximum. I’d prefer to return an empty list, but OK, I’ll do as it asks. But because the requested output cites both the minimum and maximum value, I figure the function I write should return those as well.
Which means returning multiple values from the function and unpacking them into individual variables, which Perl does very well. I whipped up this function to do the work being requested:
sub neither_min_nor_max {
my $min = min @_; # find the minimum value
my $max = max @_; # find the maximum value
# grep preserves the order of the array, it just
# passes along the elements that meet the criteria
my @neither = grep { $_ != $min && $_ != $max } @_;
if (@neither) {
# if we have elements, pass them back in an array reference
return ($min, $max, \@neither);
}
else {
# otherwise, pass back the requested -1
return ($min, $max, -1);
}
}
And calling that function and getting back three different values is easy-peasy:
my ($min, $max, $neither) = neither_min_nor_max(@ints);
Really, the rest of the code is presentation: making the output look like Mohammad asked for in stating the problem. However, I decided I didn’t want to present a single value by itself like he did in example 3: I wanted it to still have parenthesis so you could see that it was a value in an array.
#!/usr/bin/env perl
use v5.38;
use Lingua::EN::Inflexion qw( verb );
use List::Util qw( min max );
sub array_join {
return '(' . join(', ', @_) . ')';
}
sub neither_min_nor_max {
my $min = min @_; # find the minimum value
my $max = max @_; # find the maximum value
# grep preserves the order of the array, it just
# passes along the elements that meet the criteria
my @neither = grep { $_ != $min && $_ != $max } @_;
if (@neither) {
# if we have elements, pass them back in an array reference
return ($min, $max, \@neither);
}
else {
# otherwise, pass back the requested -1
return ($min, $max, -1);
}
}
sub solution {
my @ints = @_;
say 'Input: @ints = ' . array_join(@ints);
my ($min, $max, $neither) = neither_min_nor_max(@ints);
print 'Output: ';
if ( ref($neither) eq 'ARRAY' ) {
# if we were passed back an array reference,
# print it like an array
say array_join(@$neither);
# inflect the verb!
my $is = @$neither == 1
? verb('is')->singular(3)
: verb('is')->plural(3);
print "The minimum is $min and maximum is $max "
. "in the given array. ";
say "So " . array_join(@$neither)
. " $is neither min nor max.";
}
else {
# otherwise, print the value unadorned
say $neither;
}
}
say "Example 1:";
solution(3, 2, 1, 4);
say "";
say "Example 2:";
solution(3, 1);
say "";
say "Example 3:";
solution(2, 1, 3);
The Raku version:
#!/usr/bin/env raku
use v6;
sub neither_min_nor_max (*@ints where {$_.all ~~ Int}) {
my $min = @ints.min; # find the minimum value
my $max = @ints.max; # find the maximum value
# grep preserves the order of the array, it just
# passes along the elements that meet the criteria
my @neither = @ints.grep({ $_ != $min && $_ != $max });
if (@neither) {
# if we have elements, pass them back in an array reference
return $min, $max, @neither;
}
else {
# otherwise, pass back the requested -1
return $min, $max, -1;
}
}
sub solution (*@ints where {$_.all ~~ Int}) {
say 'Input: @ints = (' ~ @ints.join(', ') ~ ')';
my ($min, $max, $neither) = neither_min_nor_max(@ints);
print 'Output: ';
if ( $neither ~~ Array ) {
# if we were passed back an array reference,
# print it like an array
say '(' ~ $neither.join(', ') ~ ')';
# inflect the verb!
my $is = @$neither == 1 ?? 'is' !! 'are';
print "The minimum is $min and maximum is $max "
~ "in the given array. ";
say "So (" ~ $neither.join(', ')
~ ") $is neither min nor max.";
}
else {
# otherwise, print the value unadorned
say $neither;
}
}
say "Example 1:";
solution(3, 2, 1, 4);
say "";
say "Example 2:";
solution(3, 1);
say "";
say "Example 3:";
solution(2, 1, 3);
Task 2: Senior Citizens
Submitted by: Mohammad S Anwar
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")
Output: 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")
Output: 0
Now, I believe based on the first example, the second example should print the following after the 0 count: “The age of the passengers in the given list are 20 and 56. So we have 0 senior citizens.”
Looking at the meaty part of the problem (parsing the passenger details into their respective fields), there’s a few ways to do this. You could use the substr function:
sub passenger_details {
my $data = shift;
my $phone = substr($data, 0, 10);
my $sex = substr($data, 10, 1);
my $age = substr($data, 11, 2);
my $seat = substr($data, 13, 2);
return ($phone, $sex, $age, $seat);
}
Or you could extract the data using regular expressions:
sub passenger_details {
my $data = shift;
my($phone, $sex, $age, $seat) = $data
=~ /\A(\d{10})(\w)(\d{2})(\d{2})\z/;
return ($phone, $sex, $age, $seat);
}
But my mind went back to a really old function I used to use a lot back in the mid-aughts when my job was processing a lot of fixed-format text data: unpack.
sub passenger_details {
my $data = shift;
my($phone, $sex, $age, $seat) = unpack "A10A1A2A2", $data;
return ($phone, $sex, $age, $seat);
}
Because the data is all ASCII data, we just need the A format specifier followed by the length of the data we’re extracting. It’s a really great way to extract fixed-width data. In fact, looking at perlpacktut, it looks like the other options of substr and regular expressions are covered as well.
Combining this with the Lingua::EN::Inflexion tricks I discovered last week, we get:
#!/usr/bin/env perl
use v5.38;
use Lingua::EN::Inflexion qw( inflect wordlist );
sub quoted_array {
return '("' . join('", "', @_) . '")';
}
sub passenger_details {
my $data = shift;
my($phone, $sex, $age, $seat) = unpack "A10A1A2A2", $data;
return ($phone, $sex, $age, $seat);
}
sub ages_only {
return map {
my($phone, $sex, $age, $seat) = passenger_details($_);
$age
} @_;
}
sub count_senior_citizens {
my @seniors = grep { $_ >= 60} @_;
return scalar(@seniors);
}
sub solution {
my @list = @_;
say 'Input: ' . quoted_array(@list);
my @ages = ages_only(@list);
my $count = scalar(@ages);
my $senior_count = count_senior_citizens(@ages);
say "Output: $senior_count";
say "";
my $wordlist = wordlist(@ages);
say inflect "<#d:$count>The <N:age> of the <N:passenger> "
. "in the given list <V:is> $wordlist.";
say inflect "So we have <#n:$senior_count> "
. "senior <N:citizen>.";
}
say "Example 1:";
solution("7868190130M7522","5303914400F9211","9273338290F4010");
say "";
say "Example 2:";
solution("1313579440F2036","2921522980M5644");
say "";
say "Example 3:";
solution("5188675309F6002");
Yes, I added a third example to show what we get when there’s only one senior citizen.
Unfortunately, unpack in Raku is only available as an experimental method on the Blob (binary large object) role, so we’ll need to use another way to extract the fields from the fixed-width data. Let’s use regular expressions with named captures:
sub passenger_details (Str $data) {
$data ~~ /^ $<phone>=(\d ** 10) $<sex>=(\w ** 1)
$<age>=(\d ** 2) $<seat>=(\d ** 2) $/;
return (~$<phone>, ~$<sex>, ~$<age>, ~$<seat>);
}
I love how in Raku, all the regular expressions allow whitespace without having to specify extra qualifiers (like /x in Perl).
Anyway, this yields the following script in Raku:
#!/usr/bin/env raku
use v6;
use Lingua::Conjunction;
use Lingua::EN::Numbers;
sub quoted_list ( *@list ) {
# given a list, quote the elements and join them with commas
my @quoted = @list.map: { qq{"$_"} };
return @quoted.join(q{, });
}
sub passenger_details (Str $data) {
$data ~~ /^ $<phone>=(\d ** 10) $<sex>=(\w ** 1)
$<age>=(\d ** 2) $<seat>=(\d ** 2) $/;
return (~$<phone>, ~$<sex>, ~$<age>, ~$<seat>);
}
sub ages_only (*@list where {$_.all ~~ Str}) {
return @list.map: {
my ($phone, $sex, $age, $seat) = passenger_details($_);
$age.Int;
}
}
sub count_senior_citizens (*@list where {$_.all ~~ Int}) {
my @seniors = @list.grep: { $_ >= 60};
return @seniors.elems;
}
sub solution (*@list where {$_.all ~~ Str}) {
say 'Input: @list = (' ~ quoted_list(@list) ~ ')';
my @ages = ages_only(@list);
my $count = @ages.elems;
my $senior_count = count_senior_citizens(@ages);
say "Output: $senior_count";
say "";
my $str = "The age[|s] of the passenger[|s] "
~ "in the given list [is|are] |list|.";
say conjunction @ages, :$str;
my $no = $senior_count == 0 ?? 'no' !! $senior_count.Str;
my $citizens = $senior_count == 1 ?? 'citizen' !! 'citizens';
say "So we have $no senior $citizens.";
}
say "Example 1:";
solution("7868190130M7522","5303914400F9211","9273338290F4010");
say "";
say "Example 2:";
solution("1313579440F2036","2921522980M5644");
say "";
say "Example 3:";
solution("5188675309F6002");
Here’s my solutions in GItHub: https://github.com/packy/perlweeklychallenge-club/tree/master/challenge-231/packy-anderson