2
$\begingroup$

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

Improve this question
$\endgroup$
3
  • $\begingroup$ 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 $\endgroup$
    – Dr. belisarius
    Sep 25, 2012 at 3:31
  • 1
    $\begingroup$ Would Union @@@ FindClusters[{{1, 2}, {3, 4}, {7, 4}, {2, 5}}, DistanceFunction -> Composition[Abs, NeedlemanWunschSimilarity]] suit your needs? $\endgroup$
    – J. M.'s missing motivation ♦
    Sep 25, 2012 at 3:44
  • $\begingroup$ I intend to close this as a duplicate of mathematica.stackexchange.com/q/7620/121 -- anyone disagree? $\endgroup$
    – Mr.Wizard
    Sep 25, 2012 at 6:14

2 Answers 2

Reset to default
4
$\begingroup$

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}} *)
Improve this answer
$\endgroup$
2
$\begingroup$ 
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}} *)
Improve this answer
$\endgroup$
2
  • $\begingroup$ kguler, since you are here: do you disagree with my intention to close this question? (see comment above) $\endgroup$
    – Mr.Wizard
    Sep 25, 2012 at 6:30
  • $\begingroup$ @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. $\endgroup$
    – kglr
    Sep 25, 2012 at 6:36

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