Deleting vertices from a Graph and preserving structure

Question

My goal is to remove vertices from graphs (and the edges from them) and then take GraphComplement to find out cut sets in graphs with sink and source such as here. So

How can I delete vertices from a graph and preserve the earlier structure?

---

Trials

Trial 1. Failures in trying to remove vertices fom HararyGraph.

The structure is not preserved for which SetProperty (?) and the repetitive assignment after each removal failing -- the table below removes the other vertex from new graph not from the one where one vertex was already removed.

Trial 2. Failure in trying to remove vertices repetively from GridGraph, based on the case where only one removal.

Trial 3. Question here to be more clear.

SeedRandom[10801];
dimension = 5;
coDimension = 10;
percProbability = 0.7;
deleteMe = 
 Pick[Table[i, {i, 1, 30}], Table[RandomReal[] > 0.5, {i, 30}]]

g = GridGraph[{dimension, coDimension}, VertexLabels -> "Name", 
  ImagePadding -> 30]
H = SetProperty[VertexDelete[g, #], 
    VertexCoordinates -> Delete[GraphEmbedding[g], #]] & @@ deleteMe

H = SetProperty[VertexDelete[g, deleteMe], 
  VertexCoordinates -> Delete[GraphEmbedding[g], deleteMe]]

We are searching for perhaps relevant questions below.

• How to add new nodes to an existing graph with fixed (coordinates) nodes?

• Keeping vertexcoordinates after adding a new vertex

Ps. For the mincut goal, Alert! Alert about bug in at least 10.1 Mathematica in using Mathematica's own cut command: Finding the minimum vertex cut of a graph. Also notice that VertexConnectivity command bugging, Is there something wrong with VertexConnectivity.

Answer 1

You can use vertexDeleteKeepEmbedding which is a side effect of Clickable graph answer:

gr = CompleteGraph[17, PlotRange -> 2]

FoldList[
    vertexDeleteKeepEmbedding, 
    gr, 
    RandomSample @ Most @ VertexList @ gr
] // ListAnimate

vertexDeleteKeepEmbedding[graph_, vertex_] := Module[{
  coords, vertices = VertexList[graph]
  }
  , 
  coords = DeleteCases[vertices, vertex] /. Thread[
    vertices -> GraphEmbedding[graph]
  ];

  Graph[VertexDelete[graph, vertex], VertexCoordinates -> coords]
];

Answer 2

The solution for the GridGraph here. You need to fix the VertexCoordinates before deletions.

G = SetProperty[G, VertexCoordinates -> GraphEmbedding[G]];
VertexDelete[G, deleteMe]