Finding the number of $4$-tuples of consisting of digits $1$-$6$ satisfying a certain condition

I'm trying to enumerate a sample space for an experiment in which $4$ fair $6$-sided dice are rolled such that exactly $3$ of them are $5$s or $6$s. The way I understand it, the last die must be any number other than $5$ or $6$.

The original problem was to find the probability of this occurring, which I think would be $\dfrac2{81}$, but I'd like to verify this.

I think this can be done easily with the help of Tuples and Counts, but I'm not sure how to implement Cases to pare down the results to only get the outcomes I'm interested in.

In:= tuples = Tuples[{1, 2, 3, 4, 5, 6}, 4];

In:= Counts /@ tuples

Out= {<|1 -> 4|>, ..., <|6 -> 4|>}

The next step would be to somehow get Cases to pick out only those tuples for which the counts of 5 and 6 add up to $3$, then find that result's Length.

If my conjecture is right, that result would be 32, so that 32/Length[tuples] returns 2/81.

Workaround: An alternative approach that occurred to me was to consider $3$-tuples instead for which Counts would return either of <|5 -> 3|>, <|5 -> 2, 6 -> 1|>, <|5 -> 1, 6 -> 2|>, or <|6 -> 3|>. To recap:

In:= tuples3 = Tuples[{1, 2, 3, 4, 5, 6}, 3];

In:= counts3 = Counts /@ tuples3;

I had thought to use the pattern

In:= patt = Alternatives[<|5 -> _|>, <|5 -> _, 6 -> _|>, <|6 -> _, 5 -> _|>, <|6 -> _|>];

In:= Length[Cases[counts3, patt]]

Out= 8

and this, if I'm not mistaken, is the expected result. Multiplying by $4$ accounts for the possible faces of the fourth die, giving $32$ out of a total of

In:= Length[Tuples[{1, 2, 3, 4, 5, 6}, 4]]

Out= 1296

possible, and so the probability indeed appears to be $\dfrac{32}{1296}=\dfrac2{81}$.

To summarize, my question(s) would be

• How can I use Cases in a similar way on tuples to account for the requirement that the fourth die cannot have a value of 4 or 5?

• Is there a simpler way to do this?

• "the last die must be any number other than 5 or 6" - Cases[tuples, {Repeated[5, {3}] | Repeated[6, {3}], Except[5 | 6]}]? – J. M. will be back soon May 23 '17 at 17:24
• It seems there is a slight ambiguity in my question; by "exactly three are $5$s or $6$s", I mean that exactly three of the dice show either $5$ or $6$. So {5, 5, 6, 1} is allowed, but not {5, 5, 6, 6}, for example. Can your (@J.M.) suggestion be modified to account for this? (Also is there a better way to phrase the requirement?) – user170231 May 23 '17 at 17:42
• Cases[tuples, {Repeated[5 | 6, {3}], Except[5 | 6]}], then? – J. M. will be back soon May 23 '17 at 17:43
• Does it have to be the last of the four that is the non-5/6? – Daniel Lichtblau May 23 '17 at 21:25
• Echoing @Daniel, I'm trying to enumerate a sample space for an experiment in which 4 fair 6-sided dice are rolled such that exactly 3 of them are 5s or 6s. The way I understand it, the last die must be any number other than 5 or 6. The way I understand it, one of the dice must be any number other than 5 or 6. – LLlAMnYP May 24 '17 at 7:56

If the question is: what is the probability of having exactly 3: 5/6 results with 4 throws of die:

p = BinomialDistribution[4, 1/3]
Probability[x == 3, x \[Distributed] p]

yields: 8/81

If the question is the probability of getting (5/6)(5/6)(5/6)(1234), regarding throwing 1,2,3 or 4 as success you can useGeometricDistribution:

g = GeometricDistribution[2/3]
Probability[x == 3, x \[Distributed] g]

yields: 2/81

(as expected 1/4 of the preceding result given there are 4 ways to get exactly 3: 5/6 and one non 5/6)

Or simulation (as per @ciao):

Length[Tuples[{{5, 6}, {5, 6}, {5, 6}, Range}]]/6^4

yields 2/81

Also:

tuples = Tuples[{1, 2, 3, 4, 5, 6}, 4];
constrainedtuples = Tuples[{{5, 6}, {5, 6}, {5, 6}, Range}];
Length[constrainedtuples]

32

Length[constrainedtuples]/Length[tuples]

2/81

• FML - typed the "Why generate then filter, just generate" answer, then saw yours... +1 – ciao May 24 '17 at 6:32
• +1 for such a concise solution !! – Ali Hashmi May 25 '17 at 10:29

Here is a brute-force method. Starting from the sample space:

tuples = Tuples[{1, 2, 3, 4, 5, 6}, 4];

To enumerate the dice quadruples:

Cases[tuples, {Repeated[5 | 6, {3}], Except[5 | 6]}]
{{5, 5, 5, 1}, {5, 5, 5, 2}, {5, 5, 5, 3}, {5, 5, 5, 4}, {5, 5, 6, 1}, {5, 5, 6, 2},
{5, 5, 6, 3}, {5, 5, 6, 4}, {5, 6, 5, 1}, {5, 6, 5, 2}, {5, 6, 5, 3}, {5, 6, 5, 4},
{5, 6, 6, 1}, {5, 6, 6, 2}, {5, 6, 6, 3}, {5, 6, 6, 4}, {6, 5, 5, 1}, {6, 5, 5, 2},
{6, 5, 5, 3}, {6, 5, 5, 4}, {6, 5, 6, 1}, {6, 5, 6, 2}, {6, 5, 6, 3}, {6, 5, 6, 4},
{6, 6, 5, 1}, {6, 6, 5, 2}, {6, 6, 5, 3}, {6, 6, 5, 4}, {6, 6, 6, 1}, {6, 6, 6, 2},
{6, 6, 6, 3}, {6, 6, 6, 4}}

where the pattern {Repeated[5 | 6, {3}], Except[5 | 6]} imposes the restriction of the first three dice being either 5 or 6. and the last die not being 5 or 6.

To get the probability:

Count[tuples, {Repeated[5 | 6, {3}], Except[5 | 6]}]/Length[tuples]
2/81
• really nice pattern for Count :) – ubpdqn May 24 '17 at 8:27

probability is 8/81:

eventOccurs[L : {a_, b_, c_, d_}] := Count[L, 5] + Count[L, 6];
Tuples[{1, 2, 3, 4, 5, 6}, 4];
Count[Map[eventOccurs, %], 3]
probability = %/Length[%%]
• I have two methods that agree 2/81 is the correct probability. Could you add an explanation for your approach? – user170231 May 23 '17 at 18:26
• I read too quickly; eventOccurs should be changed to prevent the last die from beiing 5 or 6: – James Stein May 23 '17 at 18:31
• Right. It looks like this counts e.g. {5, 5, 5, 1}, {5, 5, 1, 5}, {5, 1, 5, 5}, and {1, 5, 5, 5} as individual outcomes when they should be considered the same. – user170231 May 23 '17 at 18:34
• It is not obvious from the problem description why these should be regarded as the same. I could understand a scenario wherein they are different but the last three are disallowed outcomes. – Daniel Lichtblau May 23 '17 at 21:28

Probability is 2/81; I read too quickly! revised code changes the test:

eventOccurs[L : {a_, b_, c_, d_}] :=
d < 5 && (Count[L, 5] + Count[L, 6]) == 3;
Tuples[{1, 2, 3, 4, 5, 6}, 4];
Count[Map[eventOccurs, %], True];
probability = %/Length[%%]
list = (Permutations[Flatten@ConstantArray[Range@6, 4], {4}]);
Length@Select[list, And@@Thread[#[[1 ;; 3]] >= 5] && #[] < 5 & ]/Length@list
(* 2/81 *)