Beispiel #1
1
  public static double dnbinom_mu(double x, double size, double mu, boolean give_log) {
    /* originally, just set  prob :=  size / (size + mu)  and called dbinom_raw(),
     * but that suffers from cancellation when   mu << size  */
    double ans, p;

    if (DoubleVector.isNaN(x) || DoubleVector.isNaN(size) || DoubleVector.isNaN(mu)) {
      return x + size + mu;
    }

    if (mu < 0 || size < 0) {
      return DoubleVector.NaN;
    }

    // R_D_nonint_check(x);

    if (SignRank.R_D_nonint(x, true, give_log)) {
      // MATHLIB_WARNING("non-integer x = %f", x);
      // How to warn??
      return SignRank.R_D__0(true, give_log);
    }

    if (x < 0 || !DoubleVector.isFinite(x)) {
      return SignRank.R_D__0(true, give_log);
    }
    x = SignRank.R_D_forceint(x);

    if (x == 0) /* be accerate, both for n << mu, and n >> mu :*/ {
      return SignRank.R_D_exp(
          size * (size < mu ? Math.log(size / (size + mu)) : Math.log1p(-mu / (size + mu))),
          true,
          give_log);
    }
    if (x < 1e-10 * size) {
        /* don't use dbinom_raw() but MM's formula: */
      /* FIXME --- 1e-8 shows problem; rather use algdiv() from ./toms708.c */
      return SignRank.R_D_exp(
          x * Math.log(size * mu / (size + mu))
              - mu
              - org.apache.commons.math.special.Gamma.logGamma(x + 1)
              + Math.log1p(x * (x - 1) / (2 * size)),
          true,
          give_log);
    }
    /* else: no unnecessary cancellation inside dbinom_raw, when
     * x_ = size and n_ = x+size are so close that n_ - x_ loses accuracy
     */
    ans = dbinom_raw(size, x + size, size / (size + mu), mu / (size + mu), give_log);
    p = ((double) size) / (size + x);
    return ((give_log) ? Math.log(p) + ans : p * ans);
  }
Beispiel #2
0
  /*
   * bd0.c
   */
  public static double bd0(double x, double np) {
    double ej, s, s1, v;
    int j;

    if (!DoubleVector.isFinite(x) || !DoubleVector.isFinite(np) || np == 0.0) {
      return DoubleVector.NaN;
    }

    if (Math.abs(x - np) < 0.1 * (x + np)) {
      v = (x - np) / (x + np);
      s = (x - np) * v; /* s using v -- change by MM */
      ej = 2 * x * v;
      v = v * v;
      for (j = 1; ; j++) {
          /* Taylor series */
        ej *= v;
        s1 = s + ej / ((j << 1) + 1);
        if (s1 == s) /* last term was effectively 0 */ {
          return (s1);
        }
        s = s1;
      }
    }
    /* else:  | x - np |  is not too small */
    return (x * Math.log(x / np) + np - x);
  }
Beispiel #3
0
  public static double qnbeta(
      double p, double a, double b, double ncp, boolean lower_tail, boolean log_p) {
    final double accu = 1e-15;
    final double Eps = 1e-14; /* must be > accu */

    double ux, lx, nx, pp;

    if (DoubleVector.isNaN(p)
        || DoubleVector.isNaN(a)
        || DoubleVector.isNaN(b)
        || DoubleVector.isNaN(ncp)) {
      return p + a + b + ncp;
    }

    if (!DoubleVector.isFinite(a)) {
      return DoubleVector.NaN;
    }

    if (ncp < 0. || a <= 0. || b <= 0.) {
      return DoubleVector.NaN;
    }

    // R_Q_P01_boundaries(p, 0, 1);
    if ((log_p && p > 0) || (!log_p && (p < 0 || p > 1))) {
      return DoubleVector.NaN;
    }
    if (p == SignRank.R_DT_0(lower_tail, log_p)) {
      return 0.0;
    }
    if (p == SignRank.R_DT_1(lower_tail, log_p)) {
      return 1.0;
    }
    // end of R_Q_P01_boundaries

    p = Normal.R_DT_qIv(p, log_p ? 1.0 : 0.0, lower_tail ? 1.0 : 0.0);

    /* Invert pnbeta(.) :
     * 1. finding an upper and lower bound */
    if (p > 1 - SignRank.DBL_EPSILON) {
      return 1.0;
    }
    pp = Math.min(1 - SignRank.DBL_EPSILON, p * (1 + Eps));
    for (ux = 0.5;
        ux < 1 - SignRank.DBL_EPSILON && pnbeta(ux, a, b, ncp, true, false) < pp;
        ux = 0.5 * (1 + ux)) ;
    pp = p * (1 - Eps);
    for (lx = 0.5; lx > Double.MIN_VALUE && pnbeta(lx, a, b, ncp, true, false) > pp; lx *= 0.5) ;

    /* 2. interval (lx,ux)  halving : */
    do {
      nx = 0.5 * (lx + ux);
      if (pnbeta(nx, a, b, ncp, true, false) > p) {
        ux = nx;
      } else {
        lx = nx;
      }
    } while ((ux - lx) / nx > accu);

    return 0.5 * (ux + lx);
  }
  @Test
  public void invokeMethod() throws ScriptException, NoSuchMethodException {
    Object obj = engine.eval("list(execute=sqrt)");
    DoubleVector result = (DoubleVector) invocableEngine.invokeMethod(obj, "execute", 16);

    assertThat(result.length(), equalTo(1));
    assertThat(result.get(0), equalTo(4d));
  }
  @Test
  public void invokeFunction() throws ScriptException, NoSuchMethodException {
    engine.eval("f <- function(x) sqrt(x)");
    DoubleVector result = (DoubleVector) invocableEngine.invokeFunction("f", 4);

    assertThat(result.length(), equalTo(1));
    assertThat(result.get(0), equalTo(2d));
  }
