how to successively plot Community Graphs by iteratively using VertexDelete[]

Question

Given the matrix wam:
wam={
 {∞, ∞, ∞, ∞, ∞,   ∞,  0.180744, ∞, ∞, ∞, ∞,  ∞, 0.196146, ∞, ∞, 0.192559}, 
 {∞, ∞, 0.199743, 0.189167, ∞, 0.177828, 0.136293, 0.198179, 
   0.170862, ∞, ∞, 0.150103, 0.152068, ∞, 0.145293, 0.147801}, 
 {∞, 0.17492, ∞, ∞, ∞, ∞,  ∞, 0.196928, ∞, 0.18818, ∞, ∞, ∞, ∞,  ∞, ∞}, 
 {∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞}, 
 {∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞}, 
 {∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞}, 
 {0.164114, 0.189904, ∞, ∞, ∞, 0.142879, ∞, 0.173485, ∞, 0.195519, ∞,
     0.179716, 0.152131, ∞, ∞, 0.197488}, 
 {0.193476, 0.186542, ∞, 0.196847, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, 
     0.184613, ∞, 0.195341, 0.190637}, 
 {∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞}, 
 {0.17967, ∞, ∞, ∞, ∞, 0.165566, ∞, ∞, ∞, ∞, ∞, ∞, 0.16862, ∞, ∞, ∞}, 
 {∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞},
 {∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞}, 
 {∞, ∞, ∞, ∞, ∞, 0.183951, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞, ∞}, 
 {∞, ∞, ∞, ∞, ∞, 0.189936, 0.16593, 0.197014, ∞, ∞, ∞, 0.194794, ∞, ∞, ∞, ∞}, 
 {0.189579, 0.167198, ∞, ∞, ∞,  0.18947, ∞, ∞, ∞, 0.187049, ∞, ∞, ∞, ∞, ∞, ∞}, 
 {∞, 0.149854, ∞, ∞, ∞, 0.188494, 0.150641, 0.192737, 0.194964, ∞, ∞, ∞, 
   0.14314, 0.15716, 0.14968, ∞}
};

I generate the directed graph and its community structure:
 vnames = {"AGF", "OIL", "MA1", "MA2", "EGW", "CST", "WHS", "TRS", 
      "HOT", "INF", "FIN", "EST", "ADM", "EDU", "HLT", "ENT"};
 wag = WeightedAdjacencyGraph[vnames, wam, VertexLabels -> "Name", 
     ImageSize -> 250]
 CommunityGraphPlot[wag, FindGraphCommunities[wag]]

Then I delete a vertex from the graph wag and find the communities in the resulting graph:
vdwag = VertexDelete[wag, {"WHS"}]
FindGraphCommunities[vdwag]
 (* {{"OIL", "MA1", "MA2", "TRS", "HOT", "EST", "EDU", "HLT", 
     "ENT"}, {"AGF", "CST", "INF", "ADM"}, {"EGW"}, {"FIN"}} *)

Then I wanted to draw the communities using:
 CommunityGraphPlot[vdwag, FindGraphCommunities[vdwag]]

However, this does not work, although vdwag is a graph. WHY?

kglr · Accepted Answer

In versions prior to 12.+, due to a bug in VertexDelete, (among other things)  EdgeWeights are not properly updated:
PropertyValue[vdwag, EdgeWeight] == PropertyValue[wag, EdgeWeight]

True

$Version

"11.3.0 for Microsoft Windows (64-bit) (March 7, 2018)"

A work-around: use EdgeDelete + VertexDelete:
edwag =  VertexDelete[EdgeDelete[wag, IncidenceList[wag, "WHS"]], "WHS"];

{VertexList[vdwag], EdgeList[vdwag]} == 
  {VertexList[edwag], EdgeList[edwag]}

True

CommunityGraphPlot[edwag, FindGraphCommunities[edwag]]

EdgeDelete has a similar issue.
If none of the vertices is a List we can use the following two functions instead of VertexDelete and EdgeDelete:
ClearAll[vertexDelete, edgeDelete]

vertexDelete = VertexDelete[EdgeDelete[#, IncidenceList[#, #2]], #2] &;

edgeDelete = vertexDelete[#, VertexList@Flatten[{#2}]] &;

Examples:
CommunityGraphPlot@vertexDelete[wag, "WHS"]

CommunityGraphPlot@vertexDelete[wag, {"WHS", "OIL"}]

CommunityGraphPlot@edgeDelete[wag, "AGF" [DirectedEdge] "WHS"]

CommunityGraphPlot@edgeDelete[wag, 
 {"AGF" [DirectedEdge] "WHS", "MA1" [DirectedEdge] "OIL"}]

how to successively plot Community Graphs by iteratively using VertexDelete[]

One Answer

Add your own answers!

Ask a Question