Solution to task 2

1 files changed, 158 insertions, 0 deletions

diff --git a/challenge-118/jo-37/perl/ch-2.pl b/challenge-118/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..7bfd9f579a
--- /dev/null
+++ b/challenge-118/jo-37/perl/ch-2.pl
@@ -0,0 +1,158 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use Test2::V0;
+use Graph;
+use List::Util 'reduce';
+use Math::Prime::Util qw(forperm forsetproduct vecsum);
+use experimental 'signatures';
+
+our ($examples, $tests, $start);
+$start //= 'a8';
+@ARGV = qw(b1 a2 b2 b3 c4 e6) if $examples;
+
+run_tests() if $tests;	# does not return
+
+die <<EOS unless @ARGV;
+usage: $0 [-examples] [-tests] [-start=pos] [t1 ...]
+
+-examples
+    run the examples from the challenge
+
+-tests
+    run some tests
+
+-start=pos
+    use pos as the starting square for the knight. Default: a8
+
+t1 ...
+    positions of treasures on the board in chess notation (a1 ... h8)
+
+Solving the example:
+    $0 b1 a2 b2 b3 c4 e6
+or simply:
+    $0 -examples
+
+Output is one line for each path from the starting square / previous
+treasure square to the next treasure square.
+
+EOS
+
+
+### Input and Output
+
+say join '->', @$_ for @{adventure_of_knight($start, @ARGV)};
+
+
+### Implementation
+
+# The task can be divided into four subtasks:
+#
+# 1) Build the knight's graph.  See
+#    https://en.wikipedia.org/wiki/Knight%27s_graph
+#
+# 2) Find the shortest paths between the start and all treasure squares
+#    within the knight's graph and build a weighted "treasure graph" out
+#    of it.  See https://en.wikipedia.org/wiki/Dijkstra%27s_algorithm
+#
+# 3) Solve the travelling salesman problem in the "treasure graph".  See
+#    https://en.wikipedia.org/wiki/Travelling_salesman_problem
+#
+# 4) Present the solution on the board.  This is probably the most
+#    laborious part and has been left out here.
+
+# Solve the task: subtasks 1) to 3).
+sub adventure_of_knight ($start, @treasures) {
+    min_hamiltonian($start,
+        treasure_graph(knights_graph(), $start, @treasures));
+}
+
+# Build the knight's graph.
+sub knights_graph {
+    my $g = Graph::Undirected->new;
+    forsetproduct {
+        $g->add_edge($_[0] . $_[1], $_) for knights_moves(@_);
+    } ['a' .. 'h'], [1 .. 8];
+
+    $g;
+}
+
+# Find all possible knight's moves going two squares ascending.  No need
+# to consider the opposite directions by symmetry. Use "character
+# arithmetics" for the alphabetic column identifiers.
+sub knights_moves (@sq) {
+    map $_->[0] . $_->[1],
+        grep $_->[0] ge 'a' && $_->[0] le 'h'
+            && $_->[1] > 0 && $_->[1] <= 8,
+        map [chr(ord($sq[0]) + $_->[0]), $sq[1] + $_->[1]], 
+        [2, -1], [2, 1], [-1, 2], [1, 2];
+}
+
+# Find the shortest paths between the start square and all treasure
+# squares in the knight's graph using Dijkstra's algorithm.  The result
+# is a directed graph ("treasure graph") where the edges are tagged with
+# the corresponding directed paths in the knight's graph and weighted
+# with the paths' lengths.
+sub treasure_graph ($g, $start, @treasures) {
+    # Representation of the treasure graph as HoHoA:
+    # origin, target, path.
+    my %paths;
+
+    # One-way from the start square.
+    $paths{$start}{$_} = [$g->SP_Dijkstra($start, $_)] for @treasures;
+
+    # Two-way between the treasure squares.
+    while (my $this = shift @treasures) {
+        for my $that (@treasures) {
+            my @path = $g->SP_Dijkstra($this, $that);
+            $paths{$this}{$that} = \@path;
+            $paths{$that}{$this} = [reverse @path];
+        }
+    }
+
+    \%paths;
+}
+
+# Find a minimum weighted Hamiltonian path in the treasure graph from
+# the start square with the assigned path's length as weight.  By
+# construction, every path from the starting square visiting any
+# permutation of the treasure squares is valid and Hamiltonian.
+# Adding directed, zero-weighted edges between all treasure squares and
+# the start square would turn this into an equivalent asymmetric TSP -
+# just to spot the complexity of the task.  Not attempting any
+# optimizations.
+sub min_hamiltonian ($start, $treasure) {
+    my @treasures = grep {$_ ne $start} keys %$treasure;
+    my ($minlen, $shortest) = 'inf';
+
+    # Try all permutations of the treasure squares for the minimum path.
+    forperm {
+        my @paths;
+        # Abuse "reduce" as a sliding window.
+        reduce {
+            push @paths, $treasure->{$a}{$b};
+            $b;
+        } $start, @treasures[@_];
+
+        # Record a new minimum.
+        if ((my $len = vecsum map scalar @$_, @paths) < $minlen) {
+            $shortest = \@paths;
+            $minlen = $len;
+        }
+    } @treasures;
+
+    $shortest;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+        
+    is adventure_of_knight(qw(a1 d8 f7 h6 g4 e3 c2)),
+        [[qw(a1 c2)], [qw(c2 e3)], [qw(e3 g4)], [qw(g4 h6)],
+            [qw(h6 f7)], [qw(f7 d8)]], 'lined up';
+
+    done_testing;
+    exit;
+}