12
$\begingroup$

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?

Improve this question
$\endgroup$
2
  • 1
    $\begingroup$ 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. $\endgroup$
    – ninjagecko
    Commented May 24, 2012 at 15:27
  • $\begingroup$ @Brett That's the only reasonable interpretation. I'm the editing the question to change && to ||. $\endgroup$
    – Szabolcs
    Commented May 29, 2012 at 16:31

3 Answers 3

Reset to default
13
$\begingroup$

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.

Improve this answer
$\endgroup$
3
  • $\begingroup$ 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! $\endgroup$
    – anastasiiia
    Commented May 25, 2012 at 8:39
  • $\begingroup$ @anastasiiia This question about a percolation problem may be of interest then. $\endgroup$
    – Szabolcs
    Commented May 29, 2012 at 16:34
  • 2
    $\begingroup$ Alternately: (EdgeList[Subgraph[gg, #]] & /@ comps) /. UndirectedEdge -> List $\endgroup$
    – Brett Champion
    Commented May 29, 2012 at 16:38
10
$\begingroup$

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}}}  *)
Improve this answer
$\endgroup$
2
  • $\begingroup$ 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. $\endgroup$
    – Lady InRed
    Commented Jun 4, 2012 at 15:46
  • 1
    $\begingroup$ @Heike That is a very nice approach. +1 $\endgroup$
    – Lou
    Commented Jun 4, 2012 at 18:29
1
$\begingroup$

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

Improve this answer
$\endgroup$
2
  • $\begingroup$ IntersectingQ instead of Intersection[##] =!= {}& is simpler. $\endgroup$
    – Carl Woll
    Commented Jul 25, 2017 at 23:51
  • $\begingroup$ Right, thank you @Carl! $\endgroup$
    – kglr
    Commented Jul 25, 2017 at 23:54

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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