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