Wherein we roam the world turning it on it head. Sometimes ya gotta do what ya gotta do.
THE WEEKLY CHALLENGE – PERL & RAKU #121
episode one:
“Reverse the Polarity!”
Task 1
Invert Bit
Submitted by: Mohammad S Anwar
You are given integers 0 <= $m <= 255 and 1 <= $n <= 8.
Write a script to invert $n bit from the end of the binary representation of $m and print the decimal representation of the new binary number.
Example
Input:
$m = 12
$n = 3
Output: 8
Binary representation of $m = 00001100
Invert 3rd bit from the end = 00001000
Decimal equivalent of 00001000 = 8
Input
$m = 18
$n = 4
Output: 26
Binary representation of $m = 00010010
Invert 4th bit from the end = 00011010
Decimal equivalent of 00011010 = 26
Method
The n-th bit in a binary number isn’t hard to find. In any base representation of a number the n-th place position is created by multiplying the digit value to be found there by the base raised to the power of the position count:
128 = 1 × 102 + 2 × 101 + 8 × 100
The positions, counting from the right side of the number, are a 1 in the 2nd place, a 2 in the 1st place, and an 8 in the 0th place. Here we’re counting positions as distance, rather than an absolute value. It makes no difference as we could rewrite the formula for position – 1 instead, but that just obfuscates things unnecessarily. The two ways of looking at it are always separated by the same 1 value. In computers we’re always counting 0, as offsets just as we are here, so I went with that as it keeps the demonstration cleaner
We good? Cool.
With binary notation nothing changes except the base and consequently the digits available to insert.
128 = 1000000 = 1 × 27 + 0 × 26 + 0 × 25 + 0 × 24 + 0 × 23 + 0 × 22 + 0 × 21 + 0 × 20
Here we have a single 1 in the 6th offset from the right. Counting from 0. Or 7th position… you do get the idea, right?
So looked at the other way, if we have a bit position, we can get the exponent we use to get there by counting from 0 instead of 1. The big takeaway here is that the power is the position minus one.
That’s all we need to know, seriously. That and a bit of formal logic.
What we need to do here is, at a given position, should we find a 1, make it a 0, and should we find a 0, turn it into a 1. And, here’s the important part: don’t do anything else.
It would be nice if we could construct a number that we could use to flip only this bit, leaving all of the others alone, using some operator or another. It turns out we can.
We have two states for the digits in our number, 1, for a set bit, and 0, for an unset bit. We also have two types of actions we need done: either flip a bit or do nothing. We can assign a procedure to each of these states, and construct a number that tells us what bits to flip and what bits to ignore. We’ll try assigning 1 to flipping the bit and 0 to ignore and see how that goes.
A logical AND will, if a bit is set and the comparison is also set, produce a set bit. If the bit was 1, and we AND it with 1, it remains 1. This does not do what we want.
Should we try a logical OR, the bit will be set if one or the other is set. So our set 1 will always produce a 1 in the result. Hmm. We seem to be getting further away from our goal.
An exclusive OR, or XOR, will set a bit if one input or the other is set, but not both. Meaning if we had a 1, and we give it a 1, we get a 0. Hmm. The bit has been flipped. Nice. If we had a 0 and we give it a 1, we now have a 1, and again the bit is flipped.
Further, if we supply a 0, then a previous 1 remains a 1 — one or the other — but if we had a 0 we keep the bit set to 0 — neither one nor the other is set so nothing is done. This “do nothing” approach to life is exactly the sort of get-up-and-go we need for the second part of our action.
It looks like the XOR will do what we want.
So if we build a number composed by default of 0s, with 1s signifying the bits we want flipped, all we need to do is XOR this number with the original to perform the transformation. The secret is that in the number we construct, the bits are no longer set to indicate value, but rather for indicating the specific placement of the bits we want to operate on. This actually makes sense, as the task we’ve been asked to perform also is treating the bit positions in the number the same way. This is an example of a bit mask.
Another good way of looking at it is that what we’re really dealing with are bit strings, chains of 1s and 0s without further meaning, and that considering these as binary numbers is just a handy way of referencing them. We’re not manipulating bits in numbers, per se, but rather in vectors of bits, and only after the fact are we converting them to numbers. In fact both views are correct simultaneously, as they are just two ways of looking at the same underlying truth.
PERL 5 SOLUTION
We’ve just spent quite some time explaining what ends up a very straightforward process. We know how to set one bit: raise 2 to the power of the position minus 1. Toss in an XOR operator and we barely fill a short line:
say $ARGV[0] ^ (2 ** ($ARGV[1]-1));That’s really all we need to do. Brilliant.
raku solution
I can’t even think of anything to do with it in Raku that isn’t longer and clunkier. Although I’ve learned to look, they don’t seem to have added a special “raise 2 to the power of” operator. Well, not yet. The bitwise operators have a slightly different namespace, with a ‘+’ prepended, but the rest is the same.
unit sub MAIN ( Int $num, Int $pos ) ;
say $num +^ 2**($pos-1);episode two:
“Avon Calling!”
task 2
The TRAVELING Salesman
Submitted by: Jorg Sommrey
You are given a NxN matrix containing the distances between N cities.
Write a script to find a round trip of minimum length visiting all N cities exactly once and returning to the start.
Example
Matrix: [0, 5, 2, 7]
[5, 0, 5, 3]
[3, 1, 0, 6]
[4, 5, 4, 0]
Output:
length = 10
tour = (0 2 1 3 0)
BONUS 1: For a given number N, create a random NxN distance matrix and find a solution for this matrix.
BONUS 2: Find a solution for a random matrix of size 15×15 or 20×20
Method
In a naive implementation of the problem, we need to look at all of the different ways of arranging the of cities in an itinerary, sum the traveling distances between points in each version and find the smallest. This works fine for shorter tours, but gets increasingly complicated at an increasing rate as more cities get added to the agenda.
Each additional city connects with some distance to every other city, so for however many paths there were for n cities, if we add an additional city we will be able to insert that new city between every two points in every existing path.
Working forwards from 1 city, where n is the new number of cities, we get the formula
1 × 2 × 3 × … (n – 1) × n
or n factorial, n!
Unsurprisingly, this happens to be the number of ways to permute list of of cities.
The problem is, is that it’s really, really hard to get around this complexity. The best exact solution algorithms still show exponential growth, albeit less than factorial.
The fact that the problem is hard does not, also, make the real-world manifestations of the problem go away. Trucks still need to be routed, and salesmen need to sell. Given the need, a better solution is better than no solution at all, even if it may not be the very best. The complexity is so great that for large numbers of points of contact it becomes difficult if not impossible to definitively decide the merits of a given solution, only that it more or less successfully approaches a computable lower bound. We can easily verify that a solution visits all the cities, but who knows it this solution is the very best, minimal path? We’ve got work to do. The roads must roll.
In this context, the next step is often to come up with a best guess. With heuristic algorithms guiding the way, if we can do statistically better than a random circuit we’ve gained something. There has been quite a lot of focus in this area of development, to come up with a pretty good answer in a reasonable length of time.
Notes on the Challenge
There are a couple of points to consider when assessing the problem as stated. First, we have what is known as a complete graph, where every city is directly connected to every other city. This is not always true in the real-world. In the rainy season the crick rises, and the ford goes high, and “You can’t get there from here”.
Sometimes, even, as in the case of land travel to an island, the graph is disconnected and there quite literally can be no path that exists, even indirectly, to get there. The real world, as I’ve said many times, is a lot messier than the models we make of it.
Another aspect we note is that the distances in the example are asymmetrical. I may cost 7 to get from city 0 to city 3, but because of the jet stream, it only costs 4 to do the return trip. By the way these numbers, culled from the example, correspond well with my air travel time to Las Vegas. In a routing algorithm we will would wish to to allow for one-way streets, road construction and congestion. So this is a realistic modeling of a complex system.
Lastly the data is random, or at least we’ve been asked to provide random data. In a list of actual cities, with physical locations, and a constant-cost interconnection network of roads connecting them, the points can be directly plotted, giving rise to some geometric approaches to the problem involving subdividing a convex hull circumnavigating the perimeter. A real salesman looking at a map might do this, but that won’t be fruitful here. The sole piece of data we’re given to work with is a matrix of costs of cities listed in rows traveling to cities listed in columns.
PERL 5 SOLUTION
We’re going to implement a few versions of a solution here.
0 14 30 4 15 19 14 18 23 28
19 0 1 3 18 30 25 4 3 25
11 17 0 10 12 8 22 8 22 1
13 19 13 0 26 6 27 17 10 21
7 12 28 14 0 19 7 15 3 6
16 12 12 3 17 0 24 2 1 15
23 9 30 30 9 3 0 26 19 18
2 14 19 22 14 14 30 0 25 5
8 8 13 10 27 19 23 23 0 24
10 1 7 28 14 11 29 23 14 0
exact:
min dist 52
tour 0 3 8 1 2 9 4 6 5 7 0
nearest neighbor bidirectional:
min dist 66
tour 0 3 7 4 6 5 8 1 2 9 0
nearest neighbor:
min dist 84
tour 0 3 5 8 6 4 7 1 2 9 0
nearest insertion:
min dist 99
tour 0 6 1 2 7 5 8 3 4 9 0
FIrst, we’re going to create an exact solution, using a breadth-first search to connect every pathway and add them up, selecting the shortest. As every route will contain the start city and every route connecting that city to every other city will be investigated we will anchor our search from there. This will also reduce some unnecessary duplication, as the tours
0 → 1 → 2 → 3 → 0
1 → 2 → 3 → 0 → 1
2 → 3 → 0 → 1 → 2
and
3 → 0 → 1 → 2 → 3
are all the same when rotated to begin at the assigned starting city 0.
We’ll need to calculate all permutations of the cities to connect them, so we’ll import Algorithm::Combinatorics for its permutations routine.
sub exact_ts ($mat) {
## naive exact implementation permuting and summing all possibilities. Only
## useful for smaller values of N, up to about 12
return (0, []) if $mat->@* > 12;
## metainfo about matrix
my %stats;
## starting city is at index 0
my $start = $mat->[0];
## permute cities other than start city by index
my $iter = permutations( [0..scalar $mat->@*-2] );
my $dist;
my $sp;
my $min = "Inf";
while ( my $p = $iter->next ) {
## from start to first city
$dist = $start->[ $p->[0]+1 ];
## loop through permutation of cities
for my $i (0..$p->@*-2) {
$dist += $mat->[ $p->[$i]+1 ][ $p->[$i+1]+1 ];
}
## return to start
$dist += $mat->[ $p->[ $p->@*-1 ]+1 ][ 0 ]; ## back to start
if ( $dist < $min ) {
$sp = $p;
$min = $dist;
}
}
## append and prepend 0 index to tour for completeness
my $path = [ 0, (map { $_ + 1 } $sp->@*), 0 ];
return ($min, $path);
}
Next we’ll try a straightforward heuristic known as “nearest neighbor”. In this algorithm we start with the shortest connection and build from its endpoint, adding the closest city from the remaining unallocated pool of candidates. The endpoint is updated and the process repeated until there are no more cities to allocate, and the last city is then connected back to the chosen start.
Because the smallest-cost connection in the matrix will probably not originate at the given start city, the resulting tour will need to be rotated until it originates there. This necessitates a little fiddling with our circular-array-laid-flat; in this format the start city value is seen twice, representing the origin of the first edge connection, between the first two cities, and the destination side of the last edge, connecting the last two cities. Remember that the distances are between cities, not the cities themselves.
sub nn_ts ($mat) {
## a nearest-neighbor heuristic
## as the graph is asymmetrical, we start at the shortest arc to ensure using it. Every
## tour visits every city, but only use 1/2 of the arcs to complete a the specific path
## in the direction chosen.
## create a list of unvisited cities
my %cities = map { $_ => 1 } keys $mat->@*;
## starting city holds shortest arc
my ($start, $dist) = (0, "Inf");
my @mins = map { my $idx = $_; min grep { $_ > 0 } ( $idx->@* ) } $mat->@*;
while ( my ($k, $v) = each @mins ) {
($start, $dist) = ($k, $v) if $v < $dist;
}
my $city = first { $mat->[$start][$_] == $dist }
(0..$mat->[$start]->@* - 1);
## start building the shortest path and removing visited cities from options
my @sp = ( $start, $city );
delete @cities{ @sp };
while (scalar keys %cities) {
my $min = min( map { $mat->[$city][$_] } keys %cities );
my $next = first { $mat->[$city][$_] == $min }
grep { exists $cities{$_} } (0..$mat->[$city]->@* - 1);
$dist += $min;
push @sp, $next;
delete $cities{ "$next" };
$city = $next;
}
## link back to base, rotate and return
$dist += $mat->[$city][$start];
while ( $sp[0] ) { push @sp, shift @sp };
return ( $dist, [ @sp, 0 ] );
}This method compares pretty well, all in all. Often, with smaller matrices, and symmetrical matrices, it will arrive at the optimal exact solution at fraction of the computational cost. But can we improve it?
The next version makes the growth bidirectional: at each juncture the pool of connections from both ends of the growing path are examined and the smallest selected, growing the tour from either the start or the end as required. Using random matrices this appears to provide a slight improvement, but this is not always the case, either, making an exact confirmation of this hypothesis difficult.
This highlights the fundamental problem with refining the solutions: it’s easy to verify that a given tour connects the required cities, but the effectiveness of a given heuristic is highly dependent on the specific data presented. Thus we can only determine general quality statistically.
sub nn_bidirectional_ts ($mat) {
## a nearest-neighbor heuristic
## bidirectional growth from both ends of the partial tour, selecting the
## best next step
## create a list of unvisited cities
my %cities = map { $_ => 1 } keys $mat->@*;
## starting city holds shortest arc
my ($start, $dist) = (0, "Inf");
my @mins = map { my $idx = $_; min grep { $_ > 0 } ( $idx->@* ) } $mat->@*;
while ( my ($k, $v) = each @mins ) {
($start, $dist) = ($k, $v) if $v < $dist;
}
my $city = first { $mat->[$start][$_] == $dist }
(0..$mat->[$start]->@* - 1);
## start building the shortest path and removing visited cities from options
my @sp = ( $start, $city );
delete @cities{ @sp };
while (scalar keys %cities) {
my $min_end = min( map { $mat->[$city][$_] } keys %cities );
my $next_end = first { $mat->[$city][$_] == $min_end }
grep { exists $cities{$_} } (0..$mat->[$city]->@* - 1);
my $min_start = min( map { $mat->[$_][$start] } keys %cities );
my $next_start = first { $mat->[$_][$start] == $min_start }
grep { exists $cities{$_} } (0..$mat->[$city]->@* - 1);
if ($min_start < $min_end) {
$dist += $min_start;
unshift @sp, $next_start;
delete $cities{ "$next_start" };
$start = $next_start;
}
else {
$dist += $min_end;
push @sp, $next_end;
delete $cities{ "$next_end" };
$city = $next_end;
}
}
## link back to base, rotate and return
$dist += $mat->[$city][$start];
while ( $sp[0] ) { push @sp, shift @sp };
return ( $dist, [ @sp, 0 ] );
}
Finally we will try what is known as an insertion method. In this the growth is lateral, so to speak, exchanging an existing connection edge in a partial tour with a pair of connections to and from a new city. Starting with a triangular tour of three cities, at each juncture we insert the city with the lowest cost between two existing cities in the tour. The cost used here is the cost to the new city, plus the return to the previous destination city, minus the original distance from the source to the destination. In this way the longest connections in the original tour will have a tendency to be replaced first.
Again once we have a complete tour it will need to be rotated to originate at the given start city.
This method has a lot of moving parts, primarily in the selection of the base tour. I picked a triangle to ensure a loop will be constructed, originally composed from the shortest paths available. However, during the insertion process all of the original connections are likely to be replaced, so we appear to be tossing out the shortest paths at the beginning. Maybe. Or at least one, but the actual growth is unpredictable. So I tried using the longest paths available, but it didn’t seem to make much difference, or perhaps was a slightly worse choice. I also systematically tried the shortest path, completed by the longest pair to provide two long edges to insert into. This too was not noticeably superior, which I found unexpected. Perhaps the ideal would be a kernel composed of three edges closest to the mean. Or two short and one long. It’s all very hard to say. But I eventually returned the model to the three shortest as that seemed as good as any I had found.
sub insert_ts ($mat) {
## an insertion heuristic
## an original amalgamation of several insertion algorithms
## some generic containers we'll be reusing
my ($city, $dist);
## create a list of indexes of unvisited cities
my %cities = map { $_ => 1 } keys $mat->@*;
## starting city holds shortest arc
my ($start, $end);
$dist = "Inf";
my @mins = map { my $idx = $_; min grep { $_ > 0 } ( $idx->@* ) }
$mat->@*;
while ( my ($k, $v) = each @mins ) {
($start, $dist) = ($k, $v) if $v < $dist;
}
$end = first { $mat->[$start][$_] == $dist }
(0..$mat->[$start]->@* - 1);
delete @cities{ $start, $end };
## find the city that minimizes the distance from the tour end
## to the new city and back to the start, to form a triangle
## tried min and max, this seems slightly better. Should, in an
## asymmetric matrix, perhaps be closest to the mean.
$dist = "Inf";
for (sort keys %cities) {
my $d = $mat->[$end][$_] + $mat->[$_][$start];
($city, $dist) = ($_, $d) if $d < $dist;
}
delete $cities{ $city };
## establish the working subtour
my @tour = ( $start, $end, $city, $start );
my $pick;
while ( keys %cities ) {
## find the city with the shortest insertion
for $city ( sort keys %cities ) {
for my $start_index (0..@tour-2) {
my $d = min ( $mat->[$start_index][$city], $mat->[$city][$start_index+1] );
if ($d < $min) {
$pick = $city;
}
}
}
## find the best insert point
my @best = (undef, undef, "Inf"); #( city, $insert position, distance );
for my $start_index (0..@tour-2) {
my $cost = $mat->[$start_index][$pick]
+ $mat->[$pick][$start_index+1]
- $mat->[ $tour[$start_index] ][ $tour[$start_index+1] ];
if ($cost < $best[2]) {
@best = ( $pick, $start_index, $cost );
}
}
## and insert it into the tour after the start index
splice @tour, $best[1]+1, 0, $best[0];
delete $cities{ $best[0] };
}
pop @tour;
while ( $tour[0] ) { push @tour, shift @tour };
push @tour, 0;
$dist = 0;
for my $i ( 0..@tour-2 ) {
$dist += $mat->[ $tour[$i] ][ $tour[$i+1] ]
}
return ($dist, \@tour);
}
As we saw earlier in the results presented the nearest-neighbor bidirectional algorithm seemed to outperform its unidirectional counterpart, which in turn outperformed the insertion method. Not shown here is the data on the matrix, which composed of random values from 1 to 30. For a 10 city tour this makes the average tour length 155, which may or may not represent this specific selection of values. But generally we can see that we’re outperforming a random walk in all cases.
Sometimes the simple nearest neighbor did better than the bidirectional variant, but the insertion method as-is nearly always did worse than either. The run I selected for the demonstration is fairly indicative of the general results. YMMV.
The whole shebang:
use warnings;
use strict;
use utf8;
use feature ":5.26";
use feature qw(signatures);
no warnings 'experimental::signatures';
use Algorithm::Combinatorics qw( permutations );
use List::Util qw( min first );
# srand(1234567890);
my $mat = [
[0, 5, 2, 7],
[5, 0, 5, 3],
[3, 1, 0, 6],
[4, 5, 4, 0]
];
## uncomment to produce random asymmetrical matrix
$mat = rand_amat(8);
print_mat( $mat );
say '';
my ($min, $path);
($min, $path) = exact_ts( $mat );
say '';
say 'exact:';
say "\tmin dist $min";
say "\ttour $path->@*";
($min, $path) = nn_bidirectional_ts( $mat );
say '';
say 'nearest neighbor bidirectional:';
say "\tmin dist $min";
say "\ttour $path->@*";
($min, $path) = nn_ts( $mat );
say '';
say 'nearest neighbor:';
say "\tmin dist $min";
say "\ttour $path->@*";
($min, $path) = insert_ts( $mat );
say '';
say 'nearest insertion:';
say "\tmin dist $min";
say "\ttour $path->@*";
sub exact_ts ($mat) {
## naive exact implementation permuting and summing all possibilities. Only
## useful for smaller values of N, up to about 12
return (0, []) if $mat->@* > 12;
## metainfo about matrix
my %stats;
## starting city is at index 0
my $start = $mat->[0];
## permute cities other than start city by index
my $iter = permutations( [0..scalar $mat->@*-2] );
my $dist;
my $sp;
my $min = "Inf";
while ( my $p = $iter->next ) {
## from start to first city
$dist = $start->[ $p->[0]+1 ];
## loop through permutation of cities
for my $i (0..$p->@*-2) {
$dist += $mat->[ $p->[$i]+1 ][ $p->[$i+1]+1 ];
}
## return to start
$dist += $mat->[ $p->[ $p->@*-1 ]+1 ][ 0 ]; ## back to start
if ( $dist < $min ) {
$sp = $p;
$min = $dist;
}
}
## append and prepend 0 index to tour for completeness
my $path = [ 0, (map { $_ + 1 } $sp->@*), 0 ];
return ($min, $path);
}
sub nn_ts ($mat) {
## a nearest-neighbor heuristic
## as the graph is asymmetrical, we start at the shortest arc to ensure using it. Every
## tour visits every city, but only use 1/2 of the arcs to complete a the specific path
## in the direction chosen.
## create a list of unvisited cities
my %cities = map { $_ => 1 } keys $mat->@*;
## starting city holds shortest arc
my ($start, $dist) = (0, "Inf");
my @mins = map { my $idx = $_; min grep { $_ > 0 } ( $idx->@* ) } $mat->@*;
while ( my ($k, $v) = each @mins ) {
($start, $dist) = ($k, $v) if $v < $dist;
}
my $city = first { $mat->[$start][$_] == $dist }
(0..$mat->[$start]->@* - 1);
## start building the shortest path and removing visited cities from options
my @sp = ( $start, $city );
delete @cities{ @sp };
while (scalar keys %cities) {
my $min = min( map { $mat->[$city][$_] } keys %cities );
my $next = first { $mat->[$city][$_] == $min }
grep { exists $cities{$_} } (0..$mat->[$city]->@* - 1);
$dist += $min;
push @sp, $next;
delete $cities{ "$next" };
$city = $next;
}
## link back to base, rotate and return
$dist += $mat->[$city][$start];
while ( $sp[0] ) { push @sp, shift @sp };
return ( $dist, [ @sp, 0 ] );
}
sub nn_bidirectional_ts ($mat) {
## a nearest-neighbor heuristic
## bidirectional growth from both ends of the partial tour, selecting the
## best next step
## create a list of unvisited cities
my %cities = map { $_ => 1 } keys $mat->@*;
## starting city holds shortest arc
my ($start, $dist) = (0, "Inf");
my @mins = map { my $idx = $_; min grep { $_ > 0 } ( $idx->@* ) } $mat->@*;
while ( my ($k, $v) = each @mins ) {
($start, $dist) = ($k, $v) if $v < $dist;
}
my $city = first { $mat->[$start][$_] == $dist }
(0..$mat->[$start]->@* - 1);
## start building the shortest path and removing visited cities from options
my @sp = ( $start, $city );
delete @cities{ @sp };
while (scalar keys %cities) {
my $min_end = min( map { $mat->[$city][$_] } keys %cities );
my $next_end = first { $mat->[$city][$_] == $min_end }
grep { exists $cities{$_} } (0..$mat->[$city]->@* - 1);
my $min_start = min( map { $mat->[$_][$start] } keys %cities );
my $next_start = first { $mat->[$_][$start] == $min_start }
grep { exists $cities{$_} } (0..$mat->[$city]->@* - 1);
if ($min_start < $min_end) {
$dist += $min_start;
unshift @sp, $next_start;
delete $cities{ "$next_start" };
$start = $next_start;
}
else {
$dist += $min_end;
push @sp, $next_end;
delete $cities{ "$next_end" };
$city = $next_end;
}
}
## link back to base, rotate and return
$dist += $mat->[$city][$start];
while ( $sp[0] ) { push @sp, shift @sp };
return ( $dist, [ @sp, 0 ] );
}
sub insert_ts ($mat) {
## an insertion heuristic
## an original amalgamation of several insertion algorithms
## some generic containers we'll be reusing
my ($city, $dist);
## create a list of indexes of unvisited cities
my %cities = map { $_ => 1 } keys $mat->@*;
## starting city holds shortest arc
my ($start, $end);
$dist = "Inf";
my @mins = map { my $idx = $_; min grep { $_ > 0 } ( $idx->@* ) }
$mat->@*;
while ( my ($k, $v) = each @mins ) {
($start, $dist) = ($k, $v) if $v < $dist;
}
$end = first { $mat->[$start][$_] == $dist }
(0..$mat->[$start]->@* - 1);
delete @cities{ $start, $end };
## find the city that minimizes the distance from the tour end
## to the new city and back to the start, to form a triangle
## tried min and max, this seems slightly better. Should, in an
## asymmetric matrix, perhaps be closest to the mean.
$dist = "Inf";
for (sort keys %cities) {
my $d = $mat->[$end][$_] + $mat->[$_][$start];
($city, $dist) = ($_, $d) if $d < $dist;
}
delete $cities{ $city };
## establish the working subtour
my @tour = ( $start, $end, $city, $start );
my $pick;
while ( keys %cities ) {
## find the city with the shortest insertion
for $city ( sort keys %cities ) {
for my $start_index (0..@tour-2) {
my $d = min ( $mat->[$start_index][$city], $mat->[$city][$start_index+1] );
if ($d < $min) {
$pick = $city;
}
}
}
## find the best insert point
my @best = (undef, undef, "Inf"); #( city, $insert position, distance );
for my $start_index (0..@tour-2) {
my $cost = $mat->[$start_index][$pick]
+ $mat->[$pick][$start_index+1]
- $mat->[ $tour[$start_index] ][ $tour[$start_index+1] ];
if ($cost < $best[2]) {
@best = ( $pick, $start_index, $cost );
}
}
## and insert it into the tour after the start index
splice @tour, $best[1]+1, 0, $best[0];
delete $cities{ $best[0] };
}
pop @tour;
while ( $tour[0] ) { push @tour, shift @tour };
push @tour, 0;
$dist = 0;
for my $i ( 0..@tour-2 ) {
$dist += $mat->[ $tour[$i] ][ $tour[$i+1] ]
}
return ($dist, \@tour);
}
## ## ## matrix construction functions
sub rand_amat ($size) {
## create a random asymmetric distance matrix of size $size
## for arcs of a complete graph
$size -= 1;
my @mat;
for (0..$size) {
my @row;
push @row, int( rand($size*$size/2) + 1 ) for (0..$size);
$row[$_] = 0;
push @mat, \@row;
}
return \@mat;
}
sub rand_smat ($size) {
## create a random symmetric distance matrix of size $size
## for arcs of a complete graph
$size -= 1;
my @mat;
for my $i (0..$size) {
for my $j ($i..$size) {
if ($i == $j) {
$mat[$i][$j] = 0;
next;
}
$mat[$i][$j] = $mat[$j][$i] = int( rand($size*$size) + 1 )
}
}
return \@mat;
}
sub print_mat ($mat, $width = 5) {
## print matrix allowing space $width chars wide per element
say '';
my $format = ("%${width}d" x scalar $mat->@*) . "\n";
for my $row ($mat->@*) {
printf $format, $row->@*;
}
}
Raku Solution
In Raku we have a permutations routine built-in. Translating the exact method over was pretty straightforward. Because the start city is set at 0 we need permutations of the remaining cities starting at 1, so we permute over 1 to the last index. It’s cleaner in Raku, which is nice.
unit sub MAIN () ;
my @mat = [0, 5, 2, 7],
[5, 0, 5, 3],
[3, 1, 0, 6],
[4, 5, 4, 0];
my $dist;
my @sp;
my $min = ∞ ;
for (1..@mat.elems-1).permutations -> @p {
$dist = @mat[0][ @p[0] ]; ## start leg
for 0..@p.elems-2 -> $i { ## city-to-city
$dist += @mat[ @p[$i] ][ @p[$i+1] ];
}
$dist += @mat[ @p[*-1] ][ 0 ]; ## return leg
if $dist < $min {
@sp = @p;
$min = $dist;
}
}
say $_ for @mat;
say '';
say "shortest path $min";
say "path: ", (0, |@sp, 0).join: ' → '
The Perl Weekly Challenge, that idyllic glade wherein we stumble upon the holes for these sweet descents, is now known as
The Weekly Challenge – Perl and Raku
It is the creation of the lovely Mohammad Sajid Anwar and a veritable swarm of contributors from all over the world, who gather, as might be expected, weekly online to solve puzzles. Everyone is encouraged to visit, learn and contribute at
Programming Excursions in Perl and Raku 