9
$\begingroup$

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?

$\endgroup$
10
$\begingroup$

ConnectedComponents[Graph[ex1]] would be easier.

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

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

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

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

$\endgroup$
  • $\begingroup$ Seems to fail for {{1,2},{2,3},{3,4}} ? $\endgroup$ – erfink Oct 3 '18 at 20:08
  • 1
    $\begingroup$ @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. $\endgroup$ – C. E. Oct 3 '18 at 20:13

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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