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

Improve this question
$\endgroup$

2 Answers 2

Reset to default
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.

Improve this answer
$\endgroup$
3
  • $\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, 2017 at 15:42
  • 5
    $\begingroup$ Try FindPath[g, 1, 2, GraphDistance[g, 1, 2], All] $\endgroup$
    – Quantum_Oli
    Mar 29, 2017 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, 2017 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}} *)
Improve this answer
$\endgroup$
3
  • 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, 2017 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, 2017 at 16:51
  • $\begingroup$ @SaesunKim you are welcome ! $\endgroup$
    – Ali Hashmi
    Mar 29, 2017 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.