Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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?

share|improve this question

migrated from stackoverflow.com May 29 '12 at 16:12

This question came from our site for professional and enthusiast programmers.

1  
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 '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
add comment

2 Answers 2

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}}}  *)
share|improve this answer
    
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 4 '12 at 15:46
1  
@Heike That is a very nice approach. +1 –  Lou Jun 4 '12 at 18:29
add comment

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.

share|improve this answer
    
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 '12 at 8: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
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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