## Adjacency Matrix to Clusters of Equal Sizes

2

I have a system with 72 nodes. I have a binary adjacency matrix $$S$$ of size $$72\times 72$$. If $$S_{i,j}=1$$, then node $$i$$ is adjacent to node $$j$$. So, we also have $$S_{i,j}=S{j,i}$$. So, $$S$$ is a binary symmetric matrix.

$$D$$ is an another matrix of same size. It is the distance matrix. $$D_{i,j}$$ is the distance between node $$i$$ and node $$j$$, so, $$D_{i,i}=0$$.

Now, my target is to form 12 adjacent groups of nodes where we have exactly 6 nodes in each group/cluster. The group elements are adjacent, i.e, every node of a group must be adjacent to at least one of the remaining nodes in that cluster. The group elements should be as close as possible, i.e., the sum of distances needs to be minimize.

Can this problem be modeled in Mathematica?

Lets say, vector $$U\in 1\times 12$$ contains all the summations of distances in a cluster and we can solve a min-max problem as

            Minimize Max U


But, the question is how to formulate the constraints required to form the clusters?

If possible can we consider a variable binary integer matrix $$B\in 72\times 12$$? So, $$B_{i,j}$$ defines the association of nodes in a cluster. If $$B_{i,j}=1$$, it means that node $$i$$ is in cluster $$j$$. The summation of all the elements in each column is 6.

1How about considering a smaller analogous problem, like 6 nodes that you want divided into 2 groups of 3. In this case you can list the matrices S and D explicitly, and maybe it will become more obvious how to solve it. With luck, that might generalize to the full problem. Even in the simpler case, it would seem that there are configurations of S which would make it impossible to achieve the goal -- for example, what if one of the nodes was isolated and not adjacent to any others... then it could not be in any group. – bill s – 2018-10-27T19:52:23.473

@bill s, however it is not the case. no node is isolated. – dipak narayanan – 2018-10-27T19:57:42.307

FindGraphPartition[WeightedAdjacencyGraph[adjmat],6]? – kglr – 2018-10-27T20:00:42.483

@kglr, the Mathematica documentation says that WeightedAdjacencyGraph works on weighted adjacency matrix. But in my case, the adjacency matrix is not weighted. What about your comment? – dipak narayanan – 2018-10-27T20:35:11.180

@kglr, Thanks a lot. But when run the code, I am getting this..WeightedAdjacencyGraph::matsq: Argument {{0,0,0,0,0,0,0,363.18,371.88,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},{0,0,431.19,0,0,0,0,0,0,0,0,632.24,366.3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},<<48>>,<<22>>} at position 1 is not a non-empty square matrix. – dipak narayanan – 2018-10-29T14:50:24.227

@kglr, I also get the following error...FindGraphPartition::graph: A graph object is expected at position 1 in FindGraphPartition[WeightedAdjacencyGraph[{{0,0,0,0,0,0,0,363.18,371.88,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},<<49>>,<<22>>}],6]. – dipak narayanan – 2018-10-29T15:25:03.890

@kglr, Yes...it is indeed a square matrix. But, I got that error. – dipak narayanan – 2018-10-30T10:27:53.283

@dipaknarayanan If you edit your question and add the code you are currently using, that makes it easier for others to give you good advice. – Thies Heidecke – 2018-10-30T15:09:27.123

@kglr, Unfortunately, the code you suggested gave clusters but with non-adjacent cluster members. My target is that in each cluster, any node must be adjacent to at least one of the remaining nodes in that cluster. – dipak narayanan – 2018-10-30T21:17:42.863

2

You can use the built-in functions FindGraphPartition to get partition with approximately equal sized groups and FindGraphCommunities to modify partition to equalize the group sizes.

SeedRandom[123]
n = 72;
utm = UpperTriangularize[RandomChoice[{3/4, 1/4} -> {0, 1}, {n, n}], 1];
am = utm + Transpose[utm];
coords = RandomReal[100, {n, 2}];
dm = Rescale @ DistanceMatrix[coords];
wam = ((1 - dm) am) /.  0 | 0. -> ∞;

VertexSize -> Scaled[.03], VertexLabels -> Placed["Name", Center],
ImageSize -> Large]


CommunityGraphPlot[wag]


• FindGraphPartition[g, k] gives a partition of vertices into k approximately equal-size parts.

• For a weighted graph, FindGraphPartition finds a partition such that the sum of edge weights for edges having endpoints in different parts is minimized.

partition = FindGraphPartition[wag, ConstantArray[6, 12]]


{{5, 7, 34, 44, 45, 63, 68}, {6, 10, 12, 22, 36, 58},
{1, 18, 26, 38, 39, 62}, {28, 37, 48, 51, 56, 67},
{8, 16, 43, 47, 54, 70}, {13, 14, 29, 40, 57, 64},
{11, 19, 25, 42, 50, 53}, {2, 4, 17, 23, 24, 61},
{15, 35, 46, 52, 59, 66}, {9, 21, 31, 32, 33, 65},
{20, 27, 30, 49, 55, 60}, {3, 41, 69, 71, 72}}

Length /@ partition


{7, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 5}

CommunityGraphPlot[wag, partition]


Next, we use FindGraphCommunities with option Method -> "VertexMoving" using partition as the value of the sub-option "InitialPartitioning" and (-(Length[#2] - 12)^2 - Total[(6 - Length@#)^2 & /@ #2] &) as the value of the sub-option "ObjectiveFunction" to get equal sized groups:

partition2 = FindGraphCommunities[wag,
Method -> {"VertexMoving", "InitialPartitioning" -> partition,
"ObjectiveFunction" -> (-(Length[#2] - 12)^2 - Total[(6 - Length@#)^2 & /@ #2] &)}]


{{1, 18, 26, 38, 39, 62}, {2, 4, 17, 23, 24, 61},
{3, 5, 41, 69, 71, 72}, {6, 10, 12, 22, 36, 58},
{7, 34, 44, 45, 63, 68}, {8, 16, 43, 47, 54, 70},
{9, 21, 31, 32, 33, 65}, {11, 19, 25, 42, 50, 53},
{13, 14, 29, 40, 57, 64}, {15, 35, 46, 52, 59, 66},
{20, 27, 30, 49, 55, 60}, {28, 37, 48, 51, 56, 67}}

Length /@ partition2


{6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6}

CommunityGraphPlot[wag, partition2]


HighlightGraph[Graph[Join @@ partition2, EdgeList @ wag],
Subgraph[wag, #] & /@ partition2, VertexSize -> 7/10,
GraphLayout -> "CircularEmbedding",
VertexLabels -> Placed["Name", Center]]


... every node of a group must be adjacent to at least one of the remaining nodes in that cluster.

Grid[Partition[Subgraph[wag, #, PlotLabel -> #,
GraphLayout -> "CircularEmbedding", ImageSize -> 200, VertexStyle -> White,
EdgeLabels -> {e_ :>  Round[PropertyValue[{wag, e}, EdgeWeight], .1]},
VertexLabels -> Placed["Name", Center], VertexSize -> Medium] & /@
partition2, 4]]


thanks for your answer. But I think I could not explain my question. How can I upload my data in Mathematica XChange? Lets say {a,b,c,d,e,f} is a cluster where a, b, c, d, e, f are nodes. a must be connected (have an edge) to at least of of the remaining nodes (b,c,d,e,f). Likewise b must be connected (have an edge) to at least of of the remaining nodes (a,c,d,e,f). – dipak narayanan – 2018-10-30T22:31:40.707

@dipaknarayanan, your requirement is satisfied by all the clusters in partition and partition2 (see the last picture). – kglr – 2018-10-30T22:49:20.763

@kglr beautiful answer +1 ! – chris – 2018-10-31T00:42:13.810

Thank you @chris. – kglr – 2018-10-31T00:45:25.130