How to remove vertices from a graph?
Although using Graph
and VertexDelete
is tempting (and every sane person would try that first), it is by no means an efficient way of doing this. Here is a method that circumvents Graph
and works directly on sparse adjacency matrices:
edges = {{1, 2}, {2, 3}, {3, 4}, {4, 1}, {2, 5}};
vertdel = {1, 4};
A = SparseArray[edges -> 1, {1, 1} Max[edges]];
a = DiagonalMatrix[SparseArray[Partition[vertdel, 1] -> 0, {Length[A]}, 1]];
SparseArray[a.A.a]["NonzeroPositions"]
{{2, 3}, {2, 5}}
Here A
is the (nonsymmetric) adjacency matrix of the underlying graph and a
is the diagonal matrix carrying the indicator function of the new index set on the diagonal. Then a.A.a
is the (nonsymmetric) adjacency matrix of the resulting graph; we need to wrap it with SparseArray
in order to enforce recomputation of the sparse array pattern so that the list of nonzero positions of the matrix corresponds to edges of the new graph.
(For those who are interested: The undocumented "SparseArray`"
context contains many graph-related algorithms that work directly on (weighted) adjacency matrices and that are usually much faster than the Graph
-based implementations.)
With a timing example, it is easier to realize that this is more efficient than applying MemberQ
or to use Graph
(and that Graph
is so slow should be utterly embarassing for WRI).
Of course, using SparseArray
for the adjacency matrix, I assume that the adjacency matrix is sparse...
Let's create the edge set of a random graph:
n = 10000;
m = 100000;
ndel = 1000;
G = RandomGraph[{n, m}];
edges = Developer`ToPackedArray[List @@@ EdgeList[G]];
vertdel = RandomSample[Span[1, n], ndel];
Here are the timings:
First@AbsoluteTiming[
MemberQedges = Complement[edges, Flatten[Select[edges, MemberQ[#]] & /@ vertdel, 1]];
]
131.84
First@AbsoluteTiming[
g = Graph[Range[n], UndirectedEdge @@@ edges];
gedges = EdgeList[VertexDelete[g, vertdel]];
]
9.80492
First@AbsoluteTiming[
A = SparseArray[edges -> 1, {1, 1} Max[edges]];
a = DiagonalMatrix[ SparseArray[Partition[vertdel, 1] -> 0, {Length[A]}, 1]];
spedges = SparseArray[a.A.a]["NonzeroPositions"];
]
0.006572
Of course, we have to check whether all methods return essentially the same result:
Sort[spedges] == Sort[MemberQedges] == Sort[List @@@ gedges]
True
Actually, already constructing the (old) graph g
takes 20 times(!) longer than computing the edges of the new graph with the sparse matrix method...
Finally, as in all Graph
-related threads, it is almost obligatory to mention Szabolcs' "IGraphM`"
package. There we find the function IGWeightedVertexDelete
that accomplishes the task with more acceptable speed. It may be slower than the SparseArray
method but it preserves also a lot of structure of the old graph; this may be very useful in practice and comes -- of course -- at a certain cost.
Needs["IGraphM`"]
First@AbsoluteTiming[
g2 = IGWeightedVertexDelete[g, vertdel];
]
EdgeList[g2] == gedges
0.0746
True
These are done easily with graph functions:
g = Graph[Range[5], {1 <-> 2, 2 <-> 3, 3 <-> 4, 4 <-> 1, 2 <-> 5}];
g2 = VertexDelete[g, 1];
EdgeList[g2]
(*
{2 <-> 3, 3 <-> 4, 2 <-> 5}
*)
Of course this works as well if you want to delete more than one vertex, e.g., vertices 1 and 5:
g2 = VertexDelete[g, {1, 5}];
Update: An alternative way to use SparseArray
with a better speed:
Using Henrik's timing setup
First@AbsoluteTiming[A2 = SparseArray[edges -> 1, {1, 1} Max[edges]];
A2[[All, vertdel]] = A2[[vertdel, All]] = 0;
spedges2 = A2["NonzeroPositions"];]
0.00570508
versus
First@AbsoluteTiming[A = SparseArray[edges -> 1, {1, 1} Max[edges]];
a = DiagonalMatrix[SparseArray[Partition[vertdel, 1] -> 0, {Length[A]}, 1]];
spedges = SparseArray[a.A.a]["NonzeroPositions"];]
0.0119241
spedges == spedges2
True
Original answer:
edges = {{1, 2}, {2, 3}, {3, 4}, {4, 1}, {2, 5}};
A few more alternatives:
Select[edges, FreeQ[1]]
Pick[edges, FreeQ[1] /@ edges]
DeleteCases[edges, {_, 1} | {1, _}]
List @@@ EdgeList[VertexDelete[edges, 1]]
all give
{{2, 3}, {3, 4}, {2, 5}}