Peter
Peter Campbell Smith

Any more fares, please?

Weekly challenge 219 — 29 May 2023

Week 219 - 29 May 2023

Task 2

Task — Travel expenditure

You are given two lists, @costs and @days.

@costs contains the cost of three different types of travel cards you can buy: for example @costs = (5, 30, 90), representing the cost (say in £) of a ticket for 1, 7 and 30 days' travel. So a 7 day ticket costs £30.

@days contains the day number you want to travel in the year: for example: @days = (1, 3, 4, 5, 6), meaning that you want to travel on day 1, day 3, day 4, day 5 and day 6 of the year.

Write a script to find the minimum travel cost.

Analysis

For this type of problem we face the choice between:

  1. A recursive solution looking at all the possibilities.
  2. An ingenious analysis of the problem showing how it can be solved in a single pass.
  3. A solution involving a push/pop stack that does the same as recursion, but without using Perl's (rather slow) recursion facility.

I went for 'a' on the grounds that it's easy to do (and I couldn't think of a 'b' solution).

So my solution involves a sub buy_tickets that takes as input a list of days, a cost so far (initially 0) and an explanation so far (initially ''). It tries one of each of the three ticket types, each starting on the first day in the list.

If the list can be covered completely by the ticket under conderation, it compares the total price with the best price seen so far, and if it's better, it updates global variables with the current best price and its explanation.

If the list can't be covered completely by one of the ticket types, then if the price so far exceeds the best price so far (for the whole list) it abandons that option, and otherwise it calls itself recursively with the remaining list, the cost so far, and the explanation of that cost.

The recursion will always converge, because there is always a solution of buying a 1-day ticket for each day of travel.

Try it 

@costs - cost of each of 3 ticket types eg 2, 7, 25

@periods - validity in days of each ticket type, eg 1, 7, 30

@days - list of days on which you want to travel, eg 1, 2, 4, 6, 9, 10

Script


#!/usr/bin/perl

use v5.16;    # The Weekly Challenge - 2023-05-29
use utf8;     # Week 219 task 2 - Travel expenditure
use strict;   # Peter Campbell Smith
use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

my (@costs, @periods, @days, $best_cost, $best_explain);

travel_exps([2, 7, 25], [1, 7, 30], [1, 5, 6, 7, 9, 15]);
travel_exps([2, 7, 25], [1, 7, 30], [1, 2, 3, 5, 7, 10, 11, 12, 14, 20, 30, 31]);
travel_exps([2, 7, 13], [1, 7, 14], [1, 2, 3, 5, 7, 10, 11, 12, 14, 20, 30, 31]);

# generate longer example
my ($j, @daysx);
for $j (1 .. 100) {
    push @daysx, $j if rand(1) < 0.4;
}
travel_exps([2, 7, 13], [1, 7, 14], \@daysx);


sub travel_exps {
    
    # initialise
    @costs = @{$_[0]};
    @periods = @{$_[1]};
    @days = @{$_[2]};
    $best_explain = '';
    $best_cost = 99999;
    
    # start recursive solution
    buy_tickets(\@days, 0, '');
    
    # show results
    say qq[\nInput:  \@costs   = (] . join(', ', @costs) . ')';
    say qq[        \@periods = (] . join (', ', @periods) . ')';
    say qq[        \@days    = (] . join (', ', @days) . ')';
    say qq[Output: $best_cost = ] . substr($best_explain, 0, -2);
}

sub buy_tickets {
    
    my (@days_left, $cost, $purchase_day, $j, $valid_until, $explain, $explain2, $cost2, @days_left2);
    
    # initialise
    @days_left = @{$_[0]};
    $cost = $_[1];
    $explain = $_[2];
                
    # try buying each type of ticket and see which days it covers
    for ($j = 2; $j >= 0; $j --) {
        $cost2 = $cost + $costs[$j];
        @days_left2 = @days_left;
        $purchase_day = $days_left2[0];
        $explain2 = qq[$explain$periods[$j] day ticket on day $purchase_day, ];
        $valid_until = $purchase_day + $periods[$j] - 1;
        
        # remove days now paid for
        while (@days_left2 and $days_left2[0] <= $valid_until) {
            shift @days_left2;
        }
        
        # have we finished?
        if (scalar @days_left2 == 0) {
            
            # is this the best deal
            if ($cost2 < $best_cost) {
                $best_cost = $cost2;
                $best_explain = $explain2;
            }

        # buy more tickets to cover remaining days
        } elsif ($cost2 < $best_cost) {
            buy_tickets(\@days_left2, $cost2, $explain2);
        }
    }
}          
    

Output


Input:  @costs   = (2, 7, 25)
        @periods = (1, 7, 30)
        @days    = (1, 5, 6, 7, 9, 15)
Output: 11 = 7 day ticket on day 1, 1 day ticket on day 9, 1 day ticket on day 15

Input:  @costs   = (2, 7, 25)
        @periods = (1, 7, 30)
        @days    = (1, 2, 3, 5, 7, 10, 11, 12, 14, 20, 30, 31)
Output: 20 = 7 day ticket on day 1, 7 day ticket on day 10, 1 day ticket on day 20, 1 day ticket on day 30, 1 day ticket on day 31

Input:  @costs   = (2, 7, 13)
        @periods = (1, 7, 14)
        @days    = (1, 2, 3, 5, 7, 10, 11, 12, 14, 20, 30, 31)
Output: 19 = 14 day ticket on day 1, 1 day ticket on day 20, 1 day ticket on day 30, 1 day ticket on day 31

Input:  @costs   = (2, 7, 13)
        @periods = (1, 7, 14)
        @days    = (1, 4, 6, 8, 9, 10, 11, 13, 17, 18, 21, 22, 26, 28, 29, 30, 32, 38, 40, 41, 44, 50, 51, 52, 55, 56, 58, 61, 62, 64, 66, 67, 69, 71, 73, 74, 76, 77, 79, 83, 84, 89, 98, 99, 100)
Output: 73 = 14 day ticket on day 1, 7 day ticket on day 17, 7 day ticket on day 26, 7 day ticket on day 38, 7 day ticket on day 50, 14 day ticket on day 58, 7 day ticket on day 73, 1 day ticket on day 83, 1 day ticket on day 84, 1 day ticket on day 89, 1 day ticket on day 98, 1 day ticket on day 99, 1 day ticket on day 100