Re: Dice problem
- To: mathgroup at smc.vnet.net
- Subject: [mg81364] Re: Dice problem
- From: Mark Fisher <particlefilter at gmail.com>
- Date: Thu, 20 Sep 2007 03:56:47 -0400 (EDT)
- References: <fcnm1e$shs$1@smc.vnet.net>
On Sep 18, 1:00 am, "AngleWyrm" <anglew... 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?
Is this what you're looking for?
tally = Tally[Total /@ Flatten[Outer[List, #, #, #] &[Range[6]], 2]];
probs = #/{1, Total[tally[[All, 2]]]} & /@ tally;
mean = #[[All, 1]].#[[All, 2]] &[probs] // N;
variance = (#[[All, 1]] - 21/2)^2.#[[All, 2]] &[probs] // N;
ifun = Interpolation[probs];
intval = NIntegrate[ifun[x], {x, 2.5, 18.5}];
Check the mean:
NIntegrate[(ifun[x]/intval) x, {x, 2.5, 18.5}] == mean
Check the variance:
NIntegrate[(ifun[x]/intval) (x - 10.5)^2, {x, 2.5, 18.5}] - variance
Look at the pdf:
Plot[ifun[x]/intval, {x, 2.5, 18.5}] // Quiet
Compare the densities with the probabilities;
(ifun /@ Range[3, 18]) == probs[[All, 2]]
Compare the probabilities with the probabilities
(NIntegrate[ifun[x], {x, # - .5, # + .5}] & /@ Range[3, 18])/
probs[[All, 2]] // Log
This produces a continuous pdf (ifun) over the range 2.5 to 18.5 for
which the density ifun[i] equals the probability of i and the
probability NIntegerate[ifun[x],{x,i-.5,i+.5}] is pretty close the
probability of i. The mean of ifun matches exactly and the variance is
slightly too small.
--Mark