Return to Revisions

Using Daniel Lichtblau's answer to a related question

 ConnectedComponents[Graph[UndirectedEdge @@@ pairs]] //Sort/@#& //Sort

gives

{{3, 5, 9}, 
 {11, 21, 22, 35}, 
 {12, 14, 16, 23}, 
 {1, 6, 10, 13, 36}, 
 {17, 20, 24, 25, 28, 32}, 
 {2, 8, 15, 18, 27, 29, 31}, 
 {4, 7, 19, 26, 30, 33, 34}}

EDIT: An alternative approach:Implementing transitive closure using MatrixPower:

pairs;
(*the adjacency matrix of atomic elements in pairs:*)
% // SparseArray[Table[{i, i} -> 1,{i,1,Max@#}]~Join~Thread[# -> 1], {Max@#, Max@#}] &;
(*symmetrize the adjacency matrix:*)
% // (# + Transpose@#) & // Unitize;
(*find the transitive closure:*)
% // Sign@MatrixPower[#, Length@#] &;
(*eliminate duplicate rows,and extract the atomic elements of pairs in each row:*)
% //Normal//DeleteDuplicates//Pick[#,Thread[(Tr /@ #) > ConstantArray[1, Length@#]]] &;
% // (Flatten[MapIndexed[#2 #1 &, #]] & /@ #) &;
(*back out members of pairs and organize:*)
% // (DeleteCases[#, 0] & /@ #) &
% // Sort /@ # & // Sort

Results:

 {{3, 5, 9}, 
  {11, 21, 22, 35},
  {12, 14, 16, 23},
  {1, 6, 10, 13, 36}, 
  {17, 20, 24, 25, 28, 32}, 
  {2, 8, 15, 18, 27, 29, 31}, 
  {4, 7, 19, 26, 30, 33, 34}}