Wsrtjtyk

Given a list of integer pairs such as

list = { {1,2},{1,3},{2,5},{1,5},{6,7},{6,9},{4,6} };

What is a quick way to separate the pairs into groups in which every element shares at least one integer with at least one other element, in Mathematica? e.g.:

separate[list]

{ { {1,2},{1,3},{2,5},{1,5} } , { {6,7},{6,9},{4,6} } }

Thanks for any suggestion!

G = Graph[{{1, 2}, {1, 3}, {2, 5}, {1, 5}, {6, 7}, {6, 9}, {4, 6}}];

Select[

 List @@@ EdgeList[Subgraph[G, #]] & /@ ConnectedComponents[G], 

 Length[#]>0 &

 ]

{{{4, 6}, {6, 7}, {6, 9}}, {{1, 2}, {1, 3}, {2, 5}, {1, 5}}}

If "quick" was meant as "quick at runtime", then you should better avoid Graph and use SparseArray:

componentEdges[edges_] := Module[{B},

   B = Transpose[With[{m = Length[edges], n = Max[edges]},

      (* this builds a sparse array directly from row pointers, column indices, and nonzero values; undocumentd *)

      SparseArray @@ {Automatic, {m, n}, 0, {1, {

          Range[0, 2 m, 2],

          Partition[Flatten[edges], 1]

          },

         ConstantArray[1, 2 m]}}

      ]];

   Select[

    Table[

     edges[[Flatten[(SparseArray[Partition[c, 1] -> 1, Length[B]].B)["NonzeroPositions"]]]],

     {c, SparseArray`StronglyConnectedComponents[B.B[Transpose]]}],

    Length[#] > 0 &]

   ];

Just for comparison, the Graph-based approach:

componentEdges0[edges_] := With[{G = Graph[edges]},

   Select[

    List @@@ EdgeList[Subgraph[G, #]] & /@ ConnectedComponents[G], 

    Length[#] > 0 &]

   ];

And here a usage example along with timings:

edges = Developer`ToPackedArray[List @@@ EdgeList[RandomGraph[{10000, 60000}]]];

a = componentEdges0[edges]; // RepeatedTiming // First

b = componentEdges[edges]; // RepeatedTiming // First

Sort[Sort /@ a] == Sort[Sort /@ b]

0.13

0.0084

True

Gather[list, IntersectingQ]

{{{1, 2}, {1, 3}, {2, 5}, {1, 5}},

{{6, 7}, {6, 9}, {4, 6}}}