The Weekly Challenge
This is where I post my solutions to The Weekly Challenge and try to write a bit about the problems.
Lessons learned in week 286
Mon Sep 16 19:58:52 CEST 2024
There is more than one way to get the name of the file containing the script of the first task, as well as the content of that file.
To get the file name,
we can use the $0 variable
or the __FILE__ token.
Either is a good alternative for the purpose of this script
as they will both give the same value,
but when used from a module, they may give different values.
The caller function could also be used.
It is not clear to me exactly what __FILE__ is,
but it seems to be a function.
It is referred to as a special literal
in the Camel Book,
but it also appears in the alphabetical list of functions.
In perlfunc, it is listed as a keyword.
As for getting the actual content of the file
(and apart from the quine way of doing it,
which of course is extra impressive),
we can use the open function in combination with
read or the diamond operator,
or we can, as
one contribution shows,
use the DATA file handle.
Week 286 - Self Spammer & Order Game
Mon Sep 9 19:48:37 CEST 2024
The first task, Self Spammer, seems rather straightforward. We open the current script, slurp it and split it into a list of words of which we randomly select one to print:
#!/usr/bin/perl
use v5.40;
open my $f, '<', $0;
undef $/;
@_ = split /\s+/, <$f>;
say $_[ int rand @_ ];
As for the second task,
I would not be surprised if there is some clever way
of sorting or manipulating the list so that the number of
calls to min() and max() can be minimized.
While thinking about that, let me present a solution to
Order Game
that simply plays the game according to the specification:
#!/usr/bin/perl
use v5.40;
use Test::More tests => 3;
use List::Util qw(min max pairs);
sub play_game {
return min(@_) if @_ == 2;
my $f = \&max;
return play_game(
map {
$f = $f == \&min ? \&max : \&min;
$f->($_->[0], $_->[1]);
} pairs @_
);
}
is(play_game(2, 1, 4, 5, 6, 3, 0, 2), 1);
is(play_game(0, 5, 3, 2), 0);
is(play_game(9, 2, 1, 4, 5, 6, 0, 7, 3, 1, 3, 5, 7, 9, 0, 8), 2);
That is a recursive function that stops
when the length of the list is two.
A core module helps creating pairs
and a variable that is alternately set
to min and max
helps interleaving those two calls.
Lessons learned in week 285
Sun Sep 8 14:16:47 CEST 2024
Making Change is indeed a classic problem and it turned out that it is included in George Pólya's How to Solve It which I actually had on a shelf in my bookcase. The recursive solution presented on the very last two pages of the book could be expressed like this in Perl:
#!/usr/bin/perl
use v5.40;
use Test::More tests => 3;
sub make_change {
my @coins = (1, 5, 10, 25, 50);
return 0 if (my $n = shift) < 0;
return 1 if (my $i = shift // $#coins) == 0;
return make_change($n, $i - 1) + make_change($n - $coins[$i], $i);
}
is(make_change(9), 2);
is(make_change(15), 6);
is(make_change(100), 292);
Like other contributions show, the core idea of computation by adding already known numbers can also be used to construct a table with as many rows and columns as is necessary to look up the answer.
Week 285
Sat Sep 7 15:31:58 CEST 2024
The first task, No Connection, gives rise to a number of questions. How many destinations with no further outgoing connections are there? Are there branches in the list of routes? Are there loops?
Assuming that there is only one route with no outgoing connection, the list of routes could be transformed into two lists of starting points and destinations, and the problem could then be solved by finding the element in the list of destination that does not appear in the list of starting points. This would provide an excellent opportunity to construct a glorious write-only one-liner of nested maps and greps, as well as a chance for optimization by sorting the list of starting points.
Assuming that there are no loops and that each starting point only leads to one destination, the problem could be solved by picking a random starting point and simply walking the routes until a destination with no outgoing connection is reached:
#!/usr/bin/perl
use v5.40;
use Test::More tests => 2;
sub get_no_connection {
my ($c) = my %r = map { $_->[0], $_->[1] } @_;
$c = $r{$c} while $r{$c};
return $c;
}
is(get_no_connection([ 'B', 'C' ], [ 'D', 'B' ], [ 'C', 'A' ]), 'A');
is(get_no_connection([ 'A', 'Z' ]), 'Z');
The second task, Making Change, is a bit trickier and has got the smell of a classic programming problem. I assume that there is an elegant and well known way of solving this problem that any real expert programmer is either familiar with or able to work out. I guess that the same goes for a skilled mathematician and that the solution involves something related to a tree with weighted nodes that can be multiplied or added, integer sequences or set theory.
I have not come across this problem before and I cannot immediately see the elegant way of solving this, so I have to, embarrassingly, resort to solving it by simply starting with a list of coins of as high denominations as possible and substituting each for lower denominations until a list of only pennies is reached.
The first thing to notice is that amounts that are not evenly divisible by five will be given as change in as many ways as the next lower amount that is divisible by five. For example, the amounts 5, 6, 7, 8 and 9 can all be given as change in two ways.
If we try to iteratively substitute coins for those of lower denominations, we will come across the problem of missing certain combinations of change. For example, if we for the amount 15 (a dime and a nickel) substitute the dime for two nickels, we will be able to find further combinations of nickels and pennies, but we will not find the combination of one dime and five pennies.
One way of getting around this problem by adding some depth to the algorithm, and for each substitution make further substitutions on a copy of the original list of coins. This will however introduce a new problem where certain combinations of change are found multiple times. For example, a dime can be split into two nickels, which in turn can be split into either one nickel and five pennies, or five pennies and one nickel, which in turn both can be split into ten nickels. An ugly way of getting around this problem is to keep track of the combinations found so far.
Furthermore, there is the problem of how to substitute one coin for coins of lower denominations. While quarters, dimes and nickels can all be substituted, either directly or indirectly, for all combinations of lower denominations, half-dollars can be substituted in two ways that cannot further be substituted for all combinations of lower denominations. If we split a half-dollar into two quarters, we will miss the combination of five dimes and vice versa.
There is of course also the question of how many ways the amount zero can be given as change.
A little helper function sets up the initial list of coins for a given a value and then starts the actual work of finding all ways of giving change:
#!/usr/bin/perl
use v5.40;
use List::Util qw(first);
use Test::More tests => 3;
my %coins = (
50 => [ [ 25, 25 ], [ 10, 10, 10, 10, 10 ] ],
25 => [ [ 10, 10, 5 ] ],
10 => [ [ 5, 5 ] ],
5 => [ [ 1, 1, 1, 1, 1 ] ],
1 => [ [1] ],
);
sub make_change {
my $n = shift;
my @l;
while ($n > 0) {
my $coin = first { $_ <= $n } sort { $b <=> $a } keys %coins;
push @l, $coin;
$n -= $coin;
}
return f([@l], {});
}
sub f {
my @l = sort @{ $_[0] };
my $h = $_[1];
return if exists $h->{"@l"};
$h->{"@l"} = 1;
foreach my $i (grep { $l[$_] != 1 } 0..$#l) {
foreach (@{ $coins{ $l[$i] } } ) {
my @a = @l;
splice @a, $i, 1, @{$_};
f([@a], $h);
}
}
return keys %$h;
}
is(make_change(9), 2);
is(make_change(15), 6);
is(make_change(100), 292);
Now I cannot wait to learn how to solve this problem in the proper way!