# How to delete Adjacent Vertices Pairwise from a Graph

I want to delete adjacent vertices in a graph pairwise, i.e, if {a,b} are connected by an edge, I want both a and b to removed such that not only are the vertices themselves removed, but also all the incoming and outgoing edges connected to the vertices are removed.

This is what I've written so far.

deleteAdjacentVertices[G_] :=
Module[{vertices, deleted}, vertices = VertexList[G];
deleted = {};
While[Length[vertices] > 0, a = First[vertices];
G = VertexDelete[G, a, "DeleteIncomingEdges" -> True,
"DeleteOutgoingEdges" -> True];
G = VertexDelete[G, b, "DeleteIncomingEdges" -> True,
"DeleteOutgoingEdges" -> True];
AppendTo[deleted, {a, b}]];
vertices = VertexList[G];];
Return[deleted]]

G = Graph[{1 -> 2, 2 -> 3}];

• Can you tell us also what doesn't work in the code you wrote? Does it execute but return a wrong result in all cases? In some cases? Do you get errors? Jun 3, 2023 at 11:56
• Wouldn't this delete all edges? If you delete all vertex pairs {a,b} connected by an edge, then you're deleting every single edge, right?
– ydd
Jun 3, 2023 at 18:30
• try deleteConnectedVertices1[g_] := VertexList[g, v_ /; VertexDegree[g, v] == 0]?
– kglr
Jun 3, 2023 at 20:39
• also deleteConnectedVertices2[g_] := VertexDelete[g, VertexList@EdgeList[g]]?
– kglr
Jun 3, 2023 at 20:40
• try also deleteConnectedVertices3[g_] := Flatten@Select[Length@# == 1 &]@ConnectedComponents[g]?
– kglr
Jun 3, 2023 at 20:46

This method finds pairs of adjacent vertices in a graph, and returns the list of pairs. First, make list of all vertexPairs from the list of edges. Starting with the first pair, check the rest of the pairs. If a pair does not include any vertex that's in the deleted list, add the pair to the list.

deleteAdjacentVertices[G_] := Module[{vertexPairs, deleted},
vertexPairs = Sort[VertexList/@Graph/@EdgeList[G]];
deleted = {First@vertexPairs};
If[!MemberQ[
Flatten@deleted, Alternatives[Sequence@@#]], AppendTo[deleted,#]]&/@
Rest[vertexPairs];
deleted
]


Example:

G = Graph[{1->2, 2->3}];
(*{{1, 2}}*)


Use VertexDelete to remove the deleted vertex pairs (deletedVertices) from the graph. The new graph is a single vertex, 3).

VertexDelete[G, Flatten[deletedVertices]]


Here's a larger graph. The resulting graph has disconnected vertices 7 and 9.

SeedRandom[2];
G = RandomGraph[{10, 16}, DirectedEdges->True, VertexLabels->Automatic];