4
$\begingroup$

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.

enter image description here

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

enter image description here

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

enter image description here

We are searching for perhaps relevant questions below.

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.

$\endgroup$
3
$\begingroup$

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

enter image description here

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

  Graph[VertexDelete[graph, vertex], VertexCoordinates -> coords]
];
$\endgroup$
  • $\begingroup$ I added the Trial 3 with GridGraph: Can you demonstrate it with this method? SeedRandom[10801]; dimension = 5; coDimension = 10; percProbability = 0.7; deleteMe = Pick[Table[i, {i, 1, 30}], Table[RandomReal[] > 0.5, {i, 30}]] gr = GridGraph[{dimension, coDimension}, VertexLabels -> "Name", ImagePadding -> 30] H = SetProperty[VertexDelete[g, #], VertexCoordinates -> Delete[GraphEmbedding[g], #]] & @@ deleteMe FoldList[vertexDeleteKeepEmbedding, gr, RandomSample@Most@deleteMe@gr], something like this? $\endgroup$ – hhh Jul 9 '16 at 20:10
1
$\begingroup$

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

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

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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