Suppose that $A$ is a list with $n$ elements where $n$ is even. I want to write a function that returns all pairs $(A_1,A_2)$ where the sets $A_1$ and $A_2$ each have length $\frac{n}{2}$, $A_1 \cap A_2=\emptyset$, and $A_1,A_2 \subset A$.
$\begingroup$
$\endgroup$
2
-
$\begingroup$ In "pair" order matters? $\endgroup$– KubaCommented Mar 26, 2015 at 15:07
-
$\begingroup$ I assume you meant distinct elements based on accepted answer? $\endgroup$– ciaoCommented Mar 26, 2015 at 23:41
Add a comment
|
4 Answers
$\begingroup$
$\endgroup$
5
I'm assuming in A_1 A_2 pair, order matters:
set = Range[6];
Transpose[{#, Reverse@#}] & @ Subsets[#, {Length[#]/2}] & @ set
{{{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}}, {{2, 3, 4}, {1, 5, 6}}, {{2, 3, 5}, {1, 4, 6}}, {{2, 3, 6}, {1, 4, 5}}, {{2, 4, 5}, {1, 3, 6}}, {{2, 4, 6}, {1, 3, 5}}, {{2, 5, 6}, {1, 3, 4}}, {{3, 4, 5}, {1, 2, 6}}, {{3, 4, 6}, {1, 2, 5}}, {{3, 5, 6}, {1, 2, 4}}, {{4, 5, 6}, {1, 2, 3}}}
If pair isn't ordered you can take halof of above or spare some memory doing:
With[{l = Length[#]},
Transpose[{#, Reverse@#2}] & @@
Partition[Subsets[#, {l/2}], Binomial[l, l/2]/2]] &@set
-
$\begingroup$ This is some nice tight code, but I have one issue. Once the size of the set get big (say 20 elements) speed an memory become an issue. Any ideas on how to handle this? It would be ideal if I could do this for set of size100 or better. I also was not explicit, I don't care about order. $\endgroup$ Commented Mar 26, 2015 at 17:05
-
1$\begingroup$ @Wintermute for really big data you can iterate through subsets with the third argument of
Subsetsand save them to the file. Depends of the final goal. $\endgroup$– KubaCommented Mar 26, 2015 at 17:20 -
$\begingroup$ @Kuba: Seeing as there will be 50445672272782096667406248628 disjoint paired subsets for a list of 100, not going to happen... ;-) $\endgroup$– ciaoCommented Mar 27, 2015 at 0:04
-
-
$\begingroup$ @Mr.Wizard Thanks, and you are right, this is specific case and I'm abusing the fact the partition is done in half. $\endgroup$– KubaCommented Jan 30, 2016 at 21:53
$\begingroup$
$\endgroup$
1
@Wizard, @Kuba, Sorry I do not have sufficient reputation for adding comments, therefore I take the liberty to post it as an Answer. Your solution result not only contains (A1,A2) but also contains (A2,A1), therefore // Take[#, Length @ #/2] & needs to be added in order to take only (A1,A2). :)
-
$\begingroup$ This is why I've asked a question if a pair is ordered. $\endgroup$– KubaCommented Mar 26, 2015 at 17:21
$\begingroup$
$\endgroup$
2
If order does not matter,
Clear[splitList]
splitList[
list_?(VectorQ[#] && EvenQ[Length[list]] &)] :=
Module[{a1, a2, a3, len = Length[list]},
a1 = Subsets[list, {len/2}];
a2 = Complement[list, #] & /@ a1;
a3 = Transpose[{a1, a2}];
Union[a3, SameTest ->
(Sort[Sort /@ #1] === Sort[Sort /@ #2] &)]]
splitList[{e1, e2, e3, e4, e5, e6}]
{{{e1, e2, e3}, {e4, e5, e6}}, {{e1, e2, e4}, {e3, e5, e6}}, {{e1, e2, e5}, {e3, e4, e6}}, {{e1, e2, e6}, {e3, e4, e5}}, {{e1, e3, e4}, {e2, e5, e6}}, {{e1, e3, e5}, {e2, e4, e6}}, {{e1, e3, e6}, {e2, e4, e5}}, {{e1, e4, e5}, {e2, e3, e6}}, {{e1, e4, e6}, {e2, e3, e5}}, {{e1, e5, e6}, {e2, e3, e4}}}
splitList[{j, a, l, b}]
{{{a, b}, {j, l}}, {{a, l}, {b, j}}, {{j, a}, {b, l}}}
answered Mar 26, 2015 at 15:14
-
$\begingroup$ I don't quite get this Union. Could you explain why you need this? $\endgroup$– KubaCommented Mar 26, 2015 at 15:18
-
$\begingroup$ @Kuba - it is used to eliminate equivalent pairs. To be independent of the internal workings of
SubsetsandComplement, it makes no assumptions about howSubsetsorComplementreturns their results. $\endgroup$ Commented Mar 26, 2015 at 16:01
$\begingroup$
$\endgroup$
2
I would suggest using a combination of Subsets and Complement, two basic set operations in Mathematica. Here is an example code, you should be able to transfer that to any sort of list on your own:
(*create list*)
list = {1, 2, 3, 4, 5, 6, 7, 8};
(*create all subsets of length n/2*)
subsets = Subsets[list, {Length[list]/2}];
(*create the corresponding complements*)
complements = Complement[list, #] & /@ subsets;
(*combine each subset with its corresponding complement*)
output = Transpose@{subsets, complements};
output[[i]] then contains one specific pair of complements $(A_1,A_2)$.
