# More efficient ways of listing matchings of possible rolls of 10 dice by max matching

The question is inspired by a dice game named 'Tenzi'. You roll 10 dice and record the size of the largest matching (the face-value is irrelevant). Exhaustively, listing all combinations of matchings would look like this:

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

e.g., looking at the first line, {2,2,2,2,2} corresponds to five pairs and {2,2,2,2,1,1} corresponds to four pairs and two singles. These are the only possible matchings with a maximum of 2 (since a die only has 6 sides), and so it is in its own nested list.

I wrote the following code that comes up with an equivalent list, but it is very inefficient due to using Tuples[Range[10],n].

pairs = Table[Select[Flatten[Table[Select[DeleteDuplicates[Sort /@ Tuples[Range[10], n]],
Total[#] == 10 &], {n, 1, 6}], 1], Max[#] == i &], {i, 2, 10}];

Any ideas on how to make this more efficient so I can generalize to more than 10 dice?

• Have you seen IntegerPartitions? E.g. GatherBy[#, First] &@Select[IntegerPartitions[10], Length@# < 7 &]. – corey979 Jan 6 '17 at 18:13
• That works perfectly. Thanks. I was not aware of GatherBy[] nor IntegerPartitions[]. – Gerald Jan 6 '17 at 18:22
• I'm curious - what are you going to do with the results, that is, is this an x y problem, and you're after some count of possibilities, or probabilities of same, or are you actually just after the total enumeration? If the former, much more efficient ways to do those... – ciao Jan 8 '17 at 23:18
• I'm creating a probability distribution of the sizes of the maximum matchings, i.e., the result of any play of Tenzi. – Gerald Jan 10 '17 at 2:46

IntegerPartitions[n, k] will give all possible ways to sum positive integers to n using at most k numbers. Then you can GatherBy the First element to form sublists (Reverse to have them in ascending order):

pairs = Reverse @ GatherBy[#, First] & @ IntegerPartitions[10, 6]

(* Output: {{{2, 2, 2, 2, 2}, {2, 2, 2, 2, 1, 1}}, {{3, 3, 3, 1}, {3, 3, 2,
2}, {3, 3, 2, 1, 1}, {3, 3, 1, 1, 1, 1}, {3, 2, 2, 2, 1}, {3, 2, 2,
1, 1, 1}}, {{4, 4, 2}, {4, 4, 1, 1}, {4, 3, 3}, {4, 3, 2, 1}, {4,
3, 1, 1, 1}, {4, 2, 2, 2}, {4, 2, 2, 1, 1}, {4, 2, 1, 1, 1,
1}}, {{5, 5}, {5, 4, 1}, {5, 3, 2}, {5, 3, 1, 1}, {5, 2, 2, 1}, {5,
2, 1, 1, 1}, {5, 1, 1, 1, 1, 1}}, {{6, 4}, {6, 3, 1}, {6, 2,
2}, {6, 2, 1, 1}, {6, 1, 1, 1, 1}}, {{7, 3}, {7, 2, 1}, {7, 1, 1,
1}}, {{8, 2}, {8, 1, 1}}, {{9, 1}}, {{10}}} *)

This works well up to at least n = 100. For n = 150 I have to wait a few seconds - unless I want to have the output displayed, which takes most of the time. I got bored waiting for n = 200 to display (there are $4,775,383$ partitions), but just calculating it takes only a moment. For higher n it may not be too efficient.

• Use the second argument for IntegerPartitions: IntegerPartitions[10, 6] instead of Select[IntegerPartitions[10], Length @ # < 7 &]. (It's much faster: It does the $n=100$ case in less than a second.) – march Jan 6 '17 at 18:34
• @march Thanks; I usually throw the first version of a working code and then improve the details once it's published. – corey979 Jan 6 '17 at 18:38
• Yes, this is a lot faster. For n=100 there are more than 190 million partitions so limiting the partition to 6 parts saves a lot of time. – Gerald Jan 6 '17 at 18:40