PWC 231

PWC 231

Two easy challenges this week. It is tempting to try them in Perl 5, Raku as well as Julia, but alas, I don't have the time. So here goes Perl 5 only.

Challenge 1 (Min Max)

We are given a list of distinct integers and asked to return the elements that are neither the maximum nor the minimum. If there are no such elements, then return -1. That happens if the list length is 2 or less, in which case every element is perforce either a maximum or minimum or both.

I sort the list and return the elements between the head and the tail. I use PDL.

Here is the key subroutine:

sub min_max {    
    my $ints=pdl(@_)->uniqvec;
    ($ints->dim(0) > 2) ?
        ($ints->qsort->(1:(($ints->dim(0))-2))) :
        (-1);
}

Just in case the input is not a list of distinct integers, I force it to its unique elements using the PDL uniqvec method. I then check if the length is 2 or less, in which case we return -1, else we sort and return the sub-piddle between the head and tail.

Challenge 2 (Senior citizen)

We are given a list of strings where every string is in the format "#########<####" (the first 10 digits representing a phone number, 1 alphanumeric (presumably either 'M' or 'F') denoting sex, and 4 digits, the first two of which represent age, and the last two represent a seat number).

We are asked to count the number of elements that represent an age greater than or equal to 60.

One can use grep to extract and count the strings with ages greater than or equal to 60. Just in case, we can also check that each string is in the correct format using a regex. Here is the subroutine:

sub senior_citizens {
    #
    #-- helper sub sub
    local *validate_input = sub {
        $_[0] =~ m/^\d{10}[MF]{1}\d{4}$/;
    };
    #
    #-- back to trunk of sub
    scalar
    grep
    {
        (&validate_input($_)) &&
        (substr($_,11,2) >= 60);
    }
    @_;
}

A more idiomatic approach would be to avoid the &validate_input sub-subroutine, and directly put the regex into the grep as in:

    scalar grep
    {
        (m/^\d{10}[MF]{1}\d{4}$/) &&
        (substr($_,11,2) >= 60);
    }
    @_;

I realized while typing that that the two conditions can be combined. We can just check that the 11th position in the regex is a number in [6-9] like:

     scalar grep /^\d{10}[MF]{1}[6-9]{1}\d{3}$/, @_;

I kinda like sub-subroutines though, and it is more readable with one. So I will leave my original code as is. Also the sub-subroutine can easily be extended to throw an exception if invalid input is encountered. That is not so easy with the compact one-liner just above.

Comments

Post a Comment

Popular posts from this blog

PWC 227

PWC 227 Challenge 1 (Friday 13th) This challenge requires us to count the number of times Friday 13th occurs in a particular year. I use Date::Manip. This module probably has easier ways to do this using a Date Range, but my approach is easy enough. My &friday_13th subroutine takes the year as input, throws an exception if it is outside the specified range (1753 to 9999), and then cycles through the 13th of each month, counting the Fridays. use Date::Manip; my $dateobj=Date::Manip::Date->new(); sub friday_13th {     my ($year)=@_;     my $retval=0;     ( ($year > 9999) || ($year < 1753) ) &&         die "Year should be between 1753 and 9999";     map {         ( ($dateobj->new_date("$year-$_-13")->printf('%w') ) == 5 ) &&             $retval++;     }     1 .. 12;          $retval; }   Challenge 2 (Roman Maths) This challenge requires us to implement a calculator that parses infix math operations using roman numerals.  There
Read more

PWC 234

PWC 234 I tried to restrict to Perl 4 syntax for both challenges this week, as documented in Rex Swain's Perl 4 reference or the 1st edition of Programming perl. I do use nested subroutines, which I am not sure would actually work in Perl 4, though they comply with the syntax. My programs are tested on Perl 5.38. (The -l in the shebang line works only in Perl 5. The Perl 4 equivalent was -L012 in Unix, which is no longer available.) As I have mentioned before, my aims in using the old syntax are just mild nostalgia plus to add a bit of additional challenge to the task. I know that this is not the most efficient or idiomatic way to do things today. But I should observe that it is really cool that I am able to write code using 30-year old syntax, and run it unmodified on the latest Perl 5.38. You cannot do this with Python 3 for example. This very deep backward compatibility is one of those unsung underappreciated beauties of Perl 5. In my opinion, it is a very cool thing in
Read more

PWC 249

PWC 249 Challenge 1 (Equal pairs) We are given a list of integers with an even number of elements. We are asked to check if the list can be completely divided into sub-lists of size 2 with each sub-list containing the same integer repeated, like say (2,2). If so, we are asked to return the list of such sub-lists. This is straightforward in Perl 5. I use modern conveniences this time, though it could be done using only primitive Perl 4 syntax. Here is my subroutine. It returns a list of array references. local *equal_pairs = sub {     #-- return () if input is of odd length     ((scalar(@_) % 2) > 0) && (return ());          #-- count number of occurrences of each element using a hash     local %_ = ();     map {$_{$_}++} @_;          #-- if any element occurs an odd number of times, return ()     (grep {($_{$_} % 2) > 0} keys %_) && (return ());          #-- loop thru %_ keys, returning pairs of such keys     map {         my $k=$_;         my $num_pairs=( ($_{$k}
Read more