# How to identify the edges between a set of communities

Given:

CommunityGraphPlot[
ExampleData[{"NetworkGraph", "DolphinSocialNetwork"}]]


I like to identify:

1. The edges between each pair of communities;
2. In the context of a weighted network, find out the weights associated with the edges in (1); and
3. Combining all the communities in a single weighted adjacency matrix in which the edge weights between the communities are set to zero.

UPDATE: Please see the example weighted graph to be used:

ClearAll[vn, select, mat, wam, wag, comm];
SeedRandom[2];
vn = Table[Subscript[v, i], {i, 20}];
select[matrix_, lB_, uB_] :=
matrix*Map[Boole[lB <= # <= uB] &, matrix,{-1}];
mat = RandomReal[{}, {20, 20}];
wam = select[mat, .2, .3] /. {0.->\Infinity]};
wag = WeightedAdjacencyGraph[vn, wam];
comm = CommunityGraphPlot[wag, VertexLabels->"Name"]

• can you post an example of a weighted network?
– kglr
Feb 6, 2021 at 15:49
• @kglr: Yes, of course. Please see the update of the question. Feb 6, 2021 at 16:24

dsn = ExampleData[{"NetworkGraph", "DolphinSocialNetwork"}];


1. The edges between each pair of communities:

ClearAll[cToCedges, edgesBetweenCommunities]
cToCedges = Module[{vToC = Association[
Join @@ MapIndexed[Thread[# -> #2[[1]]] &]@ FindGraphCommunities[#]]},
KeySort@GroupBy[EdgeList@#, Sort[vToC /@ VertexList[{#}]] &]] &;

edgesBetweenCommunities = KeySelect[Unequal @@ # &]@*cToCedges;

cToCedges @ dsn


edgesBetweenCommunities @ dsn


CommunityGraphPlot[HighlightGraph[dsn, edgesBetweenCommunities[dsn][{1, 3}],
GraphHighlightStyle -> "Thick"], CommunityLabels -> Range[4]]


2. The weights associated with the edges

dsn2 = SetProperty[dsn, EdgeWeight -> RandomInteger[5, EdgeCount[dsn]]];

edgesBetweenCommunities @ dsn2


CommunityGraphPlot[HighlightGraph[dsn2, edgesBetweenCommunities[dsn2][{1, 3}],
GraphHighlightStyle -> "Thick"], CommunityLabels -> Range[4]]


KeyValueMap[# -> (Map[# ->  PropertyValue[{dsn2, #}, EdgeWeight] &]@#2) &] @
edgesBetweenCommunities[dsn2]


Using wag from OP:

MapAt[Highlighted, cToCedges @ wag, {Key[{2, 3}]}]


KeyValueMap[# -> (Map[# -> PropertyValue[{wag, #}, EdgeWeight] &]@#2) &]@
edgesBetweenCommunities[wag]


CommunityGraphPlot[HighlightGraph[wag, edgesBetweenCommunities[wag][{2, 3}],
GraphHighlightStyle -> "Thick"], VertexLabels -> "Name",
CommunityLabels -> Range[Length @ FindGraphCommunities @ wag]]


3. Set the edge weights between the communities to zero

This can be done in several ways:

betweenEdges = Flatten[Values @ edgesBetweenCommunities @ wag];


i. Get the positions of vertices connecting different communities and set the values corresponding to those indices to 0 using MapAt:

positions = Flatten /@ List @@@ (betweenEdges /. PositionIndex[vn]);

MatrixForm @ MapAt[Highlighted, Round[#, .1] &@ wam1, positions]


wam2 = MapAt[0 &, wam1, positions];

MatrixForm @ MapAt[Highlighted, Round[#, .1] &@wam2, positions]


ii. Use SetProperty to set the edge weights to 0 for edges in the list betweenEdges:

wam3 = WeightedAdjacencyMatrix @
Fold[SetProperty[{#, #2}, EdgeWeight -> 0] &, wag, betweenEdges];

wam2 == wam3


True

Note: If the goal is to get the edge list betweenEdges (that is, if we are not interested in edges connecting particular community pairs), it can be done more directly:

betweenEdges2 = EdgeList[GraphDifference[wag,
GraphUnion @@ (Subgraph[wag, #] & /@ FindGraphCommunities[wag])]];

Sort @ betweenEdges2 == Sort @ betweenEdges

 True

• Your answers are not only very clear answers but also valuable material for a teaching tutorial. I learned a lot from your earlier posts. Thank you. Feb 7, 2021 at 0:59
• @TugrulTemel, thank you for the kind words and the accept.
– kglr
Feb 7, 2021 at 1:00
• @TugrulTemel, does wam3 = WeightedAdjacencyMatrix @ Fold[SetProperty[{#, #2}, EdgeWeight -> -0.4*PropertyValue[{#,#2}, EdgeWeight]] &, wag, betweenEdges] give what you need?
– kglr
Mar 2, 2021 at 0:36
• @TugrulTemel, try if MapAt[- .4 #&, wam1, positions] (where positions = Flatten /@ List @@@ (betweenEdges /. PositionIndex[vn]);) is any faster.
– kglr
Mar 2, 2021 at 6:36
• Yes, it is quite fast compared to what I have. At least, my computer generates a result without freezing. Thank you. Mar 2, 2021 at 22:08