RabbitFarm

2023-08-21

Not the MinMax Count

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

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.

Solution


use v5.38;
sub not_min_max{
    my($minimum, $maximum);
    do{
        $minimum = $_ if !$minimum || $_ < $minimum;
        $maximum = $_ if !$maximum || $_ > $maximum;
    } for @_;
    my @r = grep { $_ ^ $minimum && $_ ^ $maximum } @_;
    return @r ^ 0 ? @r : -1;
}

MAIN:{
    say join q/, /, not_min_max 3, 2, 1, 4;
    say join q/, /, not_min_max 3, 1;
    say join q/, /, not_min_max 2, 1, 3;
}

Sample Run


$ perl perl/ch-1.pl 
3, 2
-1
2

Notes

Once we find the maximum and minimum values, we need to remove them. Just to be different I used the XOR ^ operator instead of !=. The effect is the same, a false (zero) value is returned if the values are identical, true (one) otherwise.

Part 2

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).

Solution


use v5.38;
sub count_senior_citizens{
    my $count = 0;
    do{
        my @a = unpack q/A10A1A2A2/, $_; 
        $count++ if $a[2] >= 60;
    } for @_;
    return $count;
}

MAIN:{
    say count_senior_citizens qw/7868190130M7522 5303914400F9211 9273338290F4010/;
    say count_senior_citizens qw/1313579440F2036 2921522980M5644/;
}

Sample Run


$ perl perl/ch-2.pl 
2
0

Notes

It isn't all that often you find a nice clean use of unpack! This seems to be a very nice opportunity: each passenger string has fixed field lengths.

The passenger strings themselves are just Perl scalar values. They are not, say, specially constructed strings via pack. To unpack an ordinary scalar we can just use As in the template string.

References

pack/unpack Templates

Challenge 231

posted at: 20:27 by: Adam Russell | path: /perl | permanent link to this entry