MathGroup Archive 2007

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Dice problem

  • To: mathgroup at smc.vnet.net
  • Subject: [mg81325] Re: [mg81281] Dice problem
  • From: DrMajorBob <drmajorbob at bigfoot.com>
  • Date: Wed, 19 Sep 2007 05:30:56 -0400 (EDT)
  • References: <2282005.1190137695564.JavaMail.root@m35>
  • Reply-to: drmajorbob at bigfoot.com

Here's another way to get the probability table:

numSides = 6; numDice = 3;
ptab = Tally[
     Plus @@@ Tuples[Range@numSides, numDice]] /. {s_Integer,
      c_Integer} :> {s, c, N[c/numSides^numDice]};
TableForm[ptab]
ListPlot[Last /@ ptab]

and here's the distribution:

Clear[cdf]
cdf[x_] = Plus @@ (ptab /. {s_, _, p_} :> p HeavisideTheta[x - s]);
Plot[cdf[x], {x, 0, 18}]

> I want a continuous distribution
> that produces the same probabilities at these sixteen points (3..18).

That's a contradiction in terms. If the probabilities at a finite number 
of points add up to one, it's a discrete distribution. If the probability  
of ANY point isn't zero, it's not a continuous distribution.

One way to proceed might be to smooth the cdf by convolving it with a  
Gaussian kernel:

Clear[smooth]
smooth[t_] =
  Integrate[
   cdf[x] PDF[NormalDistribution[0, 1/10], x - t], {x, 0, 19}]

-0.5 Erf[5 Sqrt[2] (-19 + t)] + 0.00231481 Erf[5 Sqrt[2] (-18 + t)] +
  0.00694444 Erf[5 Sqrt[2] (-17 + t)] +
  0.0138889 Erf[5 Sqrt[2] (-16 + t)] +
  0.0231481 Erf[5 Sqrt[2] (-15 + t)] +
  0.0347222 Erf[5 Sqrt[2] (-14 + t)] +
  0.0486111 Erf[5 Sqrt[2] (-13 + t)] +
  0.0578704 Erf[5 Sqrt[2] (-12 + t)] +
  0.0625 Erf[5 Sqrt[2] (-11 + t)] + 0.0625 Erf[5 Sqrt[2] (-10 + t)] +
  0.0578704 Erf[5 Sqrt[2] (-9 + t)] +
  0.0486111 Erf[5 Sqrt[2] (-8 + t)] +
  0.0347222 Erf[5 Sqrt[2] (-7 + t)] +
  0.0231481 Erf[5 Sqrt[2] (-6 + t)] +
  0.0138889 Erf[5 Sqrt[2] (-5 + t)] +
  0.00694444 Erf[5 Sqrt[2] (-4 + t)] +
  0.00231481 Erf[5 Sqrt[2] (-3 + t)]

Here's a plot of the difference:

Plot[cdf[t] - smooth[t], {t, 0, 18.5}, PlotRange -> All]

You can't make the error less than half the largest point probability, in  
this case 1/2 of 1/8 is 1/16.

The smoothed pdf is smooth'[t].

NIntegrate[smooth'[t], {t, 0, 18.5}]

1.

Bobby

On Mon, 17 Sep 2007 23:44:32 -0500, AngleWyrm <anglewyrm at yahoo.com> wrote:

> With a set of three six-sided dice, display the chance-weights and
> probabilities of each outcome:
>
> numSides=6; numDice=3;
> poly = Sum[x^i, {i, numSides}]^numDice // Expand;
> c = CoefficientList[poly, x];
> Table[{x, c[[x + 1]], c[[x + 1]]/Total[c] // N}, {x, numDice,
> numDice numSides}] // TableForm
>
> So far, so good. Next, I want to model this discrete distribution with a
> continuous distribution. That is to say, I want a continuous distribution
> that produces the same probabilities at these sixteen points (3..18). My
> first attempt was to take the Mean and StandardDeviation of my  
> coefficients
> list, and attempt to generate a gaussian distribution on it like so:
>
> test = RandomReal[ NormalDistribution[Mean[c], StandardDeviation[c]],  
> 1000];
> ListPlot[test]
> {Min[test], Max[test]} // N
>
> But the result produces a much larger range of outcomes, approximately 
> {-25,
> 45}. Any set generated on this larger range will have smaller  
> probabilities
> for the target range of 3..18.
>
> Is there some method or model to reduce the error between the  
> mathematical
> model and the dataset?
>
>
>
>



-- 

DrMajorBob at bigfoot.com


  • Prev by Date: Re: SWF runs to fast
  • Next by Date: Re: coupled map lattice problem
  • Previous by thread: Dice problem
  • Next by thread: Re: Dice problem