# Combining lists with common elements efficiently [duplicate]

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

-

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

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 – Dr. belisarius Sep 25 '12 at 3:31
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

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

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

-
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. – kglr Sep 25 '12 at 6:36