# How to efficiently generate unique combination from several lists

For example I have a list

data={{1,3,2},{3,2,4},{2,4,3}}


sublist of data has no duplicate elements.

We know Tuples[data] will give all combination of 3 element list.

But I don't want all of them. I want those tuples with no duplicate elements, that is to say, I want

Select[Tuples[data], DuplicateFreeQ]


The problem is the data list could have many sublist, for example

data = Table[RandomSample[Range[20], 5], 15]
(*{{2,14,11,20,15},{16,12,11,4,9},{17,6,15,8,19},{12,17,18,1,8},{7,11,3,2,17},{4,16,12,17,14},{11,15,14,6,3},{11,8,19,10,14},{2,19,12,3,14},{18,17,15,14,3},{19,20,11,12,13},{15,17,12,1,18},{13,18,12,7,6},{18,17,16,11,15},{2,12,16,14,13}}*)


Apparantly, Tuples[data] will certainly blow away anyone's computer memory. But the acutally result of Select[Tuples[data], DuplicateFreeQ] could be much much less.

How to efficiently do this? Is there any built-in Combinatorial function for this job?

Update

a compile version of wuyingddg's answer, only for data of rank 2

ff4 = Compile[{{lists, _Integer, 2}, {next, _Integer, 1}},
Module[{i, n, temp, bag = InternalBag[Most@{0}]},
n = Dimensions[lists][[-1]];
For[i = 1, i <= Length@lists, i++,
temp = Complement[next, lists[[i]]];
If[Length@temp =!= 0,
InternalStuffBag[bag, Map[Append[lists[[i]], #] &, temp], 2]]];
Partition[InternalBagPart[bag, All], n + 1]],
CompilationTarget -> "C"]


timing

data = Table[RandomSample[Range[20], 5], 10];
Fold[Function[{lists, next},
Table[Map[Append[e, #] &, Complement[next, e]], {e, lists}]~
Flatten~1], {{}}, data] // Length // AbsoluteTiming
Fold[ff4, {{}}, data] // Length // AbsoluteTiming

{4.60543, 446796}

{1.80494, 446796}

• Does the order matter? With your first example data do you want both {3,2,4} and {2,3,4}? – mikado Aug 28 '16 at 22:01
• @mikado both order. That is what Tuples give. But I think this is not that matter. – matheorem Aug 28 '16 at 23:57

data = Table[RandomSample[Range[20], 5], 15];
Fold[Function[{lists, next},
Table[Append[e, #] & /@ Complement[next, e], {e, lists}]~Flatten~
1], {{}}, data] // Length // AbsoluteTiming

(* {178.779, 21925624} *)


Here is the code, it took 3 mins to get the result and the maximum memory use during its running is about 11G.

With

data2 = Fold[
Function[{lists, next},
Table[Append[e, #] & /@ Complement[next, e], {e, lists}]~Flatten~
1], {{}}, data];
MaxMemoryUsed[]


6833491432=6.36GB

data2[[1]] // Length


15`

• Thank you wuyingddg. Several months ago, my laptop only has 4GB memory. Now I only has 8GB, so ... – matheorem Aug 28 '16 at 12:34
• @matheorem Large list operations require a lot of RAM, if you have a 8gb USB stick with Readyboost, that might help. – Feyre Aug 28 '16 at 12:38
• Actually, Running this with clear kernel shows it only using 2.26GB RAM. – Feyre Aug 28 '16 at 12:39
• @matheorem the first out is from data, not the generated result. – Feyre Aug 28 '16 at 12:42
• @Feyre Yeah, I just notice that, sorry for my stupidness : ) – matheorem Aug 28 '16 at 12:43