Introduction

The following is a puzzle published by Samuel Loyd in the 19th century, and republished by Martin Gardner in his book “Mathematical Puzzles of Sam Loyd”, Dover Publications, New York 1959.

The picture shows a map of the red planet Mars with newly detected cities and channels. Start in city ‘T’ at the south pole and travel along the channels. Visit every of the 20 cities exactly once and return to the city in the south.

The names of the cities visited will form a sequence of letters that, by inserting some blanks, will generate a correct English sentence. What is this sentence?

(a) The original puzzle (b) A graph version

Figure 1: Mars channels and cities

Figure 1a shows the original graphic describing the problem. Cities are connected through channels to be used for traveling. The problem can be visualized and solved more easily when displayed as a graph with cities as vertices and channels as edges.

The puzzle as a graph problem

To represent and display the graph of this problem in R we will utilize the igraph package. First we define the graph through its edges while assigning a number from 1 to 20 to each edge. (Note that the ‘city’ letters do not uniquely identify the vertices.)

Starting with city ‘E’ in the south as vertex 1 and then numbering the cities arbitrarily, there will be edges from 1 to 2, 1 to 3, 2 to 4, etc. The following R commands will define all edges of our graph and a vector of city names according to this numbering.

channels <- c(
    1,2, 1,3, 2,4, 2,10, 2,11, 2,13, 3,6, 3,7, 3,8, 3,17,
    4,11, 4,12, 5,10, 5,13, 5,14, 6,7, 7,9, 7,14, 7,15, 8,17,
    8,18, 9,13, 9,15, 10,13, 11,12, 11,16, 11,19, 11,20, 12,19,
    13,14, 13,16, 15,17, 16,17, 17,18, 17,20, 18,20, 19,20)

cities <- c(
    "T", "H", "Y", "O", "R", "A", "W", "I", "E", "E", 
    "N", "P", "I", "E", "L", "S", "B", "S", "O", "S")

Figure 1b displays a layout of this graph. It has been generated with the following command from the igraph package.

library(igraph)

G <- make_graph(channels, directed=FALSE)
coords <- layout_(G, nicely())
plot(G, layout=coords)

We used the “nicely” layout algorithm here. There are more layout algorithms in the package to try out, none of them came up with a layout resembling the original picture. See the starting city lying in the middle of the graph. Actually, the graph is a planar graph, the city 1 can be placed outside such that there are no intersecting edges.

Find a solution

The puzzle asks us to find a travel tour through all the cities, touching every city just once, except the tour has to end in the city we started. In the terminology of Graph Theory we are looking for a closed Hamiltonian path, a Hamiltonian cycle. The Wikipedia says about it:

… a Hamiltonian path [ ] is a path in an undirected or directed graph that visits each vertex exactly once. A Hamiltonian cycle (or Hamiltonian circuit) is a Hamiltonian path that is a cycle. Determining whether such paths and cycles exist in graphs is the Hamiltonian path problem, which is NP-complete. … A graph that contains a Hamiltonian cycle is called a Hamiltonian graph.

The puzzle wants us to find a Hamiltonian cycle in our Mars channels graph. Though this problem is NP-hard, there are several algorithms to find such cycles, at least for smaller graphs. One possibility is to employ a “depth first” search: Start at a node and explore a path as far as possible along the edges before backtracking.

There is no Hamiltonian path finder in igraph. Fortunately, the adagio package provides an implementation of this backtracking algorithm in its hamiltonian() function. It works reasonably well for smaller graphs up to 40-50 vertices. So let’s apply it to our puzzle.

library(adagio)
solution <- hamiltonian(channels, start=1, cycle=TRUE)
solution
## [1]  1  2 10  5 14 13 16 11  4 12 19 20 18  8 17 15  9  7  6  3

To see which sequence of letters this corresponds to we will index city names with these city numbers.

cities[solution]
##  [1] "T" "H" "E" "R" "E" "I" "S" "N" "O" "P"
## [11] "O" "S" "S" "I" "B" "L" "E" "W" "A" "Y"
cat(cities[solution], sep="")
## THEREISNOPOSSIBLEWAY

Our solution is thus “THEREISNOPOSSIBLEWAY”, and adding blanks at the obvious places results in “THERE IS NO POSSIBLE WAY” !

Visualize the solution

I was not able to visualize our solution found in a graph produced by igraph, I could not even print the labels, the city names, instead of city numbers in such a graph. So I turned to another tool to draw a picture of this graph, still using the coordinates of the cities produced with the igraph layout function.

Our tool to draw the graph with labels and with a Hamiltonian circle included will be PGF TikZ. To rely on the same coordinates the following R command will generate the data structure to be used with TikZ.

for (i in 1:20) {
    cat(i,'/',cities[i],'/',round(coords[i,1],2),
                     '/',round(coords[i,2],2), ', ', sep='')
}
## 1/T/1.77/0.55, 2/H/2.56/-1.37, 3/Y/0.85/2.34, 4/O/1.7/-3.07, 5/R/5.1/0.19,
## 6/A/1.57/3.95, 7/W/2.65/2.84, 8/I/-0.85/1.89, 9/E/3.24/1.87, 10/E/4.37/-1.02, 
## 11/N/0.77/-2.13, 12/P/0.4/-3.63, 13/I/3.57/0.08, 14/E/4.37/1.54, 15/L/1.74/2.12,
## 16/S/1.49/-0.53, 17/B/0.09/0.87, 18/S/-1.4/0.56, 19/O/-0.59/-2.72, 20/S/-0.69/-0.98

Each vertex now has information about ‘city number/city label/x coord/y coord’ which is exactly the form we need for a \foreach loop when generating a graph with TikZ. Figure 2 shows the graph layout on the left and the (only) Hamiltonian cycle on the right. The starting city/node is marked in light red.

Figure 2: Puzzle graph layout and the Hamitonian path

The TikZ code that generates Figure 2 is the following:

\begin{tikzpicture}[scale=0.75]
\tikzstyle{every node}=[circle,fill=orange!30,scale=0.8]
\foreach \n/\l/\x\y in
{1/T/1.77/0.55, 2/H/2.56/-1.37, 3/Y/0.71/2.71, 4/O/1.7/-3.07, 5/R/5.1/0.19,
6/A/1.57/3.95, 7/W/2.8/3.1, 8/I/-0.85/1.89, 9/E/3.24/1.87, 10/E/4.37/-1.02, 
11/N/0.77/-2.13, 12/P/0.4/-3.63, 13/I/3.57/0.08, 14/E/4.37/1.54, 15/L/1.74/2.12,
16/S/1.49/-0.53, 17/B/0.09/0.87, 18/S/-1.4/0.56, 19/O/-0.59/-2.72, 20/S/-0.69/-0.98}
  \node (\n) at (\x,\y) {\l};
\node[fill=red!30] at (1.77,0.55) {T};
\foreach \f/\t in {1/2, 1/3, 2/4, 2/10, 2/11, 2/13, 3/6, 3/7, 3/8, 3/17,
    4/11, 4/12, 5/10, 5/13, 5/14, 6/7, 7/9, 7/14, 7/15, 8/17, 8/18,
    9/13, 9/15, 10/13, 11/12, 11/16, 11/19, 11/20, 12/19,
    13/14, 13/16, 15/17, 16/17, 17/18, 17/20, 18/20, 19/20}
    \draw (\f) -- (\t);
\foreach \f/\t in {1/2, 2/10, 10/5, 5/14, 14/13,
                   13/16, 16/11, 11/4, 4/12, 12/19,
                   19/20, 20/18, 18/8, 8/17, 17/15,
                   15/9, 9/7, 7/6, 6/3, 3/1}
    \draw[->,red,thick] (\f) -- (\t);
\end{tikzpicture}