double dinvparalogis(double x, double shape, double scale, int give_log) { /* We work with the density expressed as * * shape^2 * u^shape * (1 - u) / x * * with u = v/(1 + v) = 1/(1 + 1/v), v = (x/scale)^shape. */ double tmp, logu, log1mu; if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale <= 0.0) return R_NaN;; if (!R_FINITE(x) || x < 0.0) return ACT_D__0; /* handle x == 0 separately */ if (x == 0) { if (shape < 1.0) return R_PosInf; if (shape > 1.0) return ACT_D__0; /* else */ return ACT_D_val(1.0 / scale); } tmp = shape * (log(x) - log(scale)); logu = - log1pexp(-tmp); log1mu = - log1pexp(tmp); return ACT_D_exp(2.0 * log(shape) + shape * logu + log1mu - log(x)); }
double levinvparalogis(double limit, double shape, double scale, double order, int give_log) { double u, tmp1, tmp2, tmp3; if (!R_FINITE(shape) || !R_FINITE(scale) || !R_FINITE(order) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (order <= -shape * shape) return R_PosInf; tmp1 = order / shape; tmp2 = shape + tmp1; tmp3 = 1.0 - tmp1; u = exp(-log1pexp(shape * (log(scale) - log(limit)))); return R_pow(scale, order) * gammafn(tmp2) * gammafn(tmp3) * pbeta(u, tmp2, tmp3, 1, 0) / gammafn(shape) + ACT_DLIM__0(limit, order) * (0.5 - R_pow(u, shape) + 0.5); }
double pinvparalogis(double q, double shape, double scale, int lower_tail, int log_p) { double u; if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale <= 0.0) return R_NaN;; if (q <= 0) return ACT_DT_0; u = exp(-log1pexp(shape * (log(scale) - log(q)))); return ACT_DT_val(R_pow(u, shape)); }
double levinvpareto(double limit, double shape, double scale, double order, int give_log) { double u; double ex[3], lower, upper, epsabs, epsrel, result, abserr, *work; int neval, ier, subdiv, lenw, last, *iwork; if (!R_FINITE(shape) || !R_FINITE(scale) || !R_FINITE(order) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (order <= -shape) return R_PosInf; if (limit <= 0.0) return 0.0; /* Parameters for the integral are pretty much fixed here */ ex[0] = shape; ex[1] = scale; ex[2] = order; lower = 0.0; upper = limit / (limit + scale); subdiv = 100; epsabs = R_pow(DOUBLE_EPS, 0.25); epsrel = epsabs; lenw = 4 * subdiv; /* as instructed in WRE */ iwork = (int *) R_alloc(subdiv, sizeof(int)); /* idem */ work = (double *) R_alloc(lenw, sizeof(double)); /* idem */ Rdqags(fn, (void *) &ex, &lower, &upper, &epsabs, &epsrel, &result, &abserr, &neval, &ier, &subdiv, &lenw, &last, iwork, work); if (ier == 0) { u = exp(-log1pexp(log(scale) - log(limit))); return R_pow(scale, order) * shape * result + ACT_DLIM__0(limit, order) * (0.5 - R_pow(u, shape) + 0.5); } else error(_("integration failed")); }
double plogis(double x, double location, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(location) || ISNAN(scale)) return x + location + scale; #endif if (scale <= 0.0) ML_ERR_return_NAN; x = (x - location) / scale; if (ISNAN(x)) ML_ERR_return_NAN; R_P_bounds_Inf_01(x); if(log_p) { // log(1 / (1 + exp( +- x ))) = -log(1 + exp( +- x)) return -log1pexp(lower_tail ? -x : x); } else { return 1 / (1 + exp(lower_tail ? -x : x)); } }
inline long double sum_log_prob(long double a, long double b) { return a>b? a+log1pexp(b-a): b+log1pexp(a-b); }
inline double sum_log_prob(double a, double b) { return a>b? a+log1pexp(b-a): b+log1pexp(a-b); }
inline float sum_log_prob(float a, float b) { return a>b? a+log1pexp(b-a): b+log1pexp(a-b); }