Example #1
0
        /* R file: pgamma.c
         *
         * Asymptotic expansion to calculate the probability that Poisson variate * has value <= x.
         * Various assertions about this are made (without proof) at http://members.aol.com/iandjmsmith/PoissonApprox.htm
         */
        private static double ppois_asymp(double x, double lambda, bool lower_tail, bool log_p)
        {
            double elfb, elfb_term;
            double res12, res1_term, res1_ig, res2_term, res2_ig;
            double dfm, pt_, s2pt, f, np;
            int    i;

            dfm = lambda - x;

            /* If lambda is large, the distribution is highly concentrated
             * about lambda.  So representation error in x or lambda can lead
             * to arbitrarily large values of pt_ and hence divergence of the
             * coefficients of this approximation.
             */
            pt_  = -log1pmx(dfm / x);
            s2pt = Math.Sqrt(2 * x * pt_);
            if (dfm < 0)
            {
                s2pt = -s2pt;
            }

            res12   = 0;
            res1_ig = res1_term = Math.Sqrt(x);
            res2_ig = res2_term = s2pt;
            for (i = 1; i < 8; i++)
            {
                res12     += res1_ig * coefs_a4ppois_asymp[i];
                res12     += res2_ig * coefs_b4ppois_asymp[i];
                res1_term *= pt_ / i;
                res2_term *= 2 * pt_ / (2 * i + 1);
                res1_ig    = res1_ig / x + res1_term;
                res2_ig    = res2_ig / x + res2_term;
            }

            elfb      = x;
            elfb_term = 1;
            for (i = 1; i < 8; i++)
            {
                elfb      += elfb_term * coefs_b4ppois_asymp[i];
                elfb_term /= x;
            }
            if (!lower_tail)
            {
                elfb = -elfb;
            }

            f = res12 / elfb;

            np = NormalDistribution.PNorm(s2pt, 0.0, 1.0, !lower_tail, log_p);

            if (log_p)
            {
                double n_d_over_p = dpnorm(s2pt, !lower_tail, np);

                return(np + log1p(f * n_d_over_p));
            }
            else
            {
                double nd = NormalDistribution.DNorm(s2pt, 0.0, 1.0, log_p);

                return(np + f * nd);
            }
        } /* ppois_asymp() */
Example #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);
        }
Example #3
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);
        }
Example #4
0
        private static double qchisq_appr(
            double p,
            double nu,
            double g /* = log Gamma(nu/2) */,
            bool lower_tail,
            bool log_p,
            double tol /* EPS1 */)
        {
            double alpha, a, c, ch, p1;
            double p2, q, t, x;

            /* test arguments and initialise */

            if (double.IsNaN(p) || double.IsNaN(nu))
            {
                return(p + nu);
            }

            if ((log_p && (p > 0)) ||
                (!log_p && (p < 0 || p > 1)))
            {
                return(double.NaN); //ML_ERR_return_NAN
            }
            //R_Q_P01_check(p);

            if (nu <= 0)
            {
                return(double.NaN); //ML_ERR_return_NAN;
            }
            alpha = 0.5 * nu;       /* = [pq]gamma() shape */
            c     = alpha - 1;
            //p1 = (lower_tail ? (log_p ? (p) : Math.Log(p)) : ((p) > -M_LN2 ? Math.Log(-expm1(p)) : log1p(-Math.Exp(p))));
            p1 = (lower_tail ? (log_p ? (p) : Math.Log(p)) : (log_p ? ((p) > -M_LN2 ? Math.Log(-expm1(p)) : log1p(-Math.Exp(p))) : log1p(-p)));
            if (nu < (-1.24 * p1))
            {   /* for small chi-squared */
                /* Math.Log(alpha) + g = Math.Log(alpha) + Math.Log(gamma(alpha)) =
                 *        = Math.Log(alpha*gamma(alpha)) = lgamma(alpha+1) suffers from
                 *  catastrophic cancellation when alpha << 1
                 */
                double lgam1pa = (alpha < 0.5) ? GammaDistribution.lgamma1p(alpha) : (Math.Log(alpha) + g);
                ch = Math.Exp((lgam1pa + p1) / alpha + M_LN2);
            }
            else if (nu > 0.32)
            {   /*  using Wilson and Hilferty estimate */
                x  = NormalDistribution.QNorm(p, 0, 1, lower_tail, log_p);
                p1 = 2.0 / (9 * nu);
                ch = nu * Math.Pow(x * Math.Sqrt(p1) + 1 - p1, 3);

                /* approximation for p tending to 1: */
                if (ch > 2.2 * nu + 6)
                {
                    ch = -2 * (R_DT_Clog(p, lower_tail, log_p) - c * Math.Log(0.5 * ch) + g);
                }
            }
            else
            { /* "small nu" : 1.24*(-Math.Math.Log(p)) <= nu <= 0.32 */
                ch = 0.4;
                a  = R_DT_Clog(p, lower_tail, log_p) + g + c * M_LN2;

                do
                {
                    q   = ch;
                    p1  = 1.0 / (1 + ch * (C7 + ch));
                    p2  = ch * (C9 + ch * (C8 + ch));
                    t   = -0.5 + (C7 + 2 * ch) * p1 - (C9 + ch * (C10 + 3 * ch)) / p2;
                    ch -= (1 - Math.Exp(a + 0.5 * ch) * p2 * p1) / t;
                } while (Math.Abs(q - ch) > tol * Math.Abs(ch));
            }

            return(ch);
        }