Tuples which treats re-ordering as equivalent [duplicate]

Question

I would like to define a new function myTuples, that behaves just like Tuples, except that it treats, as with Subsets, re-ordering as equivalent.

As an example output:

 n = 3;
 myTuples[{1,2,3},n]
(* Output: {{1,1,1}, {1,1,2}, {1,1,3}, {1,2,2}, {1,2,3}, {1,3,3}, {2,2,2}, {2,2,3},{2,3,3},{3,3,3}} *)

It would be possible to achieve this result via the following method:

1. first, apply Tuples[{1,2,3},n]
2. then, apply Sort on each element
3. then, apply DeleteDuplicates

For small $n$, this is ok. However, for larger $n$, the initial list one gets from Tuples becomes very large, very quickly (it scales like $3^n$). In parallel, this is going to produce large amounts of duplicates which later are removed, which looks like a waste. Is there a quicker way to do this?

Alternatively, I was thinking of starting with Subsets[{1,2,3},n] instead, and then find a way to add whatever is missing, but this also looks not very straightforward.

Answer 1

You may use IntegerPartitions.

combinations[vec_, n_Integer?Positive] :=
 Flatten[
   IntegerPartitions[#, {n}, Range@Length@vec] & /@ 
    Range[n Length[vec]]
   , 1] /. Thread[Range@Length@vec -> vec]

Then

combinations[Range@3, 3]

{{1, 1, 1}, {2, 1, 1}, {3, 1, 1}, {2, 2, 1}, {3, 2, 1}, {2, 2, 2}, {3,3, 1}, {3, 2, 2}, {3, 3, 2}, {3, 3, 3}}

Works on list of any expression.

v = {"x", "y", "z"};
combinations[v, Length@v]

{{"x", "x", "x"}, {"y", "x", "x"}, {"z", "x", "x"}, {"y", "y", "x"}, {"z", "y", "x"}
 , {"y", "y", "y"}, {"z", "z", "x"}, {"z", "y", "y"}, {"z", "z", "y"}, {"z", "z", "z"}}

Works for large list and n. Note current version of @BobHanlon myTuples will fail on insufficient memory error for RepeatedTiming[myTuples[Range@10, 10];] on my 128GB RAM laptop.

RepeatedTiming[combinations[Range@10, 10];]

{0.269681, Null}

Also for n greater than or less then the length of the list.

combinations[Range@3, 2]

and

combinations[Range@3, 5]

Hope this helps.

Answer 2

You can do this by counting using nested Tables functions. Unfortunately, it gets pretty complicated for arbitrary number of elements because we need to create the Table commands by code.

For an example we take a list of n==3 elements:

n = 3;
d = Range[n];

The number of iterators needed depends on n. This makes it a bit complicated to generate programmatically the iterators in the Table command we are going to construct. The first iterator runs from 0 to n. The iterators without the last one are created by:

iters = Join[{{i1, 0, n}}, 
   Table[{Symbol["i" <> ToString[i]], 0, 
     n - Sum[Symbol["i" <> ToString[j]], {j, i - 1}]}, {i, 2, 
     n - 1}] ];

The body of our table is given by:

body := Table[
   Table[d[[i]], {Symbol["i" <> ToString[i]]}], {i, n - 1}];

To write the table, we need to insert the iterators using Evaluate because Table has the attribute HoldAll. The different table commands create too many levels of nesting, that we need to eliminate using Flatten. And to get the sublists in ascending order we finally apply Reverse:

    Flatten /@  Flatten[
Table[ Join[dat, Table[d[[n]], {n - Sum[Symbol["i" <> ToString[j]], {j, n - 1}]}]]
, Evaluate[Sequence @@ iters]]
, 1] // Reverse

For our example, we get the result: