Using Gather to rearrange my data

Question

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. — , May 24 '12 at 15:27
@Brett That's the only reasonable interpretation. I'm the editing the question to change && to ||. — Szabolcs, May 29 '12 at 16:31

score 13 · Answer 1 · answered May 24 '12 at 20:49

13

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.

answered May 24 '12 at 20:49

Daniel Lichtblau

58,970
2
101
199

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! – May 25 '12 at 08:39
@anastasiiia This question about a percolation problem may be of interest then. – Szabolcs May 29 '12 at 16:34
2

Alternately: (EdgeList[Subgraph[gg, #]] & /@ comps) /. UndirectedEdge -> List – Brett Champion May 29 '12 at 16:38

score 10 · Answer 2 · edited Jun 05 '12 at 10:06

10

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}}}  *)

edited Jun 05 '12 at 10:06

Mr.Wizard

271,378
34
587
1,371

answered May 27 '12 at 09:22

Heike

35,858
3
108
157

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. – Lady InRed Jun 04 '12 at 15:46
1

@Heike That is a very nice approach. +1 – Lou Jun 04 '12 at 18:29

score 1 · Answer 3 · edited Jul 26 '17 at 02:58

1

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}}}

edited Jul 26 '17 at 02:58

Mr.Wizard

271,378
34
587
1,371

answered Jul 25 '17 at 21:49

kglr

394,356
18
477
896

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

Using Gather to rearrange my data

3 Answers3

Linked