# Delete the subsets containing the same $2$ integers present in other subsets

From my previous question, if I consider a list like this:

$$\{\{\{1,2,3\}$$,$$\{4,5,6\}\}$$, $$\{\{1,2,4\}$$,$$\{3,5,6\}\}$$, $$\{\{1,2,5\}$$,$$\{3,4,6\}\}$$, $$\{\{1,2,6\}$$,$$\{3,4,5\}\}$$, $$\{\{1,3,4\}$$,$$\{2,5,6\}\}$$, $$\{\{1,3,5\}$$,$$\{2,4,6\}\}$$, $$\{\{1,3,6\}$$,$$\{2,4,5\}\}$$, $$\{\{1,4,5\}$$,$$\{2,3,6\}\}$$, $$\{\{1,4,6\}$$,$$\{2,3,5\}\}$$, $$\{\{1,5,6\}$$,$$\{2,3,4\}\}\}$$

how can I delete all the permuted sublists containing in one of their subset $$2$$ different integers already present in one of the subsets of the previous permuted sublists? I hope the request is clear. In the showed case, the output would just be:

$$\{\{1,2,3\}$$,$$\{4,5,6\}\}$$

While considering the sublists of $$6$$ elements divided in subsets of length $$2$$, starting with

$$\{\{1,2\}$$,$$\{3,4\}$$,$$\{5,6\}\}$$

this one has to be deleted:

$$\{\{1,3\}$$,$$\{2,4\}$$,$$\{5,6\}\}$$

while this one (and others too) should be in the output:

$$\{\{1,3\}$$,$$\{4,5\}$$,$$\{2,6\}\}$$

• With all due respect, I personally think it not quite clear ;). Feb 16, 2023 at 6:34
• @ΑλέξανδροςΖεγγ Sorry for that! I try with an example: considering the list of 6 divided in subsets of length 2, starting with $\{$$\{$$1,2$$\},\{$$3,4$$\},\{$$5,6$$\}$$\}$ this one has to be deleted: $\{$$\{$$1,3$$\},\{$$2,4$$\},\{$$5,6$$\}$$\}$ while this one should be in the output: $\{$$\{$$1,3$$\},\{$$4,5$$\},\{$$2,6$$\}$$\}$ Feb 16, 2023 at 6:49
• @user967210 perhaps you should add the second example so people have two expected results to cross-check. this will help to get a correct answer
– bmf
Feb 16, 2023 at 7:18

## 2 Answers

This works for the example you gave:

d = {{{1, 2, 3}, {4, 5, 6}}, {{1, 2, 4}, {3, 5, 6}}, {{1, 2, 5}, {3,
4, 6}}, {{1, 2, 6}, {3, 4, 5}}, {{1, 3, 4}, {2, 5, 6}}, {{1, 3,
5}, {2, 4, 6}}, {{1, 3, 6}, {2, 4, 5}}, {{1, 4, 5}, {2, 3,
6}}, {{1, 4, 6}, {2, 3, 5}}, {{1, 5, 6}, {2, 3, 4}}};;
i = 1;
While[++i <= Length[d],
If[Or @@
Flatten[Outer[Length[Intersection[#1, #2]] > 1 &,
Flatten[d[[;; i - 1]], 1], d[[i]], 1]], d = Delete[d, i]; --i;]

];
d

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


or:

d = {{{1, 2}, {3, 4}, {5, 6}}, {{1, 3}, {2, 5}, {4, 6}}, {{1, 4}, {2,
3}, {5, 6}}, {{1, 5}, {2, 4}, {3, 6}}, {{1, 6}, {2, 3}, {4, 5}}};


results in:

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

• Thank you again. I tried with other example using your function $main[6, 3]$ and the output is {{{1,2},{3,4},{5,6}}, {{1,3},{2,5},{4,6}},{{1,4},{2,3},{5,6}}, {{1,5},{2,4},{3,6}}, {{1,6},{2,3},{4,5}}} so the first 2 and last 2 sublists are fine, but not the third one because the subset {5,6} was already present in the previous sublist and is missing {{1,4},{2,6},{3,5}}. I really appreciate your help, Thank you! Feb 16, 2023 at 11:26
• Sorry I misread: "previous permuted sublist" and not "previous permuted sublists". I fixed this. Feb 16, 2023 at 15:14
• Thank you, that's what I looked for! Feb 16, 2023 at 16:23

You can use two-argument form of DeleteDuplicates:

ClearAll[cleanUp]

cleanUp = DeleteDuplicates[#,
GreaterThan[1] @ Max @ Outer[Length @* Intersection, ##, 1] &] &;


Examples:

d1 = {{{1, 2, 3}, {4, 5, 6}}, {{1, 2, 4}, {3, 5, 6}}, {{1, 2, 5}, {3, 4, 6}},
{{1, 2, 6}, {3, 4, 5}}, {{1, 3, 4}, {2, 5, 6}}, {{1, 3, 5}, {2, 4, 6}},
{{1, 3, 6}, {2, 4, 5}}, {{1, 4, 5}, {2, 3, 6}}, {{1, 4, 6}, {2, 3, 5}},
{{1, 5, 6}, {2, 3, 4}}};

cleanUp @ d1

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

d2 = {{{1, 2}, {3, 4}, {5, 6}}, {{1, 3}, {2, 5}, {4, 6}}, {{1, 4}, {2,
3}, {5, 6}}, {{1, 5}, {2, 4}, {3, 6}}, {{1, 6}, {2, 3}, {4, 5}}};

cleanUp @ d2

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