9
$\begingroup$

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]
$\endgroup$
1

3 Answers 3

10
$\begingroup$

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"]

10 by 10 graph

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]]]]

graph with the first path

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]

four paths

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

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?

$\endgroup$
8
$\begingroup$

Let's start with an abstraction:

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]

enter image description here

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]]

enter image description here

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]]]]

enter image description here

$\endgroup$
3
  • $\begingroup$ 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}]}] $\endgroup$ Commented Apr 8 at 21:01
  • 1
    $\begingroup$ 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}. $\endgroup$
    – lericr
    Commented Apr 8 at 21:17
  • $\begingroup$ 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] $\endgroup$ Commented Apr 8 at 21:35

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.