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.

Possible Duplicate:
Computing the equivalence classes of the symmetric transitive closure of a relation

I am required to process sets consisting of 2-element subsets of integers by combining those subsets whose intersection is nonempty.

For example, given

X = {{1, 2}, {3, 4}, {7, 4}, {2, 5}}

my routine merge will output

merge[X] = {{3, 4, 7}, {1, 2, 5}} .

As all List elements are considered as sets, duplicate entries and list order are to be ignored.

In fact I have implemented such an algorithm in Mathematica, however I suspect it is horribly inefficient and am looking for any reasonable way to improve its performance.

My implementation uses FixedPoint and is broken into two parts :

merge0[x_] := Block[{x0 = x},
Do[
If[i != j && Intersection[x[[i]], x[[j]]] != {}, 
x0 = Join[Delete[x, {{i}, {j}}], {Union@Flatten[Join[x[[i]], x[[j]]]]}];
Break[]], 
{i, Length[x]}, {j, i}]; x0]

merge[x_] := FixedPoint[merge0, x]

Thanks and regards,

Daniel

share|improve this question

marked as duplicate by Mr.Wizard Sep 25 '12 at 6:37

This question has been asked before and already has an answer. If those answers do not fully address your question, please ask a new question.

    
What is the expected result of {{a,b},{b,c},{c,d}}? Seems your fuction returns {a,b,c,d} ... so the "intersection" is some kind of "transitive" property here –  belisarius Sep 25 '12 at 3:31
1  
Would Union @@@ FindClusters[{{1, 2}, {3, 4}, {7, 4}, {2, 5}}, DistanceFunction -> Composition[Abs, NeedlemanWunschSimilarity]] suit your needs? –  J. M. Sep 25 '12 at 3:44
    
I intend to close this as a duplicate of mathematica.stackexchange.com/q/7620/121 -- anyone disagree? –  Mr.Wizard Sep 25 '12 at 6:14
add comment

2 Answers 2

I remember helping someone else with a similar problem recently in chat. Anyway, here's a solution using //. or ReplaceRepeated. If your lists are very large, then you should look into alternative solutions, because the performance of //. along with ___ will degrade quickly. Otherwise, it's a fine solution and I'd use it if I had a similar problem.

list = {{1, 2}, {3, 4}, {7, 4}, {2, 5}}; (* your list *)
list //. {h___, a_List, m___, b_List, t___} :> {h, m, Union[a, b], t} /; 
    Intersection[a, b] =!= {}
(* {{3, 4, 7}, {1, 2, 5}} *)
share|improve this answer
add comment
pairs = {{1, 2}, {3, 4}, {7, 4}, {2, 5}, {5, 8}};

relativesF=ConnectedComponents[Graph[UndirectedEdge @@ # & /@ #]]&
relativesF@pairs
(* {{1, 2, 5, 8}, {3, 4, 7}} *)  

or

relativesF2 = DeleteDuplicates/@ Flatten/@ Gather[#, (Intersection[#1, #2] !={} &)] &;
FixedPoint[relativesF2 , pairs]
(* {{1, 2, 5, 8}, {3, 4, 7}} *)   

or

Nest[relativesF2, pairs, Length[pairs]]
(* {{1, 2, 5, 8}, {3, 4, 7}} *)   
share|improve this answer
    
kguler, since you are here: do you disagree with my intention to close this question? (see comment above) –  Mr.Wizard Sep 25 '12 at 6:30
    
@Mr.Wizard, not at all. Actually, just noticed your comment as I was trying to put together the links to other related questions to post a similar comment. –  kguler Sep 25 '12 at 6:36
add comment

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