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.

Improve this question
$\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
    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
    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
    Dec 9, 2022 at 19:57

2 Answers 2

Reset to default
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.

Improve this answer
$\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

Improve this answer
$\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
    Dec 10, 2022 at 11:10
  • $\begingroup$ And what probabilities should a general method have? $\endgroup$
    – Daniel Huber
    Dec 10, 2022 at 12:08

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.