# Fast way to compute intersection of equivalence classes

There is a set $S=\{1, 2, \dots, m\}$ and $n$ equivalence relations on the set: $a \sim_i b$, where $a,b \in S$, $i=1, \dots, n$. Now we define $a \sim b$ iff $a \sim_i b$ $\forall i=1, \dots, n$.

The equivalence relations $\sim_i$ are given with the equivalence classes and our task is to calculate the equivalence classes of $\sim$.

What is a fast way to compute it?

In the following example $n=3$ and $m=60$.

We have the equivalence classes in a list (the first element of the list corresponds to the first equivalence relations and so on) as lists of lists:

input = {
{{1, 56, 47, 48, 15, 18, 25, 33, 35, 24, 50, 60, 5, 59, 2, 21, 22,
29, 30, 8, 17, 23, 36, 49, 9, 19, 26, 42, 52, 40, 51, 27, 46, 58,
16, 34, 53, 20, 41, 39, 54, 13, 31, 7, 55, 11, 10, 6, 37, 14, 12,
3, 43, 57}, {38, 44}, {45}, {32}, {28}, {4}},
{{1, 10, 27, 35, 14, 34, 2, 21, 17, 52, 54, 58, 11, 29, 45, 40, 51,
5, 23, 25, 46, 16, 7, 30, 9, 20, 47, 42, 60, 15, 18, 33, 57, 41, 22,
50, 13, 24, 26, 39, 48, 49, 56, 53, 19, 59, 36, 6, 8, 37, 3, 28, 12,
43, 31}, {55}, {44}, {38}, {32}, {4}},
{{1, 10, 27, 35, 56, 6, 14, 2, 55, 48, 7, 47, 12, 18, 22, 26, 17, 52,
58, 8, 25, 59, 41, 39, 49, 9, 46, 60, 16, 23, 33, 34, 30, 45, 20,
24, 37, 40, 36, 19, 50, 21, 11, 29, 3, 15, 28, 13, 31, 53, 5, 42,
57}, {38, 44}, {54}, {51}, {43}, {32}, {4}}
}


And the output should be the equivalence classes of the intersection of the equivalence relations:

output = {{1, 2, 3, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20,
21, 22, 23, 24, 25, 26, 27, 29, 30, 31, 33, 34, 35, 36, 37, 39, 40,
41, 42, 46, 47, 48, 49, 50, 52, 53, 56, 57, 58, 59,
60}, {54}, {51}, {43}, {55}, {44}, {38}, {45}, {32}, {28}, {4}}


I know how to do it as a brute-force but I am sure there are much efficient ways to do it:

Select[Flatten[Apply[Outer[Intersection, ##, 1] &, input], 2], UnsameQ[#, {}] &]

• This is not very helpful, but I think it's more natural in this case to do Cases[Flatten[Apply[Outer[Intersection, ##, 1] &, input], 2], {__}] at the end. Mar 23, 2016 at 21:50
• As possibly another unhelpful comment: is it possible to generate the full equivalence relation at the beginning, before you've generated the individual ones? It seems like it would be better to combine the conditions used to generate the equivalence classes first before generating the lists themselves. That way you can get output without generating input first. (This is still good question and should be answered. I figured I'd toss this out there anyway.) Mar 23, 2016 at 21:53
• Actually, Cases[Apply[Outer[Intersection, ##, 1] &, input], {__}, {3}]. Mar 23, 2016 at 21:56

As a first stab at things, let's at least do things sequentially rather than "Outering" everything together. Let's take a simpler version:

input = {
{{1, 2, 3, 4}, {5, 6, 7, 8, 9}, {10}},
{{1, 2, 3}, {4, 5, 6, 7}, {8, 9}, {10}},
{{1, 2, 3, 4}, {5}, {6, 7}, {8, 9, 10}}
};


and do (using a simpler version of OP's code):

op = Cases[Apply[Outer[Intersection, ##, 1] &, input], {__}, {Length@input}];
march = Fold[Cases[Outer[Intersection, ##, 1], {__}, {2}] &, input]
op === march
(* {{1, 2, 3}, {4}, {5}, {6, 7}, {8, 9}, {10}} *)
(* True *)


This compares one set of equivalence classes to the next and refines them into a new set of equivalence classes, which is then compared to the next one in the list. This led to a factor of 3 or 4 speed up on the OP's example. I have not done any more testing, although having to select out the non-empty lists at every step is likely very time-consuming.