PWC 229

PWC 229

Challenge 1 (Lexicographic Order)

We are given a list of strings. We are asked to count the number of elements that are strings whose constituent characters are not all either in weakly monotonically ascending lexicographic order or weakly monotonically descending lexicographic order (i.e., component strings whose characters are NOT either all in ascending or all in descending dictionary order).

I use a sub-subroutine &is_sorted that checks if each string is sorted. If the string has less than 3 elements, then it is automatically sorted. Otherwise, we check the order of the first 2 elements, say either element 1 is (lexical) less than or equal to (le) element 2, or element 1 is greater than or equal to (ge) element 2. We proceed to loop through the remaining elements to verify that they have the same ordering relationship (le or ge) as the first two.

In the main part of the subroutine, we call &is_sorted on each string in the array (map), then extract the zeroes (not sorted) in the resulting array (grep), and return the length of the array of extracted zeros (scalar). 

Here is the subroutine:

sub lexicographic_order {
    #-- helper subroutine
    
    local *is_sorted = sub {
        my ($str)=@_;
        
        (length($str) < 3) && (return 1);
        
        my $op;
        ( substr($str,0,1) le substr($str,1,1) ) ?
        ($op = 'le') : ($op = 'ge');
        
        INSTRING: for my $x (2 .. (length($str)-1)) {
            my $test = ('\''. substr($str,$x-1,1) .'\' '. $op .' \''. substr($str,$x,1).'\'');
            
            unless (eval($test)) {
                return 0;
                last INSTRING;
            }
        }
        1;
    };
    
    
    #-- main trunk of subroutine
    my @str = @_;
    scalar grep /0/, map {&is_sorted($str[$_])} 0 .. $#str;
}

Challenge 2 (Two out of three)

We are given three arrays (presumably 3 arrayrefs in Perl 5). We are asked to extract a list of items that are elements of at least two out of the three arrays.

My solution is probably not the most efficient. I use three hashes to record membership in each of the three arrays. Then I use another hash %two_out_of_three to count elements in at least two out of three arrays. I loop through the keys of the membership hashes for the first two arrays in the input, recording in %two_out_of_three which of the keys also exists in one or both of the other membership hashes. Finally, we return the keys of %two_out_of_three.

Here is the subroutine:

sub two_out_of_three {
    #-- helper sub sub
    local *in_arry = sub {
        local @in_arry=@_;
        local %in_arry;
      
        map {
            $in_arry{$_}=1;
        } @in_arry;
        %in_arry;
    };
    
    #-- main trunk of sub
    my ($ra1, $ra2, $ra3)=@_;
    
    my %rh1 = &in_arry($ra1->@*);
    my %rh2 = &in_arry($ra2->@*);
    my %rh3 = &in_arry($ra3->@*);
    
    my %two_out_of_three;
    
    map {( (exists $rh2{$_}) || (exists $rh3{$_}) ) &&
     ($two_out_of_three{$_}=1);} keys %rh1;
    map {( (exists $rh1{$_}) || (exists $rh3{$_}) ) &&
     ($two_out_of_three{$_}=1);} keys %rh2;

    keys %two_out_of_three;
}

I probably should have called the membership hashes %hash1, %hash2, etc., rather than %rh1, %rh2, etc. since I usually use the rh prefix as Hungarian notation to signify a hashref. I'll leave this minor inconsistency. 

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