# Create lists of equivalences from pairs

I have a list of pairs, e.g.,

ex1={{1,2},{1,3},{2,3}, {4,5}, {6,7},{6,8}, {7,8}}


that I would like to merge into the list

output={{1,2,3},{4,5},{6,7,8}}


via the transitive property. More explicitly, if {i,j}is a pair in the original list, then i and j should both be in the same list. Furthermore, if {i,j} and {j,k} are pairs, then i, j, and k should all be in the same list. Another way to view this problem is that we begin with lists of binary equivalences and wish to construct all the equivalence classes.

In the case that the original list of pairs satisfies the property that if {i,j} is listed as a pair then {j,i} is also listed, e.g.,

ex2={{1,2},{2,1},{1,3},{3,1}, {2,3},{3,2}, {4,5},{5,4}, {6,7},{7,6},{6,8},{8,6},{7,8},{8,7}}


then the following function works:

equivClasses[listOfPairs_]:=listOfPairs//GatherBy[#, First]&//Map[Fold[Union], #, {1}]&// Union


However, this function fails when the reverse of each pair doesn't necessarily appear, e.g., equivClasses[ex1]={{1,2,3},{2,3},...}. We can manufacture such a new list easily, e.g., by

newList=(Sort/@ex1)~Join~(ReverseSort/@ex1)//Union


and then calling equivClasses as before.

Q1 Is the above function equivClasses reasonable? It feels a bit kludgy to me, in particular insofar as the code creates $$n$$-copies of each sublist of length $$n$$ before Union-ing them away.

Q2 The scope in which this problem has arisen is somewhat large and computationally expensive. The list of pairs that I can generate contains ~10^5 pairs of integers and takes ~10min if I only generate the pairs {i,j} with i < j. I can certainly do the Sort...~Join~ReverseSort business, this seems a bit inefficient insofar as it doubles the memory usage (although this step does run reasonably fast, about 0.005sec on my machine). How can I optimize this code?

Q3 Particularly problematic is the case when the list of pairs doesn't include all pairwise comparisons, e.g., {{1,2},{2,3}} which should still get sorted into {{1,2,3}}. What can I do in this case?

• – kglr
Oct 3 '18 at 19:41

ConnectedComponents[Graph[ex1]] would be easier.

• Really a cool solution! Oct 3 '18 at 19:20
• @mgamer Thank you. =D Oct 3 '18 at 19:31
• Hah! That's super slick. Especially since this is happening in a graph theoretic context (construction of a Fischer cover). Thank you! Oct 3 '18 at 19:41
• You're welcome! Oct 3 '18 at 19:47
ConnectedComponents[ex1]


{{6, 7, 8}, {1, 2, 3}, {4, 5}}

• ... this more convenient form seems to be undocumented.
– kglr
Oct 3 '18 at 19:47
FixedPoint[Union @@@ Gather[#, IntersectingQ] &, ex1]


{{1, 2, 3}, {4, 5}, {6, 7, 8}}

• Seems to fail for {{1,2},{2,3},{3,4}} ? Oct 3 '18 at 20:08
• @erfink I made an update that solves that case as well, please let me know if there are cases where the new solution doesn't work. Oct 3 '18 at 20:13