steve-g-lynn

PWC 250 Disclaimer on earlier "Perl 4" attempts In my previous challenges, I often mentioned sticking to Perl 4 syntax. I did not actually have Perl 4, so could not test on that platform.  Recently, I did manage to find an old MS-DOS executable of Perl 4.019 that I can run in DOSBOX. I quickly found that my "Perl 4" answers to earlier challenges will not run in Perl 4. Particularly, my habit of using "local * xxx = sub { ...};" to create a localized sub will not work on Perl 4. Firstly, the "local" keyword must be used with a bracketed list of arguments, as local (*x, ...). The statement form "local *x," gives a syntax error. Secondly, the sub keyword cannot appear on the right-hand-side of an assignment. Syntax error again even with "local (*x)=sub {..};" . Looks like this facility to assign a sub to a local glob only became available in Perl 5. In Perl 4, looks like subroutines always had to be global or package-level in sco

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}

PWC 248 I use PDL with Inline:Pdlpp for both challenges this week. I found these docs helpful: the perldocs on PDL::PP and PDL::API , the chapter on PP in the PDL book, and the Practical Magic guide to using PP. Challenge 2 (submatrix sum) We are given a matrix, say A, with M columns and N rows. We are asked to find a matrix, say B, with M-1 columns and N-1 rows, such that the entry for column i and row j of B, or B(i,j) using column-first notation is given by: B(i,j) = A(i,j)+A(i,j+1)+A(i+1,j+1)+A(i+1,j) With PP, we write XS code which uses a traditional pair of nested loops to create B. Here is the PP definition: pp_def('submatrix_sum',     Pars => 'a(m,n); [o]b(p,q);',     RedoDimsCode => '$SIZE(p)=$SIZE(m)-1; $SIZE(q)=$SIZE(n)-1;',     Code => q{         PDL_Indx i, j, m_size, n_size;         m_size=$SIZE(m)-1;         n_size=$SIZE(n)-1;         for (i=0; i < m_size; i++) {             for (j=0; j < n_size; j++) {                 $b(p=>

PWC 247 Two easy challenges this week. I attempt to do both using only the core Perl 5 syntax inherited from Perl 4. ( Update and disclaimer : These programs will not work on Perl 4 as I discovered later when I found and installed a Perl 4.019 executable. For one thing, the ability to assign a subroutine to a locally scoped typeglob was not available in Perl 4.) Challenge 1 (Secret Santa) We are given a list of surnames, some of them repeated (representing different members of the same family). We are asked to create a scheme indicating who in the list gives gifts to who else, avoiding family members giving gifts within the family if possible. I go through the input list using a hash to count the number of occurrences of each surname, and then append the hash count to the surname and store this in another list say @secret_santa, so that for example the second occurrence of 'Anwar' is recorded as 'Anwar_2'. I then sort the @secret_santa list twice in opposite directions

PWC 246 For both challenges, I adopt conservative syntax and a procedural programming style mostly skewing towards the Perl 4.036 specification in Programming Perl 1e (pink camel). This is not Perl 4 though, as I take advantage of the map statement and the Perl 5 enhanced grep syntax and also some useful CPAN libraries. Challenge 1 (6 out of 49) We are asked to generate 6 random integers between 1 and 49 with no repetitions. This is inspired by a German lottery. In Perl 5, this can be done by creating a 49-element array of random numbers, say @rnd, and sorting their indices (plus one) based on the order of the random number at that index. We can then just peel off the first 6 indices from the sorted list of indices. (sort {$rnd[$a-1] <=> $rnd[$b-1]} 1..49)  [0..5] Here is the full subroutine: local *six_out_of_49 = sub {     local @six_out_of_49 = map {rand} 0 .. 48;     return (sort {$six_out_of_49[$a-1] <=> $six_out_of_49[$b-1]} 1 .. 49) [0 .. 5]; }; Challenge 2 (Linear r

PWC 235 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.)  Update and disclaimer : These programs will not work on Perl 4 as I discovered later when I found and installed a Perl 4.019 executable. For one thing, the ability to assign a subroutine to a locally scoped typeglob was not available in Perl 4. My solutions to this week's challenges highlight the usefulness of the splice array operator. Challenge 1 (Remove One) We are given an array of integers and asked to verify if removing any one element will leave the remaining elements in monotonically ascending order. A helper sub-subroutine &

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

PWC 233 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.  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. 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 indeed. Update and disclaimer : These programs will not work on Perl 4 as I discovered later when I found and installed a Perl 4.019 executable. For one thing, the ability to assign a subroutine to a locally scoped typeglob was not available in Perl 4. Challenge 1 (Similar Words) We are given an array of strings with every string consisting of alphabetical c

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

PWC 230 Two easy challenges this week.  Challenge 1 (Separate digits) We are given an array of positive integers say @int, and asked to return another array in which the elements of @int are split into their individual digits. Thus (1,23,456) should give (1,2,3,4,5,6). One easy way to do this in Perl 5 is to combine the elements of @int into a string using 'join', and then split the string into individual characters using split. Here is the key code snippet:     split //, join '', @_; Challenge 2 (Count words) We are given an array of strings @words say, and a single string called $prefix say. We are asked to count how many of the strings in the array @words start with $prefix. This is easy to do with grep. Here is the key snippet:      scalar grep /^$prefix/, @words;

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 so

PWC 228 Challenge 1 (Unique Sum) We are given an array of integers, and asked to return the sum of only those elements that are unique, i.e., skipping any elements that are repeated. I use a single pass through the array, adding elements as I go, and also counting their frequency with a hash. If the frequency hits 2, then I subtract the element from the running total, and thereafter ignore any further repetitions. I use the ( a ? b : c ) conditional expression. Here is the subroutine:  sub unique_sum {     my @int = @_;          #-- %int : hash to count frequency of each element of @int,     #-- $retval : return value     my (%int, $retval);          #initialize %int values, $retval, to zero     $retval=0;     map {$int{$_}=0} @int;          #-- loop thru' @int counting frequencies and updating $retval     map {         $int{$_}++;                  ($int{$_} > 1) ?             ( ($int{$_} == 2)  ? ($retval -= $_) : 1 )             : ($retval += $_);       }  @int;     $retval; }

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

PWC 220 I switched to Raku this week. Both challenges are easier to tackle with Raku. Challenge 1 (Common characters) We are given a list of words, and asked to return a sorted list of the characters that are found in every word in the list (ignoring case). Here is the subroutine: sub common_characters( @words ) {     [(&)] @words.map( {$_.lc.comb.Set} ) } For each word in @words, lowercase it, then split into characters, then store each unique character in a set . Then working on the resulting list of sets, call the reduce meta-operator [..] on the set intersection "(&)" operator, i.e., call [(&)] or "reduce using intersection" on the list of sets, to get the intersection of every set, or the characters that are found in every set. This returns a set, whose say method automatically prints the elements in sorted order (one of the task specifications). Challenge 2 (Squareful) We are given a list of integers @ints say. We are asked to identify every permu

PWC 219 Challenge 1 (Sorted Squares) This is an easy challenge, though as often happens in these challenges, it is a warm-up exercise for a more difficult Challenge 2. We are given a list of numbers. We are asked to return a list of the numbers squared, sorted in increasing order. I implement this in PDL, submitting a pdl script. The key snippet is: sub sorted_squares {$list=pdl @_; ($list*$list)->qsort; } Convert the input list to a piddle. Square it and then call the qsort method on the squared list. Challenge 2 (Travel Expenditure) We are given two numeric lists. The first one, costs say, has three elements, corresponding to the per-card price of three types of travel cards: 1-day, 7-day, and 30-day. Presumably, purchasing one of the cards entitles you to travel without additional ticketing (on say a metro or bus system)  for the day of purchase, 7 days ahead from the day of purchase,  or 30 days ahead from the day of purchase, respectively for the 1-day, 7-day and 30-day cards.