PWC 219

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.

The second numeric list, days say, gives a list of days. In the given test examples, these are all within the range 1 .. 31, so I infer that they refer to calendar dates within an arbitrary month. If a date is included in the list, we plan to travel on that date. If a date is not included, we will not travel on that date.

We are asked to calculate the minimum travel cost for the month.

I use PDL for my solution. 

I normally avoid input validation chores in solving these challenges, but in this case, input validation is useful to show the limits that I have assumed on the problem scope. 

I first establish that the costs vector makes economic sense. That is, the 7-day card cost is less than the cost of 7 daily cards, but more than the cost of 1 daily card. Similarly, the 30-day card cost is less than the cost of 30/7 7-day cards, but more than the cost of one 7-day card. Here is the snippet:

    #-- input validation check that costs are reasonable
    #-- 7 day price is less than 7 * daily price
    #-- 7 day price is greater than daily price

    (scalar(@$ra_costs) == 3) || (die "bad costs");

    ( ($ra_costs->[1] < (7*$ra_costs->[0]))
        && ($ra_costs->[1] > $ra_costs->[0]) )
     || (die "bad costs");  

    #-- 30 day price is less than 30/7* 7-day price
    #-- 30 day price is greater than 7-day price

     ( ($ra_costs->[2] < (30/7*$ra_costs->[1]))
        && ($ra_costs->[2] > $ra_costs->[1]) )
     || (die "bad costs");  

Here $ra_costs is the array reference pointing to the costs vector. I also store the array in a piddle called $costs.

Next, I validate the days array, by verifying that it only includes numbers in the 1..31 range. 

I use the days vector to construct a 31-element piddle of 0 or 1 elements called $days, where an entry whose index corresponds to an element of days (assuming 1-indexing) is set to 1, and other entries are set to zero.

As a first step, I check if I travel so frequently that it is worthwhile to buy a 30-day card for the month (plus a 1-day card if necessary for day 1 or 31, if we travel on both those days). Here is the snippet:

    #-- worth paying for a whole month?
    #-- check if # of days is greater than 30-day price / 7-day price * 7
    my $candidates=pdl [Inf, Inf]; #-- candidate solutions

    if ($days->sum > ($ra_costs->[2] / $ra_costs->[1] * 7)) {
        if ($days(0) & $days(30)) {
        #if both 1st and last day of 31-day month, then ..
            $candidates(0) .= $ra_costs->[2]+$ra_costs->[0];
            #cost is 30 days price + 1 day price
        }
        else {
            return $ra_costs->[2];
        }
    }

In the case where I pay for 30 days + 1 day, it's possible that it might be cheaper to use 7-day cards. So rather than returning immediately, I store the cost from this option as a candidate to compare with the cost using 7-day cards, which I proceed to find.

To find the cost using 7-day cards, I follow a similar logic in cycling through 7-day periods within the month, and checking if it is worthwhile to buy a weekly card for each 7-day period. 

If yes, I add to a tally of weekly cards in the $weekly_card scalar variable, and also add the number of days in that period to a tally of days paid for with weekly cards, stored in the $days_paid_weekly scalar variable. I then update my loop counter so that I next examine the 7-day period that starts at the end of the period.

If no, I move to the next day in the month (update my loop counter by 1 day), and check 7-days ahead from there.

My loop construction needs some care to avoid overshooting when approaching the 31-day mark. Also, I need to position my counter to reflect that the first day of each putative 7-day card purchase is a travel day.

Here is the snippet:

    my $weekly_card=0;
    my $days_paid_weekly=0;
    my $weekly_cutoff= int( $ra_costs->[1] / $ra_costs->[0] )+1;

    #-- cycle through $days looking for clusters of more than
    #-- 7-day price / 1-day price travel days in a 7-day stretch
    #-- (weekly cutoff days in a 7-day stretch)

    my $ctr=0;

    MYLOOP: while ($ctr <= (30 - $weekly_cutoff)) {
    #-- slow interpreted loop is good enough
    #-- because the days vector won't scale beyond 31 days

    #-- start counting 7 days from a travel day only
        if ($days($ctr)==0){
            $ctr++;
            next MYLOOP;
        }
        my $days_forward = (pdl (6, 30-$ctr) )->min;
        if ($days($ctr:($ctr+$days_forward))->sum >= $weekly_cutoff) {
            $weekly_card++;
            $days_paid_weekly += $days($ctr:($ctr+$days_forward))->sum;
            $ctr += $days_forward+1;
        }
        else {
            $ctr += 1;
        }
    }

Finally, we compute the actual travel cost by multiplying the tally in $weekly_card with the weekly card cost, and the remaining number of days (all travel days less $days_paid_weekly) times the daily card cost. If applicable, we compare this with the cost using a 30-day card plus a 1-day card, and take the lower of the two. Here is the snippet:

    $candidates(1) .= $weekly_card*$costs(1)
        +( ($days->sum)-$days_paid_weekly ) * $costs(0);
    return $candidates->flat->min;

PDL makes it easy to count days. We just call the PDL sum method on our 0-1 piddle representing days (or on the appropriate slice thereof).

I am kinda pleased with myself for having come up with this solution instead of resorting to brute force. But my smugness is tempered by a simpler, more efficient, and more general solution from fellow-contributor Lubos Kolouch.  Kolouch uses an array @dp to store the minimum cumulative travel cost so far for each day in the travel period. He solves via a single pass through @dp. At each step, he compares three numbers and selects the lowest of the three: first, the previous day's entry in @dp plus the cost of a one-day card; second, the @dp entry for 7-days earlier (if applicable) plus the cost of a seven-day card; third, the @dp entry for 30-days earlier (if applicable) plus the cost of a 30-day card.

Thoughts and Best Wishes to our Host

Our good host Mohammad Anwar mentioned on his Twitter feed that his father is seriously ill. Thoughts and best wishes to him and his family at this difficult time. 



Comments

Post a Comment

Popular posts from this blog

PWC 258

PWC 258 Last week (#257) I finished challenge 2 and my blog post for challenge 257 late last week, so had only submitted challenge 1. Here is my blog post for PWC 257 , including the full code for my challenge 2 solution. This week, I have done both challenges in perl 4.019 on DOSBOX. Both scripts also work fine on the latest Perl 5.38. I also did the challenges in Raku, where they are one-liners.  Challenge 1 (Count Even Digits Number) We are given a list of integers, and asked to count the number of elements whose base-10 representation has an even number of digits. In Raku , this is a one-liner. Here it is: raku -e 'say +@*ARGS.grep({$_.chars %% 2})' $@ It could be a one-liner in Perl 4 too, but since I run it on DOSBOX, my script would not be a bash shell script. Here is the short subroutine that does the job.  sub count_even_digits {  scalar( grep( ((length($_) % 2) == 0), @_) ); } The full code is here . Challenge 2 (Sum of values) We are given an integer k  an...
Read more

PWC 253

PWC 253 I do both challenges this week using old software on DOSBOX: perl 4.019, and for comparison, also python 1.4 beta. My solutions also work on the current versions of Perl 5 (5.38) and Python 2 (2.7.18) respectively. Challenge 1 (Split Strings) Links to code: perl4.019 python1.4b We are given a list of strings, and a single character say sep . We are asked to return the list, with the strings split into component substrings using sep as a separator. We should not include any empty strings in the output. In perl 4, I first stick a backslash in front of the separator character, so that it is escaped if entered in a regex. This is because the perl split function takes a regex as its first argument indicating the separator. If we have a character like '$' or ',', we want to escape it so that it is read literally when parsing the regex. Here is the key subroutine:   sub split_strings {  local ($separator, @words)=@_;  local (@retval)=(); #array to be returned  # ...
Read more

PWC 251

PWC 251 This time I tried both challenges using antique software on DOSBOX: Perl 4.019 for DOS, and for comparison Python 1.4 beta for DOS. My solutions also run on the current versions of Perl 5 (5.38) and Python 2 (2.7.18). Hooray for backward compatibility! Challenge 1 (Concatenation Value) Links to solution: Perl Python We are given a list of positive integers, say ints . We are asked to follow the following procedure: Concatenate ints[0] and ints[-1] (last element). Store the result in retval say. Concatenate ints[1] and ints[-2] (second-last element), and add the result to retval . Concatenate ints[2] and ints[-3] .... etc. until we have reached the middle of the list. Return retval . Here is the Perl 4.019 subroutine (it also works fine on the latest Perl 5.38). sub concatenation_value {   local(@ints)=@_;   local($x,$retval)=(0,0);   foreach $x (0 .. @ints/2-1) {    $retval += $ints[$x] . $ints[$#ints-$x];   }   (@ints % 2) && ($retva...
Read more