# Using Gather to rearrange my data

I have a list of elements:

{{1, 2}, {1, 5}, {2, 6}, {3, 7}, {4, 8}, {5, 6},
{5, 9}, {9, 13}, {10,11}, {11, 12}, {11, 15}, {15, 16}}


I have to divide it into sublists, so that:

#1[[1]] == #2[[1]] || #1[[1]] == #2[[2]] || #1[[2]] == #2[[1]] || #1[[2]] == #2[[2]] &


i.e. at the end I need to obtain:

{{{1, 2}, {1, 5}, {2, 6}, {5, 6}, {5, 9}, {9, 13}},
{3, 7}, {4, 8}, {{10,11}, {11, 12}, {11, 15}, {15, 16}}}


However, I cannot find a solution to do it with Gather. How can I accomplish this task?

• Your have not defined your desired goal sufficiently for anyone to be able to help you. Are #1 and #2 your sublists? Are there only 2 sublists? As far as I can tell, you want to divide a list of pairs into two 2-length lists where all elements are equal, which makes no sense. You will want to edit your question.
– ninjagecko
May 24, 2012 at 15:27
• @Brett That's the only reasonable interpretation. I'm the editing the question to change && to ||. May 29, 2012 at 16:31

Can be done with some graph computation.

In[585]:= gg = Graph[Apply[UndirectedEdge, ll, {1}]];

In[586]:= comps = ConnectedComponents[gg]

Out[586]= {{1, 2, 5, 6, 9, 13}, {3, 7}, {4, 8}, {10, 11, 12, 15, 16}}

In[587]:= Map[
Cases[ll, aa_ /; MemberQ[aa, Alternatives @@ #]] &, comps]

Out[587]= {{{1, 2}, {1, 5}, {2, 6}, {5, 6}, {5, 9}, {9, 13}}, {{3,
7}}, {{4, 8}}, {{10, 11}, {11, 12}, {11, 15}, {15, 16}}}


This could be made more efficient, in that last step. Only matters if you have to do this on much bigger such lists.

• Ah! Thank you very much! Actually I am doing all this stuff in order to find a percolation threshold :) so now I know how to deal with such problems!
– anastasiiia
May 25, 2012 at 8:39
• @anastasiiia This question about a percolation problem may be of interest then. May 29, 2012 at 16:34
• Alternately: (EdgeList[Subgraph[gg, #]] & /@ comps) /. UndirectedEdge -> List May 29, 2012 at 16:38

Here's a different approach using Gather and FixedPoint:

lst = {{1, 2}, {1, 5}, {2, 6}, {3, 7}, {4, 8}, {5, 6},
{5, 9}, {9, 13}, {10,11}, {11, 12}, {11, 15}, {15, 16}};

gather = Join @@@ Gather[#, Flatten[#] ⋂ Flatten[#2] =!= {} &] &;

FixedPoint[gather, List /@ lst]

(* output: {{{1, 2}, {1, 5}, {2, 6}, {5, 6}, {5, 9}, {9, 13}},
{{3, 7}},
{{4, 8}},
{{10, 11}, {11, 12}, {11, 15}, {15, 16}}}  *)

• thank you very much for helping me! I used the approach of the first and the second suggestions, since it is mostly related to my research (graph theory), but I am sure that Gather can be a very good alternative. Jun 4, 2012 at 15:46
• @Heike That is a very nice approach. +1
– Lou
Jun 4, 2012 at 18:29

In versions 10.2+, @Daniel's approach can be used more directly using RelationGraph with the relation IntersectingQ (thanks: Carl Woll). ConnectedComponents of the resulting graph gives the desired result:

data = {{1, 2}, {1, 5}, {2, 6}, {3, 7}, {4, 8}, {5, 6}, {5, 9}, {9, 13}, {10,11},
{11, 12}, {11, 15}, {15, 16}};

ConnectedComponents[RelationGraph[IntersectingQ, data]]


{{{1, 2}, {1, 5}, {2, 6}, {5, 6}, {5, 9}, {9, 13}},
{{10, 11}, {11, 12}, {11, 15}, {15, 16}},
{{4, 8}},
{{3, 7}}}

• IntersectingQ instead of Intersection[##] =!= {}& is simpler. Jul 25, 2017 at 23:51
• Right, thank you @Carl!
– kglr
Jul 25, 2017 at 23:54