private static double gamma_rand(double shape, double scale)
{
// On a et scale sont fini, a>=0 et scale>0
//if (!R_FINITE(a) || !R_FINITE(scale) || a < 0.0 || scale <= 0.0)
//{
// if (scale == 0.0) return 0.0;
// return double.NaN; //ML_ERR_return_NAN;
//}
/* State variables [FIXME for threading!] :*/
double aa = 0.0;
double aaa = 0.0;
double s = 0, s2 = 0, d = 0; /* no. 1 (step 1) */
double q0 = 0, b = 0, si = 0, c = 0; /* no. 2 (step 4) */
double e, p, q, r, t, u, v, w, x, ret_val;
if (shape < 1.0)
{ /* GS algorithm for parameters a < 1 */
if (shape == 0.0)
{
return(0.0);
}
e = 1.0 + exp_m1 * shape;
for (;;)
{
p = e * UniformDistribution.RUnif();
if (p >= 1.0)
{
x = -Math.Log((e - p) / shape);
if (ExponentialDistribution.RExp() >= (1.0 - shape) * Math.Log(x))
{
break;
}
}
else
{
x = Math.Exp(Math.Log(p) / shape);
if (ExponentialDistribution.RExp() >= x)
{
break;
}
}
}
return(scale * x);
}
/* --- a >= 1 : GD algorithm --- */
/* Step 1: Recalculations of s2, s, d if a has changed */
if (shape != aa)
{
aa = shape;
s2 = shape - 0.5;
s = Math.Sqrt(s2);
d = sqrt32 - s * 12.0;
}
/* Step 2: t = standard normal deviate,
* x = (s,1/2) -normal deviate. */
/* immediate acceptance (i) */
t = NormalDistribution.RNorm();
x = s + 0.5 * t;
ret_val = x * x;
if (t >= 0.0)
{
return(scale * ret_val);
}
/* Step 3: u = 0,1 - uniform sample. squeeze acceptance (s) */
u = UniformDistribution.RUnif();
if (d * u <= t * t * t)
{
return(scale * ret_val);
}
/* Step 4: recalculations of q0, b, si, c if necessary */
if (shape != aaa)
{
aaa = shape;
r = 1.0 / shape;
q0 = ((((((q7 * r + q6) * r + q5) * r + q4) * r + q3) * r
+ q2) * r + q1) * r;
/* Approximation depending on size of parameter a */
/* The constants in the expressions for b, si and c */
/* were established by numerical experiments */
if (shape <= 3.686)
{
b = 0.463 + s + 0.178 * s2;
si = 1.235;
c = 0.195 / s - 0.079 + 0.16 * s;
}
else if (shape <= 13.022)
{
b = 1.654 + 0.0076 * s2;
si = 1.68 / s + 0.275;
c = 0.062 / s + 0.024;
}
else
{
b = 1.77;
si = 0.75;
c = 0.1515 / s;
}
}
/* Step 5: no quotient test if x not positive */
if (x > 0.0)
{
/* Step 6: calculation of v and quotient q */
v = t / (s + s);
if (Math.Abs(v) <= 0.25)
{
q = q0 + 0.5 * t * t * ((((((a7 * v + a6) * v + a5) * v + a4) * v
+ a3) * v + a2) * v + a1) * v;
}
else
{
q = q0 - s * t + 0.25 * t * t + (s2 + s2) * Math.Log(1.0 + v);
}
/* Step 7: quotient acceptance (q) */
if (Math.Log(1.0 - u) <= q)
{
return(scale * ret_val);
}
}
while (true)
{
/* Step 8: e = standard exponential deviate
* u = 0,1 -uniform deviate
* t = (b,si)-double exponential (laplace) sample */
e = ExponentialDistribution.RExp();
u = UniformDistribution.RUnif();
u = u + u - 1.0;
if (u < 0.0)
{
t = b - si * e;
}
else
{
t = b + si * e;
}
/* Step 9: rejection if t < tau(1) = -0.71874483771719 */
if (t >= -0.71874483771719)
{
/* Step 10: calculation of v and quotient q */
v = t / (s + s);
if (Math.Abs(v) <= 0.25)
{
q = q0 + 0.5 * t * t *
((((((a7 * v + a6) * v + a5) * v + a4) * v + a3) * v
+ a2) * v + a1) * v;
}
else
{
q = q0 - s * t + 0.25 * t * t + (s2 + s2) * Math.Log(1.0 + v);
}
/* Step 11: hat acceptance (h) */
/* (if q not positive go to step 8) */
if (q > 0.0)
{
w = expm1(q);
/* ^^^^^ original code had approximation with rel.err < 2e-7 */
/* if t is rejected sample again at step 8 */
if (c * Math.Abs(u) <= w * Math.Exp(e - 0.5 * t * t))
{
break;
}
}
}
} /* repeat .. until `t' is accepted */
x = s + 0.5 * t;
return(scale * x * x);
}
internal static double poisson_rand(double mu)
{
glblCount++;
/* Local Vars [initialize some for -Wall]: */
//double del;
difmuk = 0.0; E = 0.0; fk = 0.0;
//double fx, fy, g, px, py, t;
u = 0.0;
//double v, x;
pois = -1.0;
//int k, kflag;
//bool big_mu;
bool directToStepF = false;
new_big_mu = false;
big_mu = mu >= 10.0;
if (big_mu)
{
new_big_mu = false;
}
if (!(big_mu && mu == muprev))
{/* maybe compute new persistent par.s */
if (big_mu)
{
new_big_mu = true;
/* Case A. (recalculation of s,d,l because mu has changed):
* The poisson probabilities pk exceed the discrete normal
* probabilities fk whenever k >= m(mu).
*/
muprev = mu;
s = Math.Sqrt(mu);
d = 6.0 * mu * mu;
big_l = Math.Floor(mu - 1.1484);
/* = an upper bound to m(mu) for all mu >= 10.*/
}
else
{ /* Small mu ( < 10) -- not using normal approx. */
/* Case B. (start new table and calculate p0 if necessary) */
/*muprev = 0.;-* such that next time, mu != muprev ..*/
if (mu != muprev)
{
muprev = mu;
m = Math.Max(1, (int)mu);
l = 0; /* pp[] is already ok up to pp[l] */
q = p0 = p = Math.Exp(-mu);
}
for (;;)
{
/* Step U. uniform sample for inversion method */
u = UniformDistribution.RUnif();
if (u <= p0)
{
return(0.0);
}
/* Step T. table comparison until the end pp[l] of the
* pp-table of cumulative poisson probabilities
* (0.458 > ~= pp[9](= 0.45792971447) for mu=10 ) */
if (l != 0)
{
for (k = (u <= 0.458) ? 1 : Math.Min(l, m); k <= l; k++)
{
if (u <= pp[k])
{
return((double)k);
}
}
if (l == 35) /* u > pp[35] */
{
continue;
}
}
/* Step C. creation of new poisson
* probabilities p[l..] and their cumulatives q =: pp[k] */
l++;
for (k = l; k <= 35; k++)
{
p *= mu / k;
q += p;
pp[k] = q;
if (u <= q)
{
l = k;
return((double)k);
}
}
l = 35;
} /* end(repeat) */
} /* mu < 10 */
} /* end {initialize persistent vars} */
/* Only if mu >= 10 : ----------------------- */
/* Step N. normal sample */
g = mu + s * NormalDistribution.RNorm();/* norm_rand() ~ N(0,1), standard normal */
if (g >= 0.0)
{
pois = Math.Floor(g);
/* Step I. immediate acceptance if pois is large enough */
if (pois >= big_l)
{
return(pois);
}
/* Step S. squeeze acceptance */
fk = pois;
difmuk = mu - fk;
u = UniformDistribution.RUnif(); /* ~ U(0,1) - sample */
if (d * u >= difmuk * difmuk * difmuk)
{
return(pois);
}
}
/* Step P. preparations for steps Q and H.
* (recalculations of parameters if necessary) */
if (new_big_mu || mu != muprev2)
{
/* Careful! muprev2 is not always == muprev
* because one might have exited in step I or S
*/
muprev2 = mu;
omega = RVaria.M_1_SQRT_2PI / s;
/* The quantities b1, b2, c3, c2, c1, c0 are for the Hermite
* approximations to the discrete normal probabilities fk. */
b1 = one_24 / mu;
b2 = 0.3 * b1 * b1;
c3 = one_7 * b1 * b2;
c2 = b2 - 15.0 * c3;
c1 = b1 - 6.0 * b2 + 45.0 * c3;
c0 = 1.0 - b1 + 3.0 * b2 - 15.0 * c3;
c = 0.1069 / mu; /* guarantees majorization by the 'hat'-function. */
}
if (g >= 0.0)
{
/* 'Subroutine' F is called (kflag=0 for correct return) */
kflag = 0;
//goto Step_F;
//F(mu);
directToStepF = true;
countDirectToStepF++;
}
for (;;)
{
if (!directToStepF)
{
/* Step E. Exponential Sample */
E = ExponentialDistribution.RExp(); /* ~ Exp(1) (standard exponential) */
/* sample t from the laplace 'hat'
* (if t <= -0.6744 then pk < fk for all mu >= 10.) */
u = 2 * UniformDistribution.RUnif() - 1.0;
t = 1.8 + RVaria.fsign(E, u);
}
if ((t > -0.6744) || directToStepF)
{
if (!directToStepF)
{
pois = Math.Floor(mu + s * t);
fk = pois;
difmuk = mu - fk;
kflag = 1;
}
/* 'subroutine' F is called (kflag=1 for correct return) */
F(mu);
directToStepF = false;
//Step_F: /* 'subroutine' F : calculation of px,py,fx,fy. */
// if (pois < 10)
// { /* use factorials from table fact[] */
// px = -mu;
// py = Math.Pow(mu, pois) / fact[(int)pois];
// }
// else
// {
// /* Case pois >= 10 uses polynomial approximation
// a0-a7 for accuracy when advisable */
// del = one_12 / fk;
// del = del * (1.0 - 4.8 * del * del);
// v = difmuk / fk;
// if (Math.Abs(v) <= 0.25)
// px = fk * v * v * (((((((a7 * v + a6) * v + a5) * v + a4) *
// v + a3) * v + a2) * v + a1) * v + a0)
// - del;
// else /* |v| > 1/4 */
// px = fk * Math.Log(1.0 + v) - difmuk - del;
// py = R.M_1_SQRT_2PI / Math.Sqrt(fk);
// }
// x = (0.5 - difmuk) / s;
// x *= x;/* x^2 */
// fx = -0.5 * x;
// fy = omega * (((c3 * x + c2) * x + c1) * x + c0);
if (kflag > 0)
{
/* Step H. Hat acceptance (E is repeated on rejection) */
if (c * Math.Abs(u) <= py * Math.Exp(px + E) - fy * Math.Exp(fx + E))
{
break;
}
}
else
/* Step Q. Quotient acceptance (rare case) */
if (fy - u * fy <= py * Math.Exp(px - fx))
{
break;
}
}/* t > -.67.. */
}
return(pois);
}
