Friday, October 19, 2007

Enigma 1465

Here is how Mathematica can be used to solve New Scientist Enigma number 1465 in the 20 October 2007 issue.

This Enigma problem can be solved by using a very simple analytic approach which I give at the end of this posting. But first I give a much more flexible approach to illustrate the use of one of the Mathematica packages.

Solution 1: Brute force approach using the Combinatorica package.

Load the Combinatorica package.
Needs["Combinatorica`"]

Define a large enough grid graph size that the solution is contained within it.
n=11;

Build a directed grid graph which allows movement only rightwards and upwards. Note that the starting node is at the bottom-left hand corner. This type of directed structure forces all paths from the bottom left node to each other node to also be shortest paths.
g = MakeGraph[Range[n^2], Function[{x,y}, If[y==x+1 && Mod[x,n]>0 y==x+n, True, False]]]
-Graph:<220,121,directed>-

Compute the shortest path length from the bottom left corner node to each of the nodes in the graph. Because of the directed structure of the graph all paths are also shortest paths.
pathlengths = AllPairsShortestPath[g][[1]];

Generate a list of distinct shortest path lengths.
pathlengths2 = pathlengths//Union;

For each distinct shortest path length generate a list containing the number of distinct shortest paths to each node that has this shortest path length.
pathnumbers = Map[NumberOfKPaths[g,1,#]&, pathlengths2];

Extract the two cases where the same number of paths occurs 4 times. Since the solution lies in the quadrant opposite the starting node it must have a relatively large number of paths, so it can be selected by inspection of this result.
pathnumbers2 = Transpose[Cases[pathnumbers//Flatten//Tally, {_,4}]][[1]]
{10, 3003}

Solution 2: Quick approach using the known number of paths in a directed grid graph.

Compute a table each of whose entries is the number of paths from the top-left node of a directed (rightwards or downwards) grid graph.
With[{n=11}, Table[Binomial[i+j,j], {i,0,n-1}, {j,0,n-1}] // TableForm]
{
{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1},
{1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11},
{1, 3, 6, 10, 15, 21, 28, 36, 45, 55, 66},
{1, 4, 10, 20, 35, 56, 84, 120, 165, 220, 286},
{1, 5, 15, 35, 70, 126, 210, 330, 495, 715, 1001},
{1, 6, 21, 56, 126, 252, 462, 792, 1287, 2002, 3003},
{1, 7, 28, 84, 210, 462, 924, 1716, 3003, 5005, 8008},
{1, 8, 36, 120, 330, 792, 1716, 3432, 6435, 11440, 19448},
{1, 9, 45, 165, 495, 1287, 3003, 6435, 12870, 24310, 43758},
{1, 10, 55, 220, 715, 2002, 5005, 11440, 24310, 48620, 92378},
{1, 11, 66, 286, 1001, 3003, 8008, 19448, 43758, 92378, 184756}
}

The three 6-fold paths mentioned in the first part of the problem can be seen in the correct positions in the table (i.e. (1,5), (5,1) and (2,2), where the top-left corner is (0,0)). The 4-times repeated solution(s) found above can be seen elsewhere in the table, and the larger solution lies in the lower right quadrant.

No comments: