Efron's Dice

Author

Eric W. Weisstein
January 24, 2009

This notebook downloaded from http://mathworld.wolfram.com/notebooks/GraphTheory/EfronsDice.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/EfronsDice.html.

©2009 Wolfram Research, Inc. except for portions noted otherwise

2:1

die 1

DiceA={{0,0,4,4,4,4},{3,3,3,3,3,3},{2,2,2,2,6,6},{1,1,1,5,5,5}};

Less@@@Partition[#,2,1]&/@Transpose[RandomChoice[#,10]&/@DiceA]

With[{n=10^6},Total[Map[Boole,Transpose[Less@@@Partition[#,2,1]&/@Transpose[RandomChoice[#,n]&/@DiceA]],{1}],{2}]/n]//N//Timing

die 2

DiceB={{2,3,3,9,10,11},{0,1,7,8,8,8},{5,5,6,6,6,6,6},{4,4,4,4,12,12}};

With[{n=10^6},Total[Map[Boole,Transpose[Less@@@Partition[#,2,1]&/@Transpose[RandomChoice[#,n]&/@DiceB]],{1}],{2}]/n]//N//Timing

11:6

DiceC={{1,2,3,9,10,11},{0,1,7,8,8,9},{5,5,6,6,7,7},{3,4,4,5,11,12}};

Roll[a_,b_]:=Module[{x=0,y=0},
While[x==y,x=RandomChoice[a];y=RandomChoice[b]];
Boole[x<y]
]

With[{n=10^6},Total[Table[Roll@@Take[DiceC,2],{n}]]/n]//N//Timing

With[{n=10^6},Total[Table[Roll@@Take[DiceC,{2,3}],{n}]]/n]//N//Timing

With[{n=10^6},Total[Table[Roll@@Take[DiceC,-2],{n}]]/n]//N//Timing

(6/(11+6))//N