Inverted Salesman with Raku and Perl
[137] Published 18. July 2021.This is my response to the Perl Weekly Challenge #121.
Challenge #121.1: Invert Bit
$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
Last week I avoided bitwise operations, with (in my view) clever use of
comb and flip. I'll use bitwise operators
this time.
We get the digit to flip (the decimal value) by applying 2 to the power of N-1. (The bits are numbered from zero, so we must subtract 1 to get it right; as e.g. the first bit from the end has index zero):
Flipping the bit(s) with a decimal value is a job for the Exclusive Or bitwise operator.
File: invert-bit
#! /usr/bin/env raku
unit sub MAIN (Int $m where 0 <= $m <= 255, # [1]
Int $n where 1 <= $n <= 8, # [2]
:v(:$verbose));
my $mask = 2 ** ($n -1); # [3]
my $result = $m +^ $mask; # [4]
if $verbose
{
say ": Binary: { $m.fmt('%08b') }";
say ": Mask: { $mask.fmt('%08b') }";
say ": XOR: { $result.fmt('%08b') }";
}
say $result; # [5]
[1] Ensure an integer in the range 0..255. Note the stacked comparison.
[2] Ensure an integer in the range 1..8.
[3] The mask; i.e. the bit to flip.
[4] Apply the mask (from [3]) to the initial value with the Exclusive Or operator
+^ to flip the bit.
[5] Print the result.
See
docs.raku.org/language/operators#index-entry-Integer_bitwise_XOR_operator
for more information about the Exclusive Or (bitwise) operator +^.
Running it:
$ ./invert-bit 12 3
8
$ ./invert-bit 18 4
26
Looking good.
With verbose mode:
$ ./invert-bit -v 12 3
: Binary: 00001100
: Mask: 00000100
: XOR: 00001000
8
$ ./invert-bit -v 18 4
: Binary: 00010010
: Mask: 00001000
: XOR: 00011010
26
A Perl Version
This is straight forward translation of the Raku version. File: invert-bit-perl
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use Getopt::Long;
my $verbose = 0;
GetOptions("verbose" => \$verbose);
my $m = $ARGV[0] // "";
die "Please specify an integer in the range 0..255 (first arg)"
if $m !~ /^\d+$/ || $m > 255;
my $n = $ARGV[1] // "";
die "Please specify an integer in the range 1..8 (second arg)"
if $n !~ /^[1-8]$/;
my $mask = 2 ** ($n -1);
my $result = $m ^ $mask; # [1]
if ($verbose)
{
say ": Binary: ", sprintf('%08b', $n);
say ": Mask: ", sprintf('%08b', $mask);
say ": XOR: ", sprintf('%08b', $result);
}
say $result;
[1] Note the Perl Exclusive Or operator ^.
Running it gives the same result as the Raku version:
$ ./invert-bit-perl 12 3
8
$ ./invert-bit-perl -v 12 3
: Binary: 00000011
: Mask: 00000100
: XOR: 00001000
8
$ ./invert-bit-perl 18 4
26
$ ./invert-bit-perl -v 18 4
: Binary: 00000100
: Mask: 00001000
: XOR: 00011010
26
Challenge #121.2: The Travelling Salesman
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 2: Find a solution for a random matrix of size 15x15 or 20x20
Note the zeroes on the diagonal (top left to bottom right). This means that the distance from any city to itself is zero. Which really does not matter, as we do not want to go there (so to speak). I will not enforce these zeroes, nor generate them for the random matrices, as they really does not matter.
Also note that the distance from any given city to another one may not be the same as the opposite direction. We can explain that discrepancy away, e.g. by saying that we have one-way streets only - or that the cities have different elevation, and that the value is more like fuel cost than actual distance. But again, it does not really matter.
The program handles a custom specified matrix, or a size (the N value). If none of those are used, you get the default matrix (as given in the challenge).
The format for the custom specified matrix is taken from Zero Order with Raku & Perl (the first part), my response to the Perl Weekly Challenge #068.
File: travelling-salesman (partial)
#! /usr/bin/env raku
multi MAIN (Int $N, :v(:$verbose)) # [1]
{
my $matrix = (^$N).map({ (^$N).pick(*).join(" ") }).join(" | "); # [2]
########### 2a ######## 2b ###################### # 2c ######
say ": Matrix: $matrix";
MAIN($matrix, :$verbose); # [3]
}
[1] We use multiple dispatch (the multi keyword) to handle different kinds of
arguments. This version of the program takes an integer, and optionally the verbose flag.
[2] The integer is the size of the random matrix. Set it up. The outer
level [2a] is a loop for each line in the matrix. The second one (inside the map)
[2b] uses pick to get all the values in the list (in this case
«0..$N-1» - specified with the shorthand «^$N») in a random
order. The join glues them together with a space between the values. The next
join [2c] glues the rows in the matrix together with a bar character (and some
spaces). The result is a string like e.g. «1 2 3 | 2 3 1 | 2 1 3».
[3] Pass the random matrix and the verbose flag on to the other version of the MAIN function, described below.
See
docs.raku.org/routine/pick
for more information about pick.
multi MAIN (Str $matrix = "0 5 2 7 | 5 0 5 3 | 3 1 0 6 | 4 5 4 0", # [4]
:v(:$verbose))
{
my @NN = $matrix.split("|")>>.words>>.list; # [5]
my $size = @NN.elems; # [6a]
die "All the rows and coluns must have the same length"
unless all(@NN>>.elems) == $size; # [6]
if $verbose
{
for ^$size -> $from # [7]
{
for ^$size -> $to # [7a]
{
next if $from == $to; # [7b]
say ": Distance from city #$from to #$to: @NN[$from][$to]"; # [7c]
}
}
}
[4] Use the default matrix, if none is specified. Note the type; string. If we specify an
integer, the first multi is used instead.
[5] Get the matrix as a two dimentional array. The split("|") handles
the rows, and the >>.words call turns each row into a list of its own.
The final list turn the lazy data structure (as given by words)
into a list, so that we get a true matrix.
[6] Ensure that all the rows have the same length, which is the same as the number of rows [6a].
[7] This is for debug purposes only. The outer loop iterates over the city indices. As does the inner loop [7a], as we want to show the distances from all the cities to all the other ones. Skip the distance from the city to itself [7b]. Print the distance [7c].
File: travelling-salesman (partial)
say "" if $verbose;
my %solutions; # [8]
for (^$size).permutations -> @path is copy # [9]
{
@path.push: @path[0]; # [10]
my @path2 = @path.clone; # [11]
my $from = @path.shift; # [12]
my $length = 0; # [13]
while @path # [14]
{
my $to = @path.shift; # [15]
$length += @NN[$from][$to]; # [16]
say ": { @path2.join(" ") } | $from -> $to = @NN[$from][$to] \
(sum $length)" if $verbose;
$from = $to; # [17]
}
say "" if $verbose;
%solutions{$length}.push: @path2; # [18]
}
[8] The solutions (all of them) will end up here.
[9] Get all the possible permutations of the numbers 0..$N-1, and iterate over
them. Note the is copy so that we can change the array. (The default
is read only).
[10] The path has to round trip; add the first node at the end.
[11] The path before we meddle with it. We need the original value(s) for the solution hash (see [8] and [18]).
[12] Get the first node.
[13] The length so far, which is zero initially.
[14] As long as we have nodes left to traverse.
[15] Get the next node.
[16] Add the distance between the two nodes to the total length.
[17] Set the current pointer to the second node, ready for the next iteration.
[18] Add the current path (the array) to the solution hash. The length is the key. Note that pushing to a hash is ok. The result is an array as value for that key. (But node that doing a push after a normal assignment will loose you the assigned value.)
File: travelling-salesman (final part)
if $verbose
{
for %solutions.keys.sort -> $length
{
for @(%solutions{$length}) -> @path
{
say ": $length - [ { @path.join(" ") } ]";
}
}
}
my $length = %solutions.keys.sort.first; # [19]
say "length = $length"; # [20]
say "tour = ({ %solutions{$length}[0].join(" ") })"; # [21]
}
[19] Sort the hash keys, and get the first one (with first).
That gives us the lowest value.
[20] The length,
[21] and the solution, or rather the first one.
See
docs.raku.org/routine/first
for more information about first.
Running it:
$ ./travelling-salesman
length = 10
tour = (0 2 1 3 0)
We got the same result as the page linked to in the challenge.
With randomly generated matrices:
$ ./travelling-salesman 3
: Matrix: 1 0 2 | 0 2 1 | 2 1 0
length = 3
tour = (0 1 2 0)
$ ./travelling-salesman 4
: Matrix: 0 1 3 2 | 1 2 3 0 | 3 2 1 0 | 1 2 0 3
length = 10
tour = (0 3 1 2 0)
$ ./travelling-salesman 5
: Matrix: 1 2 3 0 4 | 1 2 0 4 3 | 2 1 4 0 3 | 2 4 0 1 3 | 0 4 1 3 2
length = 10
tour = (0 1 2 4 3 0)
$ ./travelling-salesman 6
: Matrix: 0 3 2 4 5 1 | 5 0 1 4 2 3 | 4 1 5 2 0 3 | 5 3 4 0 1 2 | \
0 3 5 1 4 2 | 2 1 4 5 3 0
length = 10
tour = (0 2 1 4 3 5 0)
The generated matrix is printed so that we can check that it is correct. The format is the same as used for the input, so it is easy to pass it on to the program. Here with verbose mode (on a 3x3 matrix to keep the output short):
$ ./travelling-salesman -v "1 0 2 | 0 2 1 | 2 1 0"
: Distance from city #0 to #1: 0 # [1]
: Distance from city #0 to #2: 2
: Distance from city #1 to #0: 0
: Distance from city #1 to #2: 1
: Distance from city #2 to #0: 2
: Distance from city #2 to #1: 1
: 0 1 2 0 | 0 -> 1 = 0 (sum 0) # [2]
: 0 1 2 0 | 1 -> 2 = 1 (sum 1)
: 0 1 2 0 | 2 -> 0 = 2 (sum 3)
: 0 2 1 0 | 0 -> 2 = 2 (sum 2)
: 0 2 1 0 | 2 -> 1 = 1 (sum 3)
: 0 2 1 0 | 1 -> 0 = 0 (sum 3)
: 1 0 2 1 | 1 -> 0 = 0 (sum 0)
: 1 0 2 1 | 0 -> 2 = 2 (sum 2)
: 1 0 2 1 | 2 -> 1 = 1 (sum 3)
: 1 2 0 1 | 1 -> 2 = 1 (sum 1)
: 1 2 0 1 | 2 -> 0 = 2 (sum 3)
: 1 2 0 1 | 0 -> 1 = 0 (sum 3)
: 2 0 1 2 | 2 -> 0 = 2 (sum 2)
: 2 0 1 2 | 0 -> 1 = 0 (sum 2)
: 2 0 1 2 | 1 -> 2 = 1 (sum 3)
: 2 1 0 2 | 2 -> 1 = 1 (sum 1)
: 2 1 0 2 | 1 -> 0 = 0 (sum 1)
: 2 1 0 2 | 0 -> 2 = 2 (sum 3)
: 3 - [ 0 1 2 0 ] # [3]
: 3 - [ 0 2 1 0 ]
: 3 - [ 1 0 2 1 ]
: 3 - [ 1 2 0 1 ]
: 3 - [ 2 0 1 2 ]
: 3 - [ 2 1 0 2 ]
length = 3
tour = (0 1 2 0)
[1] This is the list of distances from cities to cities.
[2] This is the total distance for each path. The lines are for each part, with the total (sum) so far at the end of the line. The last line before each newline is the grand total.
[3] This block shows the paths (1 or many) for the lowest sum we got.
Rotation
The last element in the path is the same as the first, as our beloved salesman is required to return home. This implicitly gives us three identical solutions (when we have three elemenst in the path), in that they have the same length, for each path, when we rotate the list. «0 -> 1 -> 2 -> 0» is the same as «1 -> 2 -> 0 -> 1» and «2 -> 0 -> 1 -> 2» (when we do the rotation before adding the first node at the end).
We can check for that in the program, by registering the path when we get to a new
one, and skip those that match a old one when we rotate them. This gives a program
that does not have to compute as many distances, but the downside is that it has to
rotate the paths (and stringify them to get a string usable for a hash key). The
program «travelling-salesman-unduplicated» does just that, and is included in the zip
file. The overhead seems to actually make it slower for small(ish) values of
$N (with 9 as the point where it starts beeing faster, on my pc). With
high values for $N, both versions are depressingly
slow, but the modified version is faster (or rather, not as slow):
| $N | Original | Unduplicated |
| 7 | 0.5 sec | 0.6 sec |
| 8 | 2 sec | 2.5 sec |
| 9 | 19 sec | 14 sec |
| 10 | 4.75 min | 5.85 min |
| 11 | 378 min | 106 min |
I stopped at 11. The bonus values of 15 and (even worse) 20 are simply not doable with these programs.
The reason this takes so much time is the number of computations. The core problem is the
number of permutations. That can be expressed like 1*2*...*N, or N!
(N faculty). Raku does not have a faculty operator, but we can add one. But let us not go
there, this time. Manually computation is ok:
> say [*] 1..15; # -> 1,307,674,368,000
> say [*] 1..20; # -> 2,432,902,008,176,640,000
I have added the commas to make it easier to read the values. It will take an awfull lot of time to generate all those permutations, and the length of the paths. And worse, we cache the values so that we keep all the paths in memory.
(I used the same matrix for all three programs; the first one generated a random one, and the second and third one got that one on the command line.)
The «cache everything» approach is not very smart, as we store all the permutations in memory (as visited paths, with a corresponding length). Let us remedy that by only storing a single length (the shortest) and a corresponding path, and see where that leads us (timewise that is):
File: travelling-salesman-nosave
#! /usr/bin/env raku
multi MAIN (Int $N, :v(:$verbose))
{
my $matrix = (^$N).map({ (^$N).pick(*).join(" ") }).join(" | ");
say ": Matrix: $matrix";
MAIN($matrix, :$verbose);
}
multi MAIN (Str $matrix = "0 5 2 7 | 5 0 5 3 | 3 1 0 6 | 4 5 4 0",
:v(:$verbose))
{
my @NN = $matrix.split("|")>>.words>>.list;
my $size = @NN.elems;
die "All the rows and coluns must have the same length"
unless all(@NN>>.elems) == $size;
if $verbose
{
for ^$size -> $from
{
for ^$size -> $to
{
next if $from == $to;
say ": Distance from city #$from to #$to: @NN[$from][$to]";
}
}
}
say "" if $verbose;
my @solution; # [1]
my $solution-length = Inf; # [2]
my %seen;
PERM:
for (^$size).permutations -> @path is copy
{
my $candidate = @path.join(" ");
my @p = @path.clone;
for ^$size
{
@p.push: @p.shift;
next PERM if %seen{ @p.join(" ") };
}
%seen{$candidate} = True;
@path.push: @path[0];
my @path2 = @path.clone;
my $from = @path.shift;
my $length = 0;
while @path
{
my $to = @path.shift;
$length += @NN[$from][$to];
say ": { @path2.join(" ") } | $from -> $to = @NN[$from][$to] \
(sum $length)" if $verbose;
$from = $to;
}
say "" if $verbose;
if ($solution-length > $length) # [3]
{
$solution-length = $length;
@solution = @path2;
}
}
say "length = $solution-length";
say "tour = ({ @solution.join(" ") })";
}
[1]. The shortest path (so far) will go here.
[2] The length of the shortest path. Note the initial value (of infinity), so that we can find a shorter path.
[3] Have we found a shorter path? If so, save it.
The time usage looks like this:
| $N | Original | Unduplicated | Nosave |
| 7 | 0.5 sec | 0.6 sec | 0.05 sec |
| 8 | 2 sec | 2.5 sec | 1.9 sec |
| 9 | 19 sec | 14 sec | 15 sec |
| 10 | 4.75 min | 5.85 min | 3 min |
| 11 | 378 min | 106 min | 5 min 30 sec |
Perl
A Perl version of the second Raku program is included in the zip file (as «travelling-salesman-unduplicated-perl»). Timing values is presented later on.The following program is a straight forward translation of the third Raku version, where we only save the shortest path so far.
Perl does not have a permutations function, but the Algorithm::Permute module (the debian package «libalgorithm-permute-perl») does provide one for us.
File: travelling-salesman-nosave-perl
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use Getopt::Long;
use Algorithm::Permute;
my $verbose = 0;
GetOptions("verbose" => \$verbose);
my $matrix = $ARGV[0] // die "Please specify a matrix";
if ($matrix =~ /^\d+$/)
{
my @rows;
for (1 .. $matrix)
{
my @values = (0 .. $matrix -1);
my $p_iterator = Algorithm::Permute->new ( \@values );
push(@rows, join(" ", $p_iterator->next));
}
$matrix = join(" | ", @rows);
say ": Matrix: $matrix";
}
my @NN;
for my $row (split(/\s*\|\s*/, $matrix))
{
my @cols = split(/\s+/, $row);
push(@NN, \@cols);
}
my $size = @NN;
if ($verbose)
{
for my $from (0 .. $size -1)
{
for my $to (0 .. $size -1)
{
next if $from == $to;
say ": Distance from city #$from to #$to: " . $NN[$from][$to];
}
}
}
say "" if $verbose;
my @solution;
my $solution_length = $size ** $size ** $size; # [1]
my %seen;
my @p2 = 0 .. $size -1;
my $p_iterator = Algorithm::Permute->new ( \@p2 );
PERM:
while (my @path = $p_iterator->next)
{
my $candidate = join(" ", @path);
my @p = @path;
for (1 .. $size)
{
push(@p, shift @p);
next PERM if $seen{ join(" ", @p) };
}
$seen{$candidate} = 1;
push(@path, $path[0]);
my @path2 = @path;
my $from = shift @path;
my $length = 0;
while (@path)
{
my $to = shift @path;
$length += $NN[$from][$to];
say ": " . join(" ", @path2) . " | $from -> $to = " . $NN[$from][$to]
. " (sum $length)" if $verbose;
$from = $to;
}
say "" if $verbose;
if ($solution_length > $length)
{
$solution_length = $length;
@solution = @path2;
}
}
say "length = $solution_length";
say "tour = (" . join(" ", @solution) . ")";
[1] Perl does not have a way of expressing infinity, but we can fake a value that (hopefully) is high enough...
Running it gives the expected result:
$ ./travelling-salesman-nosave-perl "0 5 2 7 | 5 0 5 3 | 3 1 0 6 | 4 5 4 0"
length = 10
tour = (2 1 3 0 2)
And a random one, for the road:
$ ./travelling-salesman-nosave-perl 4
: Matrix: 3 2 1 0 | 3 2 1 0 | 3 2 1 0 | 3 2 1 0
length = 6
tour = (3 2 1 0 3)
Time Usage
| $N | Original | Unduplicated | Nosave | Unduplicated Perl | Nosave Perl |
| 7 | 0.5 sec | 0.6 sec | 0.05 sec | 0.03 sec | 0.04 sec |
| 8 | 2 sec | 2.5 sec | 1.9 sec | 0.18 sec | 0.23 sec |
| 9 | 19 sec | 14 sec | 15 sec | 1.75 sec | 2.5 sec |
| 10 | 4.75 min | 5.85 min | 3 min | 23 sec | 26 sec |
| 11 | 378 min | 106 min | 62 min | 5.5 min | 7 min |
| 12 | 64 min | 63 min |
Raku is fast enough for values up to 8, and Perl can do 9 as well. The bonus values of 15 and 20 are off the chart, utterly unobtainable by these programs.
And that's it.