4
$\begingroup$

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 = Internal`Bag[Most@{0}]},
   n = Dimensions[lists][[-1]];
   For[i = 1, i <= Length@lists, i++,
    temp = Complement[next, lists[[i]]];
    If[Length@temp =!= 0, 
     Internal`StuffBag[bag, Map[Append[lists[[i]], #] &, temp], 2]]];
   Partition[Internal`BagPart[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}
|improve this question
$\endgroup$
  • $\begingroup$ Does the order matter? With your first example data do you want both {3,2,4} and {2,3,4}? $\endgroup$ – mikado Aug 28 '16 at 22:01
  • $\begingroup$ @mikado both order. That is what Tuples give. But I think this is not that matter. $\endgroup$ – matheorem Aug 28 '16 at 23:57
6
$\begingroup$ 
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

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

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.