Generating a list of tuples that meet certain criteria without running out of memory

Question

I would like to generate tuples of length 21 with possible elements 1, 2, and 3. I would also like there to be an equal number of 1's, 2's, and 3's, and I want to control for how many times one element is equal to the element before it in each tuple. That's a bit hard to word, so here is what I've done.

I have my criteria:

sieve[combination_] := Count[combination, 1] === Count[combination, 2] === Count[combination, 3] && Count[Table[combination[[i]] == combination[[i + 1]], {i, 1, 20}], False] === 5;

Then I generate the tuples:

data = Select[Tuples[{1, 2, 3}, {21}], sieve]

This works readily for length 9, but for 21 it exhausts my memory. Is there a way I can do this computation?

Answer 1

Clear["Global`*"]

pool = Table[Range[3], 7] // Flatten;

Rather than produce all tuples, produce a tuple on demand

choice := Module[{ch = RandomSample[pool]},
  While[Count[Most[ch] - Rest[ch], 0] != 15,
   ch = RandomSample[pool]]; ch]

choice

(* {2, 2, 3, 3, 3, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 3, 3, 3, 3, 2, 2} *)

For multiple tuples

Table[choice, 5] // Column

Answer 2

For a length of 18 (6 groups of 1, 2, and 3) one finds 17,153,136 permutations.

n = 6;
data = Flatten[Table[{1, 2, 3}, {n}]];
p = Permutations[data];
Length[p]
(* 17153136 *)

In general for a length of 3 n there will be (3 n)!/(n!^3) permutations. For 3 n = 21 there will be 399,072,960 permuations.