Beispiel #6
0
  @Primitive
  public static double pnbeta(
      double x, double a, double b, double ncp, boolean lower_tail, boolean log_p) {

    if (DoubleVector.isNaN(x)
        || DoubleVector.isNaN(a)
        || DoubleVector.isNaN(b)
        || DoubleVector.isNaN(ncp)) {
      return x + a + b + ncp;
    }

    // R_P_bounds_01(x, 0., 1.);
    if (x <= 0.0) {
      return SignRank.R_DT_0(lower_tail, log_p);
    }
    if (x >= 1.0) {
      return SignRank.R_DT_1(lower_tail, log_p);
    }

    return pnbeta2(x, 1 - x, a, b, ncp, lower_tail, log_p);
  }
Beispiel #7
0
  public static double pnbinom_mu(
      double x, double size, double mu, boolean lower_tail, boolean log_p) {

    if (DoubleVector.isNaN(x) || DoubleVector.isNaN(size) || DoubleVector.isNaN(mu)) {
      return x + size + mu;
    }
    if (!DoubleVector.isFinite(size) || !DoubleVector.isFinite(mu)) {
      return DoubleVector.NaN;
    }

    if (size <= 0 || mu < 0) {
      return DoubleVector.NaN;
    }

    if (x < 0) {
      SignRank.R_DT_0(lower_tail, log_p);
    }
    if (!DoubleVector.isFinite(x)) {
      return SignRank.R_DT_1(lower_tail, log_p);
    }
    x = Math.floor(x + 1e-7);
    /* return
     * pbeta(pr, size, x + 1, lower_tail, log_p);  pr = size/(size + mu), 1-pr = mu/(size+mu)
     *
     *= pbeta_raw(pr, size, x + 1, lower_tail, log_p)
     *            x.  pin   qin
     *=  bratio (pin,  qin, x., 1-x., &w, &wc, &ierr, log_p),  and return w or wc ..
     *=  bratio (size, x+1, pr, 1-pr, &w, &wc, &ierr, log_p) */
    {
      int[] ierr = new int[1];
      double[] w = new double[1];
      double[] wc = new double[1];
      Utils.bratio(size, x + 1, size / (size + mu), mu / (size + mu), w, wc, ierr, log_p);
      return lower_tail ? w[0] : wc[0];
    }
  }
Beispiel #8
0
  public static double qnbinom(
      double p, double size, double prob, boolean lower_tail, boolean log_p) {
    double P, Q, mu, sigma, gamma, y;
    double[] z = new double[1];

    if (DoubleVector.isNaN(p) || DoubleVector.isNaN(size) || DoubleVector.isNaN(prob)) {
      return p + size + prob;
    }

    if (prob <= 0 || prob > 1 || size <= 0) {
      return DoubleVector.NaN;
    }

    /* FIXME: size = 0 is well defined ! */
    if (prob == 1) {
      return 0;
    }

    // R_Q_P01_boundaries(p, 0, ML_POSINF);
    // #define R_Q_P01_boundaries(p, _LEFT_, _RIGHT_)
    // This macro is defined in /src/nmath/dpq.h
    if (log_p) {
      if (p > 0) {
        return DoubleVector.NaN;
      }
      if (p == 0) {
          /* upper bound*/
        return lower_tail ? Double.POSITIVE_INFINITY : 0;
      }
      if (p == Double.NEGATIVE_INFINITY) {
        return lower_tail ? 0 : Double.POSITIVE_INFINITY;
      }
    } else {
        /* !log_p */
      if (p < 0 || p > 1) {
        return DoubleVector.NaN;
      }
      if (p == 0) {
        return lower_tail ? 0 : Double.POSITIVE_INFINITY;
      }
      if (p == 1) {
        return lower_tail ? Double.POSITIVE_INFINITY : 0;
      }
    }

    Q = 1.0 / prob;
    P = (1.0 - prob) * Q;
    mu = size * P;
    sigma = Math.sqrt(size * P * Q);
    gamma = (Q + P) / sigma;

    /* Note : "same" code in qpois.c, qbinom.c, qnbinom.c --
     * FIXME: This is far from optimal [cancellation for p ~= 1, etc]: */
    if (!lower_tail || log_p) {
      // p = R_DT_qIv(p); /* need check again (cancellation!): */
      p = Normal.R_DT_qIv(p, lower_tail ? 1.0 : 0.0, log_p ? 1.0 : 0.0);
      if (p == SignRank.R_DT_0(lower_tail, log_p)) {
        return 0;
      }
      if (p == SignRank.R_DT_1(lower_tail, log_p)) {
        return Double.POSITIVE_INFINITY;
      }
    }
    /* temporary hack --- FIXME --- */
    if (p + 1.01 * SignRank.DBL_EPSILON >= 1.) {
      return Double.POSITIVE_INFINITY;
    }

    /* y := approx.value (Cornish-Fisher expansion) :  */
    z[0] = Distributions.qnorm(p, 0., 1., /*lower_tail*/ true, /*log_p*/ false);
    y = Math.floor(mu + sigma * (z[0] + gamma * (z[0] * z[0] - 1) / 6) + 0.5);

    z[0] = Distributions.pnbinom(y, (int) size, prob, /*lower_tail*/ true, /*log_p*/ false);

    /* fuzz to ensure left continuity: */
    p *= 1 - 64 * SignRank.DBL_EPSILON;

    /* If the C-F value is not too large a simple search is OK */
    if (y < 1e5) {
      return do_search(y, z, p, size, prob, 1);
    }
    /* Otherwise be a bit cleverer in the search */
    {
      double incr = Math.floor(y * 0.001), oldincr;
      do {
        oldincr = incr;
        y = do_search(y, z, p, size, prob, incr);
        incr = Math.max(1, Math.floor(incr / 100));
      } while (oldincr > 1 && incr > y * 1e-15);
      return y;
    }
  }
Beispiel #9
0
  @Primitive
  public static double dnbeta(double x, double a, double b, double ncp, boolean give_log) {
    final double eps = 1.e-15;

    int kMax;
    double k, ncp2, dx2, d, D;
    double sum, term, p_k, q; /* They were LDOUBLE */

    if (DoubleVector.isNaN(x)
        || DoubleVector.isNaN(a)
        || DoubleVector.isNaN(b)
        || DoubleVector.isNaN(ncp)) {
      return x + a + b + ncp;
    }

    if (ncp < 0 || a <= 0 || b <= 0) {
      return DoubleVector.NaN;
    }

    if (!DoubleVector.isFinite(a) || !DoubleVector.isFinite(b) || !DoubleVector.isFinite(ncp)) {
      return DoubleVector.NaN;
    }

    if (x < 0 || x > 1) {
      return (SignRank.R_D__0(true, give_log));
    }

    if (ncp == 0) {
      return Distributions.dbeta(x, a, b, give_log);
    }

    /* New algorithm, starting with *largest* term : */
    ncp2 = 0.5 * ncp;
    dx2 = ncp2 * x;
    d = (dx2 - a - 1) / 2;
    D = d * d + dx2 * (a + b) - a;
    if (D <= 0) {
      kMax = 0;
    } else {
      D = Math.ceil(d + Math.sqrt(D));
      kMax = (D > 0) ? (int) D : 0;
    }

    /* The starting "middle term" --- first look at it's log scale: */
    term = Distributions.dbeta(x, a + kMax, b, /* log = */ true);
    p_k = Poisson.dpois_raw(kMax, ncp2, true);
    if (x == 0.
        || !DoubleVector.isFinite(term)
        || !DoubleVector.isFinite(p_k)) /* if term = +Inf */ {
      return SignRank.R_D_exp(p_k + term, true, give_log);
    }

    /* Now if s_k := p_k * t_k  {here = exp(p_k + term)} would underflow,
     * we should rather scale everything and re-scale at the end:*/

    p_k += term; /* = log(p_k) + log(t_k) == log(s_k) -- used at end to rescale */
    /* mid = 1 = the rescaled value, instead of  mid = exp(p_k); */

    /* Now sum from the inside out */
    sum = term = 1. /* = mid term */;
    /* middle to the left */
    k = kMax;
    while (k > 0 && term > sum * eps) {
      k--;
      q = /* 1 / r_k = */ (k + 1) * (k + a) / (k + a + b) / dx2;
      term *= q;
      sum += term;
    }
    /* middle to the right */
    term = 1.;
    k = kMax;
    do {
      q = /* r_{old k} = */ dx2 * (k + a + b) / (k + a) / (k + 1);
      k++;
      term *= q;
      sum += term;
    } while (term > sum * eps);

    return SignRank.R_D_exp(p_k + Math.log(sum), true, give_log);
  }