4
$\begingroup$

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.

$\endgroup$
2
  • $\begingroup$ Even after removing duplicates the resulting number of elements in the list becomes very large, very fast. Maybe if you described what you want to do with the subset of tuples, it might turn out that you don't need to generate all of them in the first place. $\endgroup$
    – JimB
    Apr 12, 2022 at 16:50
  • 3
    $\begingroup$ f[{1, 2, 3}, 3] from this answer does it: mathematica.stackexchange.com/a/42284/4999 $\endgroup$
    – Michael E2
    Apr 12, 2022 at 16:52

2 Answers 2

4
$\begingroup$

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.

$\endgroup$
2
$\begingroup$

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:

enter image description here

$\endgroup$

Not the answer you're looking for? Browse other questions tagged or ask your own question.