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