# RabbitFarm

### 2021-07-18

#### A Genetic Algorithm solution to the Travelling Salesman Problem

*The examples used here are from The Weekly Challenge problem statement and demonstrate
the working solution.*

## Part 1

*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.*

### Solution

```
use strict;
use warnings;
sub flip_bit_n{
my($x, $n) = @_;
my $bits = substr(unpack("B32", pack("N", $x)), 24, 8);
my @bits = split(//, $bits);
$bits[@bits - $n] ^= 1;
my $flipped_decimal = unpack("N", pack("B32", substr("0" x 32 . join("", @bits), -32)));
return $flipped_decimal;
}
MAIN:{
my($M, $N);
$M = 12;
$N = 3;
print flip_bit_n($M, $N) . "\n";
$M = 18;
$N = 4;
print flip_bit_n($M, $N) . "\n";
}
```

### Sample Run

```
$ perl perl/ch-1.pl
8
26
```

### Notes

This code re-uses much of the code from last week's challenge solution.
The only difference is that this week we flip the specified nth bit using the XOR
operator. I think that this may be the first time I have ever used a `^=`

operation!

## Part 2

*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.*

### Solution

```
use strict;
use warnings;
use boolean;
use AI::Genetic;
use constant N => 7;
my @matrix= ([0, 5, 2, 7],
[5, 0, 5, 3],
[3, 1, 0, 6],
[4, 5, 4, 0]);
sub fitness{
my($genes) = @_;
my $cost = 0;
return -1 if $genes->[0] != $genes->[@{$genes} - 1];
my @path = sort {$a <=> $b} @{$genes}[0 .. @{$genes} - 2];
for my $i (0 .. (@path - 2)){
return -1 if $path[$i] == $path[$i + 1];
}
for my $i (0 .. @{$genes} - 2){
$cost += $matrix[$genes->[$i]][$genes->[$i + 1]];
}
return 1/$cost;
}
sub terminate{
return true;
}
MAIN:{
srand(121);
my $aig = new AI::Genetic(
-fitness => \&fitness,
-type => "rangevector",
-population => 500,
-crossover => 0.9,
-mutation => 0.1,
);
my $genes = [];
for (0 .. N + 1){
push @{$genes}, [0, N];
}
@matrix = ();
for (0 .. N){
my $row = [];
for my $i (0 .. N){
push @{$row}, int(rand(N * 2 + 1));
}
push @matrix, $row;
}
$aig->init(
$genes
);
$aig->evolve("tournamentUniform", 100000);
my $path = $aig->getFittest()->genes();
print join(",", @{$path}) . "\n";
my $cost;
for my $i (0 .. @{$path} - 2){
$cost += $matrix[$path->[$i]][$path->[$i + 1]];
}
print "cost: $cost\n";
}
```

### Sample Run

```
$ perl perl/ch-2.pl
3,0,1,2,3
cost: 10
$ perl perl/ch-2.pl
3,1,7,5,4,6,0,2,3
cost: 24
```

### Notes

I have used Genetic Algorithm (GA) approaches to a bunch of these challenge problems in the past. I will admit that in some cases the GA approach is more for fun than as a good example of the sorts of problems GA is good for. This time, however, we have a somewhat classic use case!

The Travelling Salesman Problem is well known to be NP-Hard and Genetic Algorithms are a well studied approach to tackling these beasts.

I first tested this solution with the example in the original problem statement, hardcoded
here in `@matrix`

and obtained a result which matched the known correct one. Then, testing
with increasingly larger values of `N`

to generate random matrices I continued to get
seemingly correct results. I did not verify these by hand. Instead I set a random seed
with `srand`

and verified that I got the same cost results over several runs. As needed
I would adjust the number of generations in the `evolve()`

method call upwards until again
getting results which converged on the same cost value.

For a 20 x 20 matrix I seem to be getting correct results, but runtimes are quite lengthy and I ran out of time to test this further. However, I am very confident that a correct path is obtainable this way although perhaps some additional slight adjustment of parameters is necessary.

(Hopefully nobody is too terribly confused by this, but please do notice that the size of the matrix is actually N + 1. That is, in order to obtain a matrix like the one given in the problem statement you specify an N of 3, although obviously this is a 4 x 4 matrix. This is just in keeping with the city labels starting with 0.)

## References

posted at: 23:36 by: Adam Russell | path: /perl | permanent link to this entry