Perl Weekly Challenge 231.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 231.
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.
A simple solution may be obtained by first finding the minimum and the
maximum of the array and using them to filter the rest of the list. I
can use minmax from List::MoreUtils.
Example 1:
perl -MList::MoreUtils=minmax -E '
@x=@ARGV; ($l,$h)=minmax(@x); @y=grep {$_!=$l && $_!=$h} @x; say "(@x) -> ", join " ", @y?"(@y)":-1
' 3 2 1 4
Results:
(3 2 1 4) -> (3 2)
Example 2:
perl -MList::MoreUtils=minmax -E '
@x=@ARGV; ($l,$h)=minmax(@x); @y=grep {$_!=$l && $_!=$h} @x; say "(@x) -> ", join " ", @y?"(@y)":-1
' 3 1
Results:
(3 1) -> -1
Example 3:
perl -MList::MoreUtils=minmax -E '
@x=@ARGV; ($l,$h)=minmax(@x); @y=grep {$_!=$l && $_!=$h} @x; say "(@x) -> ", join " ", @y?"(@y)":-1
' 2 1 3
Results:
(2 1 3) -> (2)
Assuming that the list is really made of unique integers, and if I don’t care about the order of the result, I can just order the list and drop its first and last elements.
Examples:
perl -E '@x=sort @ARGV; shift @x; pop @x; say "(@ARGV) -> ", @x?"(@x)":-1;' 3 2 1 4
perl -E '@x=sort @ARGV; shift @x; pop @x; say "(@ARGV) -> ", @x?"(@x)":-1;' 3 1
perl -E '@x=sort @ARGV; shift @x; pop @x; say "(@ARGV) -> ", @x?"(@x)":-1;' 2 1 3
Results:
(3 2 1 4) -> (2 3)
(3 1) -> -1
(2 1 3) -> (2)
For the full code I go back to the first solution, as it is more permissive about repetitions.
1 # Perl weekly challenge 231
2 # Task 1: Min Max
3 #
4 # See https://wlmb.github.io/2023/08/20/PWC231/#task-1-min-max
5 use v5.36;
6 use List::MoreUtils qw(minmax);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 N1 [N2...]
9 to find all numbers Ni that are not minimum nor maximum.
10 FIN
11 my @in=@ARGV;
12 my ($low,$high)=minmax(@in);
13 my @out=grep {$_!=$low && $_!=$high} @in;
14 say "(@in) -> ", join " ", @out?"(@out)":-1
Example:
./ch-1.pl 3 2 1 4
./ch-1.pl 3 1
./ch-1.pl 2 1 3
Results:
(3 2 1 4) -> (3 2)
(3 1) -> -1
(2 1 3) -> (2)
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")
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
First I change the form to a RE to extract age.
perl -E '
$f="9999999999A1122"; $f=~s/[9A2]/./g;$f=~s/(1+)/($1)/; $f=~s/1/\\d/g; $f=~s/^(.*)$/^$1\$/; say $f;'
Results:
^...........(\d\d)..$
Now I use it, extract the ages and filter by age. Example 1:
perl -E 'say "@ARGV -> ", 0+grep {/^...........(\d\d)..$/; $1>=60} @ARGV
' 7868190130M7522 5303914400F9211 9273338290F4010
Results:
7868190130M7522 5303914400F9211 9273338290F4010 -> 2
Example 2:
perl -E 'say "@ARGV -> ", 0+grep {/^...........(\d\d)..$/; $1>=60} @ARGV
' 1313579440F2036 2921522980M5644
Results:
1313579440F2036 2921522980M5644 -> 0
Maybe its simpler to just unpack, ignoring the first 11 characters: Example 1:
perl -E 'say "@ARGV -> ", 0+grep {($x)=unpack "x11A2"; $x>=60} @ARGV
' 7868190130M7522 5303914400F9211 9273338290F4010
Results:
7868190130M7522 5303914400F9211 9273338290F4010 -> 2
The full code is:
1 # Perl weekly challenge 231
2 # Task 2: Senior Citizens
3 #
4 # See https://wlmb.github.io/2023/08/20/PWC231/#task-2-senior-citizens
5 use v5.36;
6 my $form="9999999999A1122";
7 $form=~s/[9A2]/./g; # Change form into a RE to obtain age. Change 9, A and 2 to any
8 $form=~s/(1+)/($1)/; # Capture 1's
9 $form=~s/1/\\d/g; # Change 1's to digits
10 $form=~s/^(.*)$/^$1\$/; # Add anchors
11 my $re=qr /$form/; # convert to actual RE
12 say "@ARGV -> ", 0+grep {/^...........(\d\d)..$/||die "Wrong format: $_"; $1>=60} @ARGV;
Examples:
./ch-2.pl 7868190130M7522 5303914400F9211 9273338290F4010
./ch-2.pl 1313579440F2036 2921522980M5644
Results:
7868190130M7522 5303914400F9211 9273338290F4010 -> 2
1313579440F2036 2921522980M5644 -> 0
Written on August 20, 2023