10
$\begingroup$

I have 2 lists: list 1 is a list of vertices of a graph, says, {1,2,3,4,5} and list 2 keeps track of edges (i.e which vertex connects to which) such as {{1,2}, {2,3},{3,4},{4,1},{2,5}}. Now I want to remove some vertices in list 1 and I want that any edges in list 2 that have an end same as one of the removed vertices will also be removed. What would be the best way to do this in Mathematica? (I can do this easily in other languages like vb.net, but I still am trying to get my head on Mathematica)

$\endgroup$

4 Answers 4

10
$\begingroup$

These are done easily with graph functions:

g = Graph[Range[5], {1 <-> 2, 2 <-> 3, 3 <-> 4, 4 <-> 1, 2 <-> 5}];

enter image description here

g2 = VertexDelete[g, 1];

enter image description here

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}];
$\endgroup$
14
$\begingroup$

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

$\endgroup$
8
  • 2
    $\begingroup$ @chris Thanks for the reminder. I wrote that in -- as J.M. would say -- gedanken Mathematica. $\endgroup$ Jan 1, 2019 at 15:09
  • $\begingroup$ This solution makes me realize how much there is to learn about Wolfram this year $\endgroup$
    – FredrikD
    Jan 1, 2019 at 15:14
  • $\begingroup$ As someone who hadn't quite understood the purpose of sparse arrays (until now) this is fascinating. $\endgroup$
    – geordie
    Jan 1, 2019 at 23:05
  • $\begingroup$ This answer is quite instructive. I came here because I was looking to see if anyone had mentioned that the functions for Graph are slow. I am finding that just using list manipulation on the edge list is quicker than using VertexDelete or VertexContract on simple graphs with like 6-4 vertices . Would you confirm that Graph is still slow ? Are there any functions that have a reasonable speed ? I do not understand why Graph is atomic if it is not that efficient. Maybe it is is efficient in memory more than speed ? $\endgroup$ Dec 7, 2022 at 22:15
  • 1
    $\begingroup$ "I do not understand why Graph is atomic if it is not that efficient." Yes, me neither. For small graphs, in is maybe more efficient to directly work on the (dense!) adjacency matrix. For larger, but sparse graphs one can do quite a lot with their adjacency matrix represented by a SparseArray. However, manipulations that change the nonzero structure of sparse matrix are typically also not very efficient. In general, the most suitable data structure depends on the type of graph and on what you want to do with it. $\endgroup$ Dec 9, 2022 at 20:17
9
$\begingroup$

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}}

$\endgroup$
2
  • $\begingroup$ Your first three suggestions only work for removing a single vertex. $\endgroup$
    – geordie
    Dec 31, 2018 at 23:38
  • 3
    $\begingroup$ @geordie, if you want to remove a list of vertices, say {1,2}, you can use 1|2 instead of 1. $\endgroup$
    – kglr
    Dec 31, 2018 at 23:44
4
$\begingroup$

The following works for removing several vertices and corresponding edges:

verts = {1, 2, 3, 4, 5};
edges = {{1, 2}, {2, 3}, {3, 4}, {4, 1}, {2, 5}};

vertdel = {1, 4}
verts2 = Complement[verts, vertdel]
edges2 = Complement[edges, Flatten[Select[edges, MemberQ[#]] & /@ vertdel, 1]]

{1, 4}

{2, 3, 5}

{{2, 3}, {2, 5}}

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.