Perl Weekly Challenge: Week 121
Challenge 1:
Invert Bit
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
This is very easy to do in Perl; a one liner even. We find the right bit to invert by left shifting 1, $n ($ARGV[1]) number of places minus 1 because we are starting from position 0. Then that is XOR'ed with $m ($ARGV[0]) to flip that bit.
say $ARGV[0] ^ (1 << $ARGV[1] - 1);
And it's a one-liner in Raku as well. Notice the extra pair of parentheses around @*ARGS[1] - 1. I was initially completely mystified by the wrong answers I was getting from a straight port of the Perl code until I realized that Raku had changed the order of precedence for left bit shift from what Perl had it as.
say @*ARGS[0] +^ (1 +< (@*ARGS[1] - 1));
Challenge 2:
The Travelling Salesman
You are given a
NxNmatrix containing the distances betweenNcities.Write a script to find a round trip of minimum length visiting all
Ncities 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 15x15 or 20x20
Unfortunately due to a severe lack of a time, I was not able to get this one done in time for submission though I will try to do it later.
update 7/15/24
Well it took me long enough but I finally got around to revisiting this. The Travelling Salesman Problem is one of the most famous problems in Computer Science and much has been written on how to solve it optimally. I have only done a simple implementation This page was helpful in making sure I had the algorithm correct.
The code below can solve the example and matrices of random size as per bonus 1. It is just about usable for larger matrices as per bonus 2 but you really would want a more optimal algorithm at those sizes.
The matrix is built up from command-line arguments. Each argument represents a row of the matrix and is a string consisting of integers seperated by spaces. The integers represent the cost of travelling between two cities. For
instance, @matrix[0][2] is the cost to travel between city 0 and city 2.
my @matrix = @args.map({ [$_.words] });
We will need to keep track of the minimum length. This is initially set to the highest possible value.
my $minimumLength = ∞;
The output in the example also shows the path the salesman took to visit every city. We will keep track of this also and initially the path will be empty.
my @tour = ();
Now the main part of the solution will be to go through every path from city to city and find the one with the lowest cost. Initially, I had another loop here so we could start the tour from each city. But then I realized that because the costs are fixed, the shortest route would be in the same order and have the same cost, no matter where you started from.
So for the purposes of this script I assume we will always be starting from city 0. Each permutation of
indices of @matrix[0] represents a path through the matrix. For each such path...
for (@matrix[0].keys).permutations -> $perm {
...the initial cost is 0.
my $cost = 0;
The city we are starting from is 0.
my $from = 0;
We have to filter out city 0 from the list of cities we are going to visit as we obviously already have been there.
my @cities = @$perm.grep({ $_ != 0});
We traverse through the list of remaining cities by index...
for @cities.keys -> $i {
...and add the cost of travelling from city $from to city @cities[$i].
$cost += @matrix[$from;@cities[$i]];
@cities[$i] becomes the new value of $from.
$from = @cities[$i];
}
After we have gone through the whole list, to complete the circuit, we add the cost of travelling from
city $from to city 0.
$cost += @matrix[$from;0];
If the cost just calculated is less than the current minimum cost (or length, I have been inconsistent in naming here.) It becomes the new minimum and the path is also stored in @tour.
if $cost < $minimumLength {
$minimumLength = $cost;
@tour = @cities;
}
}
After processing all paths, we print the minimum length and the path that got us to there. The path doesn't include the starting and ending city (which is the same, city 0) so those are hard coded in.
say "length = $minimumLength";
say 'tour = (0 ', @tour.join(q{ }), ' 0)';
This is the Perl version. In order to fully translate it from Raku, I had to provide
my own permute() function. I used the one I have employed in previous challenges which I originally got
from perlfaq4. However I ran into
a small problem. That function uses prototypes. The latest versions of Perl support function signatures which
do not always interact properly with prototypes. You can convert a prototype-using function to the new way but
if you can't or won't, a simple workaround (which I found from the perlsub manual page) is to use an attribute like this.
sub permute :prototype(&@) {
Apparently there are other attributes you can use in a function signature. I will have to study this more.
The rest of the code is similar to the Raku version.
my @matrix = map { [ split /\s+/, $_ ] } @ARGV;
my $minimumLength = "Inf";
my @tour = ();
my @permutations;
permute { push @permutations, \@_; } keys @{$matrix[0]};
for my $perm (@permutations) {
my $cost = 0;
my $from = 0;
my @cities = grep { $_ != 0} @{$perm};
for my $i (keys @cities) {
$cost += $matrix[$from]->[$cities[$i]];
$from = $cities[$i];
}
$cost += $matrix[$from]->[0];
if ($cost < $minimumLength) {
$minimumLength = $cost;
@tour = @cities;
}
}
say "length = $minimumLength";
say 'tour = (0 ', (join q{ }, @tour), ' 0)';