# Finding optimal inclusion cutoff to define subgraph of a "large" weighted graph

I have a weighted graph G with ~2.5K vertices and ~250K edges.

(The edge weights are all in (0, 1), and the weight of each vertex is derived as the maximum of the weights of all the edges incident on it.)

Not surprisingly (given its size), I have not yet found an adequate way to visualize G.

Therefore I'm now trying to visualize a suitable subgraph S of G, and to this end I'm trying to determine a good cutoff value that would determine which vertices and edges of the original graph to keep in the subgraph1.

Unfortunately I must be doing something very inefficient, because the following snippet takes longer to run than I've had the patience for:

truncate[g_, cutoff_]:= Module[{g0},
g0 = VertexDelete[g, Select[VertexList[g], PropertyValue[{g, #}, VertexWeight] < cutoff &]];
EdgeDelete[g0, Select[EdgeList[g0], PropertyValue[{g, #}, EdgeWeight] < cutoff &]]
];

S = truncate[G, 0.7]

(* \$Aborted *)


More generally, I'm finding that almost any operation I perform on this graph takes a very long time.

Are there techniques/tools to facilitate working with graphs of this size?

(In particular, since a suitable cutoff would most likely result in the removal of far more vertices and/or edges than would be kept, it would make more sense to produce the desired subgraph "additively", i.e. from the relatively few vertices and edges that make the cut, rather than to do so "subtractively", by removing the many vertices and edges that don't, but I have not been able to figure out a convenient way to do the former in a way that preserves all of the original per-vertex and per-edge properties.)

1Initially I tried to use such cutoff to determine which vertices and edges to display, but this proved to be a fruitless strategy, because the hidden vertices and edges still influence the graph's default layout. This layout suggests that many of the edge weights are just noise.

For the following answer, I will use my IGraph/M package. The solution is not pretty, but it is reasonably fast.

The key is to work with weighted adjacency matrices. I am assuming that all weights are strictly positive, otherwise things may go wrong.

<< IGraphM


This is a test graph. It has edge weights only.

wg = RandomGraph[{2500, 250000}, EdgeWeight -> RandomReal[1, 250000]];


Now we add vertex weights as the maximum of the weights of incident edges.

wg2 = IGVertexMap[# &, VertexWeight -> Map[Max]@*WeightedAdjacencyMatrix, wg];


We could also have done this instead (without IGraph/M):

vertexWeights = AssociationThread[VertexList[wg], Max /@ WeightedAdjacencyMatrix[wg]];

wg2 = Graph[wg, VertexWeight -> Normal[vertexWeights]];


Or derive vertexWeights from an existing wg2 as

vertexWeights = AssociationThread[VertexList[wg2], IGVertexProp[VertexWeight][wg2]];


Now we select the vertices we want to keep:

subVertexWeights = Select[vertexWeights, # > 0.999 &];


Build the subgraph:

subg = IGWeightedSubgraph[wg2, Keys[subVertexWeights]];


wam = WeightedAdjacencyMatrix[subg];


Eliminate matrix elements below the threshold, re-build the edge-weighted graph from it, then re-insert vertex weights:

subg2 = IGWeightedAdjacencyGraph[VertexList[subg], wam UnitStep[wam - 0.7], VertexWeight -> Values[subVertexWeights]]


Another, slower but more convenient way, also using the package BoolEval, is

<< BoolEval

wg2 = IGVertexMap[# &, VertexWeight -> Map[Max]@*WeightedAdjacencyMatrix, wg];

sub1 = IGTake[
wg2,
Subgraph[wg2,
BoolPick[VertexList[wg2], IGVertexProp[VertexWeight][wg2] > 0.999]]
];

sub2 = IGTake[
sub1,
BoolPick[EdgeList[sub1], IGEdgeProp[EdgeWeight][sub1] > 0.7]
];