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.
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}]
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
Get help from others!
Recent Questions
Recent Answers
© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP