5
$\begingroup$

So I have a part of transition matrix like this.

 tmat={{0, 0.2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.8, 0, 0, 0, 0, 0, 0}, {0,
       0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0,
       0.9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0}, {0, 0, 0, 
      0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 
      0.2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.8, 0, 0}, {0, 0, 0, 0, 0, 0,
       1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 
      0.9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1}, {0, 0, 0, 0, 0, 0, 0, 0,
       1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 
      0.2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
      1, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
      0.9, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
      0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
      0, 0, 0, 0, 0, 0}, {0, 0, 0.2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
      0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 
      0, 0, 0}, {0, 0, 0, 0, 0.9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
      0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 
      0}, {0, 0, 0, 0, 0, 0, 0.2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
      0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 
      0}, {0, 0, 0, 0, 0, 0, 0, 0, 0.9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}};

And I converted this to DiscreteMarkovProcess

mark = DiscreteMarkovProcess[1, tmat];
graph = Graph[mark,EdgeLabels -> {DirectedEdge[i_, j_] :> 
MarkovProcessProperties[mark, "TransitionMatrix"][[i, j]]}];
sp = FindShortestPath[graph, 1, 10]
HighlightGraph[graph, sp]

enter image description here

So is there a simple way to find the shortest path by edge weight, like the path is selected by highest transition probability? For example for 1-> 3, it will go via 14 instead the 2.

Also can we hide or remove the disjointed states like 13, 15 ?

Thanks!

$\endgroup$
4
$\begingroup$

Start from base graph:

g = Graph[DiscreteMarkovProcess[1, tmat]];

Remove isolated vertices:

graph = Subgraph[g, Flatten[Select[WeaklyConnectedComponents[g], Length[#] > 1 &]], Options[g]];

Set weights, coords, and label edges (reverse weight value to find highest path):

vcoords = 
 GraphEmbedding[g][[VertexIndex[g, #] & /@ VertexList[graph]]];
weight = MarkovProcessProperties[mark, "TransitionMatrix"][[##]] & @@@
    EdgeList[graph];
wgraph = Graph[graph, EdgeWeight -> 1/weight, 
  EdgeLabels -> Thread[EdgeList[graph] -> weight], VertexCoordinates -> vcoords]; 

sp = FindShortestPath[wgraph, 1, 10]

{1, 14, 3, 4, 5, 18, 7, 8, 9, 10}

HighlightGraph[wgraph, PathGraph[sp, DirectedEdges -> True], 
 GraphHighlightStyle -> "Thick"]
| improve this answer | |
$\endgroup$
  • $\begingroup$ @ halmir this works. Thanks. The plot flipped into mirror image when using Graph[WeaklyConnectedGraphComponents[g][[1]], Options[g]]; Is there way to plot as original? $\endgroup$ – sdc Nov 1 '17 at 16:53
  • $\begingroup$ I updated answer. $\endgroup$ – halmir Nov 2 '17 at 0:53

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.