2
$\begingroup$

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?

$\endgroup$
10
  • 2
    $\begingroup$ It works here. What version of Mathematica do you have? Until very recently, VertexDelete / EdgeDelete have been so buggy as to be completely unusable. Yes, fundamental functions like these were unusably buggy. If you have anything before v12.0, I'd say forget about any reliability when working with Graph. Ideally, use 12.2. $\endgroup$
    – Szabolcs
    Feb 14, 2021 at 16:56
  • 2
    $\begingroup$ In version 11.3.0, EdgeWeights are not properly modified byVertexDelete. A workaround: use EdgeDelete, that is, try edwag = EdgeDelete[wag, DirectedEdge["WHS", _] | DirectedEdge[_, "WHS"]] $\endgroup$
    – kglr
    Feb 14, 2021 at 17:05
  • 1
    $\begingroup$ My package, IGraph/M, has IGWeightedVertexDelete which can handle weighted graphs properly in v11.3 as well. But it will discard all edge properties except weights. There is also IGTakeSubgraph, which handles all properties correctly in versions prior to 12.0 as well, but it is very slow. $\endgroup$
    – Szabolcs
    Feb 14, 2021 at 17:21
  • 1
    $\begingroup$ Also consider IGWeightedAdjacencyGraph and IGWeightedAdjacencyMatrix which are actually consistent with each other in the handling of zeros and infinities, unlike the builtin WeightedAdjacencyMatrix and WeightedAdjacencyGraph. $\endgroup$
    – Szabolcs
    Feb 14, 2021 at 17:22
  • 2
    $\begingroup$ Finally, IGraph/M has a bunch of properly documented community detection methods. If you ever want to publish this work in a paper, the referee will ask you: what method did you use to find communities? And all you can say "I used Mathematica, I don't know how it works." If you ask Wolfram, they will not give a satisfactory answer about FindGraphCommunities $\endgroup$
    – Szabolcs
    Feb 14, 2021 at 17:25

1 Answer 1

3
$\begingroup$

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

![enter image description here

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

enter image description here

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

enter image description here

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

enter image description here

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

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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