# Extracting edge weights with Subgraph?

I am trying to efficiently extract sub-graphs from very large weighted directed graphs. I thought Subgraph would do this, but it does not, which seems a bit odd since edge weights are intrinsic properties of the graph.

First, a toy directed, weighted graph as an example:

size = 10;
rAm = Table[If[Or[i  == j, RandomReal[{0, 1}] < .8], Infinity,
RandomInteger[{1, 100}] - 1], {i, size}, {j, size}]; MatrixForm[WeightedAdjacencyMatrix[wAg] But when I extract a subgraph that includes the first 6 vertices, the edge weights are not preserved.

rSg = Subgraph[wAg, Range] I would expect: Edge weights do not come with the Subgraph even if I specify edges, as opposed to vertices.

Potential solution could be:

Clear[exWtSuGr];
exWtSuGr[gr_, verts_] := Module[{sg, el, ew, wAg}, {
sg = Subgraph[gr, verts];
el = EdgeList[sg];
ew = PropertyValue[{gr, #}, EdgeWeight] & /@ el;
wAg = Graph[verts, el, EdgeWeight -> ew]
}[]]

GR1 = exWtSuGr[wAg, Range] Why not just use WeightedAdjacencyGraph on the relevant part of the weighted adjacency matrix? The only issue with this approach is that WeightedAdjacencyGraph expects Infinity for missing edges instead of 0. The following function accounts for this:

subgraph[g_, v_] := WeightedAdjacencyGraph @ fixBackground @ WeightedAdjacencyMatrix[g][[v, v]]
fixBackground[sa_SparseArray] := Replace[
sa,
Verbatim[SparseArray][a_, b_, _, c__] :> SparseArray[a, b, Infinity, c]
]


Using a version of your example:

SeedRandom;
size=10;
rAm=Table[If[Or[i==j,RandomReal[{0,1}]<.8],Infinity,RandomInteger[{1,100}]-1],{i,size},{j,size}]; we get (note the correct adjacency matrix):

subgraph[wAg, {1,3,5,7,9}] $\left( \begin{array}{ccccc} 0 & 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 & 14 \\ 95 & 97 & 0 & 0 & 0 \\ 0 & 0 & 25 & 0 & 76 \\ 0 & 0 & 0 & 0 & 0 \\ \end{array} \right)$

The graph looks the same as what is returned by Subgraph: • This is basically what I do (and what I almost posted earlier today). IGWeightedAdjacencyGraph from IGraph/M can use any element to indicate a non-existent connection, so adding Infinity wouldn't be necessary. Some minor problems with your implementation: 1. the null graph has no adjacency matrix and therefore needs special handling. 2. directedness needs to be explicitly transferred, otherwise a directed graph that is identical to its reverse will get converted to undirected. 3. the vertex names may not be identical to the vertex indices; they may not even be integers. – Szabolcs Jan 6 '18 at 19:32
• I had this when I decided not to post after all (because the performance gain wasn't significant enough, and if performance were the goal, other, much uglier solutions could help). – Szabolcs Jan 6 '18 at 19:35

Or maybe:

subGraphWeightLookup =
DeleteCases[
Position[rAm, 0] -> -1]], 0]]] /. x_ /; x == -1 -> 0;


(The -1 is a dummy variable allowing reinsertion of '0' elements.)

Subgraph[wAg, Range,
EdgeWeight -> (subGraphWeightLookup[#] & /@
EdgeList[Subgraph[wAg, Range]])]



IGraph/M now includes IGWeightedSubgraph, a function to extract subgraphs while preserving edge weights. Unlike the adjacency matrix method, it also works with multigraphs.

This is reliable and marginally faster than the original solution by GraphMan. It makes use of IGraph/M.

ClearAll[subgraph]
subgraph[g_?MultigraphQ, vs_List] := $Failed subgraph[g_?MixedGraphQ, vs_List] :=$Failed
subgraph[wg_?GraphQ, {}] := IGEmptyGraph[] (* also works around bug in M versions where Subgraph fails on empty graphs *)
subgraph[wg_?IGEdgeWeightedQ, vs_List] :=
With[{ind = VertexIndex[wg, #] & /@ vs},