Mixing
How to remove vertices from a graph?
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)
list-manipulation graphs-and-networks
edited Jan 1 at 0:01
Henrik Schumacher
50.1k469144
asked Dec 31 '18 at 22:39
N.T.CN.T.C
44128
add a comment |
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)
list-manipulation graphs-and-networks
edited Jan 1 at 0:01
Henrik Schumacher
50.1k469144
asked Dec 31 '18 at 22:39
N.T.CN.T.C
44128
add a comment |
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)
list-manipulation graphs-and-networks
edited Jan 1 at 0:01
Henrik Schumacher
50.1k469144
asked Dec 31 '18 at 22:39
N.T.CN.T.C
44128
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)
list-manipulation graphs-and-networks
list-manipulation graphs-and-networks
edited Jan 1 at 0:01
Henrik Schumacher
50.1k469144
asked Dec 31 '18 at 22:39
N.T.CN.T.C
44128
edited Jan 1 at 0:01
Henrik Schumacher
50.1k469144
asked Dec 31 '18 at 22:39
N.T.CN.T.C
44128
edited Jan 1 at 0:01
Henrik Schumacher
50.1k469144
edited Jan 1 at 0:01
Henrik Schumacher
50.1k469144
edited Jan 1 at 0:01
Henrik Schumacher
50.1k469144
50.1k469144
asked Dec 31 '18 at 22:39
N.T.CN.T.C
44128
asked Dec 31 '18 at 22:39
N.T.CN.T.C
44128
asked Dec 31 '18 at 22:39
N.T.CN.T.C
44128
44128
add a comment |
add a comment |
4 Answers
4
active
oldest
votes
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}];
answered Dec 31 '18 at 22:58
David G. StorkDavid G. Stork
23.7k22051
add a comment |
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
answered Jan 1 at 0:08
Henrik SchumacherHenrik Schumacher
50.1k469144
2
@chris Thanks for the reminder. I wrote that in -- as J.M. would say -- gedanken Mathematica.
– Henrik Schumacher
Jan 1 at 15:09
This solution makes me realize how much there is to learn about Wolfram this year
– FredrikD
Jan 1 at 15:14
As someone who hadn't quite understood the purpose of sparse arrays (until now) this is fascinating.
– geordie
Jan 1 at 23:05
add a comment |
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}}
answered Dec 31 '18 at 23:04
kglrkglr
178k9198409
Your first three suggestions only work for removing a single vertex.
– geordie
Dec 31 '18 at 23:38
2
@geordie, if you want to remove a list of vertices, say{1,2}, you can use1|2instead of1.
– kglr
Dec 31 '18 at 23:44
add a comment |
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}}
answered Dec 31 '18 at 23:37
geordiegeordie
2,0031530
add a comment |
Your Answer
StackExchange.ifUsing("editor", function () {
return StackExchange.using("mathjaxEditing", function () {
StackExchange.MarkdownEditor.creationCallbacks.add(function (editor, postfix) {
StackExchange.mathjaxEditing.prepareWmdForMathJax(editor, postfix, [["$", "$"], ["\\(","\\)"]]);
});
});
}, "mathjax-editing");
StackExchange.ready(function() {
var channelOptions = {
tags: "".split(" "),
id: "387"
};
initTagRenderer("".split(" "), "".split(" "), channelOptions);
StackExchange.using("externalEditor", function() {
// Have to fire editor after snippets, if snippets enabled
if (StackExchange.settings.snippets.snippetsEnabled) {
StackExchange.using("snippets", function() {
createEditor();
});
}
else {
createEditor();
}
});
function createEditor() {
StackExchange.prepareEditor({
heartbeatType: 'answer',
autoActivateHeartbeat: false,
convertImagesToLinks: false,
noModals: true,
showLowRepImageUploadWarning: true,
reputationToPostImages: null,
bindNavPrevention: true,
postfix: "",
imageUploader: {
brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
allowUrls: true
},
onDemand: true,
discardSelector: ".discard-answer"
,immediatelyShowMarkdownHelp:true
});
}
});
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fmathematica.stackexchange.com%2fquestions%2f188657%2fhow-to-remove-vertices-from-a-graph%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
4 Answers
4
active
oldest
votes
4 Answers
4
active
oldest
votes
active
oldest
votes
active
oldest
votes
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}];
answered Dec 31 '18 at 22:58
David G. StorkDavid G. Stork
23.7k22051
add a comment |
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}];
answered Dec 31 '18 at 22:58
David G. StorkDavid G. Stork
23.7k22051
add a comment |
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}];
answered Dec 31 '18 at 22:58
David G. StorkDavid G. Stork
23.7k22051
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}];
answered Dec 31 '18 at 22:58
David G. StorkDavid G. Stork
23.7k22051
edited Dec 31 '18 at 23:38
answered Dec 31 '18 at 22:58
David G. StorkDavid G. Stork
23.7k22051
answered Dec 31 '18 at 22:58
David G. StorkDavid G. Stork
23.7k22051
answered Dec 31 '18 at 22:58
David G. StorkDavid G. Stork
23.7k22051
23.7k22051
add a comment |
add a comment |
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
answered Jan 1 at 0:08
Henrik SchumacherHenrik Schumacher
50.1k469144
2
@chris Thanks for the reminder. I wrote that in -- as J.M. would say -- gedanken Mathematica.
– Henrik Schumacher
Jan 1 at 15:09
This solution makes me realize how much there is to learn about Wolfram this year
– FredrikD
Jan 1 at 15:14
As someone who hadn't quite understood the purpose of sparse arrays (until now) this is fascinating.
– geordie
Jan 1 at 23:05
add a comment |
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
answered Jan 1 at 0:08
Henrik SchumacherHenrik Schumacher
50.1k469144
2
@chris Thanks for the reminder. I wrote that in -- as J.M. would say -- gedanken Mathematica.
– Henrik Schumacher
Jan 1 at 15:09
This solution makes me realize how much there is to learn about Wolfram this year
– FredrikD
Jan 1 at 15:14
As someone who hadn't quite understood the purpose of sparse arrays (until now) this is fascinating.
– geordie
Jan 1 at 23:05
add a comment |
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
answered Jan 1 at 0:08
Henrik SchumacherHenrik Schumacher
50.1k469144
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
answered Jan 1 at 0:08
Henrik SchumacherHenrik Schumacher
50.1k469144
edited Jan 1 at 23:15
answered Jan 1 at 0:08
Henrik SchumacherHenrik Schumacher
50.1k469144
answered Jan 1 at 0:08
Henrik SchumacherHenrik Schumacher
50.1k469144
answered Jan 1 at 0:08
Henrik SchumacherHenrik Schumacher
50.1k469144
50.1k469144
2
@chris Thanks for the reminder. I wrote that in -- as J.M. would say -- gedanken Mathematica.
– Henrik Schumacher
Jan 1 at 15:09
This solution makes me realize how much there is to learn about Wolfram this year
– FredrikD
Jan 1 at 15:14
As someone who hadn't quite understood the purpose of sparse arrays (until now) this is fascinating.
– geordie
Jan 1 at 23:05
add a comment |
2
@chris Thanks for the reminder. I wrote that in -- as J.M. would say -- gedanken Mathematica.
– Henrik Schumacher
Jan 1 at 15:09
This solution makes me realize how much there is to learn about Wolfram this year
– FredrikD
Jan 1 at 15:14
As someone who hadn't quite understood the purpose of sparse arrays (until now) this is fascinating.
– geordie
Jan 1 at 23:05
2
2
@chris Thanks for the reminder. I wrote that in -- as J.M. would say -- gedanken Mathematica.
– Henrik Schumacher
Jan 1 at 15:09
@chris Thanks for the reminder. I wrote that in -- as J.M. would say -- gedanken Mathematica.
– Henrik Schumacher
Jan 1 at 15:09
This solution makes me realize how much there is to learn about Wolfram this year
– FredrikD
Jan 1 at 15:14
This solution makes me realize how much there is to learn about Wolfram this year
– FredrikD
Jan 1 at 15:14
As someone who hadn't quite understood the purpose of sparse arrays (until now) this is fascinating.
– geordie
Jan 1 at 23:05
As someone who hadn't quite understood the purpose of sparse arrays (until now) this is fascinating.
– geordie
Jan 1 at 23:05
add a comment |
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}}
answered Dec 31 '18 at 23:04
kglrkglr
178k9198409
Your first three suggestions only work for removing a single vertex.
– geordie
Dec 31 '18 at 23:38
2
@geordie, if you want to remove a list of vertices, say{1,2}, you can use1|2instead of1.
– kglr
Dec 31 '18 at 23:44
add a comment |
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}}
answered Dec 31 '18 at 23:04
kglrkglr
178k9198409
Your first three suggestions only work for removing a single vertex.
– geordie
Dec 31 '18 at 23:38
2
@geordie, if you want to remove a list of vertices, say{1,2}, you can use1|2instead of1.
– kglr
Dec 31 '18 at 23:44
add a comment |
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}}
answered Dec 31 '18 at 23:04
kglrkglr
178k9198409
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}}
answered Dec 31 '18 at 23:04
kglrkglr
178k9198409
edited Jan 2 at 7:38
answered Dec 31 '18 at 23:04
kglrkglr
178k9198409
answered Dec 31 '18 at 23:04
kglrkglr
178k9198409
answered Dec 31 '18 at 23:04
kglrkglr
178k9198409
178k9198409
Your first three suggestions only work for removing a single vertex.
– geordie
Dec 31 '18 at 23:38
2
@geordie, if you want to remove a list of vertices, say{1,2}, you can use1|2instead of1.
– kglr
Dec 31 '18 at 23:44
add a comment |
Your first three suggestions only work for removing a single vertex.
– geordie
Dec 31 '18 at 23:38
2
@geordie, if you want to remove a list of vertices, say{1,2}, you can use1|2instead of1.
– kglr
Dec 31 '18 at 23:44
Your first three suggestions only work for removing a single vertex.
– geordie
Dec 31 '18 at 23:38
Your first three suggestions only work for removing a single vertex.
– geordie
Dec 31 '18 at 23:38
2
2
@geordie, if you want to remove a list of vertices, say
{1,2}, you can use 1|2 instead of 1.– kglr
Dec 31 '18 at 23:44
@geordie, if you want to remove a list of vertices, say
{1,2}, you can use 1|2 instead of 1.– kglr
Dec 31 '18 at 23:44
add a comment |
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}}
answered Dec 31 '18 at 23:37
geordiegeordie
2,0031530
add a comment |
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}}
answered Dec 31 '18 at 23:37
geordiegeordie
2,0031530
add a comment |
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}}
answered Dec 31 '18 at 23:37
geordiegeordie
2,0031530
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}}
answered Dec 31 '18 at 23:37
geordiegeordie
2,0031530
answered Dec 31 '18 at 23:37
geordiegeordie
2,0031530
answered Dec 31 '18 at 23:37
geordiegeordie
2,0031530
answered Dec 31 '18 at 23:37
geordiegeordie
2,0031530
2,0031530
add a comment |
add a comment |
Thanks for contributing an answer to Mathematica Stack Exchange!
- Please be sure to answer the question. Provide details and share your research!
But avoid …
- Asking for help, clarification, or responding to other answers.
- Making statements based on opinion; back them up with references or personal experience.
Use MathJax to format equations. MathJax reference.
To learn more, see our tips on writing great answers.
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fmathematica.stackexchange.com%2fquestions%2f188657%2fhow-to-remove-vertices-from-a-graph%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
