2
$\begingroup$

I am interested in the following problem.

I want to decorate the faces of $n$ six-sided dice with integers, such that (as closely as possible, for some reasonable definition of "close") they satisfy various constraints on their joint distributions. All else being equal, I would prefer these integers being small.

e.g. I would like three dice $A,B,C$ such that

$$\mathbf{P}(A>0) =1/2,$$ $$ \ \mathbf{P}(A+B>0) = 2/3,$$ $$ \mathbf{P}(A+B+C>0)=5/6,$$ $$\mathbf{P}(A=0) =0,$$

or as close as possible to that.

How might one code this in Mathematica?


Edit: I am asking for a general method that works for any $n$ and reasonable set of restrictions on the joint distribution, and suggest that the answerer apply the general method in the simple example I gave, where it is easy to compute an answer directly by hand.

$\endgroup$
3
  • $\begingroup$ One solution to your example is $(-1,-1,-1,1,1,1)$, $(-2,-2,2,2,2,2)$, $(-4,4,4,4,4,4)$. But I do not have Mathematica code that generates this. $\endgroup$
    – user293787
    Commented Dec 9, 2022 at 19:11
  • $\begingroup$ For a small number of dice, faces, values on the faces you can use Tuples or nested For and generate some or all the possible dice and then write a function that takes one set of the dice and tests whether that set is acceptable or not. If you use Tuples then you can use Select to extract the acceptable sets. Does this give you an idea how you might start? Start with a really easy example to test this first and then work closer to your actual problem. $\endgroup$
    – Bill
    Commented Dec 9, 2022 at 19:45
  • 1
    $\begingroup$ Not sure what you're expecting when you ask "how might one code this?". But, if you're wanting to experiment, a useful function might be EmpiricalDistribution. For example, DistributionA=EmpiricalDistribution[{-1,-1,-1,1,1,1}]. You can do the same for the B and C dice. Then you can use TransformedDistribution: DistributionAPlusB=TransformedDistribution[a+b,{a\[Distributed]DistributionA,b\[Distributed]DistributionB}]. You can test probabilities like this: Probability[x > 0, x \[Distributed] DistributionAPlusB] $\endgroup$
    – lericr
    Commented Dec 9, 2022 at 19:57

2 Answers 2

1
$\begingroup$

Code:

(* General *)
alldice[{nfaces_,min_,max_}]:=Select[Tuples[Range[min,max],nfaces],OrderedQ];
findBruteForce[admissibleDice_,ndice_,diceinfo:{nfaces_,min_,max_}]:=Catch[
   Outer[If[admissibleDice[##],Throw[{##}]]&,
         Sequence@@ConstantArray[alldice[diceinfo],ndice],1];{}];

(* Example *)
Pevent1[dice1_,dice2_,dice3_]:=1/Length[dice1]*Count[dice1,0];
Pevent2[dice1_,dice2_,dice3_]:=1/Length[dice1]*Count[dice1,_?Positive];
Pevent3[dice1_,dice2_,dice3_]:=1/Length[dice1]*1/Length[dice2]*Count[Outer[Plus,dice1,dice2],_?Positive,{2}];
Pevent4[dice1_,dice2_,dice3_]:=1/Length[dice1]*1/Length[dice2]*1/Length[dice3]*Count[Outer[Plus,dice1,dice2,dice3],_?Positive,{3}];

admissibleDiceExample[tol_]:=And[
  Abs[Pevent1[##]-0]<tol,
  Abs[Pevent2[##]-1/2]<tol,
  Abs[Pevent3[##]-2/3]<tol,
  Abs[Pevent4[##]-5/6]<tol]&;

Search among all dice with 6 faces and numbers from $-1$ to $2$, runs in less than a second:

dice123 = findBruteForce[admissibleDiceExample[0.01],3,{6,-1,2}]
(* {{-1,-1,-1,1,1,1},{-1,-1,2,2,2,2},{1,1,1,1,1,1}} *)

I used a small tolerance, but this happens to be an exact solution:

Pevent1@@dice123
(* 0 *)

Pevent2@@dice123
(* 1/2 *)

Pevent3@@dice123
(* 2/3 *)

Pevent4@@dice123
(* 5/6 *)

The Pevent functions look a little complicated. But they use Outer[Plus,...] which may be faster than some other approaches.

$\endgroup$
0
$\begingroup$

With the answer from user29378 you may get a solution that is close enough to what you want:

d1 = {-1, -1, -1, 1, 1, 1};
d2 = {-2, -2, 2, 2, 2, 2};
d3 = {-4, 4, 4, 4, 4, 4};
dis1 = EmpiricalDistribution[d1];
dis2 = EmpiricalDistribution[d2];
dis3 = EmpiricalDistribution[d3];

To test this we may use RandomVariate to generate samples from the distribution, count how many are o.k. and calculate the probability:

n = 10^6;
Count[RandomVariate[dis1, n], x_ /; x > 0]/n // N
Count[RandomVariate[dis1, n] + RandomVariate[dis2, n], x_ /; x > 0]/n // N
Count[RandomVariate[dis1, n] + RandomVariate[dis2, n] +  RandomVariate[dis3, n], x_ /; x > 0]/n // N

enter image description here

$\endgroup$
2
  • $\begingroup$ This doesn't really answer my question - to be clear, for each small example I am perfectly able to come up with custom dice by hand, and compute the probabilities. I was asking for a general method, and suggesting that the answerer apply the general method in the simple example I gave, where it is easy to compute an answer directly by hand. $\endgroup$
    – Pulcinella
    Commented Dec 10, 2022 at 11:10
  • $\begingroup$ And what probabilities should a general method have? $\endgroup$ Commented Dec 10, 2022 at 12:08

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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