# Find Closest Path I am trying to calculate atomic transition, but when I was coding with MMA, I found that is it quite annoying to write down manually, so I want to ask that there is any way that I can write the code automatically.

So I have 10 places, and only allowed path is

{{1, 6}, {1, 7}, {2, 6}, {2, 7}, {2, 8}, {3, 7}, {3, 9}, {4, 8}, {4,9}, {4, 10}, {5, 9}, {5, 10}, {6, 1}, {7, 1}, {6, 2}, {7, 2}, {8, 2}, {7, 3}, {9, 3}, {8, 4}, {9,4}, {10, 4}, {9, 5}, {10, 5}


Then If I want to go from 1 to 2, then I need to go either 1->6 and 6->2 or 1->7 and 7->2.

so I want to make path function such that

path[1,2]
(*OutPut*)
path[6, 1] - path[6, 2]
(*Minus sign because of it is up path and down path*)


Any suggestion?,

Consider using Mathematica's Graph functionality, specifically FindShortestPath:

edges = {{1, 6}, {1, 7}, {2, 6}, {2, 7}, {2, 8}, {3, 7}, {3, 9}, {4,
8}, {4, 9}, {4, 10}, {5, 9}, {5, 10}, {6, 1}, {7, 1}, {6, 2}, {7,
2}, {8, 2}, {7, 3}, {9, 3}, {8, 4}, {9, 4}, {10, 4}, {9, 5}, {10,
5}};
g = Graph[edges, VertexLabels -> Automatic]

(*In:= *)FindShortestPath[g, 1, 2]

(*Out= {1, 6, 2}*)


which isn't the exact syntax you were looking for, but explicitly shows that you need to go 1 to 6 to 2.

• The documentation of FindShortestPath says finds **the** shortest path from source vertex s to target vertex t in the graph g. as if it was unique. Do you know to return both {1, 6, 2} and {1, 7, 2}? Mar 29, 2017 at 15:42
• Try FindPath[g, 1, 2, GraphDistance[g, 1, 2], All] Mar 29, 2017 at 15:45
• @user6014 this approach does not give the second path {1,7,2} as pointed by anderstood Mar 30, 2017 at 19:05

This gives all paths and not just the shortest path

edges = {{1, 6}, {1, 7}, {2, 6}, {2, 7}, {2, 8}, {3, 7}, {3, 9}, {4,
8}, {4, 9}, {4, 10}, {5, 9}, {5, 10}, {6, 1}, {7, 1}, {6, 2}, {7,
2}, {8, 2}, {7, 3}, {9, 3}, {8, 4}, {9, 4}, {10, 4}, {9, 5}, {10,
5}};
g = Graph[edges, VertexLabels -> Automatic]
FindPath[g, 1, 2, Infinity, All]

(* {{{1, 7, 2}, {1, 6, 2}, {1, 7, 3, 9, 4, 8, 2}, {1, 7, 3, 9, 5, 10, 4, 8, 2}}} *)


if you need the closest

Select[#, Function[x, Length[x] == Min[Length /@ #]]] &@FindPath[g, 1, 2, Infinity, All]
(* {{1, 7, 2}, {1, 6, 2}} *)


or more simply

MinimalBy[#, Length] &@FindPath[g, 1, 2, Infinity, All]
(* {{1, 7, 2}, {1, 6, 2}} *)

• Seems like a useful answer. (1) No idea why it would get a downvote. (2) Might want to restrict to minimal length paths in the result. All paths can be quite long for more complex graphs. Mar 29, 2017 at 15:55
• Thank you, I like that I can see all the path! Thank you for your answer! Mar 29, 2017 at 16:51
• @SaesunKim you are welcome ! Mar 29, 2017 at 17:10