Posts

PWC 218

PWC 218 Challenge 1 (Maximum Product) We are given a list of integers, which can include negative integers and zero as well as positive integers. We are asked to find the product of any three elements of the list which is the highest of any product so formed. It is stipulated that the list must have at least three elements. To solve, I sort the list in numeric order. Then the maximum product is given by one of the following: The product of the lowest two elements and the maximum element. This is if the lowest two elements are both negative (so that their product is positive). The product of the highest three elements.  Here is the core subroutine: use List::Util qw(max); local *maximum_product = sub {          local *myprod=sub {         $_[0]*$_[1]*$_[2];     };     #-- main part of &maximum_product     my @list = sort {$a <=> $b} @_;          (scalar(@list) < 2) && (die "Need at least 3 elements in input");     max(         &myprod( $list[0], $list[

PWC 217

PWC 217 Challenge 1 (Sorted Matrix) We are given a n by n matrix of numbers, and asked to report the third-smallest number in the matrix.  The specification seems to allow arbitrary non-numeric elements too, but since all the test examples are numeric, I will restrict to numeric matrices. PDL is of course the go-to tool for this. The core subroutine: sub sorted_matrix {my ($pdl)=@_; $pdl=$pdl->flat->qsort; $pdl(2);}   The flat method flattens the matrix piddle to a vector piddle, qsort sorts the vector in ascending order, then we just return the third element.   Challenge 2 (Max Number) We are given a list of positive integers of arbitrary lengths, and asked to concatenate them so as to produce the largest possible concatenated number. Thus, given 1 and 23, we would produce 231, not 123.  To solve this, we exploit the fact that Perl can treat the elements interchangeably as numbers or as strings. We first sort the numbers using a routine that puts $b before $a if $b.$a is great

PWC 215

PWC 215 I have attempted the Perl Weekly Challenge after a hiatus of several weeks, as I was too busy at work. Still busy, so I have just attempted the current challenge in Perl 5. Like I like to do, I have restricted myself to perl 4 syntax as specified in the first edition of Programming perl. Challenge 1 (Odd one out) In this challenge, we are given a list of alphabetic strings, and asked to return the list without the strings in which the characters are not sorted (I assume that this means sorted in lexical ascending order). We are also asked to print the number of strings that were removed (i.e., that were not sorted).  I use a subroutine &odd_one_out(@words) with a nested helper sub-sub-routine to check if a string is sorted. Here is the helper sub-sub routine (not as compact as it could be, but this is easier to read):  local *is_sorted = sub { #not idiomatic but I prefer readable     local ($string)=@_;     local $chk=join('',sort {$a cmp $b} split(//,$string));    

PWC 200

Image
PWC 200 This week again, due to work pressures, I have done the challenges only in Perl 5 and Raku, not in the guest language Julia. Challenge 1 (Arithmetic Slices) Given a list of integers, we are asked to find all slices of the list (sub-lists of consecutive elements) that have at least three elements, and where the difference between every consecutive element is the same. This is a one-liner in Raku . raku -e '(0 .. @*ARGS-1).combinations(2).grep({@_[1]-@_[0]>1}).map({@*ARGS[@_[0]..@_[1]]}).grep( {my @n=@_; (0 .. @n-3).map( {(@n[$_+1]-@n[$_]) == (@n[$_+2]-@n[$_+1])} ).sum==(@n.elems-2) } ).say' $@ The steps are: Get all slices by getting all combinations of two elements (bounds of the slice) Restrict to slices that are at least three elements long (difference between the slice bounds is greater than 1) Map the pairs of bounds to get slices from the list Use grep to check if the condition is true for each slice: For each slice, loop through the slice, checking that the dis

PWC 199

PWC 199 Our good host has again given us an easy set of challenges, which works for me as I am busy at work. Again, I eschewed the guest language Julia this time, and have done the challenges only in Perl 5 and Raku. Challenge 1 (Good pairs) We are given a list of integers, and asked to count the number of pairs of items in the list say list[i] and list[j] where (i < j) and list[i]==list[j]. This is a one-liner in Raku using the combinations operator. raku -e '(0..@*ARGS-1).combinations(2).grep({@*ARGS[@_[0]]==@*ARGS[@_[1]]}).elems.say' $@ From the indices of the given list (command line argument), take all pairs of indices using the combinations operator, then use grep to extract the pairs of indices that satisfy the condition. The i < j condition is automatically taken care of by the combinations operator. I translated this to a Perl 5 one-liner using the combinations operator from Algorithm::Combinatorics. Similar logic to my Raku one-liner, but the steps are stacked

PWC 198

PWC 198 Our good host has given us easy challenges this week, which works for me as I am busy at work. Still, I have done them only in Perl 5 and Raku and skipped Julia this time. Challenge 2 (Prime Count) We are asked to find the number of prime integers between 0 and a given positive integer $n. The challenge specifies that we are looking for primes that are strictly less than $n (which I nearly missed, but caught in time). This is an easy one-liner if one does not try to implement a prime sieve from scratch (I don't). Here it is in Raku : raku -e ' (0..^@*ARGS[0]).grep(*.is-prime).elems.say ' $@ We need the ^ in ^@*ARGS[0] to exclude $n (the command-line argument) itself from the count.  In Perl 5 , I use the Math::Prime::Util function "prime_count".  perl -MMath::Prime::Util=prime_count -wl -e ' print prime_count($ARGV[0]-1) ' $@ We subtract one from the command-line argument to exclude it from the count. The "prime_count" routine gives th

PWC 197

PWC 197 I did not attempt the challenges in Julia this time. I have solutions in Perl 5 and Raku. Challenge 1 (Move Zero) We are given a list of integers, say (3,0,1,0,5). We are asked to sort the list so that all zeros move to the end, and the remaining items are in their original relative order. In my example, the sorted list would be (3,1,5,0,0). This is a one-liner in Perl 5 and Raku. Perl 5: perl -wl -e ' my @o = sort { ($a == 0) ? 1 : ( ($b == 0) ? -1 : 0 ) } @ARGV; print "@o" ' $@ Raku: raku -e ' say @*ARGS.sort( { ($^a == 0) ?? 1 !! ( ($^b == 0) ?? -1 !! 0 ) } ) ' $@ The logic is via the block argument to sort. This takes two parameters $a and $b representing two elements in the list being compared. If the comparison returns -1, then $a precedes $b in the sorted list. If the comparison returns 1, then $b precedes $a in the sorted list. If the comparison returns 0, then the order doesn't matter. The sort pattern here follows this logic: If both