1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
#!/usr/bin/perl -s
use v5.24;
use Test2::V0 '!float';
use PDL;
use PDL::NiceSlice;
use PDL::Opt::GLPK;
use experimental 'signatures';
our ($tests, $examples, $duration, $price, $verbose);
run_tests() if $tests || $examples; # does not return
die <<EOS unless $price && @ARGV;
usage: $0 [-examples] [-tests] [-verbose] [-duration=DURATION]
[-price=PRICE] [DAY...]
-examples
run the examples from the challenge
-tests
run some tests
-verbose
explain the solution as in the examples
-duration=DURATION
list of card durations. Default: 1, 7, 30
-price=PRICE
list of card prices
DAY...
list of travel days
EOS
### Input and Output
main: {
my @duration = $duration ? split /[, ] */, $duration : (1, 7, 30);
my @price = split /[, ] */, $price;
die "duration and price have different sizes" if @duration != @price;
my @cards = map [$duration[$_], $price[$_]], 0 .. $#duration;
my ($selection, $cost) = travel_cost(\@cards, \@ARGV);
if ($verbose) {
printf "On day %d, we buy a %3\$d-day pass for %2\$d.\n", @$_
for @$selection;
say "total cost: $cost";
} else {
say $cost;
}
}
### Implementation
sub travel_cost ($crd, $dy) {
my $cards = long @$crd;
my $days = long $dy;
my $from = $days->dummy(1);
my $to = $from + $cards((0))->dummy(0);
my $valid = ($days->dummy(1) >= $from->dummy(0)) &
($days->dummy(1) < $to->dummy(0));
my $a = $valid->clump(1,2)->xchg(0,1);
my $b = ones($days);
my $c = $cards((1))->dummy(0,$days->dim(0))->clump(-1);
my $xopt = null;
my $fopt = null;
my $status = null;
glpk($c, $a, $b, zeros($c), zeros($c), GLP_LO * ones($b),
GLP_BV * ones($c), GLP_MIN, $xopt, $fopt, $status);
my $selection = $xopt->reshape($to->dims);
my $solution = whichND $selection;
($days->dice($solution((0)))->dummy(0)
->glue(0, $cards->dice('X', $solution((1))))->qsortvec->unpdl, $fopt);
}
### Examples and tests
sub run_tests {
SKIP: {
skip "examples" unless $examples;
is scalar(travel_cost([[1, 2], [7, 7], [30, 25]], [1, 5, 6, 7, 9, 15])),
11, 'example 1';
is scalar(travel_cost([[1, 2], [7, 7], [30, 25]],
[1, 2, 3, 5, 7, 10, 11, 12, 14, 20, 30, 31])),
20, 'example 2';
}
SKIP: {
skip "tests" unless $tests;
}
done_testing;
exit;
}
|
