Beispiel #1
0
        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);
        }
Beispiel #2
0
        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);
        }