TransWikia.com

How can I find EdgeWeights strongly connected components using Manipulate

Mathematica Asked on June 17, 2021

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

One Answer

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.

Correct answer by kglr on June 17, 2021

Add your own answers!

Ask a Question

Get help from others!

© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP