How to reduce Tuples to unique instances?

Questions
1

If we take the “All possible 10-tuples of 4 different numbers” there are 1048576 results,
if these are then sorted and duplicates removed, we are left with just 286 results.

I am looking for a way to just reproduce the 286 results. The smaller set follow the pattern of
IntegerPartitions of 10 in to at most length 4 but I can’t see how to map those to the 4 numbers
to include the permutations of the partitions.

Any insight would be appreciated.

d = Tuples[{0, 1, 2, 3}, 10];Length[d]

Length[DeleteDuplicates[Sort/@ d]]

ip = SortBy[Sort /@ IntegerPartitions[10, 4], Length]

Regards.

2

Paul:

I’m confused. After removing the dupes of d, you have a list of 286 lists that each have 10 integers between 0 and 3.

The integer partitions of with arguments of [10, 4] is a list of 23 lists of lengths between 1 and 4 with values between 1 and 10.

Why are you trying to map one to the other?

If you could provide some context for this question, that might help the community help you.

3

Mike:

Thanks for the reply, and sorry for the confusion. The context of the problem is, lets say I have 4 different numbers to choose from
and I choose 10 of those numbers at random and after I have all 10 numbers I take the sum of them.

Now, using the 10 tuples of 4 numbers gives me all the possible totals, but there are many that are the same because the order in which
the 10 numbers were taken is irrelevant over addition, hence a sort and delete the duplicates, which leaves me with the 286 lists of all
the possible totals of the 10 numbers. I ultimately want to generate those 286 sets of numbers without having to do the 1048576 tuples lists first.
Now to the link with integer partitions as I see it

These are the integer partition.

{{10}, {1, 9}, {2, 8}, {3, 7}, {4, 6}, {5, 5}, {1, 1, 8}, {1, 2, 7}, {1, 3, 6}, {1, 4, 5}, {2, 2, 6}, {2, 3, 5}, {2, 4, 4},
{3, 3, 4}, {1, 1, 1, 7}, {1, 1, 2, 6}, {1, 1, 3, 5}, {1, 1, 4, 4}, {1, 2, 2, 5}, {1, 2, 3, 4}, {1, 3, 3, 3}, {2, 2, 2, 4}, {2, 2, 3, 3}}

and here is one of the 286 sets of numbers

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

and if we tally the numbers we get a set of {3, 2, 2, 3}, which sorted is {2, 2, 3, 3} which is also one of the integer partitions above.
So my idea is to map the {2, 2, 3, 3} to the numbers {0, 1, 2, 3}, or more specifically map {2, 2, 3, 3} to the permutations of {0, 1, 2, 3},
where the map to the first permutation would represent 2 lots of 0, 2 lots of 1, 3 lots of 2 and 3 lots of 3. to generate this set
{0, 0, 1, 1, 2, 2, 2, 3, 3, 3}. and if I am not mistaken, mapping all the integer partitions of 10 up to length 4 to all the permutations
of {0, 1, 2, 3} will generate the 286 sets of 10 numbers. But of course the mapping has to account for the different length partitions to
the constant length of the 4 numbers.

Using 10-tuples over 4 numbers is already too slow to be of any practical use and I want to take the idea beyond 10 tuples and 4 numbers.

I hope it’s a little clearer now and maybe the community can see a much easier way to achieve my goal.

Thanking everyone in advance.

4

Hello Paul,

say, the digits in question are {1,2,3,4}, and if you sum up these digits of each tuple, then the minimum sum is 10 (coming from {1,1,1,1,1,1,1,1,1,1}) and the maximum is 40 (coming from {4,4,4,4,4,4,4,4,4,4}), so one might simply do it like so:

Flatten[IntegerPartitions[#, {10}, {1, 2, 3, 4}] & /@ Range[10, 40], 1]
5

Note that 286 is Binomial[13,3]. This is not a coincidence. The latter is the number of ways one can place 3 sticks around or between 10 stones (a classic combinatorial problem). One gets from each such placement a partition by taking the first element with multiplicity equal to number of stones before (to the left of) the first stick (this number could be zero), the second element is repeated the number of stones between stick 1 and stick 2, with the third element repeated the number of stones between stick 2 and stick 3 and the fourth element repeated the number of stones after stick 3, Apologies for that belabored explanation

So here is some code. First get the stick placements.

Length[tt = Flatten[Table[{i, j, k}, {k, 3, 13}, {j, 2, k - 1}, {i, 1, j - 1}], 2]]
Short[tt]

(* Out[30]= 286

{{1, 2, 3}, {1, 2, 4}, {1, 3, 4}, {2, 3, 4}, {1, 2, 5}, << 277 >>, {8,
   12, 13}, {9, 12, 13}, {10, 12, 13}, {11, 12, 13}} *)

Now code to transform a placement into a partition of {0,1,2,3} into an ordered set of 10 elements.

partition[oll_List] := Module[{ll = Flatten[{0, oll, 14}], diffs},
  diffs = Differences[ll] - 1;
  Join @@ Table[ConstantArray[j - 1, diffs[[j]]], {j, Length[diffs]}]]

tuples = Map[partition, tt];
Short[tuples, 12]

(* {{3,3,3,3,3,3,3,3,3,3},{2,3,3,3,3,3,3,3,3,3},{1,3,3,3,3,3,3,3,3,3},{0,3,3,3,3,3,3,3,3,3},
  {2,2,3,3,3,3,3,3,3,3},{1,2,3,3,3,3,3,3,3,3},{0,2,3,3,3,3,3,3,3,3},{1,1,3,3,3,3,3,3,3,3},
  {0,1,3,3,3,3,3,3,3,3},{0,0,3,3,3,3,3,3,3,3},{2,2,2,3,3,3,3,3,3,3},{1,2,2,3,3,3,3,3,3,3},<<263>>,
  {1,1,1,1,1,1,1,1,1,1},{0,1,1,1,1,1,1,1,1,1},{0,0,1,1,1,1,1,1,1,1},{0,0,0,1,1,1,1,1,1,1},
  {0,0,0,0,1,1,1,1,1,1},{0,0,0,0,0,1,1,1,1,1},{0,0,0,0,0,0,1,1,1,1},{0,0,0,0,0,0,0,1,1,1},
  {0,0,0,0,0,0,0,0,1,1},{0,0,0,0,0,0,0,0,0,1},{0,0,0,0,0,0,0,0,0,0}} *)

Add spice, adjust to taste.

6

Thanks Henrik, that is certainly better than my code and slightly faster.

7

Thank you Daniel, very interesting indeed, and I do like coincidences, however if you don’t mind I am finding it difficult to use your code to alter the initial 4 numbers, as that is my intention and what part/s of the code would need to be changed to cater for say 5 or 6 numbers? Again, thank you for taking the time on this.

8

Here is more general code.

makeTable[size_Integer, pcount_Integer] := Module[
  {ivars, c, iters},
  ivars = Array[c, pcount - 1];
  iters = 
   Thread[{ivars, Range[Length[ivars], 1, -1], 
     Join[{size + pcount - 1}, Most[ivars] - 1]}];
  Flatten[Table[Reverse@ivars, Evaluate@Apply[Sequence, iters]], 
   pcount - 2]
  ]

partition[oll_List, vals_List] := Module[
   {ll = Flatten[{0, oll, 14}], diffs},
   diffs = Differences[ll] - 1;
   Join @@ 
    Table[ConstantArray[vals[[j]], diffs[[j]]], {j, Length[diffs]}]] /;
   Length[vals] == Length[oll] + 1

Test:

t5 = makeTable[8, 5];
tuples = Map[partition[#, {a, b, c, d, e}] &, t5];
Length[t5]
Binomial[8 + 4, 4]

(* Out[155]= 495

Out[156]= 495 *)

In[158]:= tuples[[1 ;; -1 ;; 40]]

(* Out[158]= {{e, e, e, e, e, e, e, e, e}, {b, c, d, d, e, e, e, e, 
  e}, {c, c, c, d, d, e, e, e, e}, {b, b, b, b, b, e, e, e, e}, {a, a,
   a, a, d, d, e, e, e}, {a, a, a, b, b, c, e, e, e}, {b, b, b, b, d, 
  d, d, e, e}, {a, a, a, a, c, c, d, e, e}, {a, a, a, a, a, b, c, e, 
  e}, {b, b, b, b, d, d, d, d, e}, {a, a, a, a, c, c, d, d, e}, {a, a,
   a, a, a, b, c, d, e}, {a, a, b, b, b, b, b, c, e}} *)