# Generating a large table of values and selecting some of them following some condition

I am working on a problem where I have to generate a table of components while each component of the table has 18 entries. Six of the indices among 18 run from 0 to 1 while the other 12 can take values between 0 to 3. After doing that I have to select some of the entries which follow a certain criterion (sum of all values in each component should be three). I have done this for smaller sized entry tables but for this one Mathematica gives up very fast saying General::nomem: The current computation was aborted because there was insufficient memory available to complete the computation. I don't have a larger memory computer available. Can somebody help me with this please? The commands I am using are:

list =
Table[{i, j, k, l, m, n, o, p, q, r, s, u, v, x, y, z, a, b},
{i, 0, 1}, {j, 0, 3}, {k, 0, 3}, {l, 0, 1}, {m, 0, 3}, {n, 0, 3}, {o, 0, 1},
{p, 0, 3}, {q, 0, 3}, {r, 0, 1}, {s, 0, 3}, {u, 0, 3}, {v, 0, 1}, {x, 0, 3},
{y, 0, 3}, {z, 0, 1}, {a, 0, 3}, {b, 0, 3}] // Flatten

list1 = Partition[%, 18];

f1 = Total[#] < 4 &;

f2 = Total[#] > 2 &;

list2 = Select[list1, f1];

list3 = Select[list1, f2];

list4 = Intersection[list2, list3];

• Are you after this: p1 = Join @@ Permutations /@ IntegerPartitions[3, {18}, Range[0, 3]]; result = Cases[p1, Alternatives @@@ Range[0, {1, 3, 3, 1, 3, 3, 1, 3, 3, 1, 3, 3, 1, 3, 3, 1, 3, 3}]]; ?
– ciao
Jul 27, 2015 at 6:34

I think the comment solution will serve you well:

p1 = Join @@ Permutations /@ IntegerPartitions[3, {18}, Range[0, 3]];
result = Cases[p1, Alternatives @@@ Range[0, {1, 3, 3, 1, 3, 3, 1, 3, 3, 1, 3, 3, 1, 3, 3, 1, 3, 3}]];


Testing this (on my loungebook, so I limited both yours and this to indices to u), yours took ~30 seconds and the initial table took over 50MB on ByteCount, the above finished under timer resolution with under 19KB used... I'd expect 10-20X faster speed on a workstation, same memory needs.

Same result, modulo sort order.

The advantage will of course grow extending the indices to the full set.

I don't know if this will save you sufficient memory, but it will certainly cut down your memory use.

\$HistoryLength = 0;
list1 =
Flatten[
Table[{i, j, k, l, m, n, o, p, q, r, s, u, v, x, y, z, a, b},
{i, 0, 1}, {j, 0, 3}, {k, 0, 3}, {l, 0, 1}, {m, 0, 3}, {n, 0, 3}, {o, 0, 1},
{p, 0, 3}, {q, 0, 3}, {r, 0, 1}, {s, 0, 3}, {u, 0, 3}, {v, 0, 1}, {x, 0, 3},
{y, 0, 3}, {z, 0, 1}, {a, 0, 3}, {b, 0,3}], 17];
list2 = Select[list1, 2 < Total[#] < 4 &]

• That's still going to generate over a billion entries... :-)
– ciao
Jul 27, 2015 at 6:41
• @ciao. Yeah. But it's the best I could come with. My system could possibly just handle it, but perhaps not the OP's Jul 27, 2015 at 6:43

I think this can done as follows:

pol = {1, 3, 3, 1, 3, 3, 1, 3, 3, 1, 3, 3, 1, 3, 3, 1, 3, 3};
ip = Join @@ (Permutations /@ PadRight[IntegerPartitions[3, 3]]);
subs = Subsets[Range[18], {3}];
rl = Flatten[Map[Function[u, Thread[u -> #] & /@ ip], subs], 1];
cand = ReplacePart[ConstantArray[0, 18], #] & /@ rl;
ex = Position[pol, 1]
pck = Pick[cand, Max[Extract[#, ex]] <= 1 & /@ cand];


As I understand this aims to find vectors of length 18 with restrictions described whose sum of components is 3.

cand just finds vectors with elements {0,1,2,3}. pck picks out those that comply with condition {0,1} for positions in ex. There are 5712 cases.

Apologies if I have misunderstood.

A sample (20) is presented below:

• Thank you so much all for helping. Especially ubpdqn (last response)! Aug 4, 2015 at 23:15