# Taxicab Geometry

According to taxicab geometry, there are 1226 possible paths from A(2,5) to B(7,9), all with a distance of 9 units, |2-7|+|9-5|=9. I wanted to write a code where I could be obtaining the plots of some of these paths, but I don't know how to do it. So, I tried a code where I could describe at least one plot from A to B. I didn't exactly get what I intended and I couldn't number the x and y axes of the grid in 1 and 1 unit. I appreciate any help.

start = {2, 5}; end = {7, 9};

grid = ConstantArray[0, {10, 10}];

grid[[start[[2]] + 1, start[[1]] + 1]] = 1;grid[[end[[2]] + 1, end[[1]] + 1]] = 1;

path = {{2, 5}, {3, 6}, {4, 7}, {5, 8}, {6, 9}, {7, 9}}; Do[grid[[point[[2]] + 1, point[[1]] + 1]] = 0.5, {point, path}];

ArrayPlot[Reverse@grid, ColorFunction -> "Monochrome", Mesh -> True, FrameTicks -> Automatic]

• Commented Apr 8 at 22:41

Mathematica has a large set of graph functions. Here's a 10-by-10 graph of labeled nodes. We can use the graph to find every path that has a length of 9 between two nodes, and to display the paths.

g = GridGraph[{10, 10}, VertexLabels -> "Name"]


For simplicity, I'm using numbered nodes, but here's a list of the row and column numbers for each node. Use Position to find start and end nodes for (row, column) coordinates.

vertexNames = Flatten[Table[{j, i}, {i,10}, {j,10}], 1];

rowsColumns = {{2, 5}, {7, 9}}; (* list of row, column coordinates *)
{start, end} = Flatten[Map[Position[vertexNames, #]&, rowsColumns]]
(* {42, 87} *)


We can use GraphDistance to find the distance from node 42 to 87, then FindPath to find all the paths of length 9, and HighlightGraph to display the paths. Here's a graph of the first path.

GraphDistance[g, start, end]
(* 9 *)

pathLength = 9;
paths = FindPath[g, start, end, {pathLength}, All];
Length[paths]
(* 126 *)

HighlightGraph[g, PathGraph[paths[[1]]]]


The first path visits these nodes; find the row and column for the nodes from the vertexNames.

paths[[1]]
vertexNames[[paths[[1]]]]
(* {42, 52, 62, 72, 82, 83, 84, 85, 86, 87} *)
(* {{2,5}, {2,6}, {2,7}, {2,8}, {2,9}, {3,9}, {4,9}, {5,9}, {6,9}, {7,9}} *)


This next expression makes a list of all the paths.

TableForm[paths]


It's now easy to obtain the plots of some of these paths. Here are four of the paths between start (2, 5) and end (7, 9).

SeedRandom[123]; (* remove this to display other paths *)
randomPaths = RandomSample[paths, 4]; (* pick 4 of the paths at random *)
GraphicsGrid[Partition[HighlightGraph[g, PathGraph[#]] &/@ randomPaths, 2], ImageSize -> Large]


• Awesome! FindPath is the key. (+1) Commented Apr 9 at 13:19
• Your solution is impressive. It was brilliant and much more than I expected. Thank you. Commented Apr 9 at 19:34
• @RubensVilhenaFonseca You're welcome. Your question was an interesting problem. Commented Apr 10 at 4:12

Certainly a very wasteful method to generate all possible maths, but it's a start:

steps = Join[ConstantArray[{1, 0}, 5], ConstantArray[{0, 1}, 4]];
paths = Map[
Accumulate[Prepend[#, {2, 5}]] &,
DeleteDuplicates[
Partition[steps[[Flatten[Permutations[Range@9]]]], 9]
]
];

Graphics[
{RandomColor[], Line[#]} & /@ paths
]


The idea is that each path needs 9 steps: Either one step to the right or one step upwards. Sp I generate al list step of these steps, take any possible ordering of them and discard the duplicates. Then I just need to accumulate these steps to get the actual path.

By the way, Length[paths] is just $$126$$, so maybe the number $$1226$$ in your post is a typo?

routes = Permutations[{up, up, up, up, right, right, right, right, right}];


We now have 126 paths to get from {2,5} to {7,9} by going either up or right at each step. Now we need to transform this into something that we can do geometry with. Vectors seems like a promising idea:

steps = routes /. {up -> {0, 1}, right -> {1, 0}};
(* As an example, here is steps[[100]] *)
(* {{1, 0}, {1, 0}, {0, 1}, {0, 1}, {1, 0}, {1, 0}, {0, 1}, {1, 0}, {0, 1}} *)


We could accumulate these steps into a list of points that the path passes through. We can also add our starting point, {2,5}:

Accumulate[Prepend[steps[[100]], {2, 5}]]
(* {{2, 5}, {3, 5}, {4, 5}, {4, 6}, {4, 7}, {5, 7}, {6, 7}, {6, 8}, {7, 8}, {7, 9}} *)


We could now generate graphics with this directly:

Graphics[Line[Accumulate[Prepend[steps[[100]], {2, 5}]]], Axes -> True]


Alternatively, we could use ArrayPlot like you tried to do. We'll need to set up a grid of values:

ReplacePart[ConstantArray[0, {6, 5}], Accumulate[Prepend[steps[[100]], {1, 1}]] -> 1]


This is creating an array of all zeros to start. The dimensions are {6,5} because we need 6 horizontal blocks and 5 vertical blocks. Our part specifications have the x first and the y second, and so our array needs that orientation (alternatively we could play with the part specifications instead).

ArrayPlot[ReplacePart[ConstantArray[0, {6, 5}], Accumulate[Prepend[steps[[100]], {1, 1}]] -> 1]]


To get this oriented the same way we had above, we'd need to fiddle a bit:

ArrayPlot[Reverse[Transpose[ReplacePart[ConstantArray[0, {6, 5}], Accumulate[Prepend[steps[[100]], {1, 1}]] -> 1]]]]


• Based on your information, I made another attempt, but I can’t start at (2,5) and end at (7,9): routes = Tuples[{{0, 1}, {1, 0}}, 9]; (* Generating all possible combinations of 9 steps *) steps = routes; path = Accumulate[Prepend[steps[[100]], {2, 5}]]; Graphics[{Red, Line[path]}, Frame -> True, FrameTicks -> {{Automatic, Automatic}, {Range[0, 10], Range[0, 10]}}, PlotRange -> {{0, 10}, {0, 10}}, GridLines -> {Range[0, 10], Range[0, 10]}, Epilog -> {PointSize[Large], Point[{2, 5}], Point[{7, 9}]}] Commented Apr 8 at 21:01
• Part of the problem is that Tuples[{{0, 1}, {1, 0}}, 9] doesn't constrain you to exactly 5 horizontal and 4 vertical steps. So, for example, in your routes will be a path that is 9 steps directly up, taking you from {2,5} to {2,14}. There will also be one directly right. Only a minority of them will actually take you from {2,5} to {7,9}. Commented Apr 8 at 21:17
• New attempt: start = {2, 5}; end = {7, 9}; dx = end[[1]] - start[[1]]; dy = end[[2]] - start[[2]]; steps = Permutations[Join[ConstantArray[{1, 0}, dx], ConstantArray[{0, 1}, dy]]]; paths = Accumulate /@ Map[Prepend[#, start] &, steps]; Graphics[{Red, Line /@ paths}, Frame -> True, FrameTicks -> {{Automatic, Automatic}, {Range[0, 10], Range[0, 10]}}, PlotRange -> {{0, 10}, {0, 10}}, GridLines -> {Range[0, 10], Range[0, 10]}, Epilog -> {PointSize[Large], Point[start], Point[end]}, Axes -> True] Commented Apr 8 at 21:35