1
$\begingroup$

Given the following Code:

Clear[edgeW, gr, m, mm, sa, wG, ledgeW, paths, pathMult, sccL, grSCCl];
edgeW = Module[{g = #, 
 e = DirectedEdge @@@ Partition[#, 2, 1] & /@ 
   FindPath[##, \[Infinity], All]}, 
Transpose[{e, PropertyValue[{g, #}, EdgeWeight] & /@ # & /@ e}]] &;
Manipulate[
SeedRandom[1245];
mm = RandomReal[1, {n, n}];
gr = RandomGraph[{n, m}, DirectedEdges -> True, 
VertexLabels -> "Name"]; (*full graph*)
sa = SparseArray[AdjacencyMatrix[gr]*mm];
wG = Graph[sa["NonzeroPositions"], EdgeWeight -> sa["NonzeroValues"],
DirectedEdges -> True, VertexLabels -> "Name"];
ledgeW = Length@edgeW[wG, 11, 15];
paths = Table[  edgeW[wG, 11, 15][[p, 1]], {p, 1, ledgeW}  ];
pathMult = {paths, {Table[
Times @@ 
     Table[ edgeW[wG, 11, 15][[p, 2]], {p, 1, ledgeW} ][[i]], {i, 
     1, ledgeW}
    ]} // Transpose} // Transpose // MatrixForm;
sccL = MaximalBy[Length]@ConnectedComponents[wG];
grSCCl = Subgraph[wG, sccL, VertexLabels -> "Name"];
Grid[{{pathMult, gr}, {"", grSCCl}}],
{{m, 25}, 25, 45, 5}
]

I generate the following figure, the first row of which includes all the possible pathways from a source 11 to a sink 15. I calculate multipliers for each pathway given in the matrix form.

I simply want to replicate the calculation of the pathway multipliers using the strongly connected component. I do not want to re-write the same code twice to generate the multipliers. How can I automate the calculations of the multipliers for the full graph and its largest SCC using Manipulate?

Furthermore, I like to place multiplier values on the SCC.

enter image description here

$\endgroup$
2
  • $\begingroup$ is n = 17? :) $\endgroup$
    – kglr
    Nov 11, 2019 at 19:25
  • $\begingroup$ n is the number of vertices. Sorry I forgot to include n=17 in the Manipulate. $\endgroup$ Nov 11, 2019 at 19:29

1 Answer 1

1
$\begingroup$
ClearAll[edgeW, gr, m, n, mm, sa, wG, paths, pathMult, sccL, grSCCl];
n = 17;

edgeW = Module[{g = #, e = DirectedEdge @@@ Partition[#, 2, 1] & /@ FindPath[##, ∞, All]}, 
    Transpose[{e, PropertyValue[{g, #}, EdgeWeight] & /@ # & /@ e}]] &;

Manipulate[SeedRandom[1245];
  mm = RandomReal[1, {n, n}];
  gr = RandomGraph[{n, m}, DirectedEdges -> True, 
   VertexLabels -> "Name"]; sa = SparseArray[AdjacencyMatrix[gr]*mm];
  wG = Graph[sa["NonzeroPositions"], EdgeWeight -> sa["NonzeroValues"],
    DirectedEdges -> True, VertexLabels -> "Name"];
  paths = edgeW[wG, 11, 15][[All, 1]];
  pathMult = {paths, {Times @@@ edgeW[wG, 11, 15][[All, 2]]} // 
      Transpose} // Transpose // MatrixForm;
  sccL = MaximalBy[Length]@ConnectedComponents[wG];
  grSCCl = Subgraph[wG, sccL, VertexLabels -> "Name", 
   EdgeWeight -> {e_ :> PropertyValue[{wG, e}, EdgeWeight]}, 
   EdgeLabels -> Placed["EdgeWeight", Center, Round[#, .01] &]];
  pathMult2 = First @ Reverse @ SortBy[{Length @* First, First @* Last}] @ pathMult[[1]];
  Grid[{{pathMult, HighlightGraph[gr, Subgraph[wG, sccL]]}, 
     {pathMult2, HighlightGraph[grSCCl, Subgraph[grSCCl, pathMult2]]}}], 
 {{m, 30}, 25, 45, 5}]

enter image description here

Notes: (1) You can extract the part you need from pathMult since it contains all the information you need. In the example above, I extract the row that corresponds to the longest path with the maximum product of edge weights. (2) I added the options EdgeWeights and EdgeLabels to grSCCl.

$\endgroup$
4
  • $\begingroup$ I really appreciate your extended answer to the question. $\endgroup$ Nov 11, 2019 at 20:58
  • $\begingroup$ In the subgraph on the second row, there are more pathways than the longest pathway given. Which pathways do the red links refer to? Would it be possible to restrict the red links only to the longest pathway given? $\endgroup$ Nov 11, 2019 at 22:48
  • 1
    $\begingroup$ There are two paths with 6 edges in pathMult. pathMult2 selects the one with the largest product of edgeweights. If you want to show both, you can change the last two lines to pathMult3 = MaximalBy[Length@*First]@pathMult[[1]]; Grid[{{pathMult, HighlightGraph[gr, Subgraph[wG, sccL]]}, {pathMult3, HighlightGraph[grSCCl, Subgraph[grSCCl, #] & /@ pathMult3]}} in the first argument of Manipulate. $\endgroup$
    – kglr
    Nov 11, 2019 at 23:13
  • $\begingroup$ Now I understand it. This addition is useful, too. $\endgroup$ Nov 11, 2019 at 23:21

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.