5
$\begingroup$

enter image description here

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?,

$\endgroup$
11
$\begingroup$

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[6]:= *)FindShortestPath[g, 1, 2]

(*Out[6]= {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.

$\endgroup$
  • $\begingroup$ 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}? $\endgroup$ – anderstood Mar 29 '17 at 15:42
  • 5
    $\begingroup$ Try FindPath[g, 1, 2, GraphDistance[g, 1, 2], All] $\endgroup$ – Quantum_Oli Mar 29 '17 at 15:45
  • 1
    $\begingroup$ @user6014 this approach does not give the second path {1,7,2} as pointed by anderstood $\endgroup$ – Ali Hashmi Mar 30 '17 at 19:05
6
$\begingroup$

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}} *)
$\endgroup$
  • 3
    $\begingroup$ 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. $\endgroup$ – Daniel Lichtblau Mar 29 '17 at 15:55
  • 1
    $\begingroup$ Thank you, I like that I can see all the path! Thank you for your answer! $\endgroup$ – Saesun Kim Mar 29 '17 at 16:51
  • $\begingroup$ @SaesunKim you are welcome ! $\endgroup$ – Ali Hashmi Mar 29 '17 at 17:10

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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