6
$\begingroup$

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!

$\endgroup$
5
$\begingroup$
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

$\endgroup$
2
  • $\begingroup$ But G = Graph[{{1, 2}, {1, 3}, {2, 5}, {1, 5}, {6, 7}}]; Select[List @@@ EdgeList[Subgraph[G, #]] & /@ ConnectedComponents[G], Length[#] > 0 &] where {6, 7} shares no elts with others returns the {6, 7} {{{1, 2}, {1, 3}, {2, 5}, {1, 5}}, {{6, 7}}} $\endgroup$ – Christopher Lamb Nov 6 '18 at 20:37
  • $\begingroup$ @Rabbit Well, one could fix that by using the selector function Length[#] > 1 &. But I doubt that OP had that in mind... $\endgroup$ – Henrik Schumacher Nov 6 '18 at 20:42
6
$\begingroup$
Gather[list, IntersectingQ]

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

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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