4
$\begingroup$

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?

$\endgroup$
4
  • 1
    $\begingroup$ Have you seen IntegerPartitions? E.g. GatherBy[#, First] &@Select[IntegerPartitions[10], Length@# < 7 &]. $\endgroup$ – corey979 Jan 6 '17 at 18:13
  • $\begingroup$ That works perfectly. Thanks. I was not aware of GatherBy[] nor IntegerPartitions[]. $\endgroup$ – Gerald Jan 6 '17 at 18:22
  • $\begingroup$ 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... $\endgroup$ – ciao Jan 8 '17 at 23:18
  • $\begingroup$ I'm creating a probability distribution of the sizes of the maximum matchings, i.e., the result of any play of Tenzi. $\endgroup$ – Gerald Jan 10 '17 at 2:46
5
$\begingroup$

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.

$\endgroup$
3
  • 3
    $\begingroup$ 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.) $\endgroup$ – march Jan 6 '17 at 18:34
  • $\begingroup$ @march Thanks; I usually throw the first version of a working code and then improve the details once it's published. $\endgroup$ – corey979 Jan 6 '17 at 18:38
  • $\begingroup$ 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. $\endgroup$ – Gerald Jan 6 '17 at 18:40

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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