From 206c0c298c5f4f439d0795bc14e024d01fd9efea Mon Sep 17 00:00:00 2001 From: axexlck Date: Thu, 1 Aug 2024 22:08:11 +0200 Subject: [PATCH] WIP #1034 code formatting org.matheclipse.core.numerics --- .../numerics/integral/ClenshawCurtis.java | 1107 ++++---- .../core/numerics/integral/GaussKronrod.java | 2299 +++++++++-------- .../core/numerics/integral/GaussLegendre.java | 368 +-- .../core/numerics/integral/GaussLobatto.java | 184 +- .../core/numerics/integral/NewtonCotes.java | 467 ++-- .../core/numerics/integral/Quadrature.java | 328 ++- .../core/numerics/integral/RmsRule.java | 1631 ++++++------ .../core/numerics/integral/Romberg.java | 1474 ++++++----- .../core/numerics/integral/Simpson.java | 13 +- .../series/special/EulerMaclaurin.java | 535 ++-- .../core/numerics/utils/Constants.java | 56 +- .../core/numerics/utils/SimpleMath.java | 145 +- 12 files changed, 4304 insertions(+), 4303 deletions(-) diff --git a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/ClenshawCurtis.java b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/ClenshawCurtis.java index e585b1fc8..44cec5c07 100644 --- a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/ClenshawCurtis.java +++ b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/ClenshawCurtis.java @@ -5,584 +5,581 @@ import org.matheclipse.core.numerics.utils.SimpleMath; /** - * An adaptive numerical integrator based on the Clenshaw-Curtis quadrature - * rule. There are two implementations: + * An adaptive numerical integrator based on the Clenshaw-Curtis quadrature rule. There are two + * implementations: *
    - *
  1. Havie : the integral is approximated by Chebychev polynomials over each - * subinterval, as introduced in [1]. This code is a translation of the Fortran - * subroutine by John Burkardt.
    2. - *
  2. Oliver : a doubly-adaptive Clenshaw-Curtis algorithm also using Chebychev - * polynomials as introduced in [2].
    3. + *
  3. Havie : the integral is approximated by Chebychev polynomials over each subinterval, as + * introduced in [1]. This code is a translation of the Fortran subroutine by John Burkardt.
    4. + *
  4. Oliver : a doubly-adaptive Clenshaw-Curtis algorithm also using Chebychev polynomials as + * introduced in [2].
    5. *
* *

* References: *

*

*/ public final class ClenshawCurtis extends Quadrature { - /** - * The extrapolation method to use for Clenshaw-Curtis integration. - */ - public static enum ClenshawCurtisExtrapolationMethod { - HAVIE, OLIVER + /** + * The extrapolation method to use for Clenshaw-Curtis integration. + */ + public static enum ClenshawCurtisExtrapolationMethod { + HAVIE, OLIVER + } + + private static final double[][] SIGMA = { // + {0.455, 0.272, 0.606, 0.811, 0.908}, {0.550, 0.144, 0.257, 0.376, 0.511}, + {0.667, 0.243, 0.366, 0.449, 0.522}, {0.780, 0.283, 0.468, 0.565, 0.624}, + {0.855, 0.290, 0.494, 0.634, 0.714}, {-1.00, 0.292, 0.499, 0.644, 0.745}}; + + private final ClenshawCurtisExtrapolationMethod myMethod; + + /** + * Creates a new instance of the Clenshaw-Curtis integrator. + * + * @param tolerance the smallest acceptable absolute change in integral estimates in consecutive + * iterations that indicates the algorithm has converged + * @param maxEvaluations the maximum number of evaluations of each function permitted + * @param method the extrapolation method to use + */ + public ClenshawCurtis(final double tolerance, final int maxEvaluations, + final ClenshawCurtisExtrapolationMethod method) { + super(tolerance, maxEvaluations); + myMethod = method; + } + + public ClenshawCurtis(final double tolerance, final int maxEvaluations) { + this(tolerance, maxEvaluations, ClenshawCurtisExtrapolationMethod.OLIVER); + } + + @Override + final QuadratureResult properIntegral(final DoubleUnaryOperator f, final double a, + final double b) { + switch (myMethod) { + case HAVIE: + return havie(f, a, b); + case OLIVER: + return oliver(f, a, b); + default: + return new QuadratureResult(Double.NaN, Double.NaN, 0, false); } - - private static final double[][] SIGMA = { // - { 0.455, 0.272, 0.606, 0.811, 0.908 }, { 0.550, 0.144, 0.257, 0.376, 0.511 }, - { 0.667, 0.243, 0.366, 0.449, 0.522 }, { 0.780, 0.283, 0.468, 0.565, 0.624 }, - { 0.855, 0.290, 0.494, 0.634, 0.714 }, { -1.00, 0.292, 0.499, 0.644, 0.745 } }; - - private final ClenshawCurtisExtrapolationMethod myMethod; - - /** - * Creates a new instance of the Clenshaw-Curtis integrator. - * - * @param tolerance the smallest acceptable absolute change in integral - * estimates in consecutive iterations that indicates the - * algorithm has converged - * @param maxEvaluations the maximum number of evaluations of each function - * permitted - * @param method the extrapolation method to use - */ - public ClenshawCurtis(final double tolerance, final int maxEvaluations, - final ClenshawCurtisExtrapolationMethod method) { - super(tolerance, maxEvaluations); - myMethod = method; - } - - public ClenshawCurtis(final double tolerance, final int maxEvaluations) { - this(tolerance, maxEvaluations, ClenshawCurtisExtrapolationMethod.OLIVER); - } - - @Override - final QuadratureResult properIntegral(final DoubleUnaryOperator f, final double a, - final double b) { - switch (myMethod) { - case HAVIE: - return havie(f, a, b); - case OLIVER: - return oliver(f, a, b); - default: - return new QuadratureResult(Double.NaN, Double.NaN, 0, false); - } - } - - @Override - public final String getName() { - return "Clenshaw-Curtis-" + myMethod.toString(); - } - - private final QuadratureResult havie(final DoubleUnaryOperator f, double a, double b) { - final double[] result = new double[1]; - final double[] epsout = new double[1]; - final int[] fev = new int[1]; - final boolean[] success = new boolean[1]; - final double epsin = myTol; - final int nupper = SimpleMath.log2Int(myMaxEvals) - 1; - havie(f, a, b, nupper, epsin, epsout, result, fev, success); - return new QuadratureResult(result[0], epsout[0], fev[0], success[0]); - } - - private final void havie(final DoubleUnaryOperator f, double a, double b, final int nupper, - final double epsin, final double[] epsout, final double[] result, final int[] fev, - final boolean[] success) { - double a0, a1, a2, alf, alfnj, alfno, bet, betnj, betno, bounds, cof, cofmax, const1, const2, deln, deltan, - error, etank, gamman, hnstep; - double r1, r2, rk, rn, rnderr, rounde, tend, tnew, triarg, umid, wmean, xmin, xplus, xsink; - final int mem = 1 << (nupper - 1); - final double[] acof = new double[mem + 1]; - final double[] bcof = new double[mem + 1]; - final double[] ccof = new double[(mem << 1) + 1]; - int i, index, j, k, ksign, n, ncof, nhalf, nn; - - // Set coefficients in formula for accumulated roundoff error. - // N is the current number of function values used. - fev[0] = 0; - rnderr = Constants.EPSILON; - success[0] = true; - - r1 = 1.0; - r2 = 2.0; - error = epsin; - - // Integration interval parameters. - alf = 0.5 * (b - a); - bet = 0.5 * (b + a); - - // Parameters for trigonometric recurrence relations. - triarg = Math.atan(1.0); - alfno = -1.0; - - // Parameters for integration stepsize and loops. - rn = 2.0; - n = 2; - nhalf = 1; - hnstep = 1.0; - - // Initial calculation for the end-point approximation. + } + + @Override + public final String getName() { + return "Clenshaw-Curtis-" + myMethod.toString(); + } + + private final QuadratureResult havie(final DoubleUnaryOperator f, double a, double b) { + final double[] result = new double[1]; + final double[] epsout = new double[1]; + final int[] fev = new int[1]; + final boolean[] success = new boolean[1]; + final double epsin = myTol; + final int nupper = SimpleMath.log2Int(myMaxEvals) - 1; + havie(f, a, b, nupper, epsin, epsout, result, fev, success); + return new QuadratureResult(result[0], epsout[0], fev[0], success[0]); + } + + private final void havie(final DoubleUnaryOperator f, double a, double b, final int nupper, + final double epsin, final double[] epsout, final double[] result, final int[] fev, + final boolean[] success) { + double a0, a1, a2, alf, alfnj, alfno, bet, betnj, betno, bounds, cof, cofmax, const1, const2, + deln, deltan, error, etank, gamman, hnstep; + double r1, r2, rk, rn, rnderr, rounde, tend, tnew, triarg, umid, wmean, xmin, xplus, xsink; + final int mem = 1 << (nupper - 1); + final double[] acof = new double[mem + 1]; + final double[] bcof = new double[mem + 1]; + final double[] ccof = new double[(mem << 1) + 1]; + int i, index, j, k, ksign, n, ncof, nhalf, nn; + + // Set coefficients in formula for accumulated roundoff error. + // N is the current number of function values used. + fev[0] = 0; + rnderr = Constants.EPSILON; + success[0] = true; + + r1 = 1.0; + r2 = 2.0; + error = epsin; + + // Integration interval parameters. + alf = 0.5 * (b - a); + bet = 0.5 * (b + a); + + // Parameters for trigonometric recurrence relations. + triarg = Math.atan(1.0); + alfno = -1.0; + + // Parameters for integration stepsize and loops. + rn = 2.0; + n = 2; + nhalf = 1; + hnstep = 1.0; + + // Initial calculation for the end-point approximation. const1 = 0.5 * (f.applyAsDouble(a) + f.applyAsDouble(b)); - fev[0] += 2; + fev[0] += 2; const2 = f.applyAsDouble(bet); - acof[1 - 1] = 0.5 * (const1 + const2); - acof[2 - 1] = 0.5 * (const1 - const2); - bcof[2 - 1] = acof[2 - 1]; - tend = 2.0 * (acof[1 - 1] - acof[2 - 1] / 3.0); - - // Start actual calculations. - for (i = 1; i <= nupper; ++i) { - - // Compute function values. - const1 = -Math.sin(triarg); - const2 = 0.5 * alfno / const1; - alfno = const1; - betno = const2; - gamman = 1.0 - 2.0 * alfno * alfno; - deltan = -2.0 * alfno * betno; - bcof[1 - 1] = 0.0; - for (j = 1; j <= nhalf; ++j) { - alfnj = gamman * const1 + deltan * const2; - betnj = gamman * const2 - deltan * const1; - xplus = alf * alfnj + bet; - xmin = -alf * alfnj + bet; + acof[1 - 1] = 0.5 * (const1 + const2); + acof[2 - 1] = 0.5 * (const1 - const2); + bcof[2 - 1] = acof[2 - 1]; + tend = 2.0 * (acof[1 - 1] - acof[2 - 1] / 3.0); + + // Start actual calculations. + for (i = 1; i <= nupper; ++i) { + + // Compute function values. + const1 = -Math.sin(triarg); + const2 = 0.5 * alfno / const1; + alfno = const1; + betno = const2; + gamman = 1.0 - 2.0 * alfno * alfno; + deltan = -2.0 * alfno * betno; + bcof[1 - 1] = 0.0; + for (j = 1; j <= nhalf; ++j) { + alfnj = gamman * const1 + deltan * const2; + betnj = gamman * const2 - deltan * const1; + xplus = alf * alfnj + bet; + xmin = -alf * alfnj + bet; ccof[j - 1] = f.applyAsDouble(xplus) + f.applyAsDouble(xmin); - fev[0] += 2; - bcof[1 - 1] += ccof[j - 1]; - const1 = alfnj; - const2 = betnj; - } - bcof[1 - 1] *= 0.5 * hnstep; - - // Calculation of first B-coefficient finished compute the higher - // coefficients if NHALF greater than one. - if (nhalf > 1) { - - const1 = 1.0; - const2 = 0.0; - ncof = nhalf - 1; - ksign = -1; - for (k = 1; k <= ncof; ++k) { - - // Compute trigonometric sum for B-coefficient. - etank = gamman * const1 - deltan * const2; - xsink = gamman * const2 + deltan * const1; - cof = 2.0 * (2.0 * etank * etank - 1.0); - a2 = a1 = 0.0; - a0 = ccof[nhalf - 1]; - for (j = 1; j <= ncof; ++j) { - a2 = a1; - a1 = a0; - index = nhalf - j; - a0 = ccof[index - 1] + cof * a1 - a2; - } - bcof[k + 1 - 1] = hnstep * (a0 - a1) * etank; - bcof[k + 1 - 1] *= ksign; - ksign = -ksign; - const1 = etank; - const2 = xsink; - } - } - - // Compute new modified mid-point approximation when the interval - // of integration is divided in N equal sub intervals. - umid = 0.0; - rk = rn; - nn = nhalf + 1; - for (k = 1; k <= nn; ++k) { - index = nn + 1 - k; - umid += bcof[index - 1] / (rk * rk - 1.0); - rk -= 2.0; - } - umid *= -2.0; - - // Compute new C-coefficients for end-point approximation and largest - // absolute value of coefficients. - nn = n + 2; - cofmax = 0.0; - for (j = 1; j <= nhalf; ++j) { - index = nn - j; - ccof[j - 1] = 0.5 * (acof[j - 1] + bcof[j - 1]); - ccof[index - 1] = 0.5 * (acof[j - 1] - bcof[j - 1]); - const1 = Math.abs(ccof[j - 1]); - cofmax = Math.max(cofmax, const1); - const1 = Math.abs(ccof[index - 1]); - cofmax = Math.max(cofmax, const1); - } - ccof[nhalf + 1 - 1] = acof[nhalf + 1 - 1]; - - // Compute new end-point approximation when the interval of - // integration is divided in 2N equal sub intervals. - wmean = 0.5 * (tend + umid); - bounds = 0.5 * (tend - umid); - deln = 0.0; - rk = 2.0 * rn; - for (j = 1; j <= nhalf; ++j) { - index = n + 2 - j; - deln += ccof[index - 1] / (rk * rk - 1.0); - rk -= 2.0; - } - deln *= -2.0; - tnew = wmean + deln; - epsout[0] = Math.abs(bounds / tnew); - if (cofmax >= rnderr) { - rounde = rnderr * (r1 + r2 * rn); - epsout[0] = Math.max(epsout[0], rounde); - error = Math.max(error, rounde); - if (error >= epsout[0]) { - - // Required accuracy obtained or the maximum number of function - // values used without obtaining the required accuracy. - n = 2 * n + 1; - tend = alf * (tend + deln); - umid = alf * (umid + deln); - deln *= alf; - result[0] = alf * tnew; - success[0] = true; - return; - } - } - - // If I = NUPPER then the required accuracy is not obtained. - if (i == nupper) { - - // Required accuracy obtained or the maximum number of function - // values used without obtaining the required accuracy. - n = (n << 1) + 1; - tend = alf * (tend + deln); - umid = alf * (umid + deln); - deln *= alf; - result[0] = alf * tnew; - success[0] = false; - return; - } - System.arraycopy(ccof, 0, acof, 0, n + 1); - bcof[n + 1 - 1] = ccof[n + 1 - 1]; - tend = tnew; - nhalf = n; - n <<= 1; - rn *= 2.0; - hnstep *= 0.5; - triarg *= 0.5; - } + fev[0] += 2; + bcof[1 - 1] += ccof[j - 1]; + const1 = alfnj; + const2 = betnj; + } + bcof[1 - 1] *= 0.5 * hnstep; + + // Calculation of first B-coefficient finished compute the higher + // coefficients if NHALF greater than one. + if (nhalf > 1) { + + const1 = 1.0; + const2 = 0.0; + ncof = nhalf - 1; + ksign = -1; + for (k = 1; k <= ncof; ++k) { + + // Compute trigonometric sum for B-coefficient. + etank = gamman * const1 - deltan * const2; + xsink = gamman * const2 + deltan * const1; + cof = 2.0 * (2.0 * etank * etank - 1.0); + a2 = a1 = 0.0; + a0 = ccof[nhalf - 1]; + for (j = 1; j <= ncof; ++j) { + a2 = a1; + a1 = a0; + index = nhalf - j; + a0 = ccof[index - 1] + cof * a1 - a2; + } + bcof[k + 1 - 1] = hnstep * (a0 - a1) * etank; + bcof[k + 1 - 1] *= ksign; + ksign = -ksign; + const1 = etank; + const2 = xsink; + } + } + + // Compute new modified mid-point approximation when the interval + // of integration is divided in N equal sub intervals. + umid = 0.0; + rk = rn; + nn = nhalf + 1; + for (k = 1; k <= nn; ++k) { + index = nn + 1 - k; + umid += bcof[index - 1] / (rk * rk - 1.0); + rk -= 2.0; + } + umid *= -2.0; + + // Compute new C-coefficients for end-point approximation and largest + // absolute value of coefficients. + nn = n + 2; + cofmax = 0.0; + for (j = 1; j <= nhalf; ++j) { + index = nn - j; + ccof[j - 1] = 0.5 * (acof[j - 1] + bcof[j - 1]); + ccof[index - 1] = 0.5 * (acof[j - 1] - bcof[j - 1]); + const1 = Math.abs(ccof[j - 1]); + cofmax = Math.max(cofmax, const1); + const1 = Math.abs(ccof[index - 1]); + cofmax = Math.max(cofmax, const1); + } + ccof[nhalf + 1 - 1] = acof[nhalf + 1 - 1]; + + // Compute new end-point approximation when the interval of + // integration is divided in 2N equal sub intervals. + wmean = 0.5 * (tend + umid); + bounds = 0.5 * (tend - umid); + deln = 0.0; + rk = 2.0 * rn; + for (j = 1; j <= nhalf; ++j) { + index = n + 2 - j; + deln += ccof[index - 1] / (rk * rk - 1.0); + rk -= 2.0; + } + deln *= -2.0; + tnew = wmean + deln; + epsout[0] = Math.abs(bounds / tnew); + if (cofmax >= rnderr) { + rounde = rnderr * (r1 + r2 * rn); + epsout[0] = Math.max(epsout[0], rounde); + error = Math.max(error, rounde); + if (error >= epsout[0]) { + + // Required accuracy obtained or the maximum number of function + // values used without obtaining the required accuracy. + n = 2 * n + 1; + tend = alf * (tend + deln); + umid = alf * (umid + deln); + deln *= alf; + result[0] = alf * tnew; + success[0] = true; + return; + } + } + + // If I = NUPPER then the required accuracy is not obtained. + if (i == nupper) { + + // Required accuracy obtained or the maximum number of function + // values used without obtaining the required accuracy. + n = (n << 1) + 1; + tend = alf * (tend + deln); + umid = alf * (umid + deln); + deln *= alf; + result[0] = alf * tnew; + success[0] = false; + return; + } + System.arraycopy(ccof, 0, acof, 0, n + 1); + bcof[n + 1 - 1] = ccof[n + 1 - 1]; + tend = tnew; + nhalf = n; + n <<= 1; + rn *= 2.0; + hnstep *= 0.5; + triarg *= 0.5; } - - private final QuadratureResult oliver(final DoubleUnaryOperator f, double a, double b) { - final double eps = myTol; - final double acc = 0.0; - final double eta = SimpleMath.D1MACH[1 - 1]; - final int divmax = 256; - final double[] ans = new double[1]; - final double[] error = new double[1]; - final int[] fev = new int[1]; - final boolean[] success = new boolean[1]; - adapquad(f, a, b, eps, acc, eta, divmax, ans, error, fev, myMaxEvals, success); - return new QuadratureResult(ans[0], error[0], fev[0], success[0]); + } + + private final QuadratureResult oliver(final DoubleUnaryOperator f, double a, double b) { + final double eps = myTol; + final double acc = 0.0; + final double eta = SimpleMath.D1MACH[1 - 1]; + final int divmax = 256; + final double[] ans = new double[1]; + final double[] error = new double[1]; + final int[] fev = new int[1]; + final boolean[] success = new boolean[1]; + adapquad(f, a, b, eps, acc, eta, divmax, ans, error, fev, myMaxEvals, success); + return new QuadratureResult(ans[0], error[0], fev[0], success[0]); + } + + private static final void adapquad(final DoubleUnaryOperator f, double a, double b, double eps, + double acc, final double eta, final int divmax, final double[] ans, final double[] error, + final int[] fev, final int maxfev, final boolean[] success) { + int i, j = 0, m, mmax, n, n2, nmax, maxrule, order = 0, div; + double c, cprev = 0, e = 0, eprev = 0, fmax = 0, fmin = 0, h = 0, hmin, iint = 0, intprev = 0, + k = 0, k1 = 0, re = 0, x, xa, xb, xc; + boolean caution = false; + final double[] ec = new double[6]; + final double[] fs = new double[divmax]; + final double[] xs = new double[divmax]; + final double[] fx = new double[129]; + final double[] w1 = new double[129]; + final double[] t = new double[65]; + final double[] w = new double[126]; + + ans[0] = error[0] = 0.0; + fev[0] = 0; + success[0] = true; + if (a > b) { + c = b; + b = a; + a = c; } - - private static final void adapquad(final DoubleUnaryOperator f, double a, double b, double eps, - double acc, final double eta, final int divmax, final double[] ans, final double[] error, final int[] fev, - final int maxfev, final boolean[] success) { - int i, j = 0, m, mmax, n, n2, nmax, maxrule, order = 0, div; - double c, cprev = 0, e = 0, eprev = 0, fmax = 0, fmin = 0, h = 0, hmin, iint = 0, intprev = 0, k = 0, k1 = 0, - re = 0, x, xa, xb, xc; - boolean caution = false; - final double[] ec = new double[6]; - final double[] fs = new double[divmax]; - final double[] xs = new double[divmax]; - final double[] fx = new double[129]; - final double[] w1 = new double[129]; - final double[] t = new double[65]; - final double[] w = new double[126]; - - ans[0] = error[0] = 0.0; - fev[0] = 0; - success[0] = true; - if (a > b) { - c = b; - b = a; - a = c; - } - hmin = (b - a) / SimpleMath.pow(2, divmax); - if (acc < eta) { - acc = eta; - } - acc *= 16; - x = 4; - xa = 64; - for (i = 1; i <= 6; ++i) { - ec[i - 1] = xa / ((x * x - 1) * (x * x - 9)); - x = x + x; - xa = xa + xa; - } - n = 4; - n2 = 2; - nmax = 128; - m = mmax = nmax / n; - t[0] = 1; - t[nmax >> 1] = 0; - maxrule = div = 0; - w1[0] = -1; - maxrule = quadrule(t, w, w1, n, n2, m, maxrule); - xa = xc = a; - xb = b; + hmin = (b - a) / SimpleMath.pow(2, divmax); + if (acc < eta) { + acc = eta; + } + acc *= 16; + x = 4; + xa = 64; + for (i = 1; i <= 6; ++i) { + ec[i - 1] = xa / ((x * x - 1) * (x * x - 9)); + x = x + x; + xa = xa + xa; + } + n = 4; + n2 = 2; + nmax = 128; + m = mmax = nmax / n; + t[0] = 1; + t[nmax >> 1] = 0; + maxrule = div = 0; + w1[0] = -1; + maxrule = quadrule(t, w, w1, n, n2, m, maxrule); + xa = xc = a; + xb = b; fx[0] = f.applyAsDouble(b); fx[n] = f.applyAsDouble(a); - fev[0] = 2; - - // next is one of the following values: - // 0 : NEXT - // 1 : AGAIN - // 2 : EVAL - // 3 : TEST - // 4 : UPDATE - // 5 : DOUBLE - // 6 : SPLIT - int next = 0; - while (true) { - - if (next == 0) { - - // NEXT: Integration over new subinterval - n = 4; - n2 = 2; - m = mmax; - order = 1; - caution = xa < xc; - h = xb - xa; - k1 = h / (b - xa); - if (k1 < 0.1) { - k1 = 0.1; - } - h *= 0.5; - j = 1; + fev[0] = 2; + + // next is one of the following values: + // 0 : NEXT + // 1 : AGAIN + // 2 : EVAL + // 3 : TEST + // 4 : UPDATE + // 5 : DOUBLE + // 6 : SPLIT + int next = 0; + while (true) { + + if (next == 0) { + + // NEXT: Integration over new subinterval + n = 4; + n2 = 2; + m = mmax; + order = 1; + caution = xa < xc; + h = xb - xa; + k1 = h / (b - xa); + if (k1 < 0.1) { + k1 = 0.1; + } + h *= 0.5; + j = 1; fx[n2] = f.applyAsDouble(xa + h); - ++fev[0]; - fmin = fmax = fx[0]; - if (fmax < fx[n]) { - fmax = fx[n]; - } else if (fmin > fx[n]) { - fmin = fx[n]; - } - if (fmax < fx[n2]) { - fmax = fx[n2]; - } else if (fmin > fx[n2]) { - fmin = fx[n2]; - } - next = 1; - if (fev[0] > maxfev) { - success[0] = false; - return; - } - } - - if (next == 1) { - - // AGAIN: Calculate new integrand values, Chebyshev coefficients and error - // estimate - for (i = 1; i <= n2 - 1; i += j) { + ++fev[0]; + fmin = fmax = fx[0]; + if (fmax < fx[n]) { + fmax = fx[n]; + } else if (fmin > fx[n]) { + fmin = fx[n]; + } + if (fmax < fx[n2]) { + fmax = fx[n2]; + } else if (fmin > fx[n2]) { + fmin = fx[n2]; + } + next = 1; + if (fev[0] > maxfev) { + success[0] = false; + return; + } + } + + if (next == 1) { + + // AGAIN: Calculate new integrand values, Chebyshev coefficients and error + // estimate + for (i = 1; i <= n2 - 1; i += j) { fx[i] = f.applyAsDouble(xa + (1 + t[i * m]) * h); - ++fev[0]; - if (fmax < fx[i]) { - fmax = fx[i]; - } else if (fmin > fx[i]) { - fmin = fx[i]; - } - fx[n - i] = f.applyAsDouble(xa + (1 - t[i * m]) * h); - ++fev[0]; - if (fmax < fx[n - i]) { - fmax = fx[n - i]; - } else if (fmin > fx[n - i]) { - fmin = fx[n - i]; - } - if (fev[0] > maxfev) { - success[0] = false; - return; - } - } - re = acc * Math.max(Math.abs(fmax), Math.abs(fmin)); - j = n == 4 ? 4 : 6; - k = 0; - c = Math.abs(cheb(-1, fx, n)) / n; - for (i = 2; i <= j; i += 2) { - if (i <= n2) { - x = -t[i * m]; - } else { - x = t[(n - i) * m]; - } - cprev = c; - c = Math.abs(cheb(x, fx, n)) / n2; - if (c > re) { - if (k < cprev / c) { - k = cprev / c; - } - } else if (cprev > re) { - k = 1; - } - } - next = 2; - if (k > SIGMA[order - 1][4]) { - if (n == 4) { - next = 6; - } - } else { - if (n == 4) { - cprev = c; - } else if (cprev < re) { - cprev = k * c; - } - e = h * cprev * ec[order - 1] * k * k * k; - for (i = 0; k > SIGMA[order - 1][i]; ++i) { - e *= 2; - } - re = h * re; - } - } - - if (next == 2) { - - // EVAL: Evaluate integral and select appropriate error estimate - iint = w1[n] * (fx[0] + fx[n]) + w[n - 3] * fx[n2]; - for (i = 1; i <= n2 - 1; ++i) { - iint += w[n2 + i - 3] * (fx[i] + fx[n - i]); - } - iint *= h; - if (n != 4) { - c = Math.abs(iint - intprev); - if (c > eprev) { - caution = true; - if (xc < xb) { - xc = xb; - } - } else { - caution = false; - } - if (k > SIGMA[order - 1][4] || caution) { - e = c; - } - if (e > c) { - e = c; - } - } - next = 3; - } - - if (next == 3) { - - // TEST: Finish consideration of current subinterval if local error acceptable - if (e < re || e <= k1 * eps) { - next = 4; - } else if (k > SIGMA[order - 1][0]) { - next = 6; - } else { - next = 5; - } - } - - if (next == 4) { - - // UPDATE - if (n != 4 || !(caution || (xa == a && div == 0))) { - if (e < re) { - e = re; - } - error[0] += e; - eps -= e; - if (eps < 0.1 * error[0]) { - eps = 0.1 * error[0]; - } - ans[0] += iint; - if (div == 0) { - success[0] = true; - return; - } - --div; - xa = xb; - xb = xs[div]; - fx[4] = fx[0]; - fx[0] = fs[div]; - next = 0; - } else { - next = 5; - } - } - - if (next == 5) { - - // DOUBLE: Double order of formula - for (i = n; i >= 1; --i) { - fx[i << 1] = fx[i]; - } - n2 = n; - n <<= 1; - m *= 0.5; - ++order; - eprev = e; - intprev = iint; - if (eprev < re) { - eprev = re; - } - if (n > maxrule) { - maxrule = quadrule(t, w, w1, n, n2, m, maxrule); - } - j = 2; - next = 1; - } - - if (next == 6) { - - // SPLIT: Split current subinterval unless simple error estimate acceptable and - // consider left half - e = 2 * h * (fmax - fmin); - if (e < re || e <= k1 * eps) { - iint = h * (fmax + fmin); - next = 4; - } else { - if (h < hmin) { - success[0] = false; - return; - } - xs[div] = xb; - xb = xa + h; - fs[div] = fx[0]; - fx[0] = fx[n2]; - fx[4] = fx[n]; - ++div; - next = 0; - } - } - } + ++fev[0]; + if (fmax < fx[i]) { + fmax = fx[i]; + } else if (fmin > fx[i]) { + fmin = fx[i]; + } + fx[n - i] = f.applyAsDouble(xa + (1 - t[i * m]) * h); + ++fev[0]; + if (fmax < fx[n - i]) { + fmax = fx[n - i]; + } else if (fmin > fx[n - i]) { + fmin = fx[n - i]; + } + if (fev[0] > maxfev) { + success[0] = false; + return; + } + } + re = acc * Math.max(Math.abs(fmax), Math.abs(fmin)); + j = n == 4 ? 4 : 6; + k = 0; + c = Math.abs(cheb(-1, fx, n)) / n; + for (i = 2; i <= j; i += 2) { + if (i <= n2) { + x = -t[i * m]; + } else { + x = t[(n - i) * m]; + } + cprev = c; + c = Math.abs(cheb(x, fx, n)) / n2; + if (c > re) { + if (k < cprev / c) { + k = cprev / c; + } + } else if (cprev > re) { + k = 1; + } + } + next = 2; + if (k > SIGMA[order - 1][4]) { + if (n == 4) { + next = 6; + } + } else { + if (n == 4) { + cprev = c; + } else if (cprev < re) { + cprev = k * c; + } + e = h * cprev * ec[order - 1] * k * k * k; + for (i = 0; k > SIGMA[order - 1][i]; ++i) { + e *= 2; + } + re = h * re; + } + } + + if (next == 2) { + + // EVAL: Evaluate integral and select appropriate error estimate + iint = w1[n] * (fx[0] + fx[n]) + w[n - 3] * fx[n2]; + for (i = 1; i <= n2 - 1; ++i) { + iint += w[n2 + i - 3] * (fx[i] + fx[n - i]); + } + iint *= h; + if (n != 4) { + c = Math.abs(iint - intprev); + if (c > eprev) { + caution = true; + if (xc < xb) { + xc = xb; + } + } else { + caution = false; + } + if (k > SIGMA[order - 1][4] || caution) { + e = c; + } + if (e > c) { + e = c; + } + } + next = 3; + } + + if (next == 3) { + + // TEST: Finish consideration of current subinterval if local error acceptable + if (e < re || e <= k1 * eps) { + next = 4; + } else if (k > SIGMA[order - 1][0]) { + next = 6; + } else { + next = 5; + } + } + + if (next == 4) { + + // UPDATE + if (n != 4 || !(caution || (xa == a && div == 0))) { + if (e < re) { + e = re; + } + error[0] += e; + eps -= e; + if (eps < 0.1 * error[0]) { + eps = 0.1 * error[0]; + } + ans[0] += iint; + if (div == 0) { + success[0] = true; + return; + } + --div; + xa = xb; + xb = xs[div]; + fx[4] = fx[0]; + fx[0] = fs[div]; + next = 0; + } else { + next = 5; + } + } + + if (next == 5) { + + // DOUBLE: Double order of formula + for (i = n; i >= 1; --i) { + fx[i << 1] = fx[i]; + } + n2 = n; + n <<= 1; + m *= 0.5; + ++order; + eprev = e; + intprev = iint; + if (eprev < re) { + eprev = re; + } + if (n > maxrule) { + maxrule = quadrule(t, w, w1, n, n2, m, maxrule); + } + j = 2; + next = 1; + } + + if (next == 6) { + + // SPLIT: Split current subinterval unless simple error estimate acceptable and + // consider left half + e = 2 * h * (fmax - fmin); + if (e < re || e <= k1 * eps) { + iint = h * (fmax + fmin); + next = 4; + } else { + if (h < hmin) { + success[0] = false; + return; + } + xs[div] = xb; + xb = xa + h; + fs[div] = fx[0]; + fx[0] = fx[n2]; + fx[4] = fx[n]; + ++div; + next = 0; + } + } } + } - private static final int quadrule(final double[] t, final double[] w, final double[] w1, final int n, final int n2, - final int m, final int maxrule) { - for (int i = 1; i <= n2 - 1; i += 2) { - t[i * m] = Math.cos((Math.PI * i) / n); - } - for (int i = (maxrule >> 1) + 2; i <= n; i += 2) { - w1[i - 1] = 0; - w1[i] = 1.0 / (i * i - 1); - } - for (int i = 1; i <= n2; ++i) { - w[n2 + i - 3] = -4 * cheb(t[i * m], w1, n) / n; - } - return n; + private static final int quadrule(final double[] t, final double[] w, final double[] w1, + final int n, final int n2, final int m, final int maxrule) { + for (int i = 1; i <= n2 - 1; i += 2) { + t[i * m] = Math.cos((Math.PI * i) / n); } - - private static final double cheb(final double x, final double[] a, final int n) { - double b1 = 0.0; - double b0 = 0.5 * a[n]; - final double twox = 2.0 * x; - for (int r = n - 1; r >= 1; --r) { - final double b2 = b1; - b1 = b0; - b0 = twox * b1 - b2 + a[r]; - } - return x * b0 - b1 + 0.5 * a[0]; + for (int i = (maxrule >> 1) + 2; i <= n; i += 2) { + w1[i - 1] = 0; + w1[i] = 1.0 / (i * i - 1); + } + for (int i = 1; i <= n2; ++i) { + w[n2 + i - 3] = -4 * cheb(t[i * m], w1, n) / n; + } + return n; + } + + private static final double cheb(final double x, final double[] a, final int n) { + double b1 = 0.0; + double b0 = 0.5 * a[n]; + final double twox = 2.0 * x; + for (int r = n - 1; r >= 1; --r) { + final double b2 = b1; + b1 = b0; + b0 = twox * b1 - b2 + a[r]; } + return x * b0 - b1 + 0.5 * a[0]; + } } diff --git a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/GaussKronrod.java b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/GaussKronrod.java index 98d96ecc7..10534b669 100644 --- a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/GaussKronrod.java +++ b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/GaussKronrod.java @@ -5,1191 +5,1196 @@ import org.matheclipse.core.numerics.utils.SimpleMath; /** - * Integrate a real function of one variable using a globally adaptive - * Gauss-Kronrod quadrature rule. This algorithm is a translation of subroutines - * from the QUADPACK library and well-documented in [1]. + * Integrate a real function of one variable using a globally adaptive Gauss-Kronrod quadrature + * rule. This algorithm is a translation of subroutines from the QUADPACK library and + * well-documented in [1]. * *

* References: *

*

*/ public final class GaussKronrod extends Quadrature { - private static final double EPMACH = SimpleMath.D1MACH[4 - 1]; - private static final double UFLOW = SimpleMath.D1MACH[1 - 1]; - private static final double OFLOW = SimpleMath.D1MACH[2 - 1]; - - private static final double[] WG21 = { // - 0.066671344308688137593568809893332, 0.149451349150580593145776339657697, - 0.219086362515982043995534934228163, 0.269266719309996355091226921569469, - 0.295524224714752870173892994651338 }; - private static final double[] XGK21 = { // - 0.995657163025808080735527280689003, 0.973906528517171720077964012084452, - 0.930157491355708226001207180059508, 0.865063366688984510732096688423493, - 0.780817726586416897063717578345042, 0.679409568299024406234327365114874, - 0.562757134668604683339000099272694, 0.433395394129247190799265943165784, - 0.294392862701460198131126603103866, 0.148874338981631210884826001129720, - 0.000000000000000000000000000000000 }; - private static final double[] WGK21 = { // - 0.011694638867371874278064396062192, 0.032558162307964727478818972459390, - 0.054755896574351996031381300244580, 0.075039674810919952767043140916190, - 0.093125454583697605535065465083366, 0.109387158802297641899210590325805, - 0.123491976262065851077958109831074, 0.134709217311473325928054001771707, - 0.142775938577060080797094273138717, 0.147739104901338491374841515972068, - 0.149445554002916905664936468389821 }; - - private static final double[] WG15I = { // - 0.0000000000000000, 0.1294849661688697, 0.0000000000000000, // - 0.2797053914892767, 0.0000000000000000, 0.3818300505051189, // - 0.0000000000000000, 0.4179591836734694 }; - private static final double[] XGK15I = { // - 0.9914553711208126, 0.9491079123427585, 0.8648644233597691, // - 0.7415311855993944, 0.5860872354676911, 0.4058451513773972, // - 0.2077849550078985, 0.0000000000000000 }; - private static final double[] WGK15I = { // - 0.02293532201052922, 0.06309209262997855, 0.1047900103222502, // - 0.1406532597155259, 0.1690047266392679, 0.1903505780647854, // - 0.2044329400752989, 0.2094821410847278 }; - - private final double myRelTol; - - /** - * Creates a new instance of the Gauss-Kronrod quadrature integrator. - * - * @param relativeTolerance the smallest acceptable relative change in integral - * estimates in consecutive iterations that indicates - * the algorithm has converged - * @param tolerance the smallest acceptable absolute change in integral - * estimates in consecutive iterations that indicates - * the algorithm has converged - * @param maxEvaluations the maximum number of evaluations of each function - * permitted - */ - public GaussKronrod(final double tolerance, final double relativeTolerance, final int maxEvaluations) { - super(tolerance, maxEvaluations); - myRelTol = relativeTolerance; + private static final double EPMACH = SimpleMath.D1MACH[4 - 1]; + private static final double UFLOW = SimpleMath.D1MACH[1 - 1]; + private static final double OFLOW = SimpleMath.D1MACH[2 - 1]; + + private static final double[] WG21 = { // + 0.066671344308688137593568809893332, 0.149451349150580593145776339657697, + 0.219086362515982043995534934228163, 0.269266719309996355091226921569469, + 0.295524224714752870173892994651338}; + private static final double[] XGK21 = { // + 0.995657163025808080735527280689003, 0.973906528517171720077964012084452, + 0.930157491355708226001207180059508, 0.865063366688984510732096688423493, + 0.780817726586416897063717578345042, 0.679409568299024406234327365114874, + 0.562757134668604683339000099272694, 0.433395394129247190799265943165784, + 0.294392862701460198131126603103866, 0.148874338981631210884826001129720, + 0.000000000000000000000000000000000}; + private static final double[] WGK21 = { // + 0.011694638867371874278064396062192, 0.032558162307964727478818972459390, + 0.054755896574351996031381300244580, 0.075039674810919952767043140916190, + 0.093125454583697605535065465083366, 0.109387158802297641899210590325805, + 0.123491976262065851077958109831074, 0.134709217311473325928054001771707, + 0.142775938577060080797094273138717, 0.147739104901338491374841515972068, + 0.149445554002916905664936468389821}; + + private static final double[] WG15I = { // + 0.0000000000000000, 0.1294849661688697, 0.0000000000000000, // + 0.2797053914892767, 0.0000000000000000, 0.3818300505051189, // + 0.0000000000000000, 0.4179591836734694}; + private static final double[] XGK15I = { // + 0.9914553711208126, 0.9491079123427585, 0.8648644233597691, // + 0.7415311855993944, 0.5860872354676911, 0.4058451513773972, // + 0.2077849550078985, 0.0000000000000000}; + private static final double[] WGK15I = { // + 0.02293532201052922, 0.06309209262997855, 0.1047900103222502, // + 0.1406532597155259, 0.1690047266392679, 0.1903505780647854, // + 0.2044329400752989, 0.2094821410847278}; + + private final double myRelTol; + + /** + * Creates a new instance of the Gauss-Kronrod quadrature integrator. + * + * @param relativeTolerance the smallest acceptable relative change in integral estimates in + * consecutive iterations that indicates the algorithm has converged + * @param tolerance the smallest acceptable absolute change in integral estimates in consecutive + * iterations that indicates the algorithm has converged + * @param maxEvaluations the maximum number of evaluations of each function permitted + */ + public GaussKronrod(final double tolerance, final double relativeTolerance, + final int maxEvaluations) { + super(tolerance, maxEvaluations); + myRelTol = relativeTolerance; + } + + public GaussKronrod(final double tolerance, final int maxEvaluations) { + this(tolerance, 50.0 * Constants.EPSILON, maxEvaluations); + } + + @Override + protected final QuadratureResult properIntegral(final DoubleUnaryOperator f, final double a, + final double b) { + + // prepare variables + final double[] result = new double[1]; + final double[] abserr = new double[1]; + final int[] neval = new int[1]; + final int[] ier = new int[1]; + + // call main subroutine + dqags(f, a, b, myTol, myRelTol, result, abserr, neval, ier, myMaxEvals); + return new QuadratureResult(result[0], abserr[0], neval[0], ier[0] == 0); + } + + @Override + public final QuadratureResult integrate(DoubleUnaryOperator f, final double a, final double b) { + + // null integral + if (a == b) { + return new QuadratureResult(0.0, 0.0, 0, true); } - public GaussKronrod(final double tolerance, final int maxEvaluations) { - this(tolerance, 50.0 * Constants.EPSILON, maxEvaluations); + // make sure a < b + if (a > b) { + return integrate(f, b, a); } - @Override - protected final QuadratureResult properIntegral(final DoubleUnaryOperator f, final double a, - final double b) { + // both are finite + if (Double.isFinite(a) && Double.isFinite(b)) { + return properIntegral(f, a, b); + } - // prepare variables - final double[] result = new double[1]; - final double[] abserr = new double[1]; - final int[] neval = new int[1]; - final int[] ier = new int[1]; + // infinite bounds case + final double[] result = new double[1], abserr = new double[1]; + final int[] neval = new int[1], ier = new int[1]; + final int inf; + final double bound; + if (Double.isInfinite(a) && Double.isInfinite(b)) { + inf = 2; + bound = 0.0; + } else if (Double.isFinite(a)) { + inf = 1; + bound = a; + } else { + inf = -1; + bound = b; + } - // call main subroutine - dqags(f, a, b, myTol, myRelTol, result, abserr, neval, ier, myMaxEvals); - return new QuadratureResult(result[0], abserr[0], neval[0], ier[0] == 0); + // call main subroutine + dqagi1(f, bound, inf, myTol, myRelTol, result, abserr, neval, ier, myMaxEvals); + return new QuadratureResult(result[0], abserr[0], neval[0], ier[0] == 0); + } + + @Override + public final String getName() { + return "Gauss-Kronrod"; + } + + // ******************************************************************************* + // FINITE BOUNDS INTEGRATION (DQAGS) + // ******************************************************************************* + private static final void dqags(final DoubleUnaryOperator f, final double a, final double b, + final double epsabs, final double epsrel, final double[] result, final double[] abserr, + final int[] neval, final int[] ier, final int limit) { + final int[] last = new int[1]; + + // CHECK VALIDITY OF LIMIT AND LENW + ier[0] = 6; + neval[0] = last[0] = 0; + result[0] = abserr[0] = 0.0; + if (limit < 1) { + return; } - @Override - public final QuadratureResult integrate(DoubleUnaryOperator f, final double a, final double b) { - - // null integral - if (a == b) { - return new QuadratureResult(0.0, 0.0, 0, true); - } - - // make sure a < b - if (a > b) { - return integrate(f, b, a); - } - - // both are finite - if (Double.isFinite(a) && Double.isFinite(b)) { - return properIntegral(f, a, b); - } - - // infinite bounds case - final double[] result = new double[1], abserr = new double[1]; - final int[] neval = new int[1], ier = new int[1]; - final int inf; - final double bound; - if (Double.isInfinite(a) && Double.isInfinite(b)) { - inf = 2; - bound = 0.0; - } else if (Double.isFinite(a)) { - inf = 1; - bound = a; - } else { - inf = -1; - bound = b; - } - - // call main subroutine - dqagi1(f, bound, inf, myTol, myRelTol, result, abserr, neval, ier, myMaxEvals); - return new QuadratureResult(result[0], abserr[0], neval[0], ier[0] == 0); + // PREPARE CALL FOR DQAGSE + final double[] alist = new double[limit], blist = new double[limit], rlist = new double[limit], + elist = new double[limit]; + final int[] iwork = new int[limit]; + dqagse(f, a, b, epsabs, epsrel, limit, result, abserr, neval, ier, alist, blist, rlist, elist, + iwork, last); + } + + private static final void dqagse(final DoubleUnaryOperator f, final double a, final double b, + final double epsabs, final double epsrel, final int limit, final double[] result, + final double[] abserr, final int[] neval, final int[] ier, final double[] alist, + final double[] blist, final double[] rlist, final double[] elist, final int[] iord, + final int[] last) { + double area, area12, a1, a2, b1, b2, correc = 0.0, dres, epmach, erlarg = 0.0, erlast, errbnd, + erro12, errsum, ertest = 0.0, oflow, small = 0.0, uflow; + int id, ierro, iroff1, iroff2, iroff3, jupbnd, k, ksgn, ktmin; + boolean extrap, noext; + final double[] res3la = new double[3]; + final double[] rlist2 = new double[52]; + final double[] abseps = new double[1], area1 = new double[1], area2 = new double[1], + defabs = new double[1], defab1 = new double[1], defab2 = new double[1], + errmax = new double[1], error1 = new double[1], error2 = new double[1], + resabs = new double[1], reseps = new double[1]; + final int[] maxerr = new int[1], nrmax = new int[1], numrl2 = new int[1], nres = new int[1]; + + epmach = EPMACH; + + // TEST ON VALIDITY OF PARAMETERS + ier[0] = neval[0] = last[0] = 0; + result[0] = abserr[0] = 0.0; + alist[1 - 1] = a; + blist[1 - 1] = b; + rlist[1 - 1] = elist[1 - 1] = 0.0; + if (epsabs <= 0.0 && epsrel < Math.max(50.0 * epmach, 0.5e-28)) { + ier[0] = 6; + return; } - @Override - public final String getName() { - return "Gauss-Kronrod"; + // FIRST APPROXIMATION TO THE INTEGRAL + uflow = UFLOW; + oflow = OFLOW; + ierro = 0; + dqk21(f, a, b, result, abserr, defabs, resabs); + + // TEST ON ACCURACY + dres = Math.abs(result[0]); + errbnd = Math.max(epsabs, epsrel * dres); + last[0] = 1; + rlist[1 - 1] = result[0]; + elist[1 - 1] = abserr[0]; + iord[1 - 1] = 1; + if (abserr[0] <= 100.0 * epmach * defabs[0] && abserr[0] > errbnd) { + ier[0] = 2; + } + if (limit == 1) { + ier[0] = 1; + } + if (ier[0] != 0 || (abserr[0] <= errbnd && abserr[0] != resabs[0]) || abserr[0] == 0.0) { + neval[0] = 42 * last[0] - 21; + return; } - // ******************************************************************************* - // FINITE BOUNDS INTEGRATION (DQAGS) - // ******************************************************************************* - private static final void dqags(final DoubleUnaryOperator f, final double a, final double b, - final double epsabs, final double epsrel, final double[] result, final double[] abserr, final int[] neval, - final int[] ier, final int limit) { - final int[] last = new int[1]; - - // CHECK VALIDITY OF LIMIT AND LENW - ier[0] = 6; - neval[0] = last[0] = 0; - result[0] = abserr[0] = 0.0; - if (limit < 1) { - return; - } - - // PREPARE CALL FOR DQAGSE - final double[] alist = new double[limit], blist = new double[limit], rlist = new double[limit], - elist = new double[limit]; - final int[] iwork = new int[limit]; - dqagse(f, a, b, epsabs, epsrel, limit, result, abserr, neval, ier, alist, blist, rlist, elist, iwork, last); + // INITIALIZATION + rlist2[1 - 1] = result[0]; + errmax[0] = abserr[0]; + maxerr[0] = 1; + area = result[0]; + errsum = abserr[0]; + abserr[0] = oflow; + nrmax[0] = 1; + nres[0] = 0; + numrl2[0] = 2; + ktmin = 0; + extrap = noext = false; + iroff1 = iroff2 = iroff3 = 0; + ksgn = -1; + if (dres >= (1.0 - 50.0 * epmach) * defabs[0]) { + ksgn = 1; } - private static final void dqagse(final DoubleUnaryOperator f, final double a, final double b, - final double epsabs, final double epsrel, final int limit, final double[] result, final double[] abserr, - final int[] neval, final int[] ier, final double[] alist, final double[] blist, final double[] rlist, - final double[] elist, final int[] iord, final int[] last) { - double area, area12, a1, a2, b1, b2, correc = 0.0, dres, epmach, erlarg = 0.0, erlast, errbnd, erro12, errsum, - ertest = 0.0, oflow, small = 0.0, uflow; - int id, ierro, iroff1, iroff2, iroff3, jupbnd, k, ksgn, ktmin; - boolean extrap, noext; - final double[] res3la = new double[3]; - final double[] rlist2 = new double[52]; - final double[] abseps = new double[1], area1 = new double[1], area2 = new double[1], defabs = new double[1], - defab1 = new double[1], defab2 = new double[1], errmax = new double[1], error1 = new double[1], - error2 = new double[1], resabs = new double[1], reseps = new double[1]; - final int[] maxerr = new int[1], nrmax = new int[1], numrl2 = new int[1], nres = new int[1]; - - epmach = EPMACH; - - // TEST ON VALIDITY OF PARAMETERS - ier[0] = neval[0] = last[0] = 0; - result[0] = abserr[0] = 0.0; - alist[1 - 1] = a; - blist[1 - 1] = b; - rlist[1 - 1] = elist[1 - 1] = 0.0; - if (epsabs <= 0.0 && epsrel < Math.max(50.0 * epmach, 0.5e-28)) { - ier[0] = 6; - return; - } - - // FIRST APPROXIMATION TO THE INTEGRAL - uflow = UFLOW; - oflow = OFLOW; - ierro = 0; - dqk21(f, a, b, result, abserr, defabs, resabs); - - // TEST ON ACCURACY - dres = Math.abs(result[0]); - errbnd = Math.max(epsabs, epsrel * dres); - last[0] = 1; - rlist[1 - 1] = result[0]; - elist[1 - 1] = abserr[0]; - iord[1 - 1] = 1; - if (abserr[0] <= 100.0 * epmach * defabs[0] && abserr[0] > errbnd) { - ier[0] = 2; - } - if (limit == 1) { - ier[0] = 1; - } - if (ier[0] != 0 || (abserr[0] <= errbnd && abserr[0] != resabs[0]) || abserr[0] == 0.0) { - neval[0] = 42 * last[0] - 21; - return; - } - - // INITIALIZATION - rlist2[1 - 1] = result[0]; - errmax[0] = abserr[0]; - maxerr[0] = 1; - area = result[0]; - errsum = abserr[0]; - abserr[0] = oflow; - nrmax[0] = 1; - nres[0] = 0; - numrl2[0] = 2; - ktmin = 0; - extrap = noext = false; - iroff1 = iroff2 = iroff3 = 0; - ksgn = -1; - if (dres >= (1.0 - 50.0 * epmach) * defabs[0]) { - ksgn = 1; - } - - // MAIN DO-LOOP - for (last[0] = 2; last[0] <= limit; ++last[0]) { - - // BISECT THE SUBINTERVAL WITH THE NRMAX-TH LARGEST ERROR ESTIMATE - a1 = alist[maxerr[0] - 1]; - b1 = 0.5 * (alist[maxerr[0] - 1] + blist[maxerr[0] - 1]); - a2 = b1; - b2 = blist[maxerr[0] - 1]; - erlast = errmax[0]; - dqk21(f, a1, b1, area1, error1, resabs, defab1); - dqk21(f, a2, b2, area2, error2, resabs, defab2); - - // IMPROVE PREVIOUS APPROXIMATIONS TO INTEGRAL AND ERROR AND TEST FOR ACCURACY - area12 = area1[0] + area2[0]; - erro12 = error1[0] + error2[0]; - errsum += erro12 - errmax[0]; - area += area12 - rlist[maxerr[0] - 1]; - if (defab1[0] != error1[0] && defab2[0] != error2[0]) { - final double reltol = 1e-5 * Math.abs(area12); - if (Math.abs(rlist[maxerr[0] - 1] - area12) <= reltol && erro12 >= 0.99 * errmax[0]) { - if (extrap) { - ++iroff2; - } else { - ++iroff1; - } - } - if (last[0] > 10 && erro12 > errmax[0]) { - ++iroff3; - } - } - rlist[maxerr[0] - 1] = area1[0]; - rlist[last[0] - 1] = area2[0]; - errbnd = Math.max(epsabs, epsrel * Math.abs(area)); - - // TEST FOR ROUNDOFF ERROR AND EVENTUALLY SET ERROR FLAG - if (iroff1 + iroff2 >= 10 || iroff3 >= 20) { - ier[0] = 2; - } - if (iroff2 >= 5) { - ierro = 3; - } - - // SET ERROR FLAG IN THE CASE THAT THE NUMBER OF SUBINTERVALS EQUALS LIMIT - if (last[0] == limit) { - ier[0] = 1; - } - - // SET ERROR FLAG IN THE CASE OF BAD INTEGRAND BEHAVIOUR - // AT A POINT OF THE INTEGRATION RANGE - if (Math.max(Math.abs(a1), Math.abs(b2)) <= (1.0 + 100.0 * epmach) * (Math.abs(a2) + 1000.0 * uflow)) { - ier[0] = 4; - } - - // APPEND THE NEWLY-CREATED INTERVALS TO THE LIST - if (error2[0] > error1[0]) { - alist[maxerr[0] - 1] = a2; - alist[last[0] - 1] = a1; - blist[last[0] - 1] = b1; - rlist[maxerr[0] - 1] = area2[0]; - rlist[last[0] - 1] = area1[0]; - elist[maxerr[0] - 1] = error2[0]; - elist[last[0] - 1] = error1[0]; - } else { - alist[last[0] - 1] = a2; - blist[maxerr[0] - 1] = b1; - blist[last[0] - 1] = b2; - elist[maxerr[0] - 1] = error1[0]; - elist[last[0] - 1] = error2[0]; - } - - // CALL SUBROUTINE DQPSRT TO MAINTAIN THE DESCENDING ORDERING - // IN THE LIST OF ERROR ESTIMATES AND SELECT THE SUBINTERVAL - // WITH NRMAX-TH LARGEST ERROR ESTIMATE (TO BE BISECTED NEXT) - dqpsrt(limit, last[0], maxerr, errmax, elist, iord, nrmax); - if (errsum <= errbnd) { - - // COMPUTE GLOBAL INTEGRAL SUM - result[0] = 0.0; - for (k = 1; k <= last[0]; ++k) { - result[0] += rlist[k - 1]; - } - abserr[0] = errsum; - if (ier[0] > 2) { - --ier[0]; - } - neval[0] = 42 * last[0] - 21; - return; - } - if (ier[0] != 0) { - break; - } - if (last[0] == 2) { - small = Math.abs(b - a) * 0.375; - erlarg = errsum; - ertest = errbnd; - rlist2[2 - 1] = area; - continue; - } - if (noext) { - continue; - } - erlarg -= erlast; - if (Math.abs(b1 - a1) > small) { - erlarg += erro12; - } - if (!extrap) { - - // TEST WHETHER THE INTERVAL TO BE BISECTED NEXT IS THE SMALLEST INTERVAL - if (Math.abs(blist[maxerr[0] - 1] - alist[maxerr[0] - 1]) > small) { - continue; - } - extrap = true; - nrmax[0] = 2; - } - - if (ierro != 3 && erlarg > ertest) { - - // THE SMALLEST INTERVAL HAS THE LARGEST ERROR. - // BEFORE BISECTING DECREASE THE SUM OF THE ERRORS OVER THE - // LARGER INTERVALS (ERLARG) AND PERFORM EXTRAPOLATION - id = nrmax[0]; - jupbnd = last[0]; - if (last[0] > 2 + (limit >> 1)) { - jupbnd = limit + 3 - last[0]; - } - boolean skipto90 = false; - for (k = id; k <= jupbnd; ++k) { - maxerr[0] = iord[nrmax[0] - 1]; - errmax[0] = elist[maxerr[0] - 1]; - if (Math.abs(blist[maxerr[0] - 1] - alist[maxerr[0] - 1]) > small) { - skipto90 = true; - break; - } - ++nrmax[0]; - } - if (skipto90) { - continue; - } - } - - // PERFORM EXTRAPOLATION - ++numrl2[0]; - rlist2[numrl2[0] - 1] = area; - dqelg(numrl2, rlist2, reseps, abseps, res3la, nres); - ++ktmin; - if (ktmin > 5 && abserr[0] < 1e-3 * errsum) { - ier[0] = 5; - } - if (abseps[0] < abserr[0]) { - ktmin = 0; - abserr[0] = abseps[0]; - result[0] = reseps[0]; - correc = erlarg; - ertest = Math.max(epsabs, epsrel * Math.abs(reseps[0])); - if (abserr[0] <= ertest) { - break; - } - } - - // PREPARE BISECTION OF THE SMALLEST INTERVAL - if (numrl2[0] == 1) { - noext = true; - } - if (ier[0] == 5) { - break; - } - maxerr[0] = iord[1 - 1]; - errmax[0] = elist[maxerr[0] - 1]; - nrmax[0] = 1; - extrap = false; - small *= 0.5; - erlarg = errsum; - } - - // SET FINAL RESULT AND ERROR ESTIMATE - if (abserr[0] == oflow) { - - // COMPUTE GLOBAL INTEGRAL SUM - result[0] = 0.0; - for (k = 1; k <= last[0]; ++k) { - result[0] += rlist[k - 1]; - } - abserr[0] = errsum; - if (ier[0] > 2) { - --ier[0]; - } - neval[0] = 42 * last[0] - 21; - return; - } - - if (ier[0] + ierro != 0) { - if (ierro == 3) { - abserr[0] += correc; - } - if (ier[0] == 0) { - ier[0] = 3; - } - if (result[0] != 0.0 && area != 0.0) { - if (abserr[0] / Math.abs(result[0]) > errsum / Math.abs(area)) { - - // COMPUTE GLOBAL INTEGRAL SUM - result[0] = 0.0; - for (k = 1; k <= last[0]; ++k) { - result[0] += rlist[k - 1]; - } - abserr[0] = errsum; - if (ier[0] > 2) { - --ier[0]; - } - neval[0] = 42 * last[0] - 21; - return; - } - } else { - if (abserr[0] > errsum) { - - // COMPUTE GLOBAL INTEGRAL SUM - result[0] = 0.0; - for (k = 1; k <= last[0]; ++k) { - result[0] += rlist[k - 1]; - } - abserr[0] = errsum; - if (ier[0] > 2) { - --ier[0]; - } - neval[0] = 42 * last[0] - 21; - return; - } - if (area == 0.0) { - if (ier[0] > 2) { - --ier[0]; - } - neval[0] = 42 * last[0] - 21; - return; - } - } - } - - // TEST ON DIVERGENCE - if (ksgn == -1 && Math.max(Math.abs(result[0]), Math.abs(area)) <= defabs[0] * 0.01) { - if (ier[0] > 2) { - --ier[0]; - } - neval[0] = 42 * last[0] - 21; - return; - } - if (0.01 > (result[0] / area) || (result[0] / area) > 100.0 || errsum > Math.abs(area)) { - ier[0] = 6; - } - if (ier[0] > 2) { - --ier[0]; - } - neval[0] = 42 * last[0] - 21; + // MAIN DO-LOOP + for (last[0] = 2; last[0] <= limit; ++last[0]) { + + // BISECT THE SUBINTERVAL WITH THE NRMAX-TH LARGEST ERROR ESTIMATE + a1 = alist[maxerr[0] - 1]; + b1 = 0.5 * (alist[maxerr[0] - 1] + blist[maxerr[0] - 1]); + a2 = b1; + b2 = blist[maxerr[0] - 1]; + erlast = errmax[0]; + dqk21(f, a1, b1, area1, error1, resabs, defab1); + dqk21(f, a2, b2, area2, error2, resabs, defab2); + + // IMPROVE PREVIOUS APPROXIMATIONS TO INTEGRAL AND ERROR AND TEST FOR ACCURACY + area12 = area1[0] + area2[0]; + erro12 = error1[0] + error2[0]; + errsum += erro12 - errmax[0]; + area += area12 - rlist[maxerr[0] - 1]; + if (defab1[0] != error1[0] && defab2[0] != error2[0]) { + final double reltol = 1e-5 * Math.abs(area12); + if (Math.abs(rlist[maxerr[0] - 1] - area12) <= reltol && erro12 >= 0.99 * errmax[0]) { + if (extrap) { + ++iroff2; + } else { + ++iroff1; + } + } + if (last[0] > 10 && erro12 > errmax[0]) { + ++iroff3; + } + } + rlist[maxerr[0] - 1] = area1[0]; + rlist[last[0] - 1] = area2[0]; + errbnd = Math.max(epsabs, epsrel * Math.abs(area)); + + // TEST FOR ROUNDOFF ERROR AND EVENTUALLY SET ERROR FLAG + if (iroff1 + iroff2 >= 10 || iroff3 >= 20) { + ier[0] = 2; + } + if (iroff2 >= 5) { + ierro = 3; + } + + // SET ERROR FLAG IN THE CASE THAT THE NUMBER OF SUBINTERVALS EQUALS LIMIT + if (last[0] == limit) { + ier[0] = 1; + } + + // SET ERROR FLAG IN THE CASE OF BAD INTEGRAND BEHAVIOUR + // AT A POINT OF THE INTEGRATION RANGE + if (Math.max(Math.abs(a1), Math.abs(b2)) <= (1.0 + 100.0 * epmach) + * (Math.abs(a2) + 1000.0 * uflow)) { + ier[0] = 4; + } + + // APPEND THE NEWLY-CREATED INTERVALS TO THE LIST + if (error2[0] > error1[0]) { + alist[maxerr[0] - 1] = a2; + alist[last[0] - 1] = a1; + blist[last[0] - 1] = b1; + rlist[maxerr[0] - 1] = area2[0]; + rlist[last[0] - 1] = area1[0]; + elist[maxerr[0] - 1] = error2[0]; + elist[last[0] - 1] = error1[0]; + } else { + alist[last[0] - 1] = a2; + blist[maxerr[0] - 1] = b1; + blist[last[0] - 1] = b2; + elist[maxerr[0] - 1] = error1[0]; + elist[last[0] - 1] = error2[0]; + } + + // CALL SUBROUTINE DQPSRT TO MAINTAIN THE DESCENDING ORDERING + // IN THE LIST OF ERROR ESTIMATES AND SELECT THE SUBINTERVAL + // WITH NRMAX-TH LARGEST ERROR ESTIMATE (TO BE BISECTED NEXT) + dqpsrt(limit, last[0], maxerr, errmax, elist, iord, nrmax); + if (errsum <= errbnd) { + + // COMPUTE GLOBAL INTEGRAL SUM + result[0] = 0.0; + for (k = 1; k <= last[0]; ++k) { + result[0] += rlist[k - 1]; + } + abserr[0] = errsum; + if (ier[0] > 2) { + --ier[0]; + } + neval[0] = 42 * last[0] - 21; + return; + } + if (ier[0] != 0) { + break; + } + if (last[0] == 2) { + small = Math.abs(b - a) * 0.375; + erlarg = errsum; + ertest = errbnd; + rlist2[2 - 1] = area; + continue; + } + if (noext) { + continue; + } + erlarg -= erlast; + if (Math.abs(b1 - a1) > small) { + erlarg += erro12; + } + if (!extrap) { + + // TEST WHETHER THE INTERVAL TO BE BISECTED NEXT IS THE SMALLEST INTERVAL + if (Math.abs(blist[maxerr[0] - 1] - alist[maxerr[0] - 1]) > small) { + continue; + } + extrap = true; + nrmax[0] = 2; + } + + if (ierro != 3 && erlarg > ertest) { + + // THE SMALLEST INTERVAL HAS THE LARGEST ERROR. + // BEFORE BISECTING DECREASE THE SUM OF THE ERRORS OVER THE + // LARGER INTERVALS (ERLARG) AND PERFORM EXTRAPOLATION + id = nrmax[0]; + jupbnd = last[0]; + if (last[0] > 2 + (limit >> 1)) { + jupbnd = limit + 3 - last[0]; + } + boolean skipto90 = false; + for (k = id; k <= jupbnd; ++k) { + maxerr[0] = iord[nrmax[0] - 1]; + errmax[0] = elist[maxerr[0] - 1]; + if (Math.abs(blist[maxerr[0] - 1] - alist[maxerr[0] - 1]) > small) { + skipto90 = true; + break; + } + ++nrmax[0]; + } + if (skipto90) { + continue; + } + } + + // PERFORM EXTRAPOLATION + ++numrl2[0]; + rlist2[numrl2[0] - 1] = area; + dqelg(numrl2, rlist2, reseps, abseps, res3la, nres); + ++ktmin; + if (ktmin > 5 && abserr[0] < 1e-3 * errsum) { + ier[0] = 5; + } + if (abseps[0] < abserr[0]) { + ktmin = 0; + abserr[0] = abseps[0]; + result[0] = reseps[0]; + correc = erlarg; + ertest = Math.max(epsabs, epsrel * Math.abs(reseps[0])); + if (abserr[0] <= ertest) { + break; + } + } + + // PREPARE BISECTION OF THE SMALLEST INTERVAL + if (numrl2[0] == 1) { + noext = true; + } + if (ier[0] == 5) { + break; + } + maxerr[0] = iord[1 - 1]; + errmax[0] = elist[maxerr[0] - 1]; + nrmax[0] = 1; + extrap = false; + small *= 0.5; + erlarg = errsum; } - private static final void dqelg(final int[] n, final double[] epstab, final double[] result, final double[] abserr, - final double[] res3la, final int[] nres) { - double delta1, delta2, delta3, epsinf, error, err1, err2, err3, e0, e1, e1abs, e2, e3, res, ss, tol1, tol2, - tol3; - int i, ib, ib2, ie, indx, k1, k2, k3, limexp, newelm, num; - - ++nres[0]; - abserr[0] = OFLOW; - result[0] = epstab[n[0] - 1]; - if (n[0] < 3) { - abserr[0] = Math.max(abserr[0], 5.0 * EPMACH * Math.abs(result[0])); - return; - } - - limexp = 50; - epstab[n[0] + 2 - 1] = epstab[n[0] - 1]; - newelm = (n[0] - 1) >> 1; - epstab[n[0] - 1] = OFLOW; - num = k1 = n[0]; - for (i = 1; i <= newelm; ++i) { - k2 = k1 - 1; - k3 = k1 - 2; - res = epstab[k1 + 2 - 1]; - e0 = epstab[k3 - 1]; - e1 = epstab[k2 - 1]; - e2 = res; - e1abs = Math.abs(e1); - delta2 = e2 - e1; - err2 = Math.abs(delta2); - tol2 = Math.max(Math.abs(e2), e1abs) * EPMACH; - delta3 = e1 - e0; - err3 = Math.abs(delta3); - tol3 = Math.max(e1abs, Math.abs(e0)) * EPMACH; - if (err2 <= tol2 && err3 <= tol3) { - - // if e0, e1 and e2 are equal to within machine accuracy, convergence is - // assumed. - result[0] = res; - abserr[0] = err2 + err3; - abserr[0] = Math.max(abserr[0], 5.0 * EPMACH * Math.abs(result[0])); - return; - } - - e3 = epstab[k1 - 1]; - epstab[k1 - 1] = e1; - delta1 = e1 - e3; - err1 = Math.abs(delta1); - tol1 = Math.max(e1abs, Math.abs(e3)) * EPMACH; - - // if two elements are very close to each other, omit a part of the table by - // adjusting the value of n - if (err1 <= tol1 || err2 <= tol2 || err3 <= tol3) { - n[0] = i + i - 1; - break; - } - ss = 1.0 / delta1 + 1.0 / delta2 - 1.0 / delta3; - epsinf = Math.abs(ss * e1); - - // test to detect irregular behaviour in the table, and eventually omit a part - // of the table adjusting the value of n - if (epsinf <= 0.1E-3) { - n[0] = i + i - 1; - break; - } - - // compute a new element and eventually adjust the value of result. - res = e1 + 1.0 / ss; - epstab[k1 - 1] = res; - k1 -= 2; - error = err2 + Math.abs(res - e2) + err3; - if (error <= abserr[0]) { - abserr[0] = error; - result[0] = res; - } - } - - // shift the table. - if (n[0] == limexp) { - n[0] = ((limexp >> 1) << 1) - 1; - } - ib = 1; - if (((num >> 1) << 1) == num) { - ib = 2; - } - ie = newelm + 1; - for (i = 1; i <= ie; ++i) { - ib2 = ib + 2; - epstab[ib - 1] = epstab[ib2 - 1]; - ib = ib2; - } - if (num != n[0]) { - indx = num - n[0] + 1; - for (i = 1; i <= n[0]; ++i) { - epstab[i - 1] = epstab[indx - 1]; - ++indx; - } - } - - if (nres[0] >= 4) { - - // compute error estimate - abserr[0] = Math.abs(result[0] - res3la[3 - 1]) + Math.abs(result[0] - res3la[2 - 1]) - + Math.abs(result[0] - res3la[1 - 1]); - res3la[1 - 1] = res3la[2 - 1]; - res3la[2 - 1] = res3la[3 - 1]; - res3la[3 - 1] = result[0]; - } else { - res3la[nres[0] - 1] = result[0]; - abserr[0] = OFLOW; - } - abserr[0] = Math.max(abserr[0], 5.0 * EPMACH * Math.abs(result[0])); + // SET FINAL RESULT AND ERROR ESTIMATE + if (abserr[0] == oflow) { + + // COMPUTE GLOBAL INTEGRAL SUM + result[0] = 0.0; + for (k = 1; k <= last[0]; ++k) { + result[0] += rlist[k - 1]; + } + abserr[0] = errsum; + if (ier[0] > 2) { + --ier[0]; + } + neval[0] = 42 * last[0] - 21; + return; } - private static final void dqpsrt(final int limit, final int last, final int[] maxerr, final double[] ermax, - final double[] elist, final int[] iord, final int[] nrmax) { - double errmax, errmin; - int i, ibeg, ido, isucc, j, jbnd, jupbn, k; - - if (last <= 2) { - iord[1 - 1] = 1; - iord[2 - 1] = 2; - - // set maxerr and ermax. - maxerr[0] = iord[nrmax[0] - 1]; - ermax[0] = elist[maxerr[0] - 1]; - return; - } - - // this part of the routine is only executed if, due to a - // difficult integrand, subdivision increased the error - // estimate. in the normal case the insert procedure should - // start after the nrmax-th largest error estimate. - errmax = elist[maxerr[0] - 1]; - if (nrmax[0] != 1) { - ido = nrmax[0] - 1; - for (i = 1; i <= ido; ++i) { - isucc = iord[nrmax[0] - 1]; - if (errmax <= elist[isucc - 1]) { - break; - } - iord[nrmax[0] - 1] = isucc; - --nrmax[0]; - } - } - - // compute the number of elements in the list to be maintained - // in descending order. this number depends on the number of - // subdivisions still allowed. - jupbn = last; - if (last > ((limit >> 1) + 2)) { - jupbn = limit + 3 - last; - } - errmin = elist[last - 1]; - - // insert errmax by traversing the list top-down, - // starting comparison from the element elist(iord(nrmax+1)). - jbnd = jupbn - 1; - ibeg = nrmax[0] + 1; - if (ibeg <= jbnd) { - for (i = ibeg; i <= jbnd; ++i) { - isucc = iord[i - 1]; - if (errmax >= elist[isucc - 1]) { - - // insert errmin by traversing the list bottom-up. - iord[i - 1 - 1] = maxerr[0]; - k = jbnd; - for (j = 1; j <= jbnd; ++j) { - isucc = iord[k - 1]; - if (errmin < elist[isucc - 1]) { - iord[k + 1 - 1] = last; - - // set maxerr and ermax. - maxerr[0] = iord[nrmax[0] - 1]; - ermax[0] = elist[maxerr[0] - 1]; - return; - } - iord[k + 1 - 1] = isucc; - --k; - } - iord[i - 1] = last; - - // set maxerr and ermax. - maxerr[0] = iord[nrmax[0] - 1]; - ermax[0] = elist[maxerr[0] - 1]; - return; - } - iord[i - 1 - 1] = isucc; - } - } - iord[jbnd - 1] = maxerr[0]; - iord[jupbn - 1] = last; - - // set maxerr and ermax. - maxerr[0] = iord[nrmax[0] - 1]; - ermax[0] = elist[maxerr[0] - 1]; + if (ier[0] + ierro != 0) { + if (ierro == 3) { + abserr[0] += correc; + } + if (ier[0] == 0) { + ier[0] = 3; + } + if (result[0] != 0.0 && area != 0.0) { + if (abserr[0] / Math.abs(result[0]) > errsum / Math.abs(area)) { + + // COMPUTE GLOBAL INTEGRAL SUM + result[0] = 0.0; + for (k = 1; k <= last[0]; ++k) { + result[0] += rlist[k - 1]; + } + abserr[0] = errsum; + if (ier[0] > 2) { + --ier[0]; + } + neval[0] = 42 * last[0] - 21; + return; + } + } else { + if (abserr[0] > errsum) { + + // COMPUTE GLOBAL INTEGRAL SUM + result[0] = 0.0; + for (k = 1; k <= last[0]; ++k) { + result[0] += rlist[k - 1]; + } + abserr[0] = errsum; + if (ier[0] > 2) { + --ier[0]; + } + neval[0] = 42 * last[0] - 21; + return; + } + if (area == 0.0) { + if (ier[0] > 2) { + --ier[0]; + } + neval[0] = 42 * last[0] - 21; + return; + } + } } - private static final void dqk21(final DoubleUnaryOperator f, final double a, final double b, - final double[] result, final double[] abserr, final double[] resabs, final double[] resasc) { - double absc, centr, dhlgth, fc, fsum, fval1, fval2, hlgth, resg, resk, reskh; - int j, jtw, jtwm1; - final double[] fv1 = new double[10]; - final double[] fv2 = new double[10]; + // TEST ON DIVERGENCE + if (ksgn == -1 && Math.max(Math.abs(result[0]), Math.abs(area)) <= defabs[0] * 0.01) { + if (ier[0] > 2) { + --ier[0]; + } + neval[0] = 42 * last[0] - 21; + return; + } + if (0.01 > (result[0] / area) || (result[0] / area) > 100.0 || errsum > Math.abs(area)) { + ier[0] = 6; + } + if (ier[0] > 2) { + --ier[0]; + } + neval[0] = 42 * last[0] - 21; + } + + private static final void dqelg(final int[] n, final double[] epstab, final double[] result, + final double[] abserr, final double[] res3la, final int[] nres) { + double delta1, delta2, delta3, epsinf, error, err1, err2, err3, e0, e1, e1abs, e2, e3, res, ss, + tol1, tol2, tol3; + int i, ib, ib2, ie, indx, k1, k2, k3, limexp, newelm, num; + + ++nres[0]; + abserr[0] = OFLOW; + result[0] = epstab[n[0] - 1]; + if (n[0] < 3) { + abserr[0] = Math.max(abserr[0], 5.0 * EPMACH * Math.abs(result[0])); + return; + } - centr = 0.5 * (a + b); - hlgth = 0.5 * (b - a); - dhlgth = Math.abs(hlgth); + limexp = 50; + epstab[n[0] + 2 - 1] = epstab[n[0] - 1]; + newelm = (n[0] - 1) >> 1; + epstab[n[0] - 1] = OFLOW; + num = k1 = n[0]; + for (i = 1; i <= newelm; ++i) { + k2 = k1 - 1; + k3 = k1 - 2; + res = epstab[k1 + 2 - 1]; + e0 = epstab[k3 - 1]; + e1 = epstab[k2 - 1]; + e2 = res; + e1abs = Math.abs(e1); + delta2 = e2 - e1; + err2 = Math.abs(delta2); + tol2 = Math.max(Math.abs(e2), e1abs) * EPMACH; + delta3 = e1 - e0; + err3 = Math.abs(delta3); + tol3 = Math.max(e1abs, Math.abs(e0)) * EPMACH; + if (err2 <= tol2 && err3 <= tol3) { + + // if e0, e1 and e2 are equal to within machine accuracy, convergence is + // assumed. + result[0] = res; + abserr[0] = err2 + err3; + abserr[0] = Math.max(abserr[0], 5.0 * EPMACH * Math.abs(result[0])); + return; + } + + e3 = epstab[k1 - 1]; + epstab[k1 - 1] = e1; + delta1 = e1 - e3; + err1 = Math.abs(delta1); + tol1 = Math.max(e1abs, Math.abs(e3)) * EPMACH; + + // if two elements are very close to each other, omit a part of the table by + // adjusting the value of n + if (err1 <= tol1 || err2 <= tol2 || err3 <= tol3) { + n[0] = i + i - 1; + break; + } + ss = 1.0 / delta1 + 1.0 / delta2 - 1.0 / delta3; + epsinf = Math.abs(ss * e1); + + // test to detect irregular behaviour in the table, and eventually omit a part + // of the table adjusting the value of n + if (epsinf <= 0.1E-3) { + n[0] = i + i - 1; + break; + } + + // compute a new element and eventually adjust the value of result. + res = e1 + 1.0 / ss; + epstab[k1 - 1] = res; + k1 -= 2; + error = err2 + Math.abs(res - e2) + err3; + if (error <= abserr[0]) { + abserr[0] = error; + result[0] = res; + } + } - // compute the 21-point kronrod approximation to the integral, and estimate the - // absolute error. - resg = 0.0; - fc = f.applyAsDouble(centr); - resk = WGK21[11 - 1] * fc; - resabs[0] = Math.abs(resk); - for (j = 1; j <= 5; ++j) { - jtw = j << 1; - absc = hlgth * XGK21[jtw - 1]; - fval1 = f.applyAsDouble(centr - absc); - fval2 = f.applyAsDouble(centr + absc); - fv1[jtw - 1] = fval1; - fv2[jtw - 1] = fval2; - fsum = fval1 + fval2; - resg += WG21[j - 1] * fsum; - resk += WGK21[jtw - 1] * fsum; - resabs[0] += WGK21[jtw - 1] * (Math.abs(fval1) + Math.abs(fval2)); - } - for (j = 1; j <= 5; ++j) { - jtwm1 = (j << 1) - 1; - absc = hlgth * XGK21[jtwm1 - 1]; - fval1 = f.applyAsDouble(centr - absc); - fval2 = f.applyAsDouble(centr + absc); - fv1[jtwm1 - 1] = fval1; - fv2[jtwm1 - 1] = fval2; - fsum = fval1 + fval2; - resk += WGK21[jtwm1 - 1] * fsum; - resabs[0] += WGK21[jtwm1 - 1] * (Math.abs(fval1) + Math.abs(fval2)); - } - reskh = resk * 0.5; - resasc[0] = WGK21[11 - 1] * Math.abs(fc - reskh); - for (j = 1; j <= 10; ++j) { - resasc[0] += WGK21[j - 1] * (Math.abs(fv1[j - 1] - reskh) + Math.abs(fv2[j - 1] - reskh)); - } - result[0] = resk * hlgth; - resabs[0] *= dhlgth; - resasc[0] *= dhlgth; - abserr[0] = Math.abs((resk - resg) * hlgth); - if (resasc[0] != 0.0 && abserr[0] != 0.0) { - abserr[0] = resasc[0] * Math.min(10.0, Math.pow(200.0 * abserr[0] / resasc[0], 1.5)); - } - if (resabs[0] > UFLOW / (50.0 * EPMACH)) { - abserr[0] = Math.max((EPMACH * 50.0) * resabs[0], abserr[0]); - } + // shift the table. + if (n[0] == limexp) { + n[0] = ((limexp >> 1) << 1) - 1; + } + ib = 1; + if (((num >> 1) << 1) == num) { + ib = 2; + } + ie = newelm + 1; + for (i = 1; i <= ie; ++i) { + ib2 = ib + 2; + epstab[ib - 1] = epstab[ib2 - 1]; + ib = ib2; + } + if (num != n[0]) { + indx = num - n[0] + 1; + for (i = 1; i <= n[0]; ++i) { + epstab[i - 1] = epstab[indx - 1]; + ++indx; + } } - // ******************************************************************************* - // INFINITE BOUNDS INTEGRATION (DQAGI) - // ******************************************************************************* - private static void dqk15i(final DoubleUnaryOperator f, final double boun, final int inf, - final double a, final double b, final double[] result, final double[] abserr, final double[] resabs, - final double[] resasc) { - - double absc, absc1, absc2, centr, dinf, epmach, fc, fsum, fval1, fval2, hlgth, resg, resk, reskh, tabsc1, - tabsc2, uflow; - int j; - final double[] fv1 = new double[8], fv2 = new double[8]; - - epmach = EPMACH; - uflow = UFLOW; - dinf = Math.min(1.0, inf); - centr = 0.5 * (a + b); - hlgth = 0.5 * (b - a); - tabsc1 = boun + dinf * (1.0 - centr) / centr; + if (nres[0] >= 4) { + + // compute error estimate + abserr[0] = Math.abs(result[0] - res3la[3 - 1]) + Math.abs(result[0] - res3la[2 - 1]) + + Math.abs(result[0] - res3la[1 - 1]); + res3la[1 - 1] = res3la[2 - 1]; + res3la[2 - 1] = res3la[3 - 1]; + res3la[3 - 1] = result[0]; + } else { + res3la[nres[0] - 1] = result[0]; + abserr[0] = OFLOW; + } + abserr[0] = Math.max(abserr[0], 5.0 * EPMACH * Math.abs(result[0])); + } + + private static final void dqpsrt(final int limit, final int last, final int[] maxerr, + final double[] ermax, final double[] elist, final int[] iord, final int[] nrmax) { + double errmax, errmin; + int i, ibeg, ido, isucc, j, jbnd, jupbn, k; + + if (last <= 2) { + iord[1 - 1] = 1; + iord[2 - 1] = 2; + + // set maxerr and ermax. + maxerr[0] = iord[nrmax[0] - 1]; + ermax[0] = elist[maxerr[0] - 1]; + return; + } + + // this part of the routine is only executed if, due to a + // difficult integrand, subdivision increased the error + // estimate. in the normal case the insert procedure should + // start after the nrmax-th largest error estimate. + errmax = elist[maxerr[0] - 1]; + if (nrmax[0] != 1) { + ido = nrmax[0] - 1; + for (i = 1; i <= ido; ++i) { + isucc = iord[nrmax[0] - 1]; + if (errmax <= elist[isucc - 1]) { + break; + } + iord[nrmax[0] - 1] = isucc; + --nrmax[0]; + } + } + + // compute the number of elements in the list to be maintained + // in descending order. this number depends on the number of + // subdivisions still allowed. + jupbn = last; + if (last > ((limit >> 1) + 2)) { + jupbn = limit + 3 - last; + } + errmin = elist[last - 1]; + + // insert errmax by traversing the list top-down, + // starting comparison from the element elist(iord(nrmax+1)). + jbnd = jupbn - 1; + ibeg = nrmax[0] + 1; + if (ibeg <= jbnd) { + for (i = ibeg; i <= jbnd; ++i) { + isucc = iord[i - 1]; + if (errmax >= elist[isucc - 1]) { + + // insert errmin by traversing the list bottom-up. + iord[i - 1 - 1] = maxerr[0]; + k = jbnd; + for (j = 1; j <= jbnd; ++j) { + isucc = iord[k - 1]; + if (errmin < elist[isucc - 1]) { + iord[k + 1 - 1] = last; + + // set maxerr and ermax. + maxerr[0] = iord[nrmax[0] - 1]; + ermax[0] = elist[maxerr[0] - 1]; + return; + } + iord[k + 1 - 1] = isucc; + --k; + } + iord[i - 1] = last; + + // set maxerr and ermax. + maxerr[0] = iord[nrmax[0] - 1]; + ermax[0] = elist[maxerr[0] - 1]; + return; + } + iord[i - 1 - 1] = isucc; + } + } + iord[jbnd - 1] = maxerr[0]; + iord[jupbn - 1] = last; + + // set maxerr and ermax. + maxerr[0] = iord[nrmax[0] - 1]; + ermax[0] = elist[maxerr[0] - 1]; + } + + private static final void dqk21(final DoubleUnaryOperator f, final double a, final double b, + final double[] result, final double[] abserr, final double[] resabs, final double[] resasc) { + double absc, centr, dhlgth, fc, fsum, fval1, fval2, hlgth, resg, resk, reskh; + int j, jtw, jtwm1; + final double[] fv1 = new double[10]; + final double[] fv2 = new double[10]; + + centr = 0.5 * (a + b); + hlgth = 0.5 * (b - a); + dhlgth = Math.abs(hlgth); + + // compute the 21-point kronrod approximation to the integral, and estimate the + // absolute error. + resg = 0.0; + fc = f.applyAsDouble(centr); + resk = WGK21[11 - 1] * fc; + resabs[0] = Math.abs(resk); + for (j = 1; j <= 5; ++j) { + jtw = j << 1; + absc = hlgth * XGK21[jtw - 1]; + fval1 = f.applyAsDouble(centr - absc); + fval2 = f.applyAsDouble(centr + absc); + fv1[jtw - 1] = fval1; + fv2[jtw - 1] = fval2; + fsum = fval1 + fval2; + resg += WG21[j - 1] * fsum; + resk += WGK21[jtw - 1] * fsum; + resabs[0] += WGK21[jtw - 1] * (Math.abs(fval1) + Math.abs(fval2)); + } + for (j = 1; j <= 5; ++j) { + jtwm1 = (j << 1) - 1; + absc = hlgth * XGK21[jtwm1 - 1]; + fval1 = f.applyAsDouble(centr - absc); + fval2 = f.applyAsDouble(centr + absc); + fv1[jtwm1 - 1] = fval1; + fv2[jtwm1 - 1] = fval2; + fsum = fval1 + fval2; + resk += WGK21[jtwm1 - 1] * fsum; + resabs[0] += WGK21[jtwm1 - 1] * (Math.abs(fval1) + Math.abs(fval2)); + } + reskh = resk * 0.5; + resasc[0] = WGK21[11 - 1] * Math.abs(fc - reskh); + for (j = 1; j <= 10; ++j) { + resasc[0] += WGK21[j - 1] * (Math.abs(fv1[j - 1] - reskh) + Math.abs(fv2[j - 1] - reskh)); + } + result[0] = resk * hlgth; + resabs[0] *= dhlgth; + resasc[0] *= dhlgth; + abserr[0] = Math.abs((resk - resg) * hlgth); + if (resasc[0] != 0.0 && abserr[0] != 0.0) { + abserr[0] = resasc[0] * Math.min(10.0, Math.pow(200.0 * abserr[0] / resasc[0], 1.5)); + } + if (resabs[0] > UFLOW / (50.0 * EPMACH)) { + abserr[0] = Math.max((EPMACH * 50.0) * resabs[0], abserr[0]); + } + } + + // ******************************************************************************* + // INFINITE BOUNDS INTEGRATION (DQAGI) + // ******************************************************************************* + private static void dqk15i(final DoubleUnaryOperator f, final double boun, final int inf, + final double a, final double b, final double[] result, final double[] abserr, + final double[] resabs, final double[] resasc) { + + double absc, absc1, absc2, centr, dinf, epmach, fc, fsum, fval1, fval2, hlgth, resg, resk, + reskh, tabsc1, tabsc2, uflow; + int j; + final double[] fv1 = new double[8], fv2 = new double[8]; + + epmach = EPMACH; + uflow = UFLOW; + dinf = Math.min(1.0, inf); + centr = 0.5 * (a + b); + hlgth = 0.5 * (b - a); + tabsc1 = boun + dinf * (1.0 - centr) / centr; fval1 = f.applyAsDouble(tabsc1); - if (inf == 2) { + if (inf == 2) { fval1 += f.applyAsDouble(-tabsc1); - } - fc = (fval1 / centr) / centr; - - // COMPUTE THE 15-POINT KRONROD APPROXIMATION TO THE INTEGRAL, AND ESTIMATE THE - // ERROR - resg = WG15I[8 - 1] * fc; - resk = WGK15I[8 - 1] * fc; - resabs[0] = Math.abs(resk); - for (j = 1; j <= 7; ++j) { - absc = hlgth * XGK15I[j - 1]; - absc1 = centr - absc; - absc2 = centr + absc; - tabsc1 = boun + dinf * (1.0 - absc1) / absc1; - tabsc2 = boun + dinf * (1.0 - absc2) / absc2; - fval1 = f.applyAsDouble(tabsc1); - fval2 = f.applyAsDouble(tabsc2); - if (inf == 2) { - fval1 += f.applyAsDouble(-tabsc1); - fval2 += f.applyAsDouble(-tabsc2); - } - fval1 = (fval1 / absc1) / absc1; - fval2 = (fval2 / absc2) / absc2; - fv1[j - 1] = fval1; - fv2[j - 1] = fval2; - fsum = fval1 + fval2; - resg += WG15I[j - 1] * fsum; - resk += WGK15I[j - 1] * fsum; - resabs[0] += WGK15I[j - 1] * (Math.abs(fval1) + Math.abs(fval2)); - } - - reskh = resk * 0.5; - resasc[0] = WGK15I[8 - 1] * Math.abs(fc - reskh); - for (j = 1; j <= 7; ++j) { - resasc[0] += WGK15I[j - 1] * (Math.abs(fv1[j - 1] - reskh) + Math.abs(fv2[j - 1] - reskh)); - } - result[0] = resk * hlgth; - resasc[0] *= hlgth; - resabs[0] *= hlgth; - abserr[0] = Math.abs((resk - resg) * hlgth); - if (resasc[0] != 0.0 && abserr[0] != 0.0) { - abserr[0] = resasc[0] * Math.min(1.0, Math.pow(200.0 * abserr[0] / resasc[0], 1.5)); - } - if (resabs[0] > uflow / (50.0 * epmach)) { - abserr[0] = Math.max((epmach * 50.0) * resabs[0], abserr[0]); - } + } + fc = (fval1 / centr) / centr; + + // COMPUTE THE 15-POINT KRONROD APPROXIMATION TO THE INTEGRAL, AND ESTIMATE THE + // ERROR + resg = WG15I[8 - 1] * fc; + resk = WGK15I[8 - 1] * fc; + resabs[0] = Math.abs(resk); + for (j = 1; j <= 7; ++j) { + absc = hlgth * XGK15I[j - 1]; + absc1 = centr - absc; + absc2 = centr + absc; + tabsc1 = boun + dinf * (1.0 - absc1) / absc1; + tabsc2 = boun + dinf * (1.0 - absc2) / absc2; + fval1 = f.applyAsDouble(tabsc1); + fval2 = f.applyAsDouble(tabsc2); + if (inf == 2) { + fval1 += f.applyAsDouble(-tabsc1); + fval2 += f.applyAsDouble(-tabsc2); + } + fval1 = (fval1 / absc1) / absc1; + fval2 = (fval2 / absc2) / absc2; + fv1[j - 1] = fval1; + fv2[j - 1] = fval2; + fsum = fval1 + fval2; + resg += WG15I[j - 1] * fsum; + resk += WGK15I[j - 1] * fsum; + resabs[0] += WGK15I[j - 1] * (Math.abs(fval1) + Math.abs(fval2)); + } + + reskh = resk * 0.5; + resasc[0] = WGK15I[8 - 1] * Math.abs(fc - reskh); + for (j = 1; j <= 7; ++j) { + resasc[0] += WGK15I[j - 1] * (Math.abs(fv1[j - 1] - reskh) + Math.abs(fv2[j - 1] - reskh)); + } + result[0] = resk * hlgth; + resasc[0] *= hlgth; + resabs[0] *= hlgth; + abserr[0] = Math.abs((resk - resg) * hlgth); + if (resasc[0] != 0.0 && abserr[0] != 0.0) { + abserr[0] = resasc[0] * Math.min(1.0, Math.pow(200.0 * abserr[0] / resasc[0], 1.5)); + } + if (resabs[0] > uflow / (50.0 * epmach)) { + abserr[0] = Math.max((epmach * 50.0) * resabs[0], abserr[0]); + } + } + + private static void dqagie(final DoubleUnaryOperator f, final double bound, final int inf, + final double epsabs, final double epsrel, final int limit, final double[] result, + final double[] abserr, final int[] neval, final int[] ier, final double[] alist, + final double[] blist, final double[] rlist, final double[] elist, final int[] iord, + final int[] last) { + + double area, area12, a1, a2, boun, b1, b2, correc = 0.0, dres, epmach, erlarg = 0.0, erlast, + errbnd, erro12, errsum, ertest = 0.0, oflow, small = 0.0, uflow; + final double[] res3la = new double[4], rlist2 = new double[53], defabs = new double[1], + resabs = new double[1], reseps = new double[1], area1 = new double[1], + area2 = new double[1], defab1 = new double[1], defab2 = new double[1], + error1 = new double[1], error2 = new double[1], errmax = new double[1], + abseps = new double[1]; + int id, ierro, iroff1, iroff2, iroff3, jupbnd, k, ksgn, ktmin; + final int[] maxerr = new int[1], nrmax = new int[1], numrl2 = new int[1], nres = new int[1]; + boolean extrap, noext; + + epmach = EPMACH; + + // TEST ON VALIDITY OF PARAMETERS + ier[0] = neval[0] = last[0] = 0; + result[0] = abserr[0] = 0.0; + alist[1 - 1] = 0.0; + blist[1 - 1] = 1.0; + rlist[1 - 1] = elist[1 - 1] = 0.0; + iord[1 - 1] = 0; + if (epsabs <= 0.0 && epsrel < Math.max(50.0 * epmach, 0.5e-28)) { + ier[0] = 6; + } + if (ier[0] == 6) { + return; + } + + // FIRST APPROXIMATION TO THE INTEGRAL + // ----------------------------------- + // + // DETERMINE THE INTERVAL TO BE MAPPED ONTO (0,1). + // IF INF = 2 THE INTEGRAL IS COMPUTED AS I = I1+I2, WHERE + // I1 = INTEGRAL OF F OVER (-INFINITY,0), + // I2 = INTEGRAL OF F OVER (0,+INFINITY). + boun = bound; + if (inf == 2) { + boun = 0.0; + } + dqk15i(f, boun, inf, 0.0, 1.0, result, abserr, defabs, resabs); + + // TEST ON ACCURACY + last[0] = 1; + rlist[1 - 1] = result[0]; + elist[1 - 1] = abserr[0]; + iord[1 - 1] = 1; + dres = Math.abs(result[0]); + errbnd = Math.max(epsabs, epsrel * dres); + if (abserr[0] <= 100.0 * epmach * defabs[0] && abserr[0] > errbnd) { + ier[0] = 2; + } + if (limit == 1) { + ier[0] = 1; + } + if (ier[0] != 0 || (abserr[0] <= errbnd && abserr[0] != resabs[0]) || abserr[0] == 0.0) { + neval[0] = 30 * last[0] - 15; + if (inf == 2) { + neval[0] <<= 1; + } + if (ier[0] > 2) { + --ier[0]; + } + return; + } + + // INITIALIZATION + uflow = UFLOW; + oflow = OFLOW; + rlist2[1 - 1] = result[0]; + errmax[0] = abserr[0]; + maxerr[0] = 1; + area = result[0]; + errsum = abserr[0]; + abserr[0] = oflow; + nrmax[0] = 1; + nres[0] = ktmin = 0; + numrl2[0] = 2; + extrap = noext = false; + ierro = iroff1 = iroff2 = iroff3 = 0; + ksgn = -1; + if (dres >= (1.0 - 50.0 * epmach) * defabs[0]) { + ksgn = 1; + } + + // MAIN DO-LOOP + for (last[0] = 2; last[0] <= limit; ++last[0]) { + + // BISECT THE SUBINTERVAL WITH NRMAX-TH LARGEST ERROR ESTIMATE + a1 = alist[maxerr[0] - 1]; + b1 = 0.5 * (alist[maxerr[0] - 1] + blist[maxerr[0] - 1]); + a2 = b1; + b2 = blist[maxerr[0] - 1]; + erlast = errmax[0]; + dqk15i(f, boun, inf, a1, b1, area1, error1, resabs, defab1); + dqk15i(f, boun, inf, a2, b2, area2, error2, resabs, defab2); + + // IMPROVE PREVIOUS APPROXIMATIONS TO INTEGRAL + // AND ERROR AND TEST FOR ACCURACY + area12 = area1[0] + area2[0]; + erro12 = error1[0] + error2[0]; + errsum += (erro12 - errmax[0]); + area += (area12 - rlist[maxerr[0] - 1]); + if (defab1[0] != error1[0] && defab2[0] != error2[0]) { + final double reltol = 1e-5 * Math.abs(area12); + if (Math.abs(rlist[maxerr[0] - 1] - area12) <= reltol && erro12 >= 0.99 * errmax[0]) { + if (extrap) { + ++iroff2; + } else { + ++iroff1; + } + } + if (last[0] > 10 && erro12 > errmax[0]) { + ++iroff3; + } + } + rlist[maxerr[0] - 1] = area1[0]; + rlist[last[0] - 1] = area2[0]; + errbnd = Math.max(epsabs, epsrel * Math.abs(area)); + + // TEST FOR ROUNDOFF ERROR AND EVENTUALLY SET ERROR FLAG + if (iroff1 + iroff2 >= 10 || iroff3 >= 20) { + ier[0] = 2; + } + if (iroff2 >= 5) { + ierro = 3; + } + + // SET ERROR FLAG IN THE CASE THAT THE NUMBER OF + // SUBINTERVALS EQUALS LIMIT + if (last[0] == limit) { + ier[0] = 1; + } + + // SET ERROR FLAG IN THE CASE OF BAD INTEGRAND BEHAVIOUR + // AT SOME POINTS OF THE INTEGRATION RANGE + if (Math.max(Math.abs(a1), Math.abs(b2)) <= (1.0 + 100.0 * epmach) + * (Math.abs(a2) + 1.0e3 * uflow)) { + ier[0] = 4; + } + + // APPEND THE NEWLY-CREATED INTERVALS TO THE LIST + if (error2[0] > error1[0]) { + alist[maxerr[0] - 1] = a2; + alist[last[0] - 1] = a1; + blist[last[0] - 1] = b1; + rlist[maxerr[0] - 1] = area2[0]; + rlist[last[0] - 1] = area1[0]; + elist[maxerr[0] - 1] = error2[0]; + elist[last[0] - 1] = error1[0]; + } else { + alist[last[0] - 1] = a2; + blist[maxerr[0] - 1] = b1; + blist[last[0] - 1] = b2; + elist[maxerr[0] - 1] = error1[0]; + elist[last[0] - 1] = error2[0]; + } + + // CALL SUBROUTINE DQPSRT TO MAINTAIN THE DESCENDING ORDERING + // IN THE LIST OF ERROR ESTIMATES AND SELECT THE SUBINTERVAL + // WITH NRMAX-TH LARGEST ERROR ESTIMATE (TO BE BISECTED NEXT) + dqpsrt(limit, last[0], maxerr, errmax, elist, iord, nrmax); + if (errsum <= errbnd) { + + // COMPUTE GLOBAL INTEGRAL SUM + result[0] = 0.0; + for (k = 1; k <= last[0]; ++k) { + result[0] += rlist[k - 1]; + } + abserr[0] = errsum; + neval[0] = 30 * last[0] - 15; + if (inf == 2) { + neval[0] <<= 1; + } + if (ier[0] > 2) { + --ier[0]; + } + return; + } + if (ier[0] != 0) { + break; + } + if (last[0] == 2) { + small = 0.375; + erlarg = errsum; + ertest = errbnd; + rlist2[2 - 1] = area; + continue; + } + if (noext) { + continue; + } + erlarg -= erlast; + if (Math.abs(b1 - a1) > small) { + erlarg += erro12; + } + if (!extrap) { + + // TEST WHETHER THE INTERVAL TO BE BISECTED NEXT IS THE + // SMALLEST INTERVAL + if (Math.abs(blist[maxerr[0] - 1] - alist[maxerr[0] - 1]) > small) { + continue; + } + extrap = true; + nrmax[0] = 2; + } + + if (ierro != 3 && erlarg > ertest) { + + // THE SMALLEST INTERVAL HAS THE LARGEST ERROR. + // BEFORE BISECTING DECREASE THE SUM OF THE ERRORS OVER THE + // LARGER INTERVALS (ERLARG) AND PERFORM EXTRAPOLATION + id = nrmax[0]; + jupbnd = last[0]; + if (last[0] > 2 + (limit >> 1)) { + jupbnd = limit + 3 - last[0]; + } + boolean skipto90 = false; + for (k = id; k <= jupbnd; ++k) { + maxerr[0] = iord[nrmax[0] - 1]; + errmax[0] = elist[maxerr[0] - 1]; + if (Math.abs(blist[maxerr[0] - 1] - alist[maxerr[0] - 1]) > small) { + skipto90 = true; + break; + } + ++nrmax[0]; + } + if (skipto90) { + continue; + } + } + + // PERFORM EXTRAPOLATION + ++numrl2[0]; + rlist2[numrl2[0] - 1] = area; + dqelg(numrl2, rlist2, reseps, abseps, res3la, nres); + ++ktmin; + if (ktmin > 5 && abserr[0] < 1.0e-3 * errsum) { + ier[0] = 5; + } + if (abseps[0] < abserr[0]) { + ktmin = 0; + abserr[0] = abseps[0]; + result[0] = reseps[0]; + correc = erlarg; + ertest = Math.max(epsabs, epsrel * Math.abs(reseps[0])); + if (abserr[0] <= ertest) { + break; + } + } + + // PREPARE BISECTION OF THE SMALLEST INTERVAL + if (numrl2[0] == 1) { + noext = true; + } + if (ier[0] == 5) { + break; + } + maxerr[0] = iord[1 - 1]; + errmax[0] = elist[maxerr[0] - 1]; + nrmax[0] = 1; + extrap = false; + small *= 0.5; + erlarg = errsum; } - private static void dqagie(final DoubleUnaryOperator f, final double bound, final int inf, - final double epsabs, final double epsrel, final int limit, final double[] result, final double[] abserr, - final int[] neval, final int[] ier, final double[] alist, final double[] blist, final double[] rlist, - final double[] elist, final int[] iord, final int[] last) { - - double area, area12, a1, a2, boun, b1, b2, correc = 0.0, dres, epmach, erlarg = 0.0, erlast, errbnd, erro12, - errsum, ertest = 0.0, oflow, small = 0.0, uflow; - final double[] res3la = new double[4], rlist2 = new double[53], defabs = new double[1], resabs = new double[1], - reseps = new double[1], area1 = new double[1], area2 = new double[1], defab1 = new double[1], - defab2 = new double[1], error1 = new double[1], error2 = new double[1], errmax = new double[1], - abseps = new double[1]; - int id, ierro, iroff1, iroff2, iroff3, jupbnd, k, ksgn, ktmin; - final int[] maxerr = new int[1], nrmax = new int[1], numrl2 = new int[1], nres = new int[1]; - boolean extrap, noext; - - epmach = EPMACH; - - // TEST ON VALIDITY OF PARAMETERS - ier[0] = neval[0] = last[0] = 0; - result[0] = abserr[0] = 0.0; - alist[1 - 1] = 0.0; - blist[1 - 1] = 1.0; - rlist[1 - 1] = elist[1 - 1] = 0.0; - iord[1 - 1] = 0; - if (epsabs <= 0.0 && epsrel < Math.max(50.0 * epmach, 0.5e-28)) { - ier[0] = 6; - } - if (ier[0] == 6) { - return; - } - - // FIRST APPROXIMATION TO THE INTEGRAL - // ----------------------------------- - // - // DETERMINE THE INTERVAL TO BE MAPPED ONTO (0,1). - // IF INF = 2 THE INTEGRAL IS COMPUTED AS I = I1+I2, WHERE - // I1 = INTEGRAL OF F OVER (-INFINITY,0), - // I2 = INTEGRAL OF F OVER (0,+INFINITY). - boun = bound; - if (inf == 2) { - boun = 0.0; - } - dqk15i(f, boun, inf, 0.0, 1.0, result, abserr, defabs, resabs); - - // TEST ON ACCURACY - last[0] = 1; - rlist[1 - 1] = result[0]; - elist[1 - 1] = abserr[0]; - iord[1 - 1] = 1; - dres = Math.abs(result[0]); - errbnd = Math.max(epsabs, epsrel * dres); - if (abserr[0] <= 100.0 * epmach * defabs[0] && abserr[0] > errbnd) { - ier[0] = 2; - } - if (limit == 1) { - ier[0] = 1; - } - if (ier[0] != 0 || (abserr[0] <= errbnd && abserr[0] != resabs[0]) || abserr[0] == 0.0) { - neval[0] = 30 * last[0] - 15; - if (inf == 2) { - neval[0] <<= 1; - } - if (ier[0] > 2) { - --ier[0]; - } - return; - } - - // INITIALIZATION - uflow = UFLOW; - oflow = OFLOW; - rlist2[1 - 1] = result[0]; - errmax[0] = abserr[0]; - maxerr[0] = 1; - area = result[0]; - errsum = abserr[0]; - abserr[0] = oflow; - nrmax[0] = 1; - nres[0] = ktmin = 0; - numrl2[0] = 2; - extrap = noext = false; - ierro = iroff1 = iroff2 = iroff3 = 0; - ksgn = -1; - if (dres >= (1.0 - 50.0 * epmach) * defabs[0]) { - ksgn = 1; - } - - // MAIN DO-LOOP - for (last[0] = 2; last[0] <= limit; ++last[0]) { - - // BISECT THE SUBINTERVAL WITH NRMAX-TH LARGEST ERROR ESTIMATE - a1 = alist[maxerr[0] - 1]; - b1 = 0.5 * (alist[maxerr[0] - 1] + blist[maxerr[0] - 1]); - a2 = b1; - b2 = blist[maxerr[0] - 1]; - erlast = errmax[0]; - dqk15i(f, boun, inf, a1, b1, area1, error1, resabs, defab1); - dqk15i(f, boun, inf, a2, b2, area2, error2, resabs, defab2); - - // IMPROVE PREVIOUS APPROXIMATIONS TO INTEGRAL - // AND ERROR AND TEST FOR ACCURACY - area12 = area1[0] + area2[0]; - erro12 = error1[0] + error2[0]; - errsum += (erro12 - errmax[0]); - area += (area12 - rlist[maxerr[0] - 1]); - if (defab1[0] != error1[0] && defab2[0] != error2[0]) { - final double reltol = 1e-5 * Math.abs(area12); - if (Math.abs(rlist[maxerr[0] - 1] - area12) <= reltol && erro12 >= 0.99 * errmax[0]) { - if (extrap) { - ++iroff2; - } else { - ++iroff1; - } - } - if (last[0] > 10 && erro12 > errmax[0]) { - ++iroff3; - } - } - rlist[maxerr[0] - 1] = area1[0]; - rlist[last[0] - 1] = area2[0]; - errbnd = Math.max(epsabs, epsrel * Math.abs(area)); - - // TEST FOR ROUNDOFF ERROR AND EVENTUALLY SET ERROR FLAG - if (iroff1 + iroff2 >= 10 || iroff3 >= 20) { - ier[0] = 2; - } - if (iroff2 >= 5) { - ierro = 3; - } - - // SET ERROR FLAG IN THE CASE THAT THE NUMBER OF - // SUBINTERVALS EQUALS LIMIT - if (last[0] == limit) { - ier[0] = 1; - } - - // SET ERROR FLAG IN THE CASE OF BAD INTEGRAND BEHAVIOUR - // AT SOME POINTS OF THE INTEGRATION RANGE - if (Math.max(Math.abs(a1), Math.abs(b2)) <= (1.0 + 100.0 * epmach) * (Math.abs(a2) + 1.0e3 * uflow)) { - ier[0] = 4; - } - - // APPEND THE NEWLY-CREATED INTERVALS TO THE LIST - if (error2[0] > error1[0]) { - alist[maxerr[0] - 1] = a2; - alist[last[0] - 1] = a1; - blist[last[0] - 1] = b1; - rlist[maxerr[0] - 1] = area2[0]; - rlist[last[0] - 1] = area1[0]; - elist[maxerr[0] - 1] = error2[0]; - elist[last[0] - 1] = error1[0]; - } else { - alist[last[0] - 1] = a2; - blist[maxerr[0] - 1] = b1; - blist[last[0] - 1] = b2; - elist[maxerr[0] - 1] = error1[0]; - elist[last[0] - 1] = error2[0]; - } - - // CALL SUBROUTINE DQPSRT TO MAINTAIN THE DESCENDING ORDERING - // IN THE LIST OF ERROR ESTIMATES AND SELECT THE SUBINTERVAL - // WITH NRMAX-TH LARGEST ERROR ESTIMATE (TO BE BISECTED NEXT) - dqpsrt(limit, last[0], maxerr, errmax, elist, iord, nrmax); - if (errsum <= errbnd) { - - // COMPUTE GLOBAL INTEGRAL SUM - result[0] = 0.0; - for (k = 1; k <= last[0]; ++k) { - result[0] += rlist[k - 1]; - } - abserr[0] = errsum; - neval[0] = 30 * last[0] - 15; - if (inf == 2) { - neval[0] <<= 1; - } - if (ier[0] > 2) { - --ier[0]; - } - return; - } - if (ier[0] != 0) { - break; - } - if (last[0] == 2) { - small = 0.375; - erlarg = errsum; - ertest = errbnd; - rlist2[2 - 1] = area; - continue; - } - if (noext) { - continue; - } - erlarg -= erlast; - if (Math.abs(b1 - a1) > small) { - erlarg += erro12; - } - if (!extrap) { - - // TEST WHETHER THE INTERVAL TO BE BISECTED NEXT IS THE - // SMALLEST INTERVAL - if (Math.abs(blist[maxerr[0] - 1] - alist[maxerr[0] - 1]) > small) { - continue; - } - extrap = true; - nrmax[0] = 2; - } - - if (ierro != 3 && erlarg > ertest) { - - // THE SMALLEST INTERVAL HAS THE LARGEST ERROR. - // BEFORE BISECTING DECREASE THE SUM OF THE ERRORS OVER THE - // LARGER INTERVALS (ERLARG) AND PERFORM EXTRAPOLATION - id = nrmax[0]; - jupbnd = last[0]; - if (last[0] > 2 + (limit >> 1)) { - jupbnd = limit + 3 - last[0]; - } - boolean skipto90 = false; - for (k = id; k <= jupbnd; ++k) { - maxerr[0] = iord[nrmax[0] - 1]; - errmax[0] = elist[maxerr[0] - 1]; - if (Math.abs(blist[maxerr[0] - 1] - alist[maxerr[0] - 1]) > small) { - skipto90 = true; - break; - } - ++nrmax[0]; - } - if (skipto90) { - continue; - } - } - - // PERFORM EXTRAPOLATION - ++numrl2[0]; - rlist2[numrl2[0] - 1] = area; - dqelg(numrl2, rlist2, reseps, abseps, res3la, nres); - ++ktmin; - if (ktmin > 5 && abserr[0] < 1.0e-3 * errsum) { - ier[0] = 5; - } - if (abseps[0] < abserr[0]) { - ktmin = 0; - abserr[0] = abseps[0]; - result[0] = reseps[0]; - correc = erlarg; - ertest = Math.max(epsabs, epsrel * Math.abs(reseps[0])); - if (abserr[0] <= ertest) { - break; - } - } - - // PREPARE BISECTION OF THE SMALLEST INTERVAL - if (numrl2[0] == 1) { - noext = true; - } - if (ier[0] == 5) { - break; - } - maxerr[0] = iord[1 - 1]; - errmax[0] = elist[maxerr[0] - 1]; - nrmax[0] = 1; - extrap = false; - small *= 0.5; - erlarg = errsum; - } - - // SET FINAL RESULT AND ERROR ESTIMATE - if (abserr[0] == oflow) { - - // COMPUTE GLOBAL INTEGRAL SUM - result[0] = 0.0; - for (k = 1; k <= last[0]; ++k) { - result[0] += rlist[k - 1]; - } - abserr[0] = errsum; - neval[0] = 30 * last[0] - 15; - if (inf == 2) { - neval[0] <<= 1; - } - if (ier[0] > 2) { - --ier[0]; - } - return; - } - - if (ier[0] + ierro != 0) { - if (ierro == 3) { - abserr[0] += correc; - } - if (ier[0] == 0) { - ier[0] = 3; - } - if (result[0] != 0.0 && area != 0.0) { - if (abserr[0] / Math.abs(result[0]) > errsum / Math.abs(area)) { - - // COMPUTE GLOBAL INTEGRAL SUM - result[0] = 0.0; - for (k = 1; k <= last[0]; ++k) { - result[0] += rlist[k - 1]; - } - abserr[0] = errsum; - neval[0] = 30 * last[0] - 15; - if (inf == 2) { - neval[0] <<= 1; - } - if (ier[0] > 2) { - --ier[0]; - } - return; - } - } else { - if (abserr[0] > errsum) { - - // COMPUTE GLOBAL INTEGRAL SUM - result[0] = 0.0; - for (k = 1; k <= last[0]; ++k) { - result[0] += rlist[k - 1]; - } - abserr[0] = errsum; - neval[0] = 30 * last[0] - 15; - if (inf == 2) { - neval[0] <<= 1; - } - if (ier[0] > 2) { - --ier[0]; - } - return; - } - if (area == 0.0) { - neval[0] = 30 * last[0] - 15; - if (inf == 2) { - neval[0] <<= 1; - } - if (ier[0] > 2) { - --ier[0]; - } - return; - } - } - } - - // TEST ON DIVERGENCE - if (ksgn == -1 && Math.max(Math.abs(result[0]), Math.abs(area)) <= defabs[0] * 0.01) { - neval[0] = 30 * last[0] - 15; - if (inf == 2) { - neval[0] <<= 1; - } - if (ier[0] > 2) { - --ier[0]; - } - return; - } - if (0.01 > (result[0] / area) || (result[0] / area) > 100.0 || errsum > Math.abs(area)) { - ier[0] = 6; - } - neval[0] = 30 * last[0] - 15; - if (inf == 2) { - neval[0] <<= 1; - } - if (ier[0] > 2) { - --ier[0]; - } + // SET FINAL RESULT AND ERROR ESTIMATE + if (abserr[0] == oflow) { + + // COMPUTE GLOBAL INTEGRAL SUM + result[0] = 0.0; + for (k = 1; k <= last[0]; ++k) { + result[0] += rlist[k - 1]; + } + abserr[0] = errsum; + neval[0] = 30 * last[0] - 15; + if (inf == 2) { + neval[0] <<= 1; + } + if (ier[0] > 2) { + --ier[0]; + } + return; } - private static void dqagi1(final DoubleUnaryOperator f, final double boun, final int inf, - final double epsabs, final double epsrel, final double[] result, final double[] abserr, final int[] neval, - final int[] ier, final int limit) { - - final int[] last = new int[1]; - - // CHECK VALIDITY OF LIMIT AND LENW - ier[0] = 6; - neval[0] = last[0] = 0; - result[0] = abserr[0] = 0.0; - if (limit < 1) { - return; - } - - // PREPARE CALL FOR DQAGIE - final double[] alist = new double[limit], blist = new double[limit], rlist = new double[limit], - elist = new double[limit]; - final int[] iwork = new int[limit]; - dqagie(f, boun, inf, epsabs, epsrel, limit, result, abserr, neval, ier, alist, blist, rlist, elist, iwork, - last); + if (ier[0] + ierro != 0) { + if (ierro == 3) { + abserr[0] += correc; + } + if (ier[0] == 0) { + ier[0] = 3; + } + if (result[0] != 0.0 && area != 0.0) { + if (abserr[0] / Math.abs(result[0]) > errsum / Math.abs(area)) { + + // COMPUTE GLOBAL INTEGRAL SUM + result[0] = 0.0; + for (k = 1; k <= last[0]; ++k) { + result[0] += rlist[k - 1]; + } + abserr[0] = errsum; + neval[0] = 30 * last[0] - 15; + if (inf == 2) { + neval[0] <<= 1; + } + if (ier[0] > 2) { + --ier[0]; + } + return; + } + } else { + if (abserr[0] > errsum) { + + // COMPUTE GLOBAL INTEGRAL SUM + result[0] = 0.0; + for (k = 1; k <= last[0]; ++k) { + result[0] += rlist[k - 1]; + } + abserr[0] = errsum; + neval[0] = 30 * last[0] - 15; + if (inf == 2) { + neval[0] <<= 1; + } + if (ier[0] > 2) { + --ier[0]; + } + return; + } + if (area == 0.0) { + neval[0] = 30 * last[0] - 15; + if (inf == 2) { + neval[0] <<= 1; + } + if (ier[0] > 2) { + --ier[0]; + } + return; + } + } + } + + // TEST ON DIVERGENCE + if (ksgn == -1 && Math.max(Math.abs(result[0]), Math.abs(area)) <= defabs[0] * 0.01) { + neval[0] = 30 * last[0] - 15; + if (inf == 2) { + neval[0] <<= 1; + } + if (ier[0] > 2) { + --ier[0]; + } + return; + } + if (0.01 > (result[0] / area) || (result[0] / area) > 100.0 || errsum > Math.abs(area)) { + ier[0] = 6; + } + neval[0] = 30 * last[0] - 15; + if (inf == 2) { + neval[0] <<= 1; } + if (ier[0] > 2) { + --ier[0]; + } + } + + private static void dqagi1(final DoubleUnaryOperator f, final double boun, final int inf, + final double epsabs, final double epsrel, final double[] result, final double[] abserr, + final int[] neval, final int[] ier, final int limit) { + + final int[] last = new int[1]; + + // CHECK VALIDITY OF LIMIT AND LENW + ier[0] = 6; + neval[0] = last[0] = 0; + result[0] = abserr[0] = 0.0; + if (limit < 1) { + return; + } + + // PREPARE CALL FOR DQAGIE + final double[] alist = new double[limit], blist = new double[limit], rlist = new double[limit], + elist = new double[limit]; + final int[] iwork = new int[limit]; + dqagie(f, boun, inf, epsabs, epsrel, limit, result, abserr, neval, ier, alist, blist, rlist, + elist, iwork, last); + } } diff --git a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/GaussLegendre.java b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/GaussLegendre.java index 27fcafeb3..37d3677e7 100644 --- a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/GaussLegendre.java +++ b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/GaussLegendre.java @@ -5,196 +5,196 @@ import org.matheclipse.core.numerics.utils.SimpleMath; /** - * Integrate a real function of one variable over a finite interval using an - * adaptive 8-point Legendre-Gauss algorithm. This algorithm is a translation of - * the corresponding subroutine dgaus8 from the SLATEC library. + * Integrate a real function of one variable over a finite interval using an adaptive 8-point + * Legendre-Gauss algorithm. This algorithm is a translation of the corresponding subroutine dgaus8 + * from the SLATEC library. */ public final class GaussLegendre extends Quadrature { - private static final double X1 = 1.83434642495649805e-1; - private static final double X2 = 5.25532409916328986e-1; - private static final double X3 = 7.96666477413626740e-1; - private static final double X4 = 9.60289856497536232e-1; - private static final double W1 = 3.62683783378361983e-1; - private static final double W2 = 3.13706645877887287e-1; - private static final double W3 = 2.22381034453374471e-1; - private static final double W4 = 1.01228536290376259e-1; - private static final double SQ2 = Constants.SQRT2; - - public GaussLegendre(final double tolerance, final int maxEvaluations) { - super(tolerance, maxEvaluations); + private static final double X1 = 1.83434642495649805e-1; + private static final double X2 = 5.25532409916328986e-1; + private static final double X3 = 7.96666477413626740e-1; + private static final double X4 = 9.60289856497536232e-1; + private static final double W1 = 3.62683783378361983e-1; + private static final double W2 = 3.13706645877887287e-1; + private static final double W3 = 2.22381034453374471e-1; + private static final double W4 = 1.01228536290376259e-1; + private static final double SQ2 = Constants.SQRT2; + + public GaussLegendre(final double tolerance, final int maxEvaluations) { + super(tolerance, maxEvaluations); + } + + @Override + final QuadratureResult properIntegral(final DoubleUnaryOperator f, final double a, + final double b) { + + // prepare variables + final double[] err = {myTol}; + final double[] ans = new double[1]; + final int[] ierr = new int[1]; + final int[] fev = new int[1]; + + // call main subroutine + dgaus8(f, a, b, err, ans, ierr, fev); + return new QuadratureResult(ans[0], err[0], fev[0], ierr[0] == 1 || ierr[0] == -1); + } + + @Override + public final String getName() { + return "Gauss-Legendre"; + } + + private void dgaus8(final DoubleUnaryOperator fun, final double a, final double b, + final double[] err, final double[] ans, final int[] ierr, final int[] fev) { + int k, kml = 6, kmx = 5000, l, lmx, mxl, nbits, nib, nlmx; + double ae, anib, area, c, ce, ee, ef, eps, est, gl, glr, tol, vr; + final int[] lr = new int[61]; + final double[] aa = new double[61], hh = new double[61], vl = new double[61], + gr = new double[61]; + + // Initialize + fev[0] = 0; + k = 53; + anib = SimpleMath.D1MACH[5 - 1] * k / 0.30102000; + nbits = (int) anib; + nlmx = Math.min(60, (nbits * 5) / 8); + ans[0] = 0.0; + ierr[0] = 1; + ce = 0.0; + if (a == b) { + if (err[0] < 0.0) { + err[0] = ce; + } + return; } - - @Override - final QuadratureResult properIntegral(final DoubleUnaryOperator f, final double a, - final double b) { - - // prepare variables - final double[] err = { myTol }; - final double[] ans = new double[1]; - final int[] ierr = new int[1]; - final int[] fev = new int[1]; - - // call main subroutine - dgaus8(f, a, b, err, ans, ierr, fev); - return new QuadratureResult(ans[0], err[0], fev[0], ierr[0] == 1 || ierr[0] == -1); + lmx = nlmx; + if (b != 0.0 && SimpleMath.sign(1.0, b) * a > 0.0) { + c = Math.abs(1.0 - a / b); + if (c <= 0.1) { + if (c <= 0.0) { + if (err[0] < 0.0) { + err[0] = ce; + } + return; + } + anib = 0.5 - Math.log(c) * Constants.LOG2_INV; + nib = (int) anib; + lmx = Math.min(nlmx, nbits - nib - 7); + if (lmx < 1) { + ierr[0] = -1; + if (err[0] < 0.0) { + err[0] = ce; + } + return; + } + } } - @Override - public final String getName() { - return "Gauss-Legendre"; + tol = Math.max(Math.abs(err[0]), SimpleMath.pow(2.0, 5 - nbits)) / 2.0; + if (err[0] == 0.0) { + tol = Math.sqrt(SimpleMath.D1MACH[4 - 1]); } - - private void dgaus8(final DoubleUnaryOperator fun, final double a, final double b, - final double[] err, - final double[] ans, final int[] ierr, final int[] fev) { - int k, kml = 6, kmx = 5000, l, lmx, mxl, nbits, nib, nlmx; - double ae, anib, area, c, ce, ee, ef, eps, est, gl, glr, tol, vr; - final int[] lr = new int[61]; - final double[] aa = new double[61], hh = new double[61], vl = new double[61], gr = new double[61]; - - // Initialize - fev[0] = 0; - k = 53; - anib = SimpleMath.D1MACH[5 - 1] * k / 0.30102000; - nbits = (int) anib; - nlmx = Math.min(60, (nbits * 5) / 8); - ans[0] = 0.0; - ierr[0] = 1; - ce = 0.0; - if (a == b) { - if (err[0] < 0.0) { - err[0] = ce; - } - return; - } - lmx = nlmx; - if (b != 0.0 && SimpleMath.sign(1.0, b) * a > 0.0) { - c = Math.abs(1.0 - a / b); - if (c <= 0.1) { - if (c <= 0.0) { - if (err[0] < 0.0) { - err[0] = ce; - } - return; - } - anib = 0.5 - Math.log(c) * Constants.LOG2_INV; - nib = (int) anib; - lmx = Math.min(nlmx, nbits - nib - 7); - if (lmx < 1) { - ierr[0] = -1; - if (err[0] < 0.0) { - err[0] = ce; - } - return; - } - } - } - - tol = Math.max(Math.abs(err[0]), SimpleMath.pow(2.0, 5 - nbits)) / 2.0; - if (err[0] == 0.0) { - tol = Math.sqrt(SimpleMath.D1MACH[4 - 1]); - } - eps = tol; - hh[1 - 1] = (b - a) / 4.0; - aa[1 - 1] = a; - lr[1 - 1] = 1; - l = 1; - est = g8(fun, aa[l - 1] + 2.0 * hh[l - 1], 2.0 * hh[l - 1]); - fev[0] += 8; - k = 8; - area = Math.abs(est); - ef = 0.5; - mxl = 0; - - while (true) { - - // Compute refined estimates, estimate the error, etc. - if (fev[0] - 8 >= myMaxEvals) { - // ans[0] = Double.NaN; - ierr[0] = 2; - return; - } - gl = g8(fun, aa[l - 1] + hh[l - 1], hh[l - 1]); - fev[0] += 8; - if (fev[0] - 8 >= myMaxEvals) { - // ans[0] = Double.NaN; - ierr[0] = 2; - return; - } - gr[l - 1] = g8(fun, aa[l - 1] + 3.0 * hh[l - 1], hh[l - 1]); - fev[0] += 8; - - k += 16; - area += (Math.abs(gl) + Math.abs(gr[l - 1]) - Math.abs(est)); - glr = gl + gr[l - 1]; - ee = Math.abs(est - glr) * ef; - ae = Math.max(eps * area, tol * Math.abs(glr)); - if (ee - ae > 0.0) { - - // Consider the left half of this level - if (k > kmx) { - lmx = kml; - } - if (l >= lmx) { - mxl = 1; - } else { - ++l; - eps *= 0.5; - ef /= SQ2; - hh[l - 1] = hh[l - 1 - 1] * 0.5; - lr[l - 1] = -1; - aa[l - 1] = aa[l - 1 - 1]; - est = gl; - continue; - } - } - - ce += (est - glr); - if (lr[l - 1] <= 0.0) { - - // Proceed to right half at this level - vl[l - 1] = glr; - est = gr[l - 1 - 1]; - lr[l - 1] = 1; - aa[l - 1] += 4.0 * hh[l - 1]; - } else { - - // Return one level - vr = glr; - while (true) { - if (l <= 1) { - ans[0] = vr; - if (mxl != 0 && Math.abs(ce) > 2.0 * tol * area) { - ierr[0] = 2; - } - if (err[0] < 0.0) { - err[0] = ce; - } - return; - } - --l; - eps *= 2.0; - ef *= SQ2; - if (lr[l - 1] <= 0.0) { - vl[l - 1] = vl[l + 1 - 1] + vr; - est = gr[l - 1 - 1]; - lr[l - 1] = 1; - aa[l - 1] += 4.0 * hh[l - 1]; - break; - } else { - vr += vl[l + 1 - 1]; - } - } - } - } - } - - private static double g8(final DoubleUnaryOperator fun, final double x, final double h) { - final double fx1 = fun.applyAsDouble(x - X1 * h) + fun.applyAsDouble(x + X1 * h); - final double fx2 = fun.applyAsDouble(x - X2 * h) + fun.applyAsDouble(x + X2 * h); - final double fx3 = fun.applyAsDouble(x - X3 * h) + fun.applyAsDouble(x + X3 * h); - final double fx4 = fun.applyAsDouble(x - X4 * h) + fun.applyAsDouble(x + X4 * h); - return h * (W1 * fx1 + W2 * fx2 + W3 * fx3 + W4 * fx4); + eps = tol; + hh[1 - 1] = (b - a) / 4.0; + aa[1 - 1] = a; + lr[1 - 1] = 1; + l = 1; + est = g8(fun, aa[l - 1] + 2.0 * hh[l - 1], 2.0 * hh[l - 1]); + fev[0] += 8; + k = 8; + area = Math.abs(est); + ef = 0.5; + mxl = 0; + + while (true) { + + // Compute refined estimates, estimate the error, etc. + if (fev[0] - 8 >= myMaxEvals) { + // ans[0] = Double.NaN; + ierr[0] = 2; + return; + } + gl = g8(fun, aa[l - 1] + hh[l - 1], hh[l - 1]); + fev[0] += 8; + if (fev[0] - 8 >= myMaxEvals) { + // ans[0] = Double.NaN; + ierr[0] = 2; + return; + } + gr[l - 1] = g8(fun, aa[l - 1] + 3.0 * hh[l - 1], hh[l - 1]); + fev[0] += 8; + + k += 16; + area += (Math.abs(gl) + Math.abs(gr[l - 1]) - Math.abs(est)); + glr = gl + gr[l - 1]; + ee = Math.abs(est - glr) * ef; + ae = Math.max(eps * area, tol * Math.abs(glr)); + if (ee - ae > 0.0) { + + // Consider the left half of this level + if (k > kmx) { + lmx = kml; + } + if (l >= lmx) { + mxl = 1; + } else { + ++l; + eps *= 0.5; + ef /= SQ2; + hh[l - 1] = hh[l - 1 - 1] * 0.5; + lr[l - 1] = -1; + aa[l - 1] = aa[l - 1 - 1]; + est = gl; + continue; + } + } + + ce += (est - glr); + if (lr[l - 1] <= 0.0) { + + // Proceed to right half at this level + vl[l - 1] = glr; + est = gr[l - 1 - 1]; + lr[l - 1] = 1; + aa[l - 1] += 4.0 * hh[l - 1]; + } else { + + // Return one level + vr = glr; + while (true) { + if (l <= 1) { + ans[0] = vr; + if (mxl != 0 && Math.abs(ce) > 2.0 * tol * area) { + ierr[0] = 2; + } + if (err[0] < 0.0) { + err[0] = ce; + } + return; + } + --l; + eps *= 2.0; + ef *= SQ2; + if (lr[l - 1] <= 0.0) { + vl[l - 1] = vl[l + 1 - 1] + vr; + est = gr[l - 1 - 1]; + lr[l - 1] = 1; + aa[l - 1] += 4.0 * hh[l - 1]; + break; + } else { + vr += vl[l + 1 - 1]; + } + } + } } + } + + private static double g8(final DoubleUnaryOperator fun, final double x, final double h) { + final double fx1 = fun.applyAsDouble(x - X1 * h) + fun.applyAsDouble(x + X1 * h); + final double fx2 = fun.applyAsDouble(x - X2 * h) + fun.applyAsDouble(x + X2 * h); + final double fx3 = fun.applyAsDouble(x - X3 * h) + fun.applyAsDouble(x + X3 * h); + final double fx4 = fun.applyAsDouble(x - X4 * h) + fun.applyAsDouble(x + X4 * h); + return h * (W1 * fx1 + W2 * fx2 + W3 * fx3 + W4 * fx4); + } } diff --git a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/GaussLobatto.java b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/GaussLobatto.java index dd57e27f9..dee2535a7 100644 --- a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/GaussLobatto.java +++ b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/GaussLobatto.java @@ -4,50 +4,52 @@ import org.matheclipse.core.numerics.utils.Constants; /** - * Implements an adaptive numerical integrator based on the 7-point - * Gauss-Lobatto rule, as described in [1]. + * Implements an adaptive numerical integrator based on the 7-point Gauss-Lobatto rule, as described + * in [1]. * *

* References: *

*

*/ public final class GaussLobatto extends Quadrature { - private static final double ALPHA = Constants.SQRT2 / Constants.SQRT3; - private static final double BETA = 1.0 / Constants.SQRT5; + private static final double ALPHA = Constants.SQRT2 / Constants.SQRT3; + private static final double BETA = 1.0 / Constants.SQRT5; - private static final double[] X = { 0.94288241569547971906, 0.64185334234578130578, 0.23638319966214988028 }; - private static final double[] Y = { 0.0158271919734801831, 0.0942738402188500455, 0.1550719873365853963, - 0.1888215739601824544, 0.1997734052268585268, 0.2249264653333395270, 0.2426110719014077338 }; - private static final double[] C = { 77.0, 432.0, 625.0, 672.0 }; + private static final double[] X = + {0.94288241569547971906, 0.64185334234578130578, 0.23638319966214988028}; + private static final double[] Y = + {0.0158271919734801831, 0.0942738402188500455, 0.1550719873365853963, 0.1888215739601824544, + 0.1997734052268585268, 0.2249264653333395270, 0.2426110719014077338}; + private static final double[] C = {77.0, 432.0, 625.0, 672.0}; - private int fev; + private int fev; - public GaussLobatto(final double tolerance, final int maxEvaluations) { - super(tolerance, maxEvaluations); - } + public GaussLobatto(final double tolerance, final int maxEvaluations) { + super(tolerance, maxEvaluations); + } - @Override - final QuadratureResult properIntegral(final DoubleUnaryOperator f, final double a, - final double b) { - return dlob8e(f, a, b); - } + @Override + final QuadratureResult properIntegral(final DoubleUnaryOperator f, final double a, + final double b) { + return dlob8e(f, a, b); + } - @Override - public final String getName() { - return "Gauss-Lobatto"; - } + @Override + public final String getName() { + return "Gauss-Lobatto"; + } - private final QuadratureResult dlob8e(final DoubleUnaryOperator f, final double a, - final double b) { + private final QuadratureResult dlob8e(final DoubleUnaryOperator f, final double a, + final double b) { - // compute interpolation points - final double mid = 0.5 * (a + b); - final double h = 0.5 * (b - a); + // compute interpolation points + final double mid = 0.5 * (a + b); + final double h = 0.5 * (b - a); final double y1 = f.applyAsDouble(a); final double y3 = f.applyAsDouble(mid - h * ALPHA); final double y5 = f.applyAsDouble(mid - h * BETA); @@ -61,78 +63,78 @@ private final QuadratureResult dlob8e(final DoubleUnaryOperator f, final double final double f4 = f.applyAsDouble(mid + h * X[1]); final double f5 = f.applyAsDouble(mid - h * X[2]); final double f6 = f.applyAsDouble(mid + h * X[2]); - fev = 13; - - // compute a crude initial estimate of the integral - final double est1 = (y1 + y13 + 5.0 * (y5 + y9)) * (h / 6.0); - - // compute a more refined estimate of the integral - double est2 = C[0] * (y1 + y13) + C[1] * (y3 + y11) + C[2] * (y5 + y9) + C[3] * y7; - est2 *= (h / 1470.0); - - // compute the error estimate - double s = Y[0] * (y1 + y13) + Y[1] * (f1 + f2); - s += Y[2] * (y3 + y11) + Y[3] * (f3 + f4); - s += Y[4] * (y5 + y9) + Y[5] * (f5 + f6) + Y[6] * y7; - s *= h; - double rtol = myTol; - if (est1 != s) { - final double r = Math.abs(est2 - s) / Math.abs(est1 - s); - if (r > 0.0 && r < 1.0) { - rtol /= r; - } - } - double sign = Math.signum(s); - if (sign == 0) { - sign = 1.0; - } - double s1 = sign * Math.abs(s) * rtol / Constants.EPSILON; - if (s == 0) { - s1 = Math.abs(b - a); - } - - // call the recursive subroutine - final double result = dlob8(f, a, b, y1, y13, s1, rtol); - return new QuadratureResult(result, Double.NaN, fev, Double.isFinite(result)); + fev = 13; + + // compute a crude initial estimate of the integral + final double est1 = (y1 + y13 + 5.0 * (y5 + y9)) * (h / 6.0); + + // compute a more refined estimate of the integral + double est2 = C[0] * (y1 + y13) + C[1] * (y3 + y11) + C[2] * (y5 + y9) + C[3] * y7; + est2 *= (h / 1470.0); + + // compute the error estimate + double s = Y[0] * (y1 + y13) + Y[1] * (f1 + f2); + s += Y[2] * (y3 + y11) + Y[3] * (f3 + f4); + s += Y[4] * (y5 + y9) + Y[5] * (f5 + f6) + Y[6] * y7; + s *= h; + double rtol = myTol; + if (est1 != s) { + final double r = Math.abs(est2 - s) / Math.abs(est1 - s); + if (r > 0.0 && r < 1.0) { + rtol /= r; + } } + double sign = Math.signum(s); + if (sign == 0) { + sign = 1.0; + } + double s1 = sign * Math.abs(s) * rtol / Constants.EPSILON; + if (s == 0) { + s1 = Math.abs(b - a); + } + + // call the recursive subroutine + final double result = dlob8(f, a, b, y1, y13, s1, rtol); + return new QuadratureResult(result, Double.NaN, fev, Double.isFinite(result)); + } - private final double dlob8(final DoubleUnaryOperator f, final double a, final double b, - final double fa, final double fb, final double s, final double rtol) { - - // check the budget of evaluations - if (fev >= myMaxEvals) { - return Double.NaN; - } - - // compute the interpolation points - final double h = 0.5 * (b - a); - final double mid = 0.5 * (a + b); - final double mll = mid - h * ALPHA; - final double ml = mid - h * BETA; - final double mr = mid + BETA * h; - final double mrr = mid + h * ALPHA; + private final double dlob8(final DoubleUnaryOperator f, final double a, final double b, + final double fa, final double fb, final double s, final double rtol) { + + // check the budget of evaluations + if (fev >= myMaxEvals) { + return Double.NaN; + } + + // compute the interpolation points + final double h = 0.5 * (b - a); + final double mid = 0.5 * (a + b); + final double mll = mid - h * ALPHA; + final double ml = mid - h * BETA; + final double mr = mid + BETA * h; + final double mrr = mid + h * ALPHA; final double fmll = f.applyAsDouble(mll); final double fml = f.applyAsDouble(ml); final double fmid = f.applyAsDouble(mid); final double fmr = f.applyAsDouble(mr); final double fmrr = f.applyAsDouble(mrr); - fev += 8; + fev += 8; - // compute a crude estimate of the integral - final double est1 = (fa + fb + 5.0 * (fml + fmr)) * (h / 6.0); + // compute a crude estimate of the integral + final double est1 = (fa + fb + 5.0 * (fml + fmr)) * (h / 6.0); - // compute a more refined estimate of the integral - double est2 = C[0] * (fa + fb) + C[1] * (fmll + fmrr) + C[2] * (fml + fmr) + C[3] * fmid; - est2 *= (h / 1470.0); + // compute a more refined estimate of the integral + double est2 = C[0] * (fa + fb) + C[1] * (fmll + fmrr) + C[2] * (fml + fmr) + C[3] * fmid; + est2 *= (h / 1470.0); - // check the convergence - if (s + (est2 - est1) == s || mll <= a || b <= mrr) { - return est2; - } - - // subdivide the integration region and repeat - return dlob8(f, a, mll, fa, fmll, s, rtol) + dlob8(f, mll, ml, fmll, fml, s, rtol) - + dlob8(f, ml, mid, fml, fmid, s, rtol) + dlob8(f, mid, mr, fmid, fmr, s, rtol) - + dlob8(f, mr, mrr, fmr, fmrr, s, rtol) + dlob8(f, mrr, b, fmrr, fb, s, rtol); + // check the convergence + if (s + (est2 - est1) == s || mll <= a || b <= mrr) { + return est2; } + + // subdivide the integration region and repeat + return dlob8(f, a, mll, fa, fmll, s, rtol) + dlob8(f, mll, ml, fmll, fml, s, rtol) + + dlob8(f, ml, mid, fml, fmid, s, rtol) + dlob8(f, mid, mr, fmid, fmr, s, rtol) + + dlob8(f, mr, mrr, fmr, fmrr, s, rtol) + dlob8(f, mrr, b, fmrr, fb, s, rtol); + } } diff --git a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/NewtonCotes.java b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/NewtonCotes.java index cef27d7db..d25800c4c 100644 --- a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/NewtonCotes.java +++ b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/NewtonCotes.java @@ -5,247 +5,248 @@ import org.matheclipse.core.numerics.utils.SimpleMath; /** - * Integrate a function using a 7-point adaptive Newton-Cotes quadrature rule. - * This algorithm is a translation of the corresponding subroutine dqnc79 from - * the SLATEC library. + * Integrate a function using a 7-point adaptive Newton-Cotes quadrature rule. This algorithm is a + * translation of the corresponding subroutine dqnc79 from the SLATEC library. */ public final class NewtonCotes extends Quadrature { - private static final double W1 = 41.0 / 140.0; - private static final double W2 = 216.0 / 140.0; - private static final double W3 = 27.0 / 140.0; - private static final double W4 = 272.0 / 140.0; - - public NewtonCotes(final double tolerance, final int maxEvaluations) { - super(tolerance, maxEvaluations); + private static final double W1 = 41.0 / 140.0; + private static final double W2 = 216.0 / 140.0; + private static final double W3 = 27.0 / 140.0; + private static final double W4 = 272.0 / 140.0; + + public NewtonCotes(final double tolerance, final int maxEvaluations) { + super(tolerance, maxEvaluations); + } + + @Override + final QuadratureResult properIntegral(final DoubleUnaryOperator f, final double a, + final double b) { + return dqnc79(f, a, b); + } + + @Override + public final String getName() { + return "Newton-Cotes"; + } + + private final QuadratureResult dqnc79(final DoubleUnaryOperator fun, final double a, + final double b) { + double ae, area, bank, blocal, c, ce, ee, ef, eps, q13, q7, q7l, sq2 = Constants.SQRT2, test, + tol, vr, ans; + int i, kml = 7, kmx = 5000, l, lmn, lmx, nbits, nib, nlmn = 2, nlmx, fev = 0, k = 0; + final double[] aa = new double[100], f = new double[14], f1 = new double[100], + f2 = new double[100], f3 = new double[100], f4 = new double[100], f5 = new double[100], + f6 = new double[100], f7 = new double[100], hh = new double[100], q7r = new double[100], + vl = new double[100]; + final int[] lr = new int[100]; + + nbits = (int) (SimpleMath.D1MACH[5 - 1] * 53 / 0.30102000); + nlmx = Math.min(99, (nbits * 4) / 5); + ce = 0.0; + ans = 0.0; + if (a == b) { + return new QuadratureResult(ans, ce, fev, true); } - - @Override - final QuadratureResult properIntegral(final DoubleUnaryOperator f, final double a, - final double b) { - return dqnc79(f, a, b); + lmx = nlmx; + lmn = nlmn; + if (b != 0.0 && SimpleMath.sign(1.0, b) * a > 0.0) { + c = Math.abs(1.0 - a / b); + if (c <= 0.1) { + if (c <= 0.0) { + return new QuadratureResult(ans, ce, fev, true); + } + nib = (int) (0.5 - Math.log(c) * Constants.LOG2_INV); + lmx = Math.min(nlmx, nbits - nib - 4); + if (lmx < 2) { + return new QuadratureResult(ans, ce, fev, true); + } + lmn = Math.min(lmn, lmx); + } } - @Override - public final String getName() { - return "Newton-Cotes"; + tol = Math.max(Math.abs(myTol), SimpleMath.pow(2.0, 5 - nbits)); + if (myTol == 0.0) { + tol = Math.sqrt(SimpleMath.D1MACH[4 - 1]); } - - private final QuadratureResult dqnc79(final DoubleUnaryOperator fun, final double a, - final double b) { - double ae, area, bank, blocal, c, ce, ee, ef, eps, q13, q7, q7l, sq2 = Constants.SQRT2, test, tol, vr, ans; - int i, kml = 7, kmx = 5000, l, lmn, lmx, nbits, nib, nlmn = 2, nlmx, fev = 0, k = 0; - final double[] aa = new double[100], f = new double[14], f1 = new double[100], f2 = new double[100], - f3 = new double[100], f4 = new double[100], f5 = new double[100], f6 = new double[100], - f7 = new double[100], hh = new double[100], q7r = new double[100], vl = new double[100]; - final int[] lr = new int[100]; - - nbits = (int) (SimpleMath.D1MACH[5 - 1] * 53 / 0.30102000); - nlmx = Math.min(99, (nbits * 4) / 5); - ce = 0.0; - ans = 0.0; - if (a == b) { - return new QuadratureResult(ans, ce, fev, true); - } - lmx = nlmx; - lmn = nlmn; - if (b != 0.0 && SimpleMath.sign(1.0, b) * a > 0.0) { - c = Math.abs(1.0 - a / b); - if (c <= 0.1) { - if (c <= 0.0) { - return new QuadratureResult(ans, ce, fev, true); - } - nib = (int) (0.5 - Math.log(c) * Constants.LOG2_INV); - lmx = Math.min(nlmx, nbits - nib - 4); - if (lmx < 2) { - return new QuadratureResult(ans, ce, fev, true); - } - lmn = Math.min(lmn, lmx); - } - } - - tol = Math.max(Math.abs(myTol), SimpleMath.pow(2.0, 5 - nbits)); - if (myTol == 0.0) { - tol = Math.sqrt(SimpleMath.D1MACH[4 - 1]); - } - eps = tol; - hh[1 - 1] = (b - a) / 12.0; - aa[1 - 1] = a; - lr[1 - 1] = 1; - for (i = 1; i <= 11; i += 2) { + eps = tol; + hh[1 - 1] = (b - a) / 12.0; + aa[1 - 1] = a; + lr[1 - 1] = 1; + for (i = 1; i <= 11; i += 2) { f[i - 1] = fun.applyAsDouble(a + (i - 1) * hh[1 - 1]); - ++fev; - } - blocal = b; + ++fev; + } + blocal = b; f[13 - 1] = fun.applyAsDouble(blocal); - ++fev; - k = 7; - l = 1; - area = q7 = 0.0; - ef = 256.0 / 255.0; - bank = 0.0; - - while (true) { - - // Compute refined estimates, estimate the error, etc - for (i = 2; i <= 12; i += 2) { - f[i - 1] = fun.applyAsDouble(aa[l - 1] + (i - 1) * hh[l - 1]); - ++fev; - if (fev >= myMaxEvals) { - return new QuadratureResult(ans, ce, fev, false); - } - } - k += 6; - - // Compute left and right half estimates - q7l = hh[l - 1] * ((W1 * (f[1 - 1] + f[7 - 1]) + W2 * (f[2 - 1] + f[6 - 1])) - + (W3 * (f[3 - 1] + f[5 - 1]) + W4 * f[4 - 1])); - q7r[l - 1] = hh[l - 1] * ((W1 * (f[7 - 1] + f[13 - 1]) + W2 * (f[8 - 1] + f[12 - 1])) - + (W3 * (f[9 - 1] + f[11 - 1]) + W4 * f[10 - 1])); - - // Update estimate of integral of absolute value - area += (Math.abs(q7l) + Math.abs(q7r[l - 1]) - Math.abs(q7)); - - // Do not bother to test convergence before minimum refinement level - if (l < lmn) { - ++l; - eps *= 0.5; - if (l <= 17) { - ef /= sq2; - } - hh[l - 1] = hh[l - 1 - 1] * 0.5; - lr[l - 1] = -1; - aa[l - 1] = aa[l - 1 - 1]; - q7 = q7l; - f1[l - 1] = f[7 - 1]; - f2[l - 1] = f[8 - 1]; - f3[l - 1] = f[9 - 1]; - f4[l - 1] = f[10 - 1]; - f5[l - 1] = f[11 - 1]; - f6[l - 1] = f[12 - 1]; - f7[l - 1] = f[13 - 1]; - f[13 - 1] = f[7 - 1]; - f[11 - 1] = f[6 - 1]; - f[9 - 1] = f[5 - 1]; - f[7 - 1] = f[4 - 1]; - f[5 - 1] = f[3 - 1]; - f[3 - 1] = f[2 - 1]; - continue; - } - - // Estimate the error in new value for whole interval, Q13 - q13 = q7l + q7r[l - 1]; - ee = Math.abs(q7 - q13) * ef; - - // Compute nominal allowed error - ae = eps * area; - - // Borrow from bank account, but not too much - test = Math.min(ae + 0.8 * bank, 10.0 * ae); - - // Don't ask for excessive accuracy - test = Math.max(test, Math.max(tol * Math.abs(q13), 3.0e-5 * tol * area)); - - // Now, did this interval pass or not? - if (ee - test <= 0.0) { - - // On good intervals accumulate the theoretical estimate - ce += (q7 - q13) / 255.0; - } else { - - // Consider the left half of next deeper level - if (k > kmx) { - lmx = Math.min(kml, lmx); - } - if (l >= lmx) { - - // Have hit maximum refinement level -- - // penalize the cumulative error - ce += (q7 - q13); - } else { - ++l; - eps *= 0.5; - if (l <= 17) { - ef /= sq2; - } - hh[l - 1] = hh[l - 1 - 1] * 0.5; - lr[l - 1] = -1; - aa[l - 1] = aa[l - 1 - 1]; - q7 = q7l; - f1[l - 1] = f[7 - 1]; - f2[l - 1] = f[8 - 1]; - f3[l - 1] = f[9 - 1]; - f4[l - 1] = f[10 - 1]; - f5[l - 1] = f[11 - 1]; - f6[l - 1] = f[12 - 1]; - f7[l - 1] = f[13 - 1]; - f[13 - 1] = f[7 - 1]; - f[11 - 1] = f[6 - 1]; - f[9 - 1] = f[5 - 1]; - f[7 - 1] = f[4 - 1]; - f[5 - 1] = f[3 - 1]; - f[3 - 1] = f[2 - 1]; - continue; - } - } - - // Update the bank account. Don't go into debt. - bank += (ae - ee); - if (bank < 0.0) { - bank = 0.0; - } - - // Did we just finish a left half or a right half? - if (lr[l - 1] <= 0.0) { - - // Proceed to right half at this level - vl[l - 1] = q13; - q7 = q7r[l - 1 - 1]; - lr[l - 1] = 1; - aa[l - 1] += 12.0 * hh[l - 1]; - f[1 - 1] = f1[l - 1]; - f[3 - 1] = f2[l - 1]; - f[5 - 1] = f3[l - 1]; - f[7 - 1] = f4[l - 1]; - f[9 - 1] = f5[l - 1]; - f[11 - 1] = f6[l - 1]; - f[13 - 1] = f7[l - 1]; - } else { - - // Left and right halves are done, so go back up a level - vr = q13; - while (true) { - if (l <= 1) { - ans = vr; - if (Math.abs(ce) > 2.0 * tol * area) { - return new QuadratureResult(ans, Math.abs(ce), fev, false); - } else { - return new QuadratureResult(ans, Math.abs(ce), fev, true); - } - } - if (l <= 17) { - ef *= sq2; - } - eps *= 2.0; - --l; - if (lr[l - 1] <= 0.0) { - vl[l - 1] = vl[l + 1 - 1] + vr; - q7 = q7r[l - 1 - 1]; - lr[l - 1] = 1; - aa[l - 1] += 12.0 * hh[l - 1]; - f[1 - 1] = f1[l - 1]; - f[3 - 1] = f2[l - 1]; - f[5 - 1] = f3[l - 1]; - f[7 - 1] = f4[l - 1]; - f[9 - 1] = f5[l - 1]; - f[11 - 1] = f6[l - 1]; - f[13 - 1] = f7[l - 1]; - break; - } else { - vr += vl[l + 1 - 1]; - } - } - } - } + ++fev; + k = 7; + l = 1; + area = q7 = 0.0; + ef = 256.0 / 255.0; + bank = 0.0; + + while (true) { + + // Compute refined estimates, estimate the error, etc + for (i = 2; i <= 12; i += 2) { + f[i - 1] = fun.applyAsDouble(aa[l - 1] + (i - 1) * hh[l - 1]); + ++fev; + if (fev >= myMaxEvals) { + return new QuadratureResult(ans, ce, fev, false); + } + } + k += 6; + + // Compute left and right half estimates + q7l = hh[l - 1] * ((W1 * (f[1 - 1] + f[7 - 1]) + W2 * (f[2 - 1] + f[6 - 1])) + + (W3 * (f[3 - 1] + f[5 - 1]) + W4 * f[4 - 1])); + q7r[l - 1] = hh[l - 1] * ((W1 * (f[7 - 1] + f[13 - 1]) + W2 * (f[8 - 1] + f[12 - 1])) + + (W3 * (f[9 - 1] + f[11 - 1]) + W4 * f[10 - 1])); + + // Update estimate of integral of absolute value + area += (Math.abs(q7l) + Math.abs(q7r[l - 1]) - Math.abs(q7)); + + // Do not bother to test convergence before minimum refinement level + if (l < lmn) { + ++l; + eps *= 0.5; + if (l <= 17) { + ef /= sq2; + } + hh[l - 1] = hh[l - 1 - 1] * 0.5; + lr[l - 1] = -1; + aa[l - 1] = aa[l - 1 - 1]; + q7 = q7l; + f1[l - 1] = f[7 - 1]; + f2[l - 1] = f[8 - 1]; + f3[l - 1] = f[9 - 1]; + f4[l - 1] = f[10 - 1]; + f5[l - 1] = f[11 - 1]; + f6[l - 1] = f[12 - 1]; + f7[l - 1] = f[13 - 1]; + f[13 - 1] = f[7 - 1]; + f[11 - 1] = f[6 - 1]; + f[9 - 1] = f[5 - 1]; + f[7 - 1] = f[4 - 1]; + f[5 - 1] = f[3 - 1]; + f[3 - 1] = f[2 - 1]; + continue; + } + + // Estimate the error in new value for whole interval, Q13 + q13 = q7l + q7r[l - 1]; + ee = Math.abs(q7 - q13) * ef; + + // Compute nominal allowed error + ae = eps * area; + + // Borrow from bank account, but not too much + test = Math.min(ae + 0.8 * bank, 10.0 * ae); + + // Don't ask for excessive accuracy + test = Math.max(test, Math.max(tol * Math.abs(q13), 3.0e-5 * tol * area)); + + // Now, did this interval pass or not? + if (ee - test <= 0.0) { + + // On good intervals accumulate the theoretical estimate + ce += (q7 - q13) / 255.0; + } else { + + // Consider the left half of next deeper level + if (k > kmx) { + lmx = Math.min(kml, lmx); + } + if (l >= lmx) { + + // Have hit maximum refinement level -- + // penalize the cumulative error + ce += (q7 - q13); + } else { + ++l; + eps *= 0.5; + if (l <= 17) { + ef /= sq2; + } + hh[l - 1] = hh[l - 1 - 1] * 0.5; + lr[l - 1] = -1; + aa[l - 1] = aa[l - 1 - 1]; + q7 = q7l; + f1[l - 1] = f[7 - 1]; + f2[l - 1] = f[8 - 1]; + f3[l - 1] = f[9 - 1]; + f4[l - 1] = f[10 - 1]; + f5[l - 1] = f[11 - 1]; + f6[l - 1] = f[12 - 1]; + f7[l - 1] = f[13 - 1]; + f[13 - 1] = f[7 - 1]; + f[11 - 1] = f[6 - 1]; + f[9 - 1] = f[5 - 1]; + f[7 - 1] = f[4 - 1]; + f[5 - 1] = f[3 - 1]; + f[3 - 1] = f[2 - 1]; + continue; + } + } + + // Update the bank account. Don't go into debt. + bank += (ae - ee); + if (bank < 0.0) { + bank = 0.0; + } + + // Did we just finish a left half or a right half? + if (lr[l - 1] <= 0.0) { + + // Proceed to right half at this level + vl[l - 1] = q13; + q7 = q7r[l - 1 - 1]; + lr[l - 1] = 1; + aa[l - 1] += 12.0 * hh[l - 1]; + f[1 - 1] = f1[l - 1]; + f[3 - 1] = f2[l - 1]; + f[5 - 1] = f3[l - 1]; + f[7 - 1] = f4[l - 1]; + f[9 - 1] = f5[l - 1]; + f[11 - 1] = f6[l - 1]; + f[13 - 1] = f7[l - 1]; + } else { + + // Left and right halves are done, so go back up a level + vr = q13; + while (true) { + if (l <= 1) { + ans = vr; + if (Math.abs(ce) > 2.0 * tol * area) { + return new QuadratureResult(ans, Math.abs(ce), fev, false); + } else { + return new QuadratureResult(ans, Math.abs(ce), fev, true); + } + } + if (l <= 17) { + ef *= sq2; + } + eps *= 2.0; + --l; + if (lr[l - 1] <= 0.0) { + vl[l - 1] = vl[l + 1 - 1] + vr; + q7 = q7r[l - 1 - 1]; + lr[l - 1] = 1; + aa[l - 1] += 12.0 * hh[l - 1]; + f[1 - 1] = f1[l - 1]; + f[3 - 1] = f2[l - 1]; + f[5 - 1] = f3[l - 1]; + f[7 - 1] = f4[l - 1]; + f[9 - 1] = f5[l - 1]; + f[11 - 1] = f6[l - 1]; + f[13 - 1] = f7[l - 1]; + break; + } else { + vr += vl[l + 1 - 1]; + } + } + } } + } } diff --git a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/Quadrature.java b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/Quadrature.java index 0d4618a65..c4b457044 100644 --- a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/Quadrature.java +++ b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/Quadrature.java @@ -9,180 +9,176 @@ */ public abstract class Quadrature { - /** - * - */ - public static final class QuadratureResult { - - public final double estimate; - public final double error; - public final int evaluations; - public final boolean converged; - - public QuadratureResult(final double est, final double err, final int evals, final boolean success) { - estimate = est; - error = err; - evaluations = evals; - converged = success; - } - - @Override - public String toString() { - return String.format("%.08f", estimate) + " +- " + String.format("%.08f", error) + "\n" + "evaluations: " - + evaluations + "\n" + "converged: " + converged; - } + /** + * + */ + public static final class QuadratureResult { + + public final double estimate; + public final double error; + public final int evaluations; + public final boolean converged; + + public QuadratureResult(final double est, final double err, final int evals, + final boolean success) { + estimate = est; + error = err; + evaluations = evals; + converged = success; } - protected final double myTol; - protected final int myMaxEvals; - - /** - * Creates a new instance of the current numerical integrator. - * - * @param tolerance the smallest acceptable change in integral estimates in - * consecutive iterations that indicates the algorithm has - * converged - * @param maxEvaluations the maximum number of evaluations of each function - * permitted - */ - public Quadrature(final double tolerance, final int maxEvaluations) { - myTol = tolerance; - myMaxEvals = maxEvaluations; + @Override + public String toString() { + return String.format("%.08f", estimate) + " +- " + String.format("%.08f", error) + "\n" + + "evaluations: " + evaluations + "\n" + "converged: " + converged; + } + } + + protected final double myTol; + protected final int myMaxEvals; + + /** + * Creates a new instance of the current numerical integrator. + * + * @param tolerance the smallest acceptable change in integral estimates in consecutive iterations + * that indicates the algorithm has converged + * @param maxEvaluations the maximum number of evaluations of each function permitted + */ + public Quadrature(final double tolerance, final int maxEvaluations) { + myTol = tolerance; + myMaxEvals = maxEvaluations; + } + + abstract QuadratureResult properIntegral(DoubleUnaryOperator f, double a, double b); + + /** + * Returns a string representation of the current algorithm. + * + * @return a string representation of the current algorithm + */ + public abstract String getName(); + + /** + * Estimates a definite integral, or indefinite integral in some limited cases. All algorithms + * support definite integrals. The only algorithm that currently supports indefinite integrals is + * Gauss Kronrod. + * + * @param f the function to integrate + * @param a the left endpoint of the integration interval + * @param b the right endpoint of the integration interval + * @return an estimate of the definite or indefinite integral + */ + public QuadratureResult integrate(final DoubleUnaryOperator f, final double a, final double b) { + + // empty integral (a, a) + if (a == b) { + return new QuadratureResult(0.0, 0.0, 0, true); } - abstract QuadratureResult properIntegral(DoubleUnaryOperator f, double a, double b); - - /** - * Returns a string representation of the current algorithm. - * - * @return a string representation of the current algorithm - */ - public abstract String getName(); - - /** - * Estimates a definite integral, or indefinite integral in some limited cases. - * All algorithms support definite integrals. The only algorithm that currently - * supports indefinite integrals is Gauss Kronrod. - * - * @param f the function to integrate - * @param a the left endpoint of the integration interval - * @param b the right endpoint of the integration interval - * @return an estimate of the definite or indefinite integral - */ - public QuadratureResult integrate(final DoubleUnaryOperator f, final double a, - final double b) { - - // empty integral (a, a) - if (a == b) { - return new QuadratureResult(0.0, 0.0, 0, true); - } - - // opposite bounds - if (a > b) { - return integrate(f, b, a); - } - - // finite integral (a, b) - if (Double.isFinite(a) && Double.isFinite(b)) { - return properIntegral(f, a, b); - } - - // improper integral of the form [a, infinity] - if (Double.isFinite(a) && !Double.isFinite(b)) { - final DoubleUnaryOperator ft = t -> { - if (t <= 0.0) { - return 0.0; - } - final double x = a - 1.0 + 1.0 / t; - final double dx = 1.0 / t / t; - return f.applyAsDouble(x) * dx; - }; - return properIntegral(ft, 0.0, 1.0); - } - - // improper integral of the form [-infinity, b] - if (!Double.isFinite(a) && Double.isFinite(b)) { - final DoubleUnaryOperator ft = t -> { - if (t <= 0.0) { - return 0.0; - } - final double x = b + 1.0 - 1.0 / t; - final double dx = 1.0 / t / t; - return f.applyAsDouble(x) * dx; - }; - return properIntegral(ft, 0.0, 1.0); - } - - // doubly improper integral - final QuadratureResult left = integrate(f, a, 0.0); - final QuadratureResult right = integrate(f, 0.0, b); - return new QuadratureResult(left.estimate + right.estimate, left.error + right.error, - left.evaluations + right.evaluations, left.converged && right.converged); + // opposite bounds + if (a > b) { + return integrate(f, b, a); } - /** - * Estimates a definite integral of a function by first applying a change of - * variable to the function, suitable for estimating indefinite integrals. Given - * a function to integrate, f, and a differentiable function t, this method - * integrates f(t(x)) * t'(x). - * - * @param f the function to integrate - * @param t the change of variable - * @param dt the derivative of the change of variable function t - * @param a the left endpoint of the integration interval - * @param b the right endpoint of the integration interval - * @return an estimate of the definite integral - */ - public QuadratureResult integrate(final Function f, - final Function t, final Function dt, final double a, - final double b) { - - // construct the integrand f(t(x)) t(x) dt(x) - final DoubleUnaryOperator func = (x) -> f.apply(t.apply(x)) * dt.apply(x); + // finite integral (a, b) + if (Double.isFinite(a) && Double.isFinite(b)) { + return properIntegral(f, a, b); + } - // dispatch to integration routine - return integrate(func, a, b); + // improper integral of the form [a, infinity] + if (Double.isFinite(a) && !Double.isFinite(b)) { + final DoubleUnaryOperator ft = t -> { + if (t <= 0.0) { + return 0.0; + } + final double x = a - 1.0 + 1.0 / t; + final double dx = 1.0 / t / t; + return f.applyAsDouble(x) * dx; + }; + return properIntegral(ft, 0.0, 1.0); } - /** - * This method splits a potentially indefinite integration interval into - * disjoint definite intervals. It returns a sequence of integral estimates on - * each interval. This is very useful for evaluating highly oscillating - * integrals on infinite intervals, called Longman's method [1]. - * - *

- * References: - *

- *

- * - * @param f the function to integrate - * @param splitPoints the points at which to split the integration region when - * defining definite integrals - * @return an Iterable representing the sequence of definite integrals - */ - public Iterable integratePiecewise(final DoubleUnaryOperator f, - final Iterable splitPoints) { - return () -> new Iterator<>() { - - private final Iterator it = splitPoints.iterator(); - private double left = 0.0; - private double right = it.hasNext() ? it.next() : Double.NaN; - - @Override - public final boolean hasNext() { - return it.hasNext(); - } - - @Override - public final Double next() { - left = right; - right = it.next(); - return integrate(f, left, right).estimate; - } - }; + // improper integral of the form [-infinity, b] + if (!Double.isFinite(a) && Double.isFinite(b)) { + final DoubleUnaryOperator ft = t -> { + if (t <= 0.0) { + return 0.0; + } + final double x = b + 1.0 - 1.0 / t; + final double dx = 1.0 / t / t; + return f.applyAsDouble(x) * dx; + }; + return properIntegral(ft, 0.0, 1.0); } + + // doubly improper integral + final QuadratureResult left = integrate(f, a, 0.0); + final QuadratureResult right = integrate(f, 0.0, b); + return new QuadratureResult(left.estimate + right.estimate, left.error + right.error, + left.evaluations + right.evaluations, left.converged && right.converged); + } + + /** + * Estimates a definite integral of a function by first applying a change of variable to the + * function, suitable for estimating indefinite integrals. Given a function to integrate, f, and a + * differentiable function t, this method integrates f(t(x)) * t'(x). + * + * @param f the function to integrate + * @param t the change of variable + * @param dt the derivative of the change of variable function t + * @param a the left endpoint of the integration interval + * @param b the right endpoint of the integration interval + * @return an estimate of the definite integral + */ + public QuadratureResult integrate(final Function f, + final Function t, final Function dt, + final double a, final double b) { + + // construct the integrand f(t(x)) t(x) dt(x) + final DoubleUnaryOperator func = (x) -> f.apply(t.apply(x)) * dt.apply(x); + + // dispatch to integration routine + return integrate(func, a, b); + } + + /** + * This method splits a potentially indefinite integration interval into disjoint definite + * intervals. It returns a sequence of integral estimates on each interval. This is very useful + * for evaluating highly oscillating integrals on infinite intervals, called Longman's method [1]. + * + *

+ * References: + *

    + *
  • [1] Longman, I. (1956). Note on a method for computing infinite integrals of oscillatory + * functions. Mathematical Proceedings of the Cambridge Philosophical Society, 52(4), 764-768. + * doi:10.1017/S030500410003187X
    • + *
+ *

+ * + * @param f the function to integrate + * @param splitPoints the points at which to split the integration region when defining definite + * integrals + * @return an Iterable representing the sequence of definite integrals + */ + public Iterable integratePiecewise(final DoubleUnaryOperator f, + final Iterable splitPoints) { + return () -> new Iterator<>() { + + private final Iterator it = splitPoints.iterator(); + private double left = 0.0; + private double right = it.hasNext() ? it.next() : Double.NaN; + + @Override + public final boolean hasNext() { + return it.hasNext(); + } + + @Override + public final Double next() { + left = right; + right = it.next(); + return integrate(f, left, right).estimate; + } + }; + } } diff --git a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/RmsRule.java b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/RmsRule.java index 8e9a4ab18..00992d940 100644 --- a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/RmsRule.java +++ b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/RmsRule.java @@ -4,856 +4,861 @@ import org.matheclipse.core.numerics.utils.Constants; /** - * An adaptive integrator obtained by replacing the Gauss-Kronrod rules in - * QUADPACK with recursive monotone stable (RMS) formulas [1]. A translation of - * a corresponding Fortran subroutine by Alan Miller. + * An adaptive integrator obtained by replacing the Gauss-Kronrod rules in QUADPACK with recursive + * monotone stable (RMS) formulas [1]. A translation of a corresponding Fortran subroutine by Alan + * Miller. * *

* References: *

    - *
  • [1] Favati, Paola, Grazia Lotti, and Francesco Romani. "Algorithm 691: - * Improving QUADPACK automatic integration routines." ACM Transactions on - * Mathematical Software (TOMS) 17.2 (1991): 218-232.
    • + *
  • [1] Favati, Paola, Grazia Lotti, and Francesco Romani. "Algorithm 691: Improving QUADPACK + * automatic integration routines." ACM Transactions on Mathematical Software (TOMS) 17.2 (1991): + * 218-232.
    • *
*

*/ public final class RmsRule extends Quadrature { - private static final int[] istart = { 0, 7, 17, 31 }; - private static final int[] length = { 7, 10, 14, 21 }; - - private static final double[] xx = { 0.0, .25000000000000000000E+00, .50000000000000000000E+00, - .75000000000000000000E+00, .87500000000000000000E+00, .93750000000000000000E+00, .10000000000000000000E+01, - .37500000000000000000E+00, .62500000000000000000E+00, .96875000000000000000E+00, .12500000000000000000E+00, - .68750000000000000000E+00, .81250000000000000000E+00, .98437500000000000000E+00, .18750000000000000000E+00, - .31250000000000000000E+00, .43750000000000000000E+00, .56250000000000000000E+00, .84375000000000000000E+00, - .90625000000000000000E+00, .99218750000000000000E+00 }; - - private static final double[] ww = { 1.303262173284849021810473057638590518409112513421E-1, - 2.390632866847646220320329836544615917290026806242E-1, - 2.630626354774670227333506083741355715758124943143E-1, - 2.186819313830574175167853094864355208948886875898E-1, - 2.757897646642836865859601197607471574336674206700E-2, - 1.055750100538458443365034879086669791305550493830E-1, - 1.571194260595182254168429283636656908546309467968E-2, - 1.298751627936015783241173611320651866834051160074E-1, - 2.249996826462523640447834514709508786970828213187E-1, - 1.680415725925575286319046726692683040162290325505E-1, - 1.415567675701225879892811622832845252125600939627E-1, - 1.006482260551160175038684459742336605269707889822E-1, - 2.510604860724282479058338820428989444699235030871E-2, - 9.402964360009747110031098328922608224934320397592E-3, - 5.542699233295875168406783695143646338274805359780E-2, - 9.986735247403367525720377847755415293097913496236E-2, - 4.507523056810492466415880450799432587809828791196E-2, - 6.300942249647773931746170540321811473310938661469E-2, - 1.261383225537664703012999637242003647020326905948E-1, - 1.273864433581028272878709981850307363453523117880E-1, - 8.576500414311820514214087864326799153427368592787E-2, - 7.102884842310253397447305465997026228407227220665E-2, - 5.026383572857942403759829860675892897279675661654E-2, - 4.683670010609093810432609684738393586390722052124E-3, - 1.235837891364555000245004813294817451524633100256E-1, - 1.148933497158144016800199601785309838604146040215E-1, - 1.252575774226122633391477702593585307254527198070E-2, - 1.239572396231834242194189674243818619042280816640E-1, - 2.501306413750310579525950767549691151739047969345E-2, - 4.915957918146130094258849161350510503556792927578E-2, - 2.259167374956474713302030584548274729936249753832E-2, - 6.362762978782724559269342300509058175967124446839E-2, - 9.950065827346794643193261975720606296171462239514E-2, - 7.048220002718565366098742295389607994441704889441E-2, - 6.512297339398335645872697307762912795346716454337E-2, - 3.998229150313659724790527138690215186863915308702E-2, - 3.456512257080287509832054272964315588028252136044E-2, - 2.212167975884114432760321569298651047876071264944E-3, - 8.140326425945938045967829319725797511040878579808E-2, - 6.583213447600552906273539578430361199084485578379E-2, - 2.592913726450792546064232192976262988065252032902E-2, - 1.187141856692283347609436153545356484256869129472E-1, - 5.999947605385971985589674757013565610751028128731E-2, - 5.500937980198041736910257988346101839062581489820E-2, - 5.264422421764655969760271538981443718440340270116E-3, - 1.533126874056586959338368742803997744815413565014E-2, - 3.527159369750123100455704702965541866345781113903E-2, - 5.000556431653955124212795201196389006184693561679E-2, - 5.744164831179720106340717579281831675999717767532E-2, - 1.598823797283813438301248206397233634639162043386E-2, - 2.635660410220884993472478832884065450876913559421E-2, - 1.196003937945541091670106760660561117114584656319E-2 }; - - private final double myRelTol; - - /** - * Creates a new instance of the RMS quadrature integrator. - * - * @param relativeTolerance the smallest acceptable relative change in integral - * estimates in consecutive iterations that indicates - * the algorithm has converged - * @param tolerance the smallest acceptable absolute change in integral - * estimates in consecutive iterations that indicates - * the algorithm has converged - * @param maxEvaluations the maximum number of evaluations of each function - * permitted - */ - public RmsRule(final double tolerance, final double relativeTolerance, final int maxEvaluations) { - super(tolerance, maxEvaluations); - myRelTol = relativeTolerance; + private static final int[] istart = {0, 7, 17, 31}; + private static final int[] length = {7, 10, 14, 21}; + + private static final double[] xx = {0.0, .25000000000000000000E+00, .50000000000000000000E+00, + .75000000000000000000E+00, .87500000000000000000E+00, .93750000000000000000E+00, + .10000000000000000000E+01, .37500000000000000000E+00, .62500000000000000000E+00, + .96875000000000000000E+00, .12500000000000000000E+00, .68750000000000000000E+00, + .81250000000000000000E+00, .98437500000000000000E+00, .18750000000000000000E+00, + .31250000000000000000E+00, .43750000000000000000E+00, .56250000000000000000E+00, + .84375000000000000000E+00, .90625000000000000000E+00, .99218750000000000000E+00}; + + private static final double[] ww = {1.303262173284849021810473057638590518409112513421E-1, + 2.390632866847646220320329836544615917290026806242E-1, + 2.630626354774670227333506083741355715758124943143E-1, + 2.186819313830574175167853094864355208948886875898E-1, + 2.757897646642836865859601197607471574336674206700E-2, + 1.055750100538458443365034879086669791305550493830E-1, + 1.571194260595182254168429283636656908546309467968E-2, + 1.298751627936015783241173611320651866834051160074E-1, + 2.249996826462523640447834514709508786970828213187E-1, + 1.680415725925575286319046726692683040162290325505E-1, + 1.415567675701225879892811622832845252125600939627E-1, + 1.006482260551160175038684459742336605269707889822E-1, + 2.510604860724282479058338820428989444699235030871E-2, + 9.402964360009747110031098328922608224934320397592E-3, + 5.542699233295875168406783695143646338274805359780E-2, + 9.986735247403367525720377847755415293097913496236E-2, + 4.507523056810492466415880450799432587809828791196E-2, + 6.300942249647773931746170540321811473310938661469E-2, + 1.261383225537664703012999637242003647020326905948E-1, + 1.273864433581028272878709981850307363453523117880E-1, + 8.576500414311820514214087864326799153427368592787E-2, + 7.102884842310253397447305465997026228407227220665E-2, + 5.026383572857942403759829860675892897279675661654E-2, + 4.683670010609093810432609684738393586390722052124E-3, + 1.235837891364555000245004813294817451524633100256E-1, + 1.148933497158144016800199601785309838604146040215E-1, + 1.252575774226122633391477702593585307254527198070E-2, + 1.239572396231834242194189674243818619042280816640E-1, + 2.501306413750310579525950767549691151739047969345E-2, + 4.915957918146130094258849161350510503556792927578E-2, + 2.259167374956474713302030584548274729936249753832E-2, + 6.362762978782724559269342300509058175967124446839E-2, + 9.950065827346794643193261975720606296171462239514E-2, + 7.048220002718565366098742295389607994441704889441E-2, + 6.512297339398335645872697307762912795346716454337E-2, + 3.998229150313659724790527138690215186863915308702E-2, + 3.456512257080287509832054272964315588028252136044E-2, + 2.212167975884114432760321569298651047876071264944E-3, + 8.140326425945938045967829319725797511040878579808E-2, + 6.583213447600552906273539578430361199084485578379E-2, + 2.592913726450792546064232192976262988065252032902E-2, + 1.187141856692283347609436153545356484256869129472E-1, + 5.999947605385971985589674757013565610751028128731E-2, + 5.500937980198041736910257988346101839062581489820E-2, + 5.264422421764655969760271538981443718440340270116E-3, + 1.533126874056586959338368742803997744815413565014E-2, + 3.527159369750123100455704702965541866345781113903E-2, + 5.000556431653955124212795201196389006184693561679E-2, + 5.744164831179720106340717579281831675999717767532E-2, + 1.598823797283813438301248206397233634639162043386E-2, + 2.635660410220884993472478832884065450876913559421E-2, + 1.196003937945541091670106760660561117114584656319E-2}; + + private final double myRelTol; + + /** + * Creates a new instance of the RMS quadrature integrator. + * + * @param relativeTolerance the smallest acceptable relative change in integral estimates in + * consecutive iterations that indicates the algorithm has converged + * @param tolerance the smallest acceptable absolute change in integral estimates in consecutive + * iterations that indicates the algorithm has converged + * @param maxEvaluations the maximum number of evaluations of each function permitted + */ + public RmsRule(final double tolerance, final double relativeTolerance, final int maxEvaluations) { + super(tolerance, maxEvaluations); + myRelTol = relativeTolerance; + } + + public RmsRule(final double tolerance, final int maxEvaluations) { + this(tolerance, 50.0 * Constants.EPSILON, maxEvaluations); + } + + @Override + final QuadratureResult properIntegral(final DoubleUnaryOperator f, final double a, + final double b) { + return qxgs(f, a, b, myTol, myRelTol, myMaxEvals); + } + + @Override + public final String getName() { + return "RMS Rule"; + } + + private final QuadratureResult qxgs(final DoubleUnaryOperator f, final double a, final double b, + final double epsabs, final double epsrel, final int limit) { + + // prepare variables + final int[] ier = new int[1]; + final double[] result = new double[1]; + final double[] abserr = new double[1]; + final int[] last = new int[1]; + final int[] fev = new int[1]; + + // call main subroutine + qxgs(f, a, b, epsabs, epsrel, result, abserr, ier, limit, last, fev); + return new QuadratureResult(result[0], abserr[0], fev[0], ier[0] == 0); + } + + private static void qxgs(final DoubleUnaryOperator f, final double a, final double b, + final double epsabs, final double epsrel, final double[] result, final double[] abserr, + final int[] ier, final int limit, final int[] last, final int[] fev) { + ier[0] = 6; + last[0] = 0; + result[0] = abserr[0] = 0.0; + fev[0] = 0; + if (limit < 1) { + return; } - public RmsRule(final double tolerance, final int maxEvaluations) { - this(tolerance, 50.0 * Constants.EPSILON, maxEvaluations); + // PREPARE CALL FOR QXGSE. + qxgse1(f, a, b, epsabs, epsrel, limit, result, abserr, ier, last, fev); + } + + private static void qxgse1(final DoubleUnaryOperator f, final double a, final double b, + final double epsabs, final double epsrel, final int limit, final double[] result, + final double[] abserr, final int[] ier, final int[] last, final int[] fev) { + + // THE ROUTINE CALCULATES AN APPROXIMATION RESULT TO A + // DEFINITE INTEGRAL I = INTEGRAL OF F OVER (A,B), + // HOPEFULLY SATISFYING FOLLOWING CLAIM FOR ACCURACY + // ABS(I-RESULT).LE.MAX(EPSABS,EPSREL*ABS(I)). + boolean extrap, noext; + int id, ierro, iroff1, iroff2, iroff3, jupbnd, k, ksgn, ktmin; + double area, area12, a1, a2, b1, b2, correc = 0.0, dres, epmach, erlarg = 0.0, erlast, errbnd, + erro12, errsum, ertest = 0.0, oflow, rerr, small = 0.0, t, uflow; + final int[] ln1 = new int[1], lp1 = new int[1], ln2 = new int[1], lp2 = new int[1], + maxerr = new int[1], nrmax = new int[1], numrl2 = new int[1], nres = new int[1]; + final double[] resabs = new double[1], defabs = new double[1], area1 = new double[1], + error1 = new double[1], defab1 = new double[1], defab2 = new double[1], + area2 = new double[1], error2 = new double[1], errmax = new double[1], + reseps = new double[1], abseps = new double[1]; + final double[] alist = new double[limit]; + final double[] blist = new double[limit]; + final double[] elist = new double[limit]; + final double[] res3la = new double[3]; + final double[] rlist = new double[limit]; + final double[] rlist2 = new double[52]; + final double[][] valp = new double[limit][21]; + final double[][] valn = new double[limit][21]; + final double[] vp1 = new double[21]; + final double[] vp2 = new double[21]; + final double[] vn1 = new double[21]; + final double[] vn2 = new double[21]; + final int[] iord = new int[limit]; + final int[] lp = new int[limit]; + final int[] ln = new int[limit]; + + // MACHINE DEPENDENT CONSTANTS + epmach = Constants.EPSILON; + uflow = Double.MIN_VALUE; + oflow = Double.MAX_VALUE; + + // TEST ON VALIDITY OF parameterS + last[0] = 0; + result[0] = abserr[0] = 0.0; + alist[1 - 1] = a; + blist[1 - 1] = b; + rlist[1 - 1] = elist[1 - 1] = 0.0; + ier[0] = 6; + if (epsabs < 0.0 || epsrel < 0.0) { + return; } + ier[0] = 0; + rerr = Math.max(epsrel, 50.0 * epmach); + fev[0] = 0; - @Override - final QuadratureResult properIntegral(final DoubleUnaryOperator f, final double a, - final double b) { - return qxgs(f, a, b, myTol, myRelTol, myMaxEvals); + // FIRST APPROXIMATION TO THE INTEGRAL + ierro = 0; + lp[1 - 1] = ln[1 - 1] = 1; + valp[1 - 1][1 - 1] = f.applyAsDouble((a + b) * 0.5); + ++fev[0]; + valn[1 - 1][1 - 1] = valp[1 - 1][1 - 1]; + qxlqm(f, a, b, result, abserr, resabs, defabs, valp[1 - 1], valn[1 - 1], lp, ln, 2, epmach, + uflow, oflow, fev); + + // TEST ON ACCURACY. + dres = Math.abs(result[0]); + errbnd = Math.max(epsabs, rerr * dres); + last[0] = 1; + rlist[1 - 1] = result[0]; + elist[1 - 1] = abserr[0]; + iord[1 - 1] = 1; + if (abserr[0] <= 100.0 * epmach * defabs[0] && abserr[0] > errbnd) { + ier[0] = 2; } - - @Override - public final String getName() { - return "RMS Rule"; + if (limit == 1) { + ier[0] = 1; } - - private final QuadratureResult qxgs(final DoubleUnaryOperator f, final double a, final double b, - final double epsabs, final double epsrel, final int limit) { - - // prepare variables - final int[] ier = new int[1]; - final double[] result = new double[1]; - final double[] abserr = new double[1]; - final int[] last = new int[1]; - final int[] fev = new int[1]; - - // call main subroutine - qxgs(f, a, b, epsabs, epsrel, result, abserr, ier, limit, last, fev); - return new QuadratureResult(result[0], abserr[0], fev[0], ier[0] == 0); + if (ier[0] != 0 || (abserr[0] <= errbnd && abserr[0] != resabs[0]) || (abserr[0] == 0.0)) { + return; } - private static void qxgs(final DoubleUnaryOperator f, final double a, final double b, - final double epsabs, final double epsrel, final double[] result, final double[] abserr, final int[] ier, - final int limit, final int[] last, final int[] fev) { - ier[0] = 6; - last[0] = 0; - result[0] = abserr[0] = 0.0; - fev[0] = 0; - if (limit < 1) { - return; - } - - // PREPARE CALL FOR QXGSE. - qxgse1(f, a, b, epsabs, epsrel, limit, result, abserr, ier, last, fev); + // INITIALIZATION + rlist2[1 - 1] = result[0]; + errmax[0] = abserr[0]; + maxerr[0] = 1; + area = result[0]; + errsum = abserr[0]; + abserr[0] = oflow; + nrmax[0] = 1; + nres[0] = 0; + numrl2[0] = 2; + ktmin = 0; + extrap = noext = false; + iroff1 = iroff2 = iroff3 = 0; + ksgn = -1; + if (dres >= (1.0 - 50.0 * epmach) * defabs[0]) { + ksgn = 1; } - - private static void qxgse1(final DoubleUnaryOperator f, final double a, final double b, - final double epsabs, final double epsrel, final int limit, final double[] result, final double[] abserr, - final int[] ier, final int[] last, final int[] fev) { - - // THE ROUTINE CALCULATES AN APPROXIMATION RESULT TO A - // DEFINITE INTEGRAL I = INTEGRAL OF F OVER (A,B), - // HOPEFULLY SATISFYING FOLLOWING CLAIM FOR ACCURACY - // ABS(I-RESULT).LE.MAX(EPSABS,EPSREL*ABS(I)). - boolean extrap, noext; - int id, ierro, iroff1, iroff2, iroff3, jupbnd, k, ksgn, ktmin; - double area, area12, a1, a2, b1, b2, correc = 0.0, dres, epmach, erlarg = 0.0, erlast, errbnd, erro12, errsum, - ertest = 0.0, oflow, rerr, small = 0.0, t, uflow; - final int[] ln1 = new int[1], lp1 = new int[1], ln2 = new int[1], lp2 = new int[1], maxerr = new int[1], - nrmax = new int[1], numrl2 = new int[1], nres = new int[1]; - final double[] resabs = new double[1], defabs = new double[1], area1 = new double[1], error1 = new double[1], - defab1 = new double[1], defab2 = new double[1], area2 = new double[1], error2 = new double[1], - errmax = new double[1], reseps = new double[1], abseps = new double[1]; - final double[] alist = new double[limit]; - final double[] blist = new double[limit]; - final double[] elist = new double[limit]; - final double[] res3la = new double[3]; - final double[] rlist = new double[limit]; - final double[] rlist2 = new double[52]; - final double[][] valp = new double[limit][21]; - final double[][] valn = new double[limit][21]; - final double[] vp1 = new double[21]; - final double[] vp2 = new double[21]; - final double[] vn1 = new double[21]; - final double[] vn2 = new double[21]; - final int[] iord = new int[limit]; - final int[] lp = new int[limit]; - final int[] ln = new int[limit]; - - // MACHINE DEPENDENT CONSTANTS - epmach = Constants.EPSILON; - uflow = Double.MIN_VALUE; - oflow = Double.MAX_VALUE; - - // TEST ON VALIDITY OF parameterS - last[0] = 0; - result[0] = abserr[0] = 0.0; - alist[1 - 1] = a; - blist[1 - 1] = b; - rlist[1 - 1] = elist[1 - 1] = 0.0; - ier[0] = 6; - if (epsabs < 0.0 || epsrel < 0.0) { - return; - } - ier[0] = 0; - rerr = Math.max(epsrel, 50.0 * epmach); - fev[0] = 0; - - // FIRST APPROXIMATION TO THE INTEGRAL - ierro = 0; - lp[1 - 1] = ln[1 - 1] = 1; - valp[1 - 1][1 - 1] = f.applyAsDouble((a + b) * 0.5); - ++fev[0]; - valn[1 - 1][1 - 1] = valp[1 - 1][1 - 1]; - qxlqm(f, a, b, result, abserr, resabs, defabs, valp[1 - 1], valn[1 - 1], lp, ln, 2, epmach, uflow, oflow, fev); - - // TEST ON ACCURACY. - dres = Math.abs(result[0]); - errbnd = Math.max(epsabs, rerr * dres); - last[0] = 1; - rlist[1 - 1] = result[0]; - elist[1 - 1] = abserr[0]; - iord[1 - 1] = 1; - if (abserr[0] <= 100.0 * epmach * defabs[0] && abserr[0] > errbnd) { - ier[0] = 2; - } - if (limit == 1) { - ier[0] = 1; - } - if (ier[0] != 0 || (abserr[0] <= errbnd && abserr[0] != resabs[0]) || (abserr[0] == 0.0)) { - return; - } - - // INITIALIZATION - rlist2[1 - 1] = result[0]; - errmax[0] = abserr[0]; - maxerr[0] = 1; - area = result[0]; - errsum = abserr[0]; - abserr[0] = oflow; - nrmax[0] = 1; - nres[0] = 0; - numrl2[0] = 2; - ktmin = 0; - extrap = noext = false; - iroff1 = iroff2 = iroff3 = 0; - ksgn = -1; - if (dres >= (1.0 - 50.0 * epmach) * defabs[0]) { - ksgn = 1; - } - t = 1.0 + 100.0 * epmach; - - // MAIN DO-LOOP - int exit = 100; - for (last[0] = 2; last[0] <= limit; ++last[0]) { - - // BISECT THE SUBINTERVAL WITH THE NRMAX-TH LARGEST ERROR ESTIMATE. - a1 = alist[maxerr[0] - 1]; - b1 = 0.5 * (alist[maxerr[0] - 1] + blist[maxerr[0] - 1]); - a2 = b1; - b2 = blist[maxerr[0] - 1]; - erlast = errmax[0]; - qxrrd(f, valn[maxerr[0] - 1], ln[maxerr[0] - 1], b1, a1, vn1, vp1, ln1, lp1, fev); - qxlqm(f, a1, b1, area1, error1, resabs, defab1, vp1, vn1, lp1, ln1, 2, epmach, uflow, oflow, fev); - qxrrd(f, valp[maxerr[0] - 1], lp[maxerr[0] - 1], a2, b2, vp2, vn2, lp2, ln2, fev); - qxlqm(f, a2, b2, area2, error2, resabs, defab2, vp2, vn2, lp2, ln2, 2, epmach, uflow, oflow, fev); - - // IMPROVE PREVIOUS APPROXIMATIONS TO INTEGRAL - // AND ERROR AND TEST FOR ACCURACY. - area12 = area1[0] + area2[0]; - erro12 = error1[0] + error2[0]; - errsum = errsum + erro12 - errmax[0]; - area = area + area12 - rlist[maxerr[0] - 1]; - if (defab1[0] == error1[0] || defab2[0] == error2[0]) { - } else { - if (Math.abs(rlist[maxerr[0] - 1] - area12) > 0.1e-4 * Math.abs(area12) || erro12 < 0.99 * errmax[0]) { - } else { - if (extrap) { - ++iroff2; - } - if (!extrap) { - ++iroff1; - } - } - if (last[0] > 10 && erro12 > errmax[0]) { - ++iroff3; - } - } - rlist[maxerr[0] - 1] = area1[0]; - rlist[last[0] - 1] = area2[0]; - errbnd = Math.max(epsabs, rerr * Math.abs(area)); - - // TEST FOR ROUNDOFF ERROR AND EVENTUALLY SET ERROR FLAG. - if (iroff1 + iroff2 >= 10 || iroff3 >= 20) { - ier[0] = 2; - } - if (iroff2 >= 5) { - ierro = 3; - } - - // SET ERROR FLAG IN THE CASE THAT THE NUMBER OF SUBINTERVALS - // EQUALS LIMIT. - if (last[0] == limit) { - ier[0] = 1; - } - - // SET ERROR FLAG IN THE CASE OF BAD INTEGRAND BEHAVIOUR - // AT A POINT OF THE INTEGRATION RANGE. - if (Math.max(Math.abs(a1), Math.abs(b2)) <= t * (Math.abs(a2) + 1.0e3 * uflow)) { - ier[0] = 4; - } - - // APPEND THE NEWLY-CREATED INTERVALS TO THE LIST. - if (error2[0] > error1[0]) { - alist[maxerr[0] - 1] = a2; - alist[last[0] - 1] = a1; - blist[last[0] - 1] = b1; - rlist[maxerr[0] - 1] = area2[0]; - rlist[last[0] - 1] = area1[0]; - elist[maxerr[0] - 1] = error2[0]; - elist[last[0] - 1] = error1[0]; - qxcpy(valp[maxerr[0] - 1], vp2, lp2[0]); - lp[maxerr[0] - 1] = lp2[0]; - qxcpy(valn[maxerr[0] - 1], vn2, ln2[0]); - ln[maxerr[0] - 1] = ln2[0]; - qxcpy(valp[last[0] - 1], vp1, lp1[0]); - lp[last[0] - 1] = lp1[0]; - qxcpy(valn[last[0] - 1], vn1, ln1[0]); - ln[last[0] - 1] = ln1[0]; - } else { - alist[last[0] - 1] = a2; - blist[maxerr[0] - 1] = b1; - blist[last[0] - 1] = b2; - elist[maxerr[0] - 1] = error1[0]; - elist[last[0] - 1] = error2[0]; - qxcpy(valp[maxerr[0] - 1], vp1, lp1[0]); - lp[maxerr[0] - 1] = lp1[0]; - qxcpy(valn[maxerr[0] - 1], vn1, ln1[0]); - ln[maxerr[0] - 1] = ln1[0]; - qxcpy(valp[last[0] - 1], vp2, lp2[0]); - lp[last[0] - 1] = lp2[0]; - qxcpy(valn[last[0] - 1], vn2, ln2[0]); - ln[last[0] - 1] = ln2[0]; - } - - // 30: CALL subroutine QPSRT TO MAINTAIN THE DESCENDING ORDERING - // IN THE LIST OF ERROR ESTIMATES AND SELECT THE SUBINTERVAL - // WITH NRMAX-TH LARGEST ERROR ESTIMATE (TO BE BISECTED NEXT). - qpsrt(limit, last, maxerr, errmax, elist, iord, nrmax); - if (errsum <= errbnd) { - exit = 115; - break; - } - if (ier[0] != 0) { - break; - } - if (last[0] == 2) { - small = Math.abs(b - a) * 0.375; - erlarg = errsum; - ertest = errbnd; - rlist2[2 - 1] = area; - continue; - } - if (noext) { - continue; - } - erlarg -= erlast; - if (Math.abs(b1 - a1) > small) { - erlarg += erro12; - } - if (extrap) { - } else { - - // TEST WHETHER THE INTERVAL TO BE BISECTED NEXT - // IS THE SMALLEST INTERVAL. - if (Math.abs(blist[maxerr[0] - 1] - alist[maxerr[0] - 1]) > small) { - continue; - } - extrap = true; - nrmax[0] = 2; - } - - // 40: THE BOUND 0.3*ERTEST HAS BEEN INTRODUCED TO PERFORM A - // MORE CAUTIOUS EXTRAPOLATION THAN IN THE ORIGINAL DQAGSE R(out)INE - if (ierro == 3 || erlarg <= 0.3 * ertest) { - } else { - - // THE SMALLEST INTERVAL HAS THE LARGEST ERROR. - // BEFORE BISECTING DECREASE THE SUM OF THE ERRORS OVER THE - // LARGER INTERVALS (ERLARG) AND PERFORM EXTRAPOLATION. - id = nrmax[0]; - jupbnd = last[0]; - if (last[0] > (2 + (limit >> 1))) { - jupbnd = limit + 3 - last[0]; - } - for (k = id; k <= jupbnd; ++k) { - maxerr[0] = iord[nrmax[0] - 1]; - errmax[0] = elist[maxerr[0] - 1]; - if (Math.abs(blist[maxerr[0] - 1] - alist[maxerr[0] - 1]) > small) { - continue; - } - ++nrmax[0]; - } - } - - // 60: PERFORM EXTRAPOLATION. - ++numrl2[0]; - rlist2[numrl2[0] - 1] = area; - qelg(numrl2, rlist2, reseps, abseps, res3la, nres, epmach, oflow); - ++ktmin; - if (ktmin > 5 && abserr[0] < 0.1e-2 * errsum) { - ier[0] = 5; - } - if (abseps[0] >= abserr[0]) { - } else { - ktmin = 0; - abserr[0] = abseps[0]; - result[0] = reseps[0]; - correc = erlarg; - ertest = Math.max(epsabs, rerr * Math.abs(reseps[0])); - if (abserr[0] <= ertest) { - break; - } - } - - // 70: PREPARE BISECTION OF THE SMALLEST INTERVAL. - if (numrl2[0] == 1) { - noext = true; - } - if (ier[0] == 5) { - break; - } - maxerr[0] = iord[1 - 1]; - errmax[0] = elist[maxerr[0] - 1]; - nrmax[0] = 1; - extrap = false; - small *= 0.5; - erlarg = errsum; - } - - if (exit == 100) { - - // 100: SET FINAL RESULT AND ERROR ESTIMATE. - if (abserr[0] == oflow) { - exit = 115; - } else if (ier[0] + ierro == 0) { - exit = 110; - } else { - if (ierro == 3) { - abserr[0] += correc; - } - if (ier[0] == 0) { - ier[0] = 3; - } - if (result[0] != 0.0 && area != 0.0) { - if (abserr[0] / Math.abs(result[0]) > errsum / Math.abs(area)) { - exit = 115; - } else { - exit = 110; - } - } else if (abserr[0] > errsum) { - exit = 115; - } else { - if (area == 0.0) { - if (ier[0] > 2) { - --ier[0]; - } - return; - } - exit = 110; - } - } - } - - if (exit == 110) { - - // 110: TEST ON DIVERGENCE. - if (ksgn == -1 && Math.max(Math.abs(result[0]), Math.abs(area)) <= defabs[0] * 0.1e-1) { - } else if (0.1e-1 > (result[0] / area) || (result[0] / area) > 0.1e3 || errsum > Math.abs(area)) { - ier[0] = 6; - } - if (ier[0] > 2) { - --ier[0]; - } - } else { - - // 115: COMPUTE GLOBAL INTEGRAL SUM. - result[0] = 0.0; - for (int ii = 1; ii <= last[0]; ++ii) { - result[0] += rlist[ii - 1]; - } - abserr[0] = errsum; - if (ier[0] > 2) { - --ier[0]; - } - } + t = 1.0 + 100.0 * epmach; + + // MAIN DO-LOOP + int exit = 100; + for (last[0] = 2; last[0] <= limit; ++last[0]) { + + // BISECT THE SUBINTERVAL WITH THE NRMAX-TH LARGEST ERROR ESTIMATE. + a1 = alist[maxerr[0] - 1]; + b1 = 0.5 * (alist[maxerr[0] - 1] + blist[maxerr[0] - 1]); + a2 = b1; + b2 = blist[maxerr[0] - 1]; + erlast = errmax[0]; + qxrrd(f, valn[maxerr[0] - 1], ln[maxerr[0] - 1], b1, a1, vn1, vp1, ln1, lp1, fev); + qxlqm(f, a1, b1, area1, error1, resabs, defab1, vp1, vn1, lp1, ln1, 2, epmach, uflow, oflow, + fev); + qxrrd(f, valp[maxerr[0] - 1], lp[maxerr[0] - 1], a2, b2, vp2, vn2, lp2, ln2, fev); + qxlqm(f, a2, b2, area2, error2, resabs, defab2, vp2, vn2, lp2, ln2, 2, epmach, uflow, oflow, + fev); + + // IMPROVE PREVIOUS APPROXIMATIONS TO INTEGRAL + // AND ERROR AND TEST FOR ACCURACY. + area12 = area1[0] + area2[0]; + erro12 = error1[0] + error2[0]; + errsum = errsum + erro12 - errmax[0]; + area = area + area12 - rlist[maxerr[0] - 1]; + if (defab1[0] == error1[0] || defab2[0] == error2[0]) { + } else { + if (Math.abs(rlist[maxerr[0] - 1] - area12) > 0.1e-4 * Math.abs(area12) + || erro12 < 0.99 * errmax[0]) { + } else { + if (extrap) { + ++iroff2; + } + if (!extrap) { + ++iroff1; + } + } + if (last[0] > 10 && erro12 > errmax[0]) { + ++iroff3; + } + } + rlist[maxerr[0] - 1] = area1[0]; + rlist[last[0] - 1] = area2[0]; + errbnd = Math.max(epsabs, rerr * Math.abs(area)); + + // TEST FOR ROUNDOFF ERROR AND EVENTUALLY SET ERROR FLAG. + if (iroff1 + iroff2 >= 10 || iroff3 >= 20) { + ier[0] = 2; + } + if (iroff2 >= 5) { + ierro = 3; + } + + // SET ERROR FLAG IN THE CASE THAT THE NUMBER OF SUBINTERVALS + // EQUALS LIMIT. + if (last[0] == limit) { + ier[0] = 1; + } + + // SET ERROR FLAG IN THE CASE OF BAD INTEGRAND BEHAVIOUR + // AT A POINT OF THE INTEGRATION RANGE. + if (Math.max(Math.abs(a1), Math.abs(b2)) <= t * (Math.abs(a2) + 1.0e3 * uflow)) { + ier[0] = 4; + } + + // APPEND THE NEWLY-CREATED INTERVALS TO THE LIST. + if (error2[0] > error1[0]) { + alist[maxerr[0] - 1] = a2; + alist[last[0] - 1] = a1; + blist[last[0] - 1] = b1; + rlist[maxerr[0] - 1] = area2[0]; + rlist[last[0] - 1] = area1[0]; + elist[maxerr[0] - 1] = error2[0]; + elist[last[0] - 1] = error1[0]; + qxcpy(valp[maxerr[0] - 1], vp2, lp2[0]); + lp[maxerr[0] - 1] = lp2[0]; + qxcpy(valn[maxerr[0] - 1], vn2, ln2[0]); + ln[maxerr[0] - 1] = ln2[0]; + qxcpy(valp[last[0] - 1], vp1, lp1[0]); + lp[last[0] - 1] = lp1[0]; + qxcpy(valn[last[0] - 1], vn1, ln1[0]); + ln[last[0] - 1] = ln1[0]; + } else { + alist[last[0] - 1] = a2; + blist[maxerr[0] - 1] = b1; + blist[last[0] - 1] = b2; + elist[maxerr[0] - 1] = error1[0]; + elist[last[0] - 1] = error2[0]; + qxcpy(valp[maxerr[0] - 1], vp1, lp1[0]); + lp[maxerr[0] - 1] = lp1[0]; + qxcpy(valn[maxerr[0] - 1], vn1, ln1[0]); + ln[maxerr[0] - 1] = ln1[0]; + qxcpy(valp[last[0] - 1], vp2, lp2[0]); + lp[last[0] - 1] = lp2[0]; + qxcpy(valn[last[0] - 1], vn2, ln2[0]); + ln[last[0] - 1] = ln2[0]; + } + + // 30: CALL subroutine QPSRT TO MAINTAIN THE DESCENDING ORDERING + // IN THE LIST OF ERROR ESTIMATES AND SELECT THE SUBINTERVAL + // WITH NRMAX-TH LARGEST ERROR ESTIMATE (TO BE BISECTED NEXT). + qpsrt(limit, last, maxerr, errmax, elist, iord, nrmax); + if (errsum <= errbnd) { + exit = 115; + break; + } + if (ier[0] != 0) { + break; + } + if (last[0] == 2) { + small = Math.abs(b - a) * 0.375; + erlarg = errsum; + ertest = errbnd; + rlist2[2 - 1] = area; + continue; + } + if (noext) { + continue; + } + erlarg -= erlast; + if (Math.abs(b1 - a1) > small) { + erlarg += erro12; + } + if (extrap) { + } else { + + // TEST WHETHER THE INTERVAL TO BE BISECTED NEXT + // IS THE SMALLEST INTERVAL. + if (Math.abs(blist[maxerr[0] - 1] - alist[maxerr[0] - 1]) > small) { + continue; + } + extrap = true; + nrmax[0] = 2; + } + + // 40: THE BOUND 0.3*ERTEST HAS BEEN INTRODUCED TO PERFORM A + // MORE CAUTIOUS EXTRAPOLATION THAN IN THE ORIGINAL DQAGSE R(out)INE + if (ierro == 3 || erlarg <= 0.3 * ertest) { + } else { + + // THE SMALLEST INTERVAL HAS THE LARGEST ERROR. + // BEFORE BISECTING DECREASE THE SUM OF THE ERRORS OVER THE + // LARGER INTERVALS (ERLARG) AND PERFORM EXTRAPOLATION. + id = nrmax[0]; + jupbnd = last[0]; + if (last[0] > (2 + (limit >> 1))) { + jupbnd = limit + 3 - last[0]; + } + for (k = id; k <= jupbnd; ++k) { + maxerr[0] = iord[nrmax[0] - 1]; + errmax[0] = elist[maxerr[0] - 1]; + if (Math.abs(blist[maxerr[0] - 1] - alist[maxerr[0] - 1]) > small) { + continue; + } + ++nrmax[0]; + } + } + + // 60: PERFORM EXTRAPOLATION. + ++numrl2[0]; + rlist2[numrl2[0] - 1] = area; + qelg(numrl2, rlist2, reseps, abseps, res3la, nres, epmach, oflow); + ++ktmin; + if (ktmin > 5 && abserr[0] < 0.1e-2 * errsum) { + ier[0] = 5; + } + if (abseps[0] >= abserr[0]) { + } else { + ktmin = 0; + abserr[0] = abseps[0]; + result[0] = reseps[0]; + correc = erlarg; + ertest = Math.max(epsabs, rerr * Math.abs(reseps[0])); + if (abserr[0] <= ertest) { + break; + } + } + + // 70: PREPARE BISECTION OF THE SMALLEST INTERVAL. + if (numrl2[0] == 1) { + noext = true; + } + if (ier[0] == 5) { + break; + } + maxerr[0] = iord[1 - 1]; + errmax[0] = elist[maxerr[0] - 1]; + nrmax[0] = 1; + extrap = false; + small *= 0.5; + erlarg = errsum; } - private static void qxlqm(final DoubleUnaryOperator f, final double a, final double b, - final double[] result, final double[] abserr, final double[] resabs, final double[] resasc, - final double[] vr, final double[] vs, final int[] lr, final int[] ls, final int key, final double epmach, - final double uflow, final double oflow, final int[] fev) { - - // TO COMPUTE I = INTEGRAL OF F OVER (A, B), WITH ERROR ESTIMATE - // J = INTEGRAL OF ABS(F) OVER (A,B) - final double[] resg = new double[1]; - final double[] resk = new double[1]; - double t, errold; - int k, k0, k1, k2, key1; - - key1 = Math.max(key, 0); - key1 = Math.min(key1, 4); - k0 = Math.max(key1 - 2, 0); - k1 = k0 + 1; - k2 = Math.min(key1 + 1, 3); - qxrul(f, a, b, resg, resabs, resasc, k0, k1, vr, vs, lr, ls, fev); - errold = oflow; - t = 10.0 * epmach; - for (k = k1; k <= k2; ++k) { - qxrul(f, a, b, resk, resabs, resasc, k, k1, vr, vs, lr, ls, fev); - result[0] = resk[0]; - abserr[0] = Math.abs(resk[0] - resg[0]); - if (resasc[0] != 0.0 && abserr[0] != 0.0) { - abserr[0] = resasc[0] * Math.min(1.0, Math.pow(200.0 * abserr[0] / resasc[0], 1.5)); - } - if (resabs[0] > uflow / t) { - abserr[0] = Math.max(t * resabs[0], abserr[0]); - } - resg[0] = resk[0]; - if (abserr[0] > errold * 0.16) { - break; - } - if (abserr[0] < 1000.0 * epmach * resabs[0]) { - continue; - } - errold = abserr[0]; - } + if (exit == 100) { + + // 100: SET FINAL RESULT AND ERROR ESTIMATE. + if (abserr[0] == oflow) { + exit = 115; + } else if (ier[0] + ierro == 0) { + exit = 110; + } else { + if (ierro == 3) { + abserr[0] += correc; + } + if (ier[0] == 0) { + ier[0] = 3; + } + if (result[0] != 0.0 && area != 0.0) { + if (abserr[0] / Math.abs(result[0]) > errsum / Math.abs(area)) { + exit = 115; + } else { + exit = 110; + } + } else if (abserr[0] > errsum) { + exit = 115; + } else { + if (area == 0.0) { + if (ier[0] > 2) { + --ier[0]; + } + return; + } + exit = 110; + } + } } - private static void qxrul(final DoubleUnaryOperator f, final double xl, final double xu, - final double[] y, final double[] ya, final double[] ym, final int ke, final int k1, final double[] fv1, - final double[] fv2, final int[] l1, final int[] l2, final int[] fev) { - - // TO COMPUTE I = INTEGRAL OF F OVER (A,B), WITH ERROR ESTIMATE - // AND CONDITIONALLY COMPUTE J = INTEGRAL OF ABS(F) OVER (A,B) - // BY USING AN RMS RULE - double ldl, y2, aa, bb, c; - int j, i, is, k, ks; - - k = ke + 1; - is = istart[k - 1]; - ks = length[k - 1]; - ldl = xu - xl; - bb = ldl * 0.5; - aa = xl + bb; - y[0] = 0.0; - for (i = 1; i <= ks; ++i) { - c = bb * xx[i - 1]; - if (i > l1[0]) { - fv1[i - 1] = f.applyAsDouble(aa + c); - ++fev[0]; - if (aa + c >= xu && !Double.isFinite(fv1[i - 1])) { - fv1[i - 1] = 0.0; - } - } - if (i > l2[0]) { - fv2[i - 1] = f.applyAsDouble(aa - c); - ++fev[0]; - if (aa - c <= xl && !Double.isFinite(fv2[i - 1])) { - fv2[i - 1] = 0.0; - } - } - j = is + i; - y[0] += (fv1[i - 1] + fv2[i - 1]) * ww[j - 1]; - } - y2 = y[0]; - y[0] *= bb; - if (l1[0] < ks) { - l1[0] = ks; - } - if (l2[0] < ks) { - l2[0] = ks; - } - if (ke != k1) { - return; - } - ya[0] = 0.0; - for (i = 1; i <= ks; ++i) { - j = is + i; - ya[0] += (Math.abs(fv1[i - 1]) + Math.abs(fv2[i - 1])) * ww[j - 1]; - } - ya[0] *= Math.abs(bb); - y2 *= 0.5; - ym[0] = 0.0; - for (i = 1; i <= ks; ++i) { - j = is + i; - ym[0] += (Math.abs(fv1[i - 1] - y2) + Math.abs(fv2[i - 1] - y2)) * ww[j - 1]; - } - ym[0] *= Math.abs(bb); + if (exit == 110) { + + // 110: TEST ON DIVERGENCE. + if (ksgn == -1 && Math.max(Math.abs(result[0]), Math.abs(area)) <= defabs[0] * 0.1e-1) { + } else if (0.1e-1 > (result[0] / area) || (result[0] / area) > 0.1e3 + || errsum > Math.abs(area)) { + ier[0] = 6; + } + if (ier[0] > 2) { + --ier[0]; + } + } else { + + // 115: COMPUTE GLOBAL INTEGRAL SUM. + result[0] = 0.0; + for (int ii = 1; ii <= last[0]; ++ii) { + result[0] += rlist[ii - 1]; + } + abserr[0] = errsum; + if (ier[0] > 2) { + --ier[0]; + } } - - private static void qxrrd(final DoubleUnaryOperator f, final double[] z, final int lz, - final double xl, - final double xu, final double[] r, final double[] s, final int[] lr, final int[] ls, final int[] fev) { - - // TO REORDER THE COMPUTED FUNCTIONAL VALUES BEFORE THE BISECTION - // OF AN INTERVAL - final double dlen = 0.5 * (xu - xl); - final double centr = xl + dlen; - r[1 - 1] = z[3 - 1]; - r[2 - 1] = z[9 - 1]; - r[3 - 1] = z[4 - 1]; - r[4 - 1] = z[5 - 1]; - r[5 - 1] = z[6 - 1]; - r[6 - 1] = z[10 - 1]; - r[7 - 1] = z[7 - 1]; - s[1 - 1] = z[3 - 1]; - s[2 - 1] = z[8 - 1]; - s[3 - 1] = z[2 - 1]; - s[7 - 1] = z[1 - 1]; - if (lz <= 11) { + } + + private static void qxlqm(final DoubleUnaryOperator f, final double a, final double b, + final double[] result, final double[] abserr, final double[] resabs, final double[] resasc, + final double[] vr, final double[] vs, final int[] lr, final int[] ls, final int key, + final double epmach, final double uflow, final double oflow, final int[] fev) { + + // TO COMPUTE I = INTEGRAL OF F OVER (A, B), WITH ERROR ESTIMATE + // J = INTEGRAL OF ABS(F) OVER (A,B) + final double[] resg = new double[1]; + final double[] resk = new double[1]; + double t, errold; + int k, k0, k1, k2, key1; + + key1 = Math.max(key, 0); + key1 = Math.min(key1, 4); + k0 = Math.max(key1 - 2, 0); + k1 = k0 + 1; + k2 = Math.min(key1 + 1, 3); + qxrul(f, a, b, resg, resabs, resasc, k0, k1, vr, vs, lr, ls, fev); + errold = oflow; + t = 10.0 * epmach; + for (k = k1; k <= k2; ++k) { + qxrul(f, a, b, resk, resabs, resasc, k, k1, vr, vs, lr, ls, fev); + result[0] = resk[0]; + abserr[0] = Math.abs(resk[0] - resg[0]); + if (resasc[0] != 0.0 && abserr[0] != 0.0) { + abserr[0] = resasc[0] * Math.min(1.0, Math.pow(200.0 * abserr[0] / resasc[0], 1.5)); + } + if (resabs[0] > uflow / t) { + abserr[0] = Math.max(t * resabs[0], abserr[0]); + } + resg[0] = resk[0]; + if (abserr[0] > errold * 0.16) { + break; + } + if (abserr[0] < 1000.0 * epmach * resabs[0]) { + continue; + } + errold = abserr[0]; + } + } + + private static void qxrul(final DoubleUnaryOperator f, final double xl, final double xu, + final double[] y, final double[] ya, final double[] ym, final int ke, final int k1, + final double[] fv1, final double[] fv2, final int[] l1, final int[] l2, final int[] fev) { + + // TO COMPUTE I = INTEGRAL OF F OVER (A,B), WITH ERROR ESTIMATE + // AND CONDITIONALLY COMPUTE J = INTEGRAL OF ABS(F) OVER (A,B) + // BY USING AN RMS RULE + double ldl, y2, aa, bb, c; + int j, i, is, k, ks; + + k = ke + 1; + is = istart[k - 1]; + ks = length[k - 1]; + ldl = xu - xl; + bb = ldl * 0.5; + aa = xl + bb; + y[0] = 0.0; + for (i = 1; i <= ks; ++i) { + c = bb * xx[i - 1]; + if (i > l1[0]) { + fv1[i - 1] = f.applyAsDouble(aa + c); + ++fev[0]; + if (aa + c >= xu && !Double.isFinite(fv1[i - 1])) { + fv1[i - 1] = 0.0; + } + } + if (i > l2[0]) { + fv2[i - 1] = f.applyAsDouble(aa - c); + ++fev[0]; + if (aa - c <= xl && !Double.isFinite(fv2[i - 1])) { + fv2[i - 1] = 0.0; + } + } + j = is + i; + y[0] += (fv1[i - 1] + fv2[i - 1]) * ww[j - 1]; + } + y2 = y[0]; + y[0] *= bb; + if (l1[0] < ks) { + l1[0] = ks; + } + if (l2[0] < ks) { + l2[0] = ks; + } + if (ke != k1) { + return; + } + ya[0] = 0.0; + for (i = 1; i <= ks; ++i) { + j = is + i; + ya[0] += (Math.abs(fv1[i - 1]) + Math.abs(fv2[i - 1])) * ww[j - 1]; + } + ya[0] *= Math.abs(bb); + y2 *= 0.5; + ym[0] = 0.0; + for (i = 1; i <= ks; ++i) { + j = is + i; + ym[0] += (Math.abs(fv1[i - 1] - y2) + Math.abs(fv2[i - 1] - y2)) * ww[j - 1]; + } + ym[0] *= Math.abs(bb); + } + + private static void qxrrd(final DoubleUnaryOperator f, final double[] z, final int lz, + final double xl, final double xu, final double[] r, final double[] s, final int[] lr, + final int[] ls, final int[] fev) { + + // TO REORDER THE COMPUTED FUNCTIONAL VALUES BEFORE THE BISECTION + // OF AN INTERVAL + final double dlen = 0.5 * (xu - xl); + final double centr = xl + dlen; + r[1 - 1] = z[3 - 1]; + r[2 - 1] = z[9 - 1]; + r[3 - 1] = z[4 - 1]; + r[4 - 1] = z[5 - 1]; + r[5 - 1] = z[6 - 1]; + r[6 - 1] = z[10 - 1]; + r[7 - 1] = z[7 - 1]; + s[1 - 1] = z[3 - 1]; + s[2 - 1] = z[8 - 1]; + s[3 - 1] = z[2 - 1]; + s[7 - 1] = z[1 - 1]; + if (lz <= 11) { r[8 - 1] = f.applyAsDouble(centr + 0.375 * dlen); r[9 - 1] = f.applyAsDouble(centr + 0.625 * dlen); r[10 - 1] = f.applyAsDouble(centr + 0.96875 * dlen); - fev[0] += 3; - lr[0] = 10; - if (lz != 11) { - s[4 - 1] = f.applyAsDouble(centr - dlen * 0.75); - ++fev[0]; - } - if (lz == 11) { - s[4 - 1] = z[11 - 1]; - } - s[5 - 1] = f.applyAsDouble(centr - dlen * 0.875); - s[6 - 1] = f.applyAsDouble(centr - dlen * 0.9375); - s[8 - 1] = f.applyAsDouble(centr - dlen * 0.375); - s[9 - 1] = f.applyAsDouble(centr - dlen * 0.625); - s[10 - 1] = f.applyAsDouble(centr - dlen * 0.96875); - fev[0] += 5; - ls[0] = 10; - return; - } - r[8 - 1] = z[12 - 1]; - r[9 - 1] = z[13 - 1]; - r[10 - 1] = z[14 - 1]; - lr[0] = 10; - s[4 - 1] = z[11 - 1]; + fev[0] += 3; + lr[0] = 10; + if (lz != 11) { + s[4 - 1] = f.applyAsDouble(centr - dlen * 0.75); + ++fev[0]; + } + if (lz == 11) { + s[4 - 1] = z[11 - 1]; + } + s[5 - 1] = f.applyAsDouble(centr - dlen * 0.875); + s[6 - 1] = f.applyAsDouble(centr - dlen * 0.9375); + s[8 - 1] = f.applyAsDouble(centr - dlen * 0.375); + s[9 - 1] = f.applyAsDouble(centr - dlen * 0.625); + s[10 - 1] = f.applyAsDouble(centr - dlen * 0.96875); + fev[0] += 5; + ls[0] = 10; + return; + } + r[8 - 1] = z[12 - 1]; + r[9 - 1] = z[13 - 1]; + r[10 - 1] = z[14 - 1]; + lr[0] = 10; + s[4 - 1] = z[11 - 1]; s[5 - 1] = f.applyAsDouble(centr - dlen * 0.875); s[6 - 1] = f.applyAsDouble(centr - dlen * 0.9375); - fev[0] += 2; - if (lz <= 14) { + fev[0] += 2; + if (lz <= 14) { s[8 - 1] = f.applyAsDouble(centr - dlen * 0.375); s[9 - 1] = f.applyAsDouble(centr - dlen * 0.625); s[10 - 1] = f.applyAsDouble(centr - dlen * 0.96875); - fev[0] += 3; - ls[0] = 10; - return; - } - r[11 - 1] = z[18 - 1]; - r[12 - 1] = z[19 - 1]; - r[13 - 1] = z[20 - 1]; - r[14 - 1] = z[21 - 1]; - lr[0] = 14; - s[8 - 1] = z[16 - 1]; - s[9 - 1] = z[15 - 1]; + fev[0] += 3; + ls[0] = 10; + return; + } + r[11 - 1] = z[18 - 1]; + r[12 - 1] = z[19 - 1]; + r[13 - 1] = z[20 - 1]; + r[14 - 1] = z[21 - 1]; + lr[0] = 14; + s[8 - 1] = z[16 - 1]; + s[9 - 1] = z[15 - 1]; s[10 - 1] = f.applyAsDouble(centr - dlen * 0.96875); - ++fev[0]; - s[11 - 1] = z[17 - 1]; - ls[0] = 11; + ++fev[0]; + s[11 - 1] = z[17 - 1]; + ls[0] = 11; + } + + private static void qxcpy(final double[] a, final double[] b, final int l) { + + // TO COPY THE REAL VECTOR B OF LENGTH L INTO THE REAL VECTOR A OF LENGTH L + System.arraycopy(b, 0, a, 0, l); + } + + private static void qpsrt(final int limit, final int[] last, final int[] maxerr, + final double[] ermax, final double[] elist, final int[] iord, final int[] nrmax) { + double errmax, errmin; + int i, ibeg, ido, isucc, j, jbnd, jupbn, k; + + // CHECK WHETHER THE LIST CONTAINS MORE THAN TWO ERROR ESTIMATES. + if (last[0] <= 2) { + iord[1 - 1] = 1; + iord[2 - 1] = 2; + maxerr[0] = iord[nrmax[0] - 1]; + ermax[0] = elist[maxerr[0] - 1]; + return; } - private static void qxcpy(final double[] a, final double[] b, final int l) { - - // TO COPY THE REAL VECTOR B OF LENGTH L INTO THE REAL VECTOR A OF LENGTH L - System.arraycopy(b, 0, a, 0, l); + // 10: THIS PART OF THE ROUTINE IS ONLY EXECUTED IF, + // DUE TO A DIFFICULT INTEGRAND, SUBDIVISION INCREASED + // THE ERROR ESTIMATE. IN THE NORMAL CASE THE INSERT PROCEDURE + // SHOULD START AFTER THE NRMAX-TH LARGEST ERROR ESTIMATE. + errmax = elist[maxerr[0] - 1]; + if (nrmax[0] != 1) { + ido = nrmax[0] - 1; + for (i = 1; i <= ido; ++i) { + isucc = iord[nrmax[0] - 1 - 1]; + if (errmax <= elist[isucc - 1]) { + break; + } + iord[nrmax[0] - 1] = isucc; + --nrmax[0]; + } } - private static void qpsrt(final int limit, final int[] last, final int[] maxerr, final double[] ermax, - final double[] elist, final int[] iord, final int[] nrmax) { - double errmax, errmin; - int i, ibeg, ido, isucc, j, jbnd, jupbn, k; - - // CHECK WHETHER THE LIST CONTAINS MORE THAN TWO ERROR ESTIMATES. - if (last[0] <= 2) { - iord[1 - 1] = 1; - iord[2 - 1] = 2; - maxerr[0] = iord[nrmax[0] - 1]; - ermax[0] = elist[maxerr[0] - 1]; - return; - } - - // 10: THIS PART OF THE ROUTINE IS ONLY EXECUTED IF, - // DUE TO A DIFFICULT INTEGRAND, SUBDIVISION INCREASED - // THE ERROR ESTIMATE. IN THE NORMAL CASE THE INSERT PROCEDURE - // SHOULD START AFTER THE NRMAX-TH LARGEST ERROR ESTIMATE. - errmax = elist[maxerr[0] - 1]; - if (nrmax[0] != 1) { - ido = nrmax[0] - 1; - for (i = 1; i <= ido; ++i) { - isucc = iord[nrmax[0] - 1 - 1]; - if (errmax <= elist[isucc - 1]) { - break; - } - iord[nrmax[0] - 1] = isucc; - --nrmax[0]; - } - } - - // 30: COMPUTE THE NUMBER OF ELEMENTS IN THE LIST TO BE MAINTAINED - // IN DESCENDING ORDER. THIS NUMBER DEPENDS ON THE NUMBER OF - // SUBDIVISIONS STILL ALLOWED. - jupbn = last[0]; - if (last[0] > ((limit >> 1) + 2)) { - jupbn = limit + 3 - last[0]; - } - errmin = elist[last[0] - 1]; - - // INSERT ERRMAX BY TRAVERSING THE LIST TOP-DOWN, - // STARTING COMPARISON FROM THE ELEMENT ELIST(IORD(NRMAX+1)). - jbnd = jupbn - 1; - ibeg = nrmax[0] + 1; - for (i = ibeg; i <= jbnd; ++i) { - isucc = iord[i - 1]; - if (errmax >= elist[isucc - 1]) { - - // 60: INSERT ERRMIN BY TRAVERSING THE LIST BOTTOM-UP. - iord[i - 1 - 1] = maxerr[0]; - k = jbnd; - for (j = 1; j <= jbnd; ++j) { - isucc = iord[k - 1]; - if (errmin < elist[isucc - 1]) { - iord[k + 1 - 1] = last[0]; - maxerr[0] = iord[nrmax[0] - 1]; - ermax[0] = elist[maxerr[0] - 1]; - return; - } - iord[k + 1 - 1] = isucc; - --k; - } - iord[i - 1] = last[0]; - maxerr[0] = iord[nrmax[0] - 1]; - ermax[0] = elist[maxerr[0] - 1]; - return; - } - iord[i - 1 - 1] = isucc; - } - iord[jbnd - 1] = maxerr[0]; - iord[jupbn - 1] = last[0]; - maxerr[0] = iord[nrmax[0] - 1]; - ermax[0] = elist[maxerr[0] - 1]; + // 30: COMPUTE THE NUMBER OF ELEMENTS IN THE LIST TO BE MAINTAINED + // IN DESCENDING ORDER. THIS NUMBER DEPENDS ON THE NUMBER OF + // SUBDIVISIONS STILL ALLOWED. + jupbn = last[0]; + if (last[0] > ((limit >> 1) + 2)) { + jupbn = limit + 3 - last[0]; + } + errmin = elist[last[0] - 1]; + + // INSERT ERRMAX BY TRAVERSING THE LIST TOP-DOWN, + // STARTING COMPARISON FROM THE ELEMENT ELIST(IORD(NRMAX+1)). + jbnd = jupbn - 1; + ibeg = nrmax[0] + 1; + for (i = ibeg; i <= jbnd; ++i) { + isucc = iord[i - 1]; + if (errmax >= elist[isucc - 1]) { + + // 60: INSERT ERRMIN BY TRAVERSING THE LIST BOTTOM-UP. + iord[i - 1 - 1] = maxerr[0]; + k = jbnd; + for (j = 1; j <= jbnd; ++j) { + isucc = iord[k - 1]; + if (errmin < elist[isucc - 1]) { + iord[k + 1 - 1] = last[0]; + maxerr[0] = iord[nrmax[0] - 1]; + ermax[0] = elist[maxerr[0] - 1]; + return; + } + iord[k + 1 - 1] = isucc; + --k; + } + iord[i - 1] = last[0]; + maxerr[0] = iord[nrmax[0] - 1]; + ermax[0] = elist[maxerr[0] - 1]; + return; + } + iord[i - 1 - 1] = isucc; + } + iord[jbnd - 1] = maxerr[0]; + iord[jupbn - 1] = last[0]; + maxerr[0] = iord[nrmax[0] - 1]; + ermax[0] = elist[maxerr[0] - 1]; + } + + private static void qelg(final int[] n, final double[] epstab, final double[] result, + final double[] abserr, final double[] res3la, final int[] nres, final double epmach, + final double oflow) { + double delta1, delta2, delta3, epsinf, error, err1, err2, err3, e0, e1, e1abs, e2, e3, res, ss, + tol1, tol2, tol3; + int i, ib, ib2, ie, indx, k1, k2, k3, limexp, newelm, num; + + ++nres[0]; + abserr[0] = oflow; + result[0] = epstab[n[0] - 1]; + if (n[0] < 3) { + abserr[0] = Math.max(abserr[0], 5.0 * epmach * Math.abs(result[0])); + return; + } + limexp = 50; + epstab[n[0] + 2 - 1] = epstab[n[0] - 1]; + newelm = (n[0] - 1) >> 1; + epstab[n[0] - 1] = oflow; + num = k1 = n[0]; + for (i = 1; i <= newelm; ++i) { + k2 = k1 - 1; + k3 = k1 - 2; + res = epstab[k1 + 2 - 1]; + e0 = epstab[k3 - 1]; + e1 = epstab[k2 - 1]; + e2 = res; + e1abs = Math.abs(e1); + delta2 = e2 - e1; + err2 = Math.abs(delta2); + tol2 = Math.max(Math.abs(e2), e1abs) * epmach; + delta3 = e1 - e0; + err3 = Math.abs(delta3); + tol3 = Math.max(e1abs, Math.abs(e0)) * epmach; + if (err2 <= tol2 && err3 <= tol3) { + + // IF E0, E1 AND E2 ARE EQUAL TO WITHIN MACHINE + // ACCURACY, CONVERGENCE IS ASSUMED. + // RESULT = E2 + // ABSERR = ABS(E1-E0) + ABS(E2-E1) + result[0] = res; + abserr[0] = err2 + err3; + abserr[0] = Math.max(abserr[0], 5.0 * epmach * Math.abs(result[0])); + return; + } + e3 = epstab[k1 - 1]; + epstab[k1 - 1] = e1; + delta1 = e1 - e3; + err1 = Math.abs(delta1); + tol1 = Math.max(e1abs, Math.abs(e3)) * epmach; + + // IF TWO ELEMENTS ARE VERY CLOSE TO EACH OTHER, OMIT + // A PART OF THE TABLE BY ADJUSTING THE VALUE OF N + if (err1 <= tol1 || err2 <= tol2 || err3 <= tol3) { + n[0] = i + i - 1; + break; + } + ss = 1.0 / delta1 + 1.0 / delta2 - 1.0 / delta3; + epsinf = Math.abs(ss * e1); + + // TEST TO DETECT IRREGULAR BEHAVIOUR IN THE TABLE, AND EVENTUALLY + // OMIT A PART OF THE TABLE ADJUSTING THE VALUE OF N. + if (epsinf <= 0.1e-3) { + n[0] = i + i - 1; + break; + } + + // 30: COMPUTE A NEW ELEMENT AND EVENTUALLY ADJUST THE VALUE + // OF RESULT. + res = e1 + 1.0 / ss; + epstab[k1 - 1] = res; + k1 -= 2; + error = err2 + Math.abs(res - e2) + err3; + if (error > abserr[0]) { + continue; + } + abserr[0] = error; + result[0] = res; } - private static void qelg(final int[] n, final double[] epstab, final double[] result, final double[] abserr, - final double[] res3la, final int[] nres, final double epmach, final double oflow) { - double delta1, delta2, delta3, epsinf, error, err1, err2, err3, e0, e1, e1abs, e2, e3, res, ss, tol1, tol2, - tol3; - int i, ib, ib2, ie, indx, k1, k2, k3, limexp, newelm, num; - - ++nres[0]; - abserr[0] = oflow; - result[0] = epstab[n[0] - 1]; - if (n[0] < 3) { - abserr[0] = Math.max(abserr[0], 5.0 * epmach * Math.abs(result[0])); - return; - } - limexp = 50; - epstab[n[0] + 2 - 1] = epstab[n[0] - 1]; - newelm = (n[0] - 1) >> 1; - epstab[n[0] - 1] = oflow; - num = k1 = n[0]; - for (i = 1; i <= newelm; ++i) { - k2 = k1 - 1; - k3 = k1 - 2; - res = epstab[k1 + 2 - 1]; - e0 = epstab[k3 - 1]; - e1 = epstab[k2 - 1]; - e2 = res; - e1abs = Math.abs(e1); - delta2 = e2 - e1; - err2 = Math.abs(delta2); - tol2 = Math.max(Math.abs(e2), e1abs) * epmach; - delta3 = e1 - e0; - err3 = Math.abs(delta3); - tol3 = Math.max(e1abs, Math.abs(e0)) * epmach; - if (err2 <= tol2 && err3 <= tol3) { - - // IF E0, E1 AND E2 ARE EQUAL TO WITHIN MACHINE - // ACCURACY, CONVERGENCE IS ASSUMED. - // RESULT = E2 - // ABSERR = ABS(E1-E0) + ABS(E2-E1) - result[0] = res; - abserr[0] = err2 + err3; - abserr[0] = Math.max(abserr[0], 5.0 * epmach * Math.abs(result[0])); - return; - } - e3 = epstab[k1 - 1]; - epstab[k1 - 1] = e1; - delta1 = e1 - e3; - err1 = Math.abs(delta1); - tol1 = Math.max(e1abs, Math.abs(e3)) * epmach; - - // IF TWO ELEMENTS ARE VERY CLOSE TO EACH OTHER, OMIT - // A PART OF THE TABLE BY ADJUSTING THE VALUE OF N - if (err1 <= tol1 || err2 <= tol2 || err3 <= tol3) { - n[0] = i + i - 1; - break; - } - ss = 1.0 / delta1 + 1.0 / delta2 - 1.0 / delta3; - epsinf = Math.abs(ss * e1); - - // TEST TO DETECT IRREGULAR BEHAVIOUR IN THE TABLE, AND EVENTUALLY - // OMIT A PART OF THE TABLE ADJUSTING THE VALUE OF N. - if (epsinf <= 0.1e-3) { - n[0] = i + i - 1; - break; - } - - // 30: COMPUTE A NEW ELEMENT AND EVENTUALLY ADJUST THE VALUE - // OF RESULT. - res = e1 + 1.0 / ss; - epstab[k1 - 1] = res; - k1 -= 2; - error = err2 + Math.abs(res - e2) + err3; - if (error > abserr[0]) { - continue; - } - abserr[0] = error; - result[0] = res; - } - - // 50: SHIFT THE TABLE. - if (n[0] == limexp) { - n[0] = ((limexp >> 1) << 1) - 1; - } - ib = 1; - if (((num >> 1) << 1) == num) { - ib = 2; - } - ie = newelm + 1; - for (i = 1; i <= ie; ++i) { - ib2 = ib + 2; - epstab[ib - 1] = epstab[ib2 - 1]; - ib = ib2; - } - if (num != n[0]) { - indx = num - n[0] + 1; - for (i = 1; i <= n[0]; ++i) { - epstab[i - 1] = epstab[indx - 1]; - ++indx; - } - } - if (nres[0] < 4) { - res3la[nres[0] - 1] = result[0]; - abserr[0] = oflow; - abserr[0] = Math.max(abserr[0], 5.0 * epmach * Math.abs(result[0])); - return; - } - - // 90: COMPUTE ERROR ESTIMATE - abserr[0] = Math.abs(result[0] - res3la[3 - 1]) + Math.abs(result[0] - res3la[2 - 1]) - + Math.abs(result[0] - res3la[1 - 1]); - res3la[1 - 1] = res3la[2 - 1]; - res3la[2 - 1] = res3la[3 - 1]; - res3la[3 - 1] = result[0]; - abserr[0] = Math.max(abserr[0], 5.0 * epmach * Math.abs(result[0])); + // 50: SHIFT THE TABLE. + if (n[0] == limexp) { + n[0] = ((limexp >> 1) << 1) - 1; + } + ib = 1; + if (((num >> 1) << 1) == num) { + ib = 2; + } + ie = newelm + 1; + for (i = 1; i <= ie; ++i) { + ib2 = ib + 2; + epstab[ib - 1] = epstab[ib2 - 1]; + ib = ib2; } + if (num != n[0]) { + indx = num - n[0] + 1; + for (i = 1; i <= n[0]; ++i) { + epstab[i - 1] = epstab[indx - 1]; + ++indx; + } + } + if (nres[0] < 4) { + res3la[nres[0] - 1] = result[0]; + abserr[0] = oflow; + abserr[0] = Math.max(abserr[0], 5.0 * epmach * Math.abs(result[0])); + return; + } + + // 90: COMPUTE ERROR ESTIMATE + abserr[0] = Math.abs(result[0] - res3la[3 - 1]) + Math.abs(result[0] - res3la[2 - 1]) + + Math.abs(result[0] - res3la[1 - 1]); + res3la[1 - 1] = res3la[2 - 1]; + res3la[2 - 1] = res3la[3 - 1]; + res3la[3 - 1] = result[0]; + abserr[0] = Math.max(abserr[0], 5.0 * epmach * Math.abs(result[0])); + } } diff --git a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/Romberg.java b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/Romberg.java index 172268496..6f054e1a6 100644 --- a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/Romberg.java +++ b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/Romberg.java @@ -7,10 +7,8 @@ /** * Implements three versions of the Romberg numerical integrator: *
    - *
  1. Richardson is the simplest and is based on Richardson extrapolation - * [4]
    2. - *
  2. CADRE is a translation of the Cautious Adaptive Romberg Extrapolator - * (CADRE) [1, 2]
    3. + *
  3. Richardson is the simplest and is based on Richardson extrapolation [4]
    4. + *
  4. CADRE is a translation of the Cautious Adaptive Romberg Extrapolator (CADRE) [1, 2]
    5. *
  5. Havie is a translation of the Havie integrator introduced in [3]
    6. *
* All three versions are translated from the INTLIB package by John Burkardt. @@ -18,759 +16,759 @@ *

* References: *

    - *
  • [1] Philip Davis, Philip Rabinowitz. Methods of Numerical Integration, - * Second Edition, Dover, 2007.
    • - *
  • [2] de Boor, Carl. "CADRE: An algorithm for numerical quadrature." - * Mathematical software. Academic Press, 1971. 417-449.
    • - *
  • [3] Robert N. Kubik. 1965. Algorithm 257: Havie integrator. Commun. ACM - * 8, 6 (June 1965), 381. DOI:https://doi.org/10.1145/364955.364978
    • - *
  • [4] CF Dunkl, Romberg quadrature to prescribed accuracy, SHARE file - * number 7090-1481 TYQUAD
    • + *
  • [1] Philip Davis, Philip Rabinowitz. Methods of Numerical Integration, Second Edition, Dover, + * 2007.
    • + *
  • [2] de Boor, Carl. "CADRE: An algorithm for numerical quadrature." Mathematical software. + * Academic Press, 1971. 417-449.
    • + *
  • [3] Robert N. Kubik. 1965. Algorithm 257: Havie integrator. Commun. ACM 8, 6 (June 1965), + * 381. DOI:https://doi.org/10.1145/364955.364978
    • + *
  • [4] CF Dunkl, Romberg quadrature to prescribed accuracy, SHARE file number 7090-1481 + * TYQUAD
    • *
*

*/ public final class Romberg extends Quadrature { - private final double myRelTol; - private final RombergExtrapolationMethod myMethod; - - /** - * The extrapolation method to use for Romberg integration. - */ - public static enum RombergExtrapolationMethod { - RICHARDSON, CADRE, HAVIE - } - - /** - * Creates a new instance of the Romberg integrator. - * - * @param relativeTolerance the smallest acceptable relative change in integral - * estimates in consecutive iterations that indicates - * the algorithm has converged - * @param absoluteTolerance the smallest acceptable absolute change in integral - * estimates in consecutive iterations that indicates - * the algorithm has converged - * @param maxEvaluations the maximum number of function evaluations - * @param method the extrapolation method to use - */ - public Romberg(final double absoluteTolerance, final double relativeTolerance, final int maxEvaluations, - final RombergExtrapolationMethod method) { - super(absoluteTolerance, maxEvaluations); - myRelTol = relativeTolerance; - myMethod = method; - } - - /** - * Creates a new instance of the Romberg integrator. - * - * @param absoluteTolerance the smallest acceptable absolute change in integral - * estimates in consecutive iterations that indicates - * the algorithm has converged - * @param maxEvaluations the maximum number of function evaluations - * @param method the extrapolation method to use - * - */ - public Romberg(final double absoluteTolerance, final int maxEvaluations, final RombergExtrapolationMethod method) { - this(absoluteTolerance, 100.0 * Constants.EPSILON, maxEvaluations, method); - } - - public Romberg(final double absoluteTolerance, final int maxEvaluations) { - this(absoluteTolerance, maxEvaluations, RombergExtrapolationMethod.CADRE); - } - - @Override - final QuadratureResult properIntegral(final DoubleUnaryOperator f, final double a, - final double b) { - switch (myMethod) { - case RICHARDSON: - return romberg(f, a, b); - case CADRE: - return cadre(f, a, b); - case HAVIE: - return havie(f, a, b, 2); - default: - return new QuadratureResult(Double.NaN, Double.NaN, 0, false); - } - } - - @Override - public final String getName() { - return "Romberg-" + myMethod.toString(); + private final double myRelTol; + private final RombergExtrapolationMethod myMethod; + + /** + * The extrapolation method to use for Romberg integration. + */ + public static enum RombergExtrapolationMethod { + RICHARDSON, CADRE, HAVIE + } + + /** + * Creates a new instance of the Romberg integrator. + * + * @param relativeTolerance the smallest acceptable relative change in integral estimates in + * consecutive iterations that indicates the algorithm has converged + * @param absoluteTolerance the smallest acceptable absolute change in integral estimates in + * consecutive iterations that indicates the algorithm has converged + * @param maxEvaluations the maximum number of function evaluations + * @param method the extrapolation method to use + */ + public Romberg(final double absoluteTolerance, final double relativeTolerance, + final int maxEvaluations, final RombergExtrapolationMethod method) { + super(absoluteTolerance, maxEvaluations); + myRelTol = relativeTolerance; + myMethod = method; + } + + /** + * Creates a new instance of the Romberg integrator. + * + * @param absoluteTolerance the smallest acceptable absolute change in integral estimates in + * consecutive iterations that indicates the algorithm has converged + * @param maxEvaluations the maximum number of function evaluations + * @param method the extrapolation method to use + * + */ + public Romberg(final double absoluteTolerance, final int maxEvaluations, + final RombergExtrapolationMethod method) { + this(absoluteTolerance, 100.0 * Constants.EPSILON, maxEvaluations, method); + } + + public Romberg(final double absoluteTolerance, final int maxEvaluations) { + this(absoluteTolerance, maxEvaluations, RombergExtrapolationMethod.CADRE); + } + + @Override + final QuadratureResult properIntegral(final DoubleUnaryOperator f, final double a, + final double b) { + switch (myMethod) { + case RICHARDSON: + return romberg(f, a, b); + case CADRE: + return cadre(f, a, b); + case HAVIE: + return havie(f, a, b, 2); + default: + return new QuadratureResult(Double.NaN, Double.NaN, 0, false); } - - private final QuadratureResult romberg(final DoubleUnaryOperator func, final double a, - final double b) { - - // prepare variables - final double[] work = new double[myMaxEvals + 1]; - double rnderr = Constants.EPSILON; - double qx1 = 0.0; - double qx2 = 0.0; - double h = b - a; + } + + @Override + public final String getName() { + return "Romberg-" + myMethod.toString(); + } + + private final QuadratureResult romberg(final DoubleUnaryOperator func, final double a, + final double b) { + + // prepare variables + final double[] work = new double[myMaxEvals + 1]; + double rnderr = Constants.EPSILON; + double qx1 = 0.0; + double qx2 = 0.0; + double h = b - a; double fcna = func.applyAsDouble(a); double fcnb = func.applyAsDouble(b); - double tabs = Math.abs(h) * (Math.abs(fcna) + Math.abs(fcnb)) * 0.5; - double t = h * (fcna + fcnb) * 0.5; - int nx = 1; - int nfev = 2; - final int nleast = 6; - - // main iterations - for (int i = 1; nfev < myMaxEvals; ++i) { - h *= 0.5; - double sum1 = 0.0; - double sumabs = 0.0; - for (int j = 1; j <= nx; ++j) { - final double fcnxi = func.applyAsDouble(a + h * ((j << 1) - 1)); - sumabs += Math.abs(fcnxi); - sum1 += fcnxi; - ++nfev; - if (nfev >= myMaxEvals) { - return new QuadratureResult(work[0], Double.NaN, nfev, false); - } - } - t = 0.5 * t + h * sum1; - tabs = tabs * 0.5 + Math.abs(h) * sumabs; - work[i - 1] = 2.0 * (t + h * sum1) / 3.0; - if (1 < i) { - - // Construct difference table for Richardson extrapolation. - double f = 4.0; - for (int j = 2; j <= i; ++j) { - final int k = i + 1 - j; - f *= 4.0; - work[k - 1] = work[k] + (work[k] - work[k - 1]) / (f - 1.0); - } - - // Perform acceptance check. - if (nleast <= i) { - final double x = Math.abs(work[0] - qx2) + Math.abs(qx2 - qx1); - if (x <= 3.0 * tabs * (Math.abs(myRelTol) + rnderr) || x <= 3.0 * Math.abs(myTol)) { - return new QuadratureResult(work[0], x, nfev, true); - } - } - - // Save old result, perform bisection, repeat. - qx1 = qx2; - } - qx2 = work[0]; - nx <<= 1; - } - return new QuadratureResult(work[0], Double.NaN, nfev, false); + double tabs = Math.abs(h) * (Math.abs(fcna) + Math.abs(fcnb)) * 0.5; + double t = h * (fcna + fcnb) * 0.5; + int nx = 1; + int nfev = 2; + final int nleast = 6; + + // main iterations + for (int i = 1; nfev < myMaxEvals; ++i) { + h *= 0.5; + double sum1 = 0.0; + double sumabs = 0.0; + for (int j = 1; j <= nx; ++j) { + final double fcnxi = func.applyAsDouble(a + h * ((j << 1) - 1)); + sumabs += Math.abs(fcnxi); + sum1 += fcnxi; + ++nfev; + if (nfev >= myMaxEvals) { + return new QuadratureResult(work[0], Double.NaN, nfev, false); + } + } + t = 0.5 * t + h * sum1; + tabs = tabs * 0.5 + Math.abs(h) * sumabs; + work[i - 1] = 2.0 * (t + h * sum1) / 3.0; + if (1 < i) { + + // Construct difference table for Richardson extrapolation. + double f = 4.0; + for (int j = 2; j <= i; ++j) { + final int k = i + 1 - j; + f *= 4.0; + work[k - 1] = work[k] + (work[k] - work[k - 1]) / (f - 1.0); + } + + // Perform acceptance check. + if (nleast <= i) { + final double x = Math.abs(work[0] - qx2) + Math.abs(qx2 - qx1); + if (x <= 3.0 * tabs * (Math.abs(myRelTol) + rnderr) || x <= 3.0 * Math.abs(myTol)) { + return new QuadratureResult(work[0], x, nfev, true); + } + } + + // Save old result, perform bisection, repeat. + qx1 = qx2; + } + qx2 = work[0]; + nx <<= 1; } - - private final QuadratureResult cadre(final DoubleUnaryOperator func, final double a, - final double b) { - final int mxstge = 30, maxtbl = 10, maxts = 2049; - final double aitlow = 1.1, aittol = 0.1, h2tol = 0.15, tljump = 0.01; - final boolean[] reglsv = new boolean[mxstge]; - final int[] ibegs = new int[mxstge]; - final double[] ait = new double[maxtbl], begin = new double[mxstge], dif = new double[maxtbl], - est = new double[mxstge], finis = new double[mxstge], r = new double[maxtbl], rn = new double[4], - ts = new double[maxts]; - final double[][] t = new double[maxtbl][maxtbl]; - boolean aitken, h2conv, reglar, right; - int i = 0, ibeg, iend, ii, iii, istage, istep, istep2, it = 0, l, lm1 = 0, n, n2, nnleft, fev = 0, ind; - double astep, beg, bma, curest, diff = 0.0, end, ergoal = 0.0, erra, errer = 0.0, errr, fbeg, fbeg2 = 0.0, fend, - fextm1, fextrp = 0.0, fn, fnsize, h2next = 0.0, h2tfex, hovn, prever, rnderr, sing, singnx = 0.0, - slope = 0.0, stage, step, stepmn, sum1, sumabs, tabs, tabtlm = 0.0, vint, result = 0.0, error = 0.0; - - vint = 0.0; - rn[0] = 0.7142005; - rn[1] = 0.3466282; - rn[2] = 0.8437510; - rn[3] = 0.1263305; - rnderr = Constants.EPSILON; - ind = 1; - bma = Math.abs(b - a); - errr = Math.min(0.1, Math.max(Math.abs(myRelTol), 10.0 * rnderr)); - erra = Math.abs(myTol); - final double absmax = Math.max(Math.abs(a), Math.abs(b)); - stepmn = Math.max(bma / SimpleMath.pow(2.0, mxstge), Math.max(bma, absmax) * rnderr); - stage = 0.5; - istage = 1; - curest = fnsize = prever = 0.0; - reglar = false; - beg = a; + return new QuadratureResult(work[0], Double.NaN, nfev, false); + } + + private final QuadratureResult cadre(final DoubleUnaryOperator func, final double a, + final double b) { + final int mxstge = 30, maxtbl = 10, maxts = 2049; + final double aitlow = 1.1, aittol = 0.1, h2tol = 0.15, tljump = 0.01; + final boolean[] reglsv = new boolean[mxstge]; + final int[] ibegs = new int[mxstge]; + final double[] ait = new double[maxtbl], begin = new double[mxstge], dif = new double[maxtbl], + est = new double[mxstge], finis = new double[mxstge], r = new double[maxtbl], + rn = new double[4], ts = new double[maxts]; + final double[][] t = new double[maxtbl][maxtbl]; + boolean aitken, h2conv, reglar, right; + int i = 0, ibeg, iend, ii, iii, istage, istep, istep2, it = 0, l, lm1 = 0, n, n2, nnleft, + fev = 0, ind; + double astep, beg, bma, curest, diff = 0.0, end, ergoal = 0.0, erra, errer = 0.0, errr, fbeg, + fbeg2 = 0.0, fend, fextm1, fextrp = 0.0, fn, fnsize, h2next = 0.0, h2tfex, hovn, prever, + rnderr, sing, singnx = 0.0, slope = 0.0, stage, step, stepmn, sum1, sumabs, tabs, + tabtlm = 0.0, vint, result = 0.0, error = 0.0; + + vint = 0.0; + rn[0] = 0.7142005; + rn[1] = 0.3466282; + rn[2] = 0.8437510; + rn[3] = 0.1263305; + rnderr = Constants.EPSILON; + ind = 1; + bma = Math.abs(b - a); + errr = Math.min(0.1, Math.max(Math.abs(myRelTol), 10.0 * rnderr)); + erra = Math.abs(myTol); + final double absmax = Math.max(Math.abs(a), Math.abs(b)); + stepmn = Math.max(bma / SimpleMath.pow(2.0, mxstge), Math.max(bma, absmax) * rnderr); + stage = 0.5; + istage = 1; + curest = fnsize = prever = 0.0; + reglar = false; + beg = a; fbeg = func.applyAsDouble(beg) / 2.0; - fev = 1; - ts[1 - 1] = fbeg; - ibeg = 1; - end = b; + fev = 1; + ts[1 - 1] = fbeg; + ibeg = 1; + end = b; fend = func.applyAsDouble(end) / 2.0; - ++fev; - ts[2 - 1] = fend; - iend = 2; - - right = false; - step = end - beg; - astep = Math.abs(step); - if (astep < stepmn) { - ind = 5; - return new QuadratureResult(curest + vint, error, fev, true); - } - t[1 - 1][1 - 1] = fbeg + fend; - tabs = Math.abs(fbeg) + Math.abs(fend); - l = n = 1; - h2conv = aitken = false; - - int flag = 40; - while (true) { - - if (flag == 40) { - lm1 = l; - ++l; - n2 = n << 1; - fn = n2; - istep = (iend - ibeg) / n; - if (1 >= istep) { - ii = iend; - iend += n; - if (maxts < iend) { - ind = 4; - return new QuadratureResult(curest + vint, error, fev, true); - } - hovn = step / fn; - iii = iend; - for (i = 1; i <= n2; i += 2) { - ts[iii - 1] = ts[ii - 1]; + ++fev; + ts[2 - 1] = fend; + iend = 2; + + right = false; + step = end - beg; + astep = Math.abs(step); + if (astep < stepmn) { + ind = 5; + return new QuadratureResult(curest + vint, error, fev, true); + } + t[1 - 1][1 - 1] = fbeg + fend; + tabs = Math.abs(fbeg) + Math.abs(fend); + l = n = 1; + h2conv = aitken = false; + + int flag = 40; + while (true) { + + if (flag == 40) { + lm1 = l; + ++l; + n2 = n << 1; + fn = n2; + istep = (iend - ibeg) / n; + if (1 >= istep) { + ii = iend; + iend += n; + if (maxts < iend) { + ind = 4; + return new QuadratureResult(curest + vint, error, fev, true); + } + hovn = step / fn; + iii = iend; + for (i = 1; i <= n2; i += 2) { + ts[iii - 1] = ts[ii - 1]; ts[iii - 1 - 1] = func.applyAsDouble(end - i * hovn); - ++fev; - iii -= 2; - --ii; - if (fev >= myMaxEvals) { - return new QuadratureResult(Double.NaN, error, fev, false); - } - } - istep = 2; - } - - istep2 = ibeg + (istep >> 1); - sum1 = sumabs = 0.0; - for (i = istep2; i <= iend; i += istep) { - sum1 += ts[i - 1]; - sumabs += Math.abs(ts[i - 1]); - } - - t[l - 1][1 - 1] = t[l - 1 - 1][1 - 1] / 2.0 + sum1 / fn; - tabs = tabs / 2.0 + sumabs / fn; - n = n2; - it = 1; - vint = step * t[l - 1][1 - 1]; - tabtlm = tabs * rnderr; - fnsize = Math.max(fnsize, Math.abs(t[l - 1][1 - 1])); - ergoal = Math.max(astep * rnderr * fnsize, stage * Math.max(erra, errr * Math.abs(curest + vint))); - fextrp = 1.0; - for (i = 1; i <= lm1; ++i) { - fextrp *= 4.0; - t[i - 1][l - 1] = t[l - 1][i - 1] - t[l - 1 - 1][i - 1]; - t[l - 1][i + 1 - 1] = t[l - 1][i - 1] + t[i - 1][l - 1] / (fextrp - 1.0); - } - - errer = astep * Math.abs(t[1 - 1][l - 1]); - if (2 >= l) { - if (Math.abs(t[1 - 1][2 - 1]) <= tabtlm) { - slope = (fend - fbeg) * 2.0; - fbeg2 = fbeg * 2.0; - int next = 340; - for (i = 1; i <= 4; ++i) { + ++fev; + iii -= 2; + --ii; + if (fev >= myMaxEvals) { + return new QuadratureResult(Double.NaN, error, fev, false); + } + } + istep = 2; + } + + istep2 = ibeg + (istep >> 1); + sum1 = sumabs = 0.0; + for (i = istep2; i <= iend; i += istep) { + sum1 += ts[i - 1]; + sumabs += Math.abs(ts[i - 1]); + } + + t[l - 1][1 - 1] = t[l - 1 - 1][1 - 1] / 2.0 + sum1 / fn; + tabs = tabs / 2.0 + sumabs / fn; + n = n2; + it = 1; + vint = step * t[l - 1][1 - 1]; + tabtlm = tabs * rnderr; + fnsize = Math.max(fnsize, Math.abs(t[l - 1][1 - 1])); + ergoal = Math.max(astep * rnderr * fnsize, + stage * Math.max(erra, errr * Math.abs(curest + vint))); + fextrp = 1.0; + for (i = 1; i <= lm1; ++i) { + fextrp *= 4.0; + t[i - 1][l - 1] = t[l - 1][i - 1] - t[l - 1 - 1][i - 1]; + t[l - 1][i + 1 - 1] = t[l - 1][i - 1] + t[i - 1][l - 1] / (fextrp - 1.0); + } + + errer = astep * Math.abs(t[1 - 1][l - 1]); + if (2 >= l) { + if (Math.abs(t[1 - 1][2 - 1]) <= tabtlm) { + slope = (fend - fbeg) * 2.0; + fbeg2 = fbeg * 2.0; + int next = 340; + for (i = 1; i <= 4; ++i) { + diff = + Math.abs(func.applyAsDouble(beg + rn[i - 1] * step) - fbeg2 - rn[i - 1] * slope); + ++fev; + if (fev >= myMaxEvals) { + return new QuadratureResult(Double.NaN, error, fev, false); + } + if (tabtlm < diff) { + next = 330; + break; + } + } + if (next == 330) { + flag = 330; + } else { + flag = 340; + } + } + continue; + } + + for (i = 2; i <= lm1; ++i) { + if (tabtlm < Math.abs(t[i - 1 - 1][l - 1])) { + diff = t[i - 1 - 1][lm1 - 1] / t[i - 1 - 1][l - 1]; + } else { + diff = 0.0; + } + t[i - 1 - 1][lm1 - 1] = diff; + } + + if (Math.abs(4.0 - t[1 - 1][lm1 - 1]) > h2tol) { + if (t[1 - 1][lm1 - 1] == 0.0) { + if (errer <= ergoal) { + slope = (fend - fbeg) * 2.0; + fbeg2 = fbeg * 2.0; + i = 1; diff = Math.abs(func.applyAsDouble(beg + rn[i - 1] * step) - fbeg2 - rn[i - 1] * slope); - ++fev; - if (fev >= myMaxEvals) { - return new QuadratureResult(Double.NaN, error, fev, false); - } - if (tabtlm < diff) { - next = 330; - break; - } - } - if (next == 330) { - flag = 330; - } else { - flag = 340; - } - } - continue; - } - - for (i = 2; i <= lm1; ++i) { - if (tabtlm < Math.abs(t[i - 1 - 1][l - 1])) { - diff = t[i - 1 - 1][lm1 - 1] / t[i - 1 - 1][l - 1]; - } else { - diff = 0.0; - } - t[i - 1 - 1][lm1 - 1] = diff; - } - - if (Math.abs(4.0 - t[1 - 1][lm1 - 1]) > h2tol) { - if (t[1 - 1][lm1 - 1] == 0.0) { - if (errer <= ergoal) { - slope = (fend - fbeg) * 2.0; - fbeg2 = fbeg * 2.0; - i = 1; - diff = Math - .abs(func.applyAsDouble(beg + rn[i - 1] * step) - fbeg2 - rn[i - 1] * slope); - ++fev; - flag = 330; - if (fev >= myMaxEvals) { - return new QuadratureResult(Double.NaN, error, fev, false); - } - } else { - flag = 380; - } - } else if (Math.abs(2.0 - Math.abs(t[1 - 1][lm1 - 1])) < tljump) { - if (ergoal < errer) { - reglar = true; - flag = 380; - } else { - diff = Math.abs(t[1 - 1][l - 1]) * 2.0 * fn; - flag = 340; - } - } else if (l == 3) { - flag = 40; - } else { - h2conv = false; - if (Math.abs((t[1 - 1][lm1 - 1] - t[1 - 1][l - 2 - 1]) / t[1 - 1][lm1 - 1]) <= aittol) { - flag = 160; - } else if (!reglar && l == 4) { - flag = 40; - } else if (errer <= ergoal) { - slope = (fend - fbeg) * 2.0; - fbeg2 = fbeg * 2.0; - i = 1; - diff = Math - .abs(func.applyAsDouble(beg + rn[i - 1] * step) - fbeg2 - rn[i - 1] * slope); - ++fev; - flag = 330; - if (fev >= myMaxEvals) { - return new QuadratureResult(Double.NaN, error, fev, false); - } - } else { - flag = 380; - } - } - continue; - } else { - if (!h2conv) { - aitken = false; - h2conv = true; - } - fextrp = 4.0; - flag = 150; - } - } - - if (flag == 150) { - while (true) { - ++it; - vint = step * t[l - 1][it - 1]; - errer = Math.abs(step / (fextrp - 1.0) * t[it - 1 - 1][l - 1]); - if (errer <= ergoal) { - flag = 340; - break; - } else if (it == lm1) { - flag = 270; - break; - } else if (t[it - 1][lm1 - 1] == 0.0) { - } else if (t[it - 1][lm1 - 1] <= fextrp) { - flag = 270; - break; - } else if (Math.abs(t[it - 1][lm1 - 1] / 4.0 - fextrp) / fextrp < aittol) { - fextrp *= 4.0; - } - } - } - - if (flag == 160) { - if (t[1 - 1][lm1 - 1] < aitlow) { - flag = 380; - } else { - if (!aitken) { - h2conv = false; - aitken = true; - } - fextrp = t[l - 2 - 1][lm1 - 1]; - if (4.5 < fextrp) { - fextrp = 4.0; - flag = 150; - continue; - } else if (fextrp < aitlow - || h2tol < Math.abs(fextrp - t[l - 3 - 1][lm1 - 1]) / t[1 - 1][lm1 - 1]) { - flag = 380; - } else { - sing = fextrp; - fextm1 = fextrp - 1.0; - ait[1 - 1] = 0.0; - for (i = 2; i <= l; ++i) { - ait[i - 1] = t[i - 1][1 - 1] + (t[i - 1][1 - 1] - t[i - 1 - 1][1 - 1]) / fextm1; - r[i - 1] = t[1 - 1][i - 1 - 1]; - dif[i - 1] = ait[i - 1] - ait[i - 1 - 1]; - } - it = 2; - - while (true) { - vint = step * ait[l - 1]; - errer /= fextm1; - if (errer <= ergoal) { - ind = Math.max(ind, 2); - flag = 340; - break; - } - ++it; - if (it == lm1) { - flag = 270; - break; - } - if (it <= 3) { - h2next = 4.0; - singnx = 2.0 * sing; - } - if (h2next < singnx) { - fextrp = h2next; - h2next *= 4.0; - } else { - fextrp = singnx; - singnx *= 2.0; - } - - for (i = it; i <= lm1; ++i) { - if (tabtlm < Math.abs(dif[i + 1 - 1])) { - r[i + 1 - 1] = dif[i - 1] / dif[i + 1 - 1]; - } else { - r[i + 1 - 1] = 0.0; - } - } - h2tfex = -h2tol * fextrp; - if (r[l - 1] - fextrp >= h2tfex && r[l - 1 - 1] - fextrp >= h2tfex) { - errer = astep * Math.abs(dif[l - 1]); - fextm1 = fextrp - 1.0; - for (i = it; i <= l; ++i) { - ait[i - 1] += (dif[i - 1] / fextm1); - dif[i - 1] = ait[i - 1] - ait[i - 1 - 1]; - } - } else { - flag = 270; - break; - } - } - } - } - } - - if (flag == 270) { - fextrp = Math.max(prever / errer, aitlow); - prever = errer; - if (l < 5) { - flag = 40; - continue; - } else if (2.0 < l - it && istage < mxstge) { - reglar = true; - flag = 380; - } else if (errer / SimpleMath.pow(fextrp, maxtbl - l) < ergoal) { - flag = 40; - continue; - } else { - reglar = true; - flag = 380; - } - } - - if (flag == 330) { - while (true) { - errer = Math.max(errer, astep * diff); - if (ergoal < errer) { - flag = 380; - break; - } - ++i; - if (i <= 4) { + ++fev; + flag = 330; + if (fev >= myMaxEvals) { + return new QuadratureResult(Double.NaN, error, fev, false); + } + } else { + flag = 380; + } + } else if (Math.abs(2.0 - Math.abs(t[1 - 1][lm1 - 1])) < tljump) { + if (ergoal < errer) { + reglar = true; + flag = 380; + } else { + diff = Math.abs(t[1 - 1][l - 1]) * 2.0 * fn; + flag = 340; + } + } else if (l == 3) { + flag = 40; + } else { + h2conv = false; + if (Math.abs((t[1 - 1][lm1 - 1] - t[1 - 1][l - 2 - 1]) / t[1 - 1][lm1 - 1]) <= aittol) { + flag = 160; + } else if (!reglar && l == 4) { + flag = 40; + } else if (errer <= ergoal) { + slope = (fend - fbeg) * 2.0; + fbeg2 = fbeg * 2.0; + i = 1; diff = Math.abs(func.applyAsDouble(beg + rn[i - 1] * step) - fbeg2 - rn[i - 1] * slope); - ++fev; - if (fev >= myMaxEvals) { - return new QuadratureResult(Double.NaN, error, fev, false); - } - } else { - ind = 3; - flag = 340; - break; - } - } - } - - if (flag == 340) { - result += vint; - error += errer; - if (right) { - curest += vint; - stage *= 2.0; - iend = ibeg; - ibeg = ibegs[istage - 1]; - end = beg; - beg = begin[istage - 1]; - fend = fbeg; - fbeg = ts[ibeg - 1]; - right = false; - } else { - --istage; - if (istage == 0) { - return new QuadratureResult(result, error, fev, true); - } - reglar = reglsv[istage - 1]; - beg = begin[istage - 1]; - end = finis[istage - 1]; - curest = curest - est[istage + 1 - 1] + vint; - iend = ibeg - 1; - fend = ts[iend - 1]; - ibeg = ibegs[istage - 1]; - right = true; - beg = (beg + end) / 2.0; - ibeg = (ibeg + iend) >> 1; - ts[ibeg - 1] /= 2.0; - fbeg = ts[ibeg - 1]; - } - step = end - beg; - astep = Math.abs(step); - if (astep < stepmn) { - ind = 5; - return new QuadratureResult(curest + vint, error, fev, true); - } - t[1 - 1][1 - 1] = fbeg + fend; - tabs = Math.abs(fbeg) + Math.abs(fend); - l = n = 1; - h2conv = aitken = false; - flag = 40; - continue; - } - - if (flag == 380) { - if (istage == mxstge) { - ind = 5; - return new QuadratureResult(curest + vint, error, fev, true); - } - if (!right) { - reglsv[istage + 1 - 1] = reglar; - begin[istage - 1] = beg; - ibegs[istage - 1] = ibeg; - stage /= 2.0; - right = true; - beg = (beg + end) / 2.0; - ibeg = (ibeg + iend) >> 1; - ts[ibeg - 1] /= 2.0; - fbeg = ts[ibeg - 1]; - } else { - - nnleft = ibeg - ibegs[istage - 1]; - if (maxts <= end + nnleft) { - ind = 4; - return new QuadratureResult(curest + vint, error, fev, true); - } - iii = ibegs[istage - 1]; - ii = iend; - for (i = iii; i <= ibeg; ++i) { - ++ii; - ts[ii - 1] = ts[i - 1]; - } - for (i = ibeg; i <= ii; ++i) { - ts[iii - 1] = ts[i - 1]; - ++iii; - } - - ++iend; - ibeg = iend - nnleft; - fend = fbeg; - fbeg = ts[ibeg - 1]; - finis[istage - 1] = end; - end = beg; - beg = begin[istage - 1]; - begin[istage - 1] = end; - reglsv[istage - 1] = reglar; - ++istage; - reglar = reglsv[istage - 1]; - est[istage - 1] = vint; - curest += est[istage - 1]; - right = false; - } - step = end - beg; - astep = Math.abs(step); - if (astep < stepmn) { - ind = 5; - return new QuadratureResult(curest + vint, error, fev, true); - } - t[1 - 1][1 - 1] = fbeg + fend; - tabs = Math.abs(fbeg) + Math.abs(fend); - l = n = 1; - h2conv = aitken = false; - flag = 40; - } - } + ++fev; + flag = 330; + if (fev >= myMaxEvals) { + return new QuadratureResult(Double.NaN, error, fev, false); + } + } else { + flag = 380; + } + } + continue; + } else { + if (!h2conv) { + aitken = false; + h2conv = true; + } + fextrp = 4.0; + flag = 150; + } + } + + if (flag == 150) { + while (true) { + ++it; + vint = step * t[l - 1][it - 1]; + errer = Math.abs(step / (fextrp - 1.0) * t[it - 1 - 1][l - 1]); + if (errer <= ergoal) { + flag = 340; + break; + } else if (it == lm1) { + flag = 270; + break; + } else if (t[it - 1][lm1 - 1] == 0.0) { + } else if (t[it - 1][lm1 - 1] <= fextrp) { + flag = 270; + break; + } else if (Math.abs(t[it - 1][lm1 - 1] / 4.0 - fextrp) / fextrp < aittol) { + fextrp *= 4.0; + } + } + } + + if (flag == 160) { + if (t[1 - 1][lm1 - 1] < aitlow) { + flag = 380; + } else { + if (!aitken) { + h2conv = false; + aitken = true; + } + fextrp = t[l - 2 - 1][lm1 - 1]; + if (4.5 < fextrp) { + fextrp = 4.0; + flag = 150; + continue; + } else if (fextrp < aitlow + || h2tol < Math.abs(fextrp - t[l - 3 - 1][lm1 - 1]) / t[1 - 1][lm1 - 1]) { + flag = 380; + } else { + sing = fextrp; + fextm1 = fextrp - 1.0; + ait[1 - 1] = 0.0; + for (i = 2; i <= l; ++i) { + ait[i - 1] = t[i - 1][1 - 1] + (t[i - 1][1 - 1] - t[i - 1 - 1][1 - 1]) / fextm1; + r[i - 1] = t[1 - 1][i - 1 - 1]; + dif[i - 1] = ait[i - 1] - ait[i - 1 - 1]; + } + it = 2; + + while (true) { + vint = step * ait[l - 1]; + errer /= fextm1; + if (errer <= ergoal) { + ind = Math.max(ind, 2); + flag = 340; + break; + } + ++it; + if (it == lm1) { + flag = 270; + break; + } + if (it <= 3) { + h2next = 4.0; + singnx = 2.0 * sing; + } + if (h2next < singnx) { + fextrp = h2next; + h2next *= 4.0; + } else { + fextrp = singnx; + singnx *= 2.0; + } + + for (i = it; i <= lm1; ++i) { + if (tabtlm < Math.abs(dif[i + 1 - 1])) { + r[i + 1 - 1] = dif[i - 1] / dif[i + 1 - 1]; + } else { + r[i + 1 - 1] = 0.0; + } + } + h2tfex = -h2tol * fextrp; + if (r[l - 1] - fextrp >= h2tfex && r[l - 1 - 1] - fextrp >= h2tfex) { + errer = astep * Math.abs(dif[l - 1]); + fextm1 = fextrp - 1.0; + for (i = it; i <= l; ++i) { + ait[i - 1] += (dif[i - 1] / fextm1); + dif[i - 1] = ait[i - 1] - ait[i - 1 - 1]; + } + } else { + flag = 270; + break; + } + } + } + } + } + + if (flag == 270) { + fextrp = Math.max(prever / errer, aitlow); + prever = errer; + if (l < 5) { + flag = 40; + continue; + } else if (2.0 < l - it && istage < mxstge) { + reglar = true; + flag = 380; + } else if (errer / SimpleMath.pow(fextrp, maxtbl - l) < ergoal) { + flag = 40; + continue; + } else { + reglar = true; + flag = 380; + } + } + + if (flag == 330) { + while (true) { + errer = Math.max(errer, astep * diff); + if (ergoal < errer) { + flag = 380; + break; + } + ++i; + if (i <= 4) { + diff = Math.abs(func.applyAsDouble(beg + rn[i - 1] * step) - fbeg2 - rn[i - 1] * slope); + ++fev; + if (fev >= myMaxEvals) { + return new QuadratureResult(Double.NaN, error, fev, false); + } + } else { + ind = 3; + flag = 340; + break; + } + } + } + + if (flag == 340) { + result += vint; + error += errer; + if (right) { + curest += vint; + stage *= 2.0; + iend = ibeg; + ibeg = ibegs[istage - 1]; + end = beg; + beg = begin[istage - 1]; + fend = fbeg; + fbeg = ts[ibeg - 1]; + right = false; + } else { + --istage; + if (istage == 0) { + return new QuadratureResult(result, error, fev, true); + } + reglar = reglsv[istage - 1]; + beg = begin[istage - 1]; + end = finis[istage - 1]; + curest = curest - est[istage + 1 - 1] + vint; + iend = ibeg - 1; + fend = ts[iend - 1]; + ibeg = ibegs[istage - 1]; + right = true; + beg = (beg + end) / 2.0; + ibeg = (ibeg + iend) >> 1; + ts[ibeg - 1] /= 2.0; + fbeg = ts[ibeg - 1]; + } + step = end - beg; + astep = Math.abs(step); + if (astep < stepmn) { + ind = 5; + return new QuadratureResult(curest + vint, error, fev, true); + } + t[1 - 1][1 - 1] = fbeg + fend; + tabs = Math.abs(fbeg) + Math.abs(fend); + l = n = 1; + h2conv = aitken = false; + flag = 40; + continue; + } + + if (flag == 380) { + if (istage == mxstge) { + ind = 5; + return new QuadratureResult(curest + vint, error, fev, true); + } + if (!right) { + reglsv[istage + 1 - 1] = reglar; + begin[istage - 1] = beg; + ibegs[istage - 1] = ibeg; + stage /= 2.0; + right = true; + beg = (beg + end) / 2.0; + ibeg = (ibeg + iend) >> 1; + ts[ibeg - 1] /= 2.0; + fbeg = ts[ibeg - 1]; + } else { + + nnleft = ibeg - ibegs[istage - 1]; + if (maxts <= end + nnleft) { + ind = 4; + return new QuadratureResult(curest + vint, error, fev, true); + } + iii = ibegs[istage - 1]; + ii = iend; + for (i = iii; i <= ibeg; ++i) { + ++ii; + ts[ii - 1] = ts[i - 1]; + } + for (i = ibeg; i <= ii; ++i) { + ts[iii - 1] = ts[i - 1]; + ++iii; + } + + ++iend; + ibeg = iend - nnleft; + fend = fbeg; + fbeg = ts[ibeg - 1]; + finis[istage - 1] = end; + end = beg; + beg = begin[istage - 1]; + begin[istage - 1] = end; + reglsv[istage - 1] = reglar; + ++istage; + reglar = reglsv[istage - 1]; + est[istage - 1] = vint; + curest += est[istage - 1]; + right = false; + } + step = end - beg; + astep = Math.abs(step); + if (astep < stepmn) { + ind = 5; + return new QuadratureResult(curest + vint, error, fev, true); + } + t[1 - 1][1 - 1] = fbeg + fend; + tabs = Math.abs(fbeg) + Math.abs(fend); + l = n = 1; + h2conv = aitken = false; + flag = 40; + } } + } + + private final QuadratureResult havie(final DoubleUnaryOperator func, final double a, + final double b, final int iop) { + double alf, alfnj, alfno = 0.0, ar = 0.0, bet, betnj, betno, const1, const2, deltan, + endpts = 0.0, error, fac1 = 0.411233516712057, fac2 = 0.822467033441132, factor, gamman, + hnstep, pi = Math.PI, r1, r2, rn, rnderr, rounde, tend = 0.0, triarg = 0.0, umid, xmin, + xplus, epsout = Double.NaN; + int i, index = 0, iout = 0, j, n, nhalf, nupper = 9, fev = 0; + final double[] acof = new double[11], bcof = new double[nupper + 1]; + + // Set coefficients in formula for accumulated roundoff error, + // rounde = rnderr*(r1+r2*n), where r1, r2 are two empirical constants + // and n is the current number of function values used. + rnderr = Constants.EPSILON; + if (iop == 2) { + r1 = 50.0; + } else { + r1 = 1.0; + } + if (iop == 1) { + r2 = 0.02; + } else { + r2 = 2.0; + } + error = myTol; - private final QuadratureResult havie(final DoubleUnaryOperator func, final double a, - final double b, - final int iop) { - double alf, alfnj, alfno = 0.0, ar = 0.0, bet, betnj, betno, const1, const2, deltan, endpts = 0.0, error, - fac1 = 0.411233516712057, fac2 = 0.822467033441132, factor, gamman, hnstep, pi = Math.PI, r1, r2, rn, - rnderr, rounde, tend = 0.0, triarg = 0.0, umid, xmin, xplus, epsout = Double.NaN; - int i, index = 0, iout = 0, j, n, nhalf, nupper = 9, fev = 0; - final double[] acof = new double[11], bcof = new double[nupper + 1]; - - // Set coefficients in formula for accumulated roundoff error, - // rounde = rnderr*(r1+r2*n), where r1, r2 are two empirical constants - // and n is the current number of function values used. - rnderr = Constants.EPSILON; - if (iop == 2) { - r1 = 50.0; - } else { - r1 = 1.0; - } - if (iop == 1) { - r2 = 0.02; - } else { - r2 = 2.0; - } - error = myTol; - - // Initial calculations. - alf = 0.5 * (b - a); - bet = 0.5 * (a + b); + // Initial calculations. + alf = 0.5 * (b - a); + bet = 0.5 * (a + b); acof[1 - 1] = func.applyAsDouble(a) + func.applyAsDouble(b); - fev += 2; + fev += 2; bcof[1 - 1] = func.applyAsDouble(bet); - ++fev; - - // Modified Romberg algorithm, ordinary case. - if (iop != 2) { - hnstep = 2.0; - bcof[1 - 1] *= hnstep; - factor = 1.0; - } else { - - // Modified Romberg, cosine transformed case. - hnstep = pi; - ar = fac1; - endpts = acof[1 - 1]; - acof[1 - 1] *= fac2; - bcof[1 - 1] = hnstep * bcof[1 - 1] - ar * endpts; - factor = 4.0; - ar /= 4.0; - triarg = pi / 4.0; - alfno = -1.0; - } - hnstep *= 0.5; - nhalf = 1; - n = 2; - rn = 2.0; - acof[1 - 1] = 0.5 * (acof[1 - 1] + bcof[1 - 1]); - acof[2 - 1] = acof[1 - 1] - (acof[1 - 1] - bcof[1 - 1]) / (4.0 * factor - 1.0); - - // End of initial calculation. Start actual calculations. - for (i = 1; i <= nupper; ++i) { - umid = 0.0; - - if (iop == 1) { - - // Modified Romberg algorithm, ordinary case. - // compute first element in mid-point formula for ordinary case - alfnj = 0.5 * hnstep; - for (j = 1; j <= nhalf; ++j) { - xplus = alf * alfnj + bet; - xmin = -alf * alfnj + bet; - umid += (func.applyAsDouble(xplus) + func.applyAsDouble(xmin)); - fev += 2; - alfnj += hnstep; - if (fev >= myMaxEvals) { - return new QuadratureResult(Double.NaN, epsout, fev, false); - } - } - umid *= hnstep; - } else if (iop == 2) { - - // Modified Romberg algorithm, cosine transformed case - // compute first element in mid-point formula for cosine - // transformed Romberg algorithm. - const1 = -Math.sin(triarg); - const2 = 0.5 * alfno / const1; - alfno = const1; - betno = const2; - gamman = 1.0 - 2.0 * alfno * alfno; - deltan = -2.0 * alfno * betno; - for (j = 1; j <= nhalf; ++j) { - alfnj = gamman * const1 + deltan * const2; - betnj = gamman * const2 - deltan * const1; - xplus = alf * alfnj + bet; - xmin = -alf * alfnj + bet; - umid += betnj * (func.applyAsDouble(xplus) + func.applyAsDouble(xmin)); - fev += 2; - const1 = alfnj; - const2 = betnj; - if (fev >= myMaxEvals) { - return new QuadratureResult(Double.NaN, epsout, fev, false); - } - } - umid = hnstep * umid - ar * endpts; - ar /= 4.0; - } - - // Modified Romberg algorithm, calculate (i+1)-th row in the U table. - const1 = 4.0 * factor; - index = i + 1; - for (j = 2; j <= i + 1; ++j) { - tend = umid + (umid - bcof[j - 1 - 1]) / (const1 - 1.0); - bcof[j - 1 - 1] = umid; - umid = tend; - const1 *= 4.0; - } - bcof[i + 1 - 1] = tend; - xplus = const1; - - // Calculation of (i+1)-th row in the U table is finished - // Test to see if the required accuracy has been obtained. - epsout = 1.0; - iout = 1; - for (j = 1; j <= index; ++j) { - const1 = 0.5 * (acof[j - 1] + bcof[j - 1]); - const2 = 0.5 * Math.abs((acof[j - 1] - bcof[j - 1]) / const1); - if (const2 <= epsout) { - epsout = const2; - iout = j; - } - acof[j - 1] = const1; - } - - // Testing on accuracy finished - if (iout == index) { - ++iout; - } - acof[index + 1 - 1] = acof[index - 1] - (acof[index - 1] - bcof[index - 1]) / (xplus - 1.0); - rounde = rnderr * (r1 + r2 * rn); - epsout = Math.max(epsout, rounde); - error = Math.max(error, rounde); - if (epsout <= error) { - - // Calculation for modified Romberg algorithm finished. - n <<= 1; - --index; - ++n; - return new QuadratureResult(alf * acof[iout - 1], epsout, fev, true); - } - nhalf = n; - n <<= 1; - rn *= 2.0; - hnstep *= 0.5; - if (1 < iop) { - triarg *= 0.5; - } - } - - // Accuracy not reached with maximum number of subdivisions. - n = nhalf; - - // Calculation for modified Romberg algorithm finished. - n <<= 1; - --index; - ++n; - return new QuadratureResult(alf * acof[iout - 1], epsout, fev, true); + ++fev; + + // Modified Romberg algorithm, ordinary case. + if (iop != 2) { + hnstep = 2.0; + bcof[1 - 1] *= hnstep; + factor = 1.0; + } else { + + // Modified Romberg, cosine transformed case. + hnstep = pi; + ar = fac1; + endpts = acof[1 - 1]; + acof[1 - 1] *= fac2; + bcof[1 - 1] = hnstep * bcof[1 - 1] - ar * endpts; + factor = 4.0; + ar /= 4.0; + triarg = pi / 4.0; + alfno = -1.0; + } + hnstep *= 0.5; + nhalf = 1; + n = 2; + rn = 2.0; + acof[1 - 1] = 0.5 * (acof[1 - 1] + bcof[1 - 1]); + acof[2 - 1] = acof[1 - 1] - (acof[1 - 1] - bcof[1 - 1]) / (4.0 * factor - 1.0); + + // End of initial calculation. Start actual calculations. + for (i = 1; i <= nupper; ++i) { + umid = 0.0; + + if (iop == 1) { + + // Modified Romberg algorithm, ordinary case. + // compute first element in mid-point formula for ordinary case + alfnj = 0.5 * hnstep; + for (j = 1; j <= nhalf; ++j) { + xplus = alf * alfnj + bet; + xmin = -alf * alfnj + bet; + umid += (func.applyAsDouble(xplus) + func.applyAsDouble(xmin)); + fev += 2; + alfnj += hnstep; + if (fev >= myMaxEvals) { + return new QuadratureResult(Double.NaN, epsout, fev, false); + } + } + umid *= hnstep; + } else if (iop == 2) { + + // Modified Romberg algorithm, cosine transformed case + // compute first element in mid-point formula for cosine + // transformed Romberg algorithm. + const1 = -Math.sin(triarg); + const2 = 0.5 * alfno / const1; + alfno = const1; + betno = const2; + gamman = 1.0 - 2.0 * alfno * alfno; + deltan = -2.0 * alfno * betno; + for (j = 1; j <= nhalf; ++j) { + alfnj = gamman * const1 + deltan * const2; + betnj = gamman * const2 - deltan * const1; + xplus = alf * alfnj + bet; + xmin = -alf * alfnj + bet; + umid += betnj * (func.applyAsDouble(xplus) + func.applyAsDouble(xmin)); + fev += 2; + const1 = alfnj; + const2 = betnj; + if (fev >= myMaxEvals) { + return new QuadratureResult(Double.NaN, epsout, fev, false); + } + } + umid = hnstep * umid - ar * endpts; + ar /= 4.0; + } + + // Modified Romberg algorithm, calculate (i+1)-th row in the U table. + const1 = 4.0 * factor; + index = i + 1; + for (j = 2; j <= i + 1; ++j) { + tend = umid + (umid - bcof[j - 1 - 1]) / (const1 - 1.0); + bcof[j - 1 - 1] = umid; + umid = tend; + const1 *= 4.0; + } + bcof[i + 1 - 1] = tend; + xplus = const1; + + // Calculation of (i+1)-th row in the U table is finished + // Test to see if the required accuracy has been obtained. + epsout = 1.0; + iout = 1; + for (j = 1; j <= index; ++j) { + const1 = 0.5 * (acof[j - 1] + bcof[j - 1]); + const2 = 0.5 * Math.abs((acof[j - 1] - bcof[j - 1]) / const1); + if (const2 <= epsout) { + epsout = const2; + iout = j; + } + acof[j - 1] = const1; + } + + // Testing on accuracy finished + if (iout == index) { + ++iout; + } + acof[index + 1 - 1] = acof[index - 1] - (acof[index - 1] - bcof[index - 1]) / (xplus - 1.0); + rounde = rnderr * (r1 + r2 * rn); + epsout = Math.max(epsout, rounde); + error = Math.max(error, rounde); + if (epsout <= error) { + + // Calculation for modified Romberg algorithm finished. + n <<= 1; + --index; + ++n; + return new QuadratureResult(alf * acof[iout - 1], epsout, fev, true); + } + nhalf = n; + n <<= 1; + rn *= 2.0; + hnstep *= 0.5; + if (1 < iop) { + triarg *= 0.5; + } } + + // Accuracy not reached with maximum number of subdivisions. + n = nhalf; + + // Calculation for modified Romberg algorithm finished. + n <<= 1; + --index; + ++n; + return new QuadratureResult(alf * acof[iout - 1], epsout, fev, true); + } } diff --git a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/Simpson.java b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/Simpson.java index 5a406612d..37b5f3a5e 100644 --- a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/Simpson.java +++ b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/integral/Simpson.java @@ -94,9 +94,8 @@ public final String getName() { return myMethod.toString() + "-Simpson"; } - private static final double[] simpson13(final DoubleUnaryOperator func, - final double a, final double mid, final double b, final double fa, final double fmid, - final double fb) { + private static final double[] simpson13(final DoubleUnaryOperator func, final double a, + final double mid, final double b, final double fa, final double fmid, final double fb) { final double lmid = 0.5 * (a + mid); final double rmid = 0.5 * (mid + b); final double flmid = func.applyAsDouble(lmid); @@ -110,8 +109,8 @@ private static final double[] simpson13(final DoubleUnaryOperator func, return result; } - private final QuadratureResult globalSimpson(final DoubleUnaryOperator func, - final double a, final double b) { + private final QuadratureResult globalSimpson(final DoubleUnaryOperator func, final double a, + final double b) { // estimate the error on [a, b] using Lyness'-Richardson final double m0 = 0.5 * (a + b); @@ -182,8 +181,8 @@ private final QuadratureResult globalSimpson(final DoubleUnaryOperator func, return new QuadratureResult(est, error, fev, true); } - private final QuadratureResult localSimpson(final DoubleUnaryOperator func, - final double a, final double b) { + private final QuadratureResult localSimpson(final DoubleUnaryOperator func, final double a, + final double b) { // initialize the first interval final double m0 = 0.5 * (a + b); diff --git a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/series/special/EulerMaclaurin.java b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/series/special/EulerMaclaurin.java index 5e19fbc04..2eeb030a4 100644 --- a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/series/special/EulerMaclaurin.java +++ b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/series/special/EulerMaclaurin.java @@ -15,282 +15,283 @@ */ public final class EulerMaclaurin { - public static enum EulerMaclaurinErrorCode { - NO_ERROR, TOO_MANY_EVALS, BIN_TOO_LARGE, DERIVATIVE_ESTIMATION_FAILED, INTEGRAL_LOWER_BOUND_SEARCH_FAILED, - SERIES_ACCELERATION_FAILED, PIECEWISE_INTEGRATION_FAILED + public static enum EulerMaclaurinErrorCode { + NO_ERROR, TOO_MANY_EVALS, BIN_TOO_LARGE, DERIVATIVE_ESTIMATION_FAILED, INTEGRAL_LOWER_BOUND_SEARCH_FAILED, SERIES_ACCELERATION_FAILED, PIECEWISE_INTEGRATION_FAILED + } + + private static final double STEP = 1.4; + private static final double DECAY = 0.1; + private static final int WORK_MEMORY_FOR_RIDDER = 100; + private static final int MAX_RANGE = 1 << 12; + private static final double MAX_BIN = 1e30; + + private final boolean myVerbose; + private final double myTol; + private final Quadrature myQuad; + private final SeriesAlgorithm myAccelerator; + private final Function myBins; + + private int myFEvals, myDEvals; + private final double[] myWorkArray = new double[2]; + private List myErrorCodes; + + /** + * + * @param tolerance + * @param integrator + * @param accelerator + * @param binSequence + */ + public EulerMaclaurin(final double tolerance, final Quadrature integrator, + final SeriesAlgorithm accelerator, final Function binSequence, + final boolean verbose) { + myTol = tolerance; + myQuad = integrator; + myAccelerator = accelerator; + myBins = binSequence; + myVerbose = verbose; + } + + /** + * + * @param tolerance + * @param integrator + * @param binSequence + */ + public EulerMaclaurin(final double tolerance, final Quadrature integrator, + final SeriesAlgorithm accelerator, final Function binSequence) { + this(tolerance, integrator, accelerator, binSequence, false); + } + + /** + * + * @return + */ + public final int getEvaluations() { + return myFEvals; + } + + /** + * + * @return + */ + public final int getDEvaluations() { + return myDEvals; + } + + /* + * + */ + public final List getErrorStack() { + return Collections.unmodifiableList(myErrorCodes); + } + + // ========================================================================== + // SERIES EVALUATION USING EULER-MACLAURIN INTEGRATION + // ========================================================================== + /** + * + * @param f + * @param df + * @param start + * @return + */ + public final double limit(final Function f, + final Function df, final long start) { + myFEvals = myDEvals = 0; + myErrorCodes = new ArrayList<>(); + + // find an N large enough so that the error estimate <= tol + final long n = determineLowerBound(f, df, start); + if (n < 0) { + myErrorCodes.add(EulerMaclaurinErrorCode.INTEGRAL_LOWER_BOUND_SEARCH_FAILED); + return Double.NaN; } - private static final double STEP = 1.4; - private static final double DECAY = 0.1; - private static final int WORK_MEMORY_FOR_RIDDER = 100; - private static final int MAX_RANGE = 1 << 12; - private static final double MAX_BIN = 1e30; - - private final boolean myVerbose; - private final double myTol; - private final Quadrature myQuad; - private final SeriesAlgorithm myAccelerator; - private final Function myBins; - - private int myFEvals, myDEvals; - private final double[] myWorkArray = new double[2]; - private List myErrorCodes; - - /** - * - * @param tolerance - * @param integrator - * @param accelerator - * @param binSequence - */ - public EulerMaclaurin(final double tolerance, final Quadrature integrator, final SeriesAlgorithm accelerator, - final Function binSequence, final boolean verbose) { - myTol = tolerance; - myQuad = integrator; - myAccelerator = accelerator; - myBins = binSequence; - myVerbose = verbose; - } - - /** - * - * @param tolerance - * @param integrator - * @param binSequence - */ - public EulerMaclaurin(final double tolerance, final Quadrature integrator, final SeriesAlgorithm accelerator, - final Function binSequence) { - this(tolerance, integrator, accelerator, binSequence, false); - } - - /** - * - * @return - */ - public final int getEvaluations() { - return myFEvals; - } - - /** - * - * @return - */ - public final int getDEvaluations() { - return myDEvals; - } - - /* - * - */ - public final List getErrorStack() { - return Collections.unmodifiableList(myErrorCodes); - } - - // ========================================================================== - // SERIES EVALUATION USING EULER-MACLAURIN INTEGRATION - // ========================================================================== - /** - * - * @param f - * @param df - * @param start - * @return - */ - public final double limit(final Function f, final Function df, - final long start) { - myFEvals = myDEvals = 0; - myErrorCodes = new ArrayList<>(); - - // find an N large enough so that the error estimate <= tol - final long n = determineLowerBound(f, df, start); - if (n < 0) { - myErrorCodes.add(EulerMaclaurinErrorCode.INTEGRAL_LOWER_BOUND_SEARCH_FAILED); - return Double.NaN; - } - - // estimate sum - final double sum = finiteSum(f, start, n); - - // compute the two lower bounds using an integral from N + 1/2 to infinity - final double integral = improperIntegral(f, n); - final double lower = lowerBound(f, df, n); - final double upper = upperBound(f, df, n); - return 0.5 * (lower + upper) + sum + integral; - } - - /** - * - * @param f - * @param start - * @return - */ - public final double limit(final Function f, final long start) { - return limit(f, null, start); - } - - private final double improperIntegral(final Function f, final long n) { - myWorkArray[0] = 0.0; - final Function seq = k -> { - - // compute bounds of integration according to provided bins - final double s1 = myWorkArray[0]; - final double s2 = s1 + myBins.apply(k); - myWorkArray[0] = s2; - if (s2 > MAX_BIN) { - myErrorCodes.add(EulerMaclaurinErrorCode.BIN_TOO_LARGE); - return Double.NaN; - } - - // perform a change of variable to integrate on [0, 1] + // estimate sum + final double sum = finiteSum(f, start, n); + + // compute the two lower bounds using an integral from N + 1/2 to infinity + final double integral = improperIntegral(f, n); + final double lower = lowerBound(f, df, n); + final double upper = upperBound(f, df, n); + return 0.5 * (lower + upper) + sum + integral; + } + + /** + * + * @param f + * @param start + * @return + */ + public final double limit(final Function f, final long start) { + return limit(f, null, start); + } + + private final double improperIntegral(final Function f, final long n) { + myWorkArray[0] = 0.0; + final Function seq = k -> { + + // compute bounds of integration according to provided bins + final double s1 = myWorkArray[0]; + final double s2 = s1 + myBins.apply(k); + myWorkArray[0] = s2; + if (s2 > MAX_BIN) { + myErrorCodes.add(EulerMaclaurinErrorCode.BIN_TOO_LARGE); + return Double.NaN; + } + + // perform a change of variable to integrate on [0, 1] final DoubleUnaryOperator f01 = t -> { - final double interp = (1.0 - t) * s1 + t * s2; - return f.apply(n + 0.5 + interp); - }; - - // apply numerical integration to this new function - double integrand = myQuad.integrate(f01, 0.0, 1.0).estimate; - if (Double.isNaN(integrand)) { - myErrorCodes.add(EulerMaclaurinErrorCode.PIECEWISE_INTEGRATION_FAILED); - } - integrand *= (s2 - s1); - return integrand; - }; - - // accelerate the series of definite integrals - final double result = myAccelerator.limit(Sequences.toIterable(seq, 1L), true).limit; - if (Double.isNaN(result)) { - myErrorCodes.add(EulerMaclaurinErrorCode.SERIES_ACCELERATION_FAILED); - } - return result; + final double interp = (1.0 - t) * s1 + t * s2; + return f.apply(n + 0.5 + interp); + }; + + // apply numerical integration to this new function + double integrand = myQuad.integrate(f01, 0.0, 1.0).estimate; + if (Double.isNaN(integrand)) { + myErrorCodes.add(EulerMaclaurinErrorCode.PIECEWISE_INTEGRATION_FAILED); + } + integrand *= (s2 - s1); + return integrand; + }; + + // accelerate the series of definite integrals + final double result = myAccelerator.limit(Sequences.toIterable(seq, 1L), true).limit; + if (Double.isNaN(result)) { + myErrorCodes.add(EulerMaclaurinErrorCode.SERIES_ACCELERATION_FAILED); } - - private final double finiteSum(final Function f, final long start, final long end) { - double sum = 0.0; - for (long k = start; k <= end; ++k) { - sum += f.apply((double) k); - } - myFEvals += end - start + 1; - return sum; - } - - private final long determineLowerBound(final Function f, - final Function df, final long start) { - long a = start; - long b = MAX_RANGE; - long n = -1L; - - // do binary search to find a suitable bound - while (a != b) { - final long mid = SimpleMath.average(a, b); - final double error = estimateError(f, df, mid); - if (Double.isNaN(error)) { - return -1L; - } else if (!Double.isFinite(error)) { - b = mid; - } else if (error > myTol) { - a = mid + 1L; - } else { - b = n = mid; - } - } - final double error = estimateError(f, df, a); - if (error <= myTol) { - n = a; - } - if (myVerbose) { - System.out.println("Lower bound of integral = " + n + " with error = " + error + "."); - } - return n; + return result; + } + + private final double finiteSum(final Function f, final long start, + final long end) { + double sum = 0.0; + for (long k = start; k <= end; ++k) { + sum += f.apply((double) k); } - - // ========================================================================== - // ERROR ESTIMATION FOR MACLAURIN FORMULA - // ========================================================================== - private final double estimateError(final Function f, - final Function df, final long x) { - return Math.abs(upperBound(f, df, x) - lowerBound(f, df, x)) / 2.0; + myFEvals += end - start + 1; + return sum; + } + + private final long determineLowerBound(final Function f, + final Function df, final long start) { + long a = start; + long b = MAX_RANGE; + long n = -1L; + + // do binary search to find a suitable bound + while (a != b) { + final long mid = SimpleMath.average(a, b); + final double error = estimateError(f, df, mid); + if (Double.isNaN(error)) { + return -1L; + } else if (!Double.isFinite(error)) { + b = mid; + } else if (error > myTol) { + a = mid + 1L; + } else { + b = n = mid; + } } - - private final double lowerBound(final Function f, final Function df, - final long x) { - return deriv(f, df, -0.5 + x) / 24.0; + final double error = estimateError(f, df, a); + if (error <= myTol) { + n = a; } - - private final double upperBound(final Function f, final Function df, - final long x) { - return deriv(f, df, +1.5 + x) / 24.0; + if (myVerbose) { + System.out.println("Lower bound of integral = " + n + " with error = " + error + "."); } - - // ========================================================================== - // APPROXIMATE AND EXACT NUMERICAL DIFFERENTIATION - // ========================================================================== - private final double deriv(final Function f, final Function df, - final double x) { - if (df == null) { - return derivRidder(f, x); - } else { - ++myDEvals; - return df.apply(x); - } + return n; + } + + // ========================================================================== + // ERROR ESTIMATION FOR MACLAURIN FORMULA + // ========================================================================== + private final double estimateError(final Function f, + final Function df, final long x) { + return Math.abs(upperBound(f, df, x) - lowerBound(f, df, x)) / 2.0; + } + + private final double lowerBound(final Function f, + final Function df, final long x) { + return deriv(f, df, -0.5 + x) / 24.0; + } + + private final double upperBound(final Function f, + final Function df, final long x) { + return deriv(f, df, +1.5 + x) / 24.0; + } + + // ========================================================================== + // APPROXIMATE AND EXACT NUMERICAL DIFFERENTIATION + // ========================================================================== + private final double deriv(final Function f, + final Function df, final double x) { + if (df == null) { + return derivRidder(f, x); + } else { + ++myDEvals; + return df.apply(x); } - - private final double derivRidder(final Function f, final double x) { - double h = 1.0; - final double[][] work = new double[WORK_MEMORY_FOR_RIDDER][WORK_MEMORY_FOR_RIDDER]; - while (h > Double.MIN_VALUE / DECAY) { - updateRidder(f, x, h, WORK_MEMORY_FOR_RIDDER, work); - if (Double.isNaN(myWorkArray[0])) { - break; - } else if (Math.abs(myWorkArray[1]) <= myTol) { - return myWorkArray[0]; - } - h *= DECAY; - } - myErrorCodes.add(EulerMaclaurinErrorCode.DERIVATIVE_ESTIMATION_FAILED); - return Double.NaN; + } + + private final double derivRidder(final Function f, final double x) { + double h = 1.0; + final double[][] work = new double[WORK_MEMORY_FOR_RIDDER][WORK_MEMORY_FOR_RIDDER]; + while (h > Double.MIN_VALUE / DECAY) { + updateRidder(f, x, h, WORK_MEMORY_FOR_RIDDER, work); + if (Double.isNaN(myWorkArray[0])) { + break; + } else if (Math.abs(myWorkArray[1]) <= myTol) { + return myWorkArray[0]; + } + h *= DECAY; } - - private final void updateRidder(final Function f, final double x, double s, final int iwork, - final double[][] work) { - myWorkArray[0] = myWorkArray[1] = 0.0; - double result = 0.0; - double error = Double.POSITIVE_INFINITY; - final double step2 = STEP * STEP; - - // uses Ridder's extrapolation method to numerically differentiate - work[0][0] = (f.apply(x + s) - f.apply(x - s)) / (2.0 * s); - myFEvals += 2; - for (int i = 1; i < iwork; ++i) { - - // update tableau - s /= STEP; - work[0][i] = (f.apply(x + s) - f.apply(x - s)) / (2.0 * s); - myFEvals += 2; - double fx = step2; - for (int j = 1; j <= i; ++j) { - - // update the tableau - work[j][i] = (work[j - 1][i] * fx - work[j - 1][i - 1]) / (fx - 1.0); - fx *= step2; - - // check for a lower-error estimate - final double dif1 = work[j][i] - work[j - 1][i]; - final double dif2 = work[j][i] - work[j - 1][i - 1]; - final double new_error = Math.max(Math.abs(dif1), Math.abs(dif2)); - if (new_error <= error) { - error = new_error; - result = work[j][i]; - } - } - - // check whether we can return result - if (Math.abs(work[i][i] - work[i - 1][i - 1]) >= 2.0 * error) { - myWorkArray[0] = result; - myWorkArray[1] = error; - return; - } - } - myWorkArray[0] = Double.NaN; - myWorkArray[1] = Double.POSITIVE_INFINITY; + myErrorCodes.add(EulerMaclaurinErrorCode.DERIVATIVE_ESTIMATION_FAILED); + return Double.NaN; + } + + private final void updateRidder(final Function f, final double x, + double s, final int iwork, final double[][] work) { + myWorkArray[0] = myWorkArray[1] = 0.0; + double result = 0.0; + double error = Double.POSITIVE_INFINITY; + final double step2 = STEP * STEP; + + // uses Ridder's extrapolation method to numerically differentiate + work[0][0] = (f.apply(x + s) - f.apply(x - s)) / (2.0 * s); + myFEvals += 2; + for (int i = 1; i < iwork; ++i) { + + // update tableau + s /= STEP; + work[0][i] = (f.apply(x + s) - f.apply(x - s)) / (2.0 * s); + myFEvals += 2; + double fx = step2; + for (int j = 1; j <= i; ++j) { + + // update the tableau + work[j][i] = (work[j - 1][i] * fx - work[j - 1][i - 1]) / (fx - 1.0); + fx *= step2; + + // check for a lower-error estimate + final double dif1 = work[j][i] - work[j - 1][i]; + final double dif2 = work[j][i] - work[j - 1][i - 1]; + final double new_error = Math.max(Math.abs(dif1), Math.abs(dif2)); + if (new_error <= error) { + error = new_error; + result = work[j][i]; + } + } + + // check whether we can return result + if (Math.abs(work[i][i] - work[i - 1][i - 1]) >= 2.0 * error) { + myWorkArray[0] = result; + myWorkArray[1] = error; + return; + } } + myWorkArray[0] = Double.NaN; + myWorkArray[1] = Double.POSITIVE_INFINITY; + } } diff --git a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/utils/Constants.java b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/utils/Constants.java index a32b0a98c..1a2e57737 100644 --- a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/utils/Constants.java +++ b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/utils/Constants.java @@ -1,33 +1,33 @@ package org.matheclipse.core.numerics.utils; +import org.matheclipse.core.basic.Config; + public final class Constants { - /** - * The machine epsilon. - */ - public static final double EPSILON = Math.ulp(1.0); - - /** - * The closest {@code double} value to the square root of two. - */ - public static final double SQRT2 = Math.sqrt(2.0); - - /** - * The closest {@code double} value to the square root of three. - */ - public static final double SQRT3 = Math.sqrt(3.0); - - /** - * The closest {@code double} value to the square root of five. - */ - public static final double SQRT5 = Math.sqrt(5.0); - - /** - * The closest {@code double} value to the number 1 divided by the natural-base - * logarithm of 2. - */ - public static final double LOG2_INV = 1.4426950408889634073599; - - private Constants() { - } + /** + * The machine epsilon. + */ + public static final double EPSILON = Config.DOUBLE_EPSILON; + + /** + * The closest {@code double} value to the square root of two. + */ + public static final double SQRT2 = Math.sqrt(2.0); + + /** + * The closest {@code double} value to the square root of three. + */ + public static final double SQRT3 = Math.sqrt(3.0); + + /** + * The closest {@code double} value to the square root of five. + */ + public static final double SQRT5 = Math.sqrt(5.0); + + /** + * The closest {@code double} value to the number 1 divided by the natural-base logarithm of 2. + */ + public static final double LOG2_INV = 1.4426950408889634073599; + + private Constants() {} } diff --git a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/utils/SimpleMath.java b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/utils/SimpleMath.java index 357aa39f7..6280aefcd 100644 --- a/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/utils/SimpleMath.java +++ b/symja_android_library/matheclipse-core/src/main/java/org/matheclipse/core/numerics/utils/SimpleMath.java @@ -2,89 +2,86 @@ public final class SimpleMath { - // ========================================================================== - // INTEGER MATH - // ========================================================================== - /** - * Computes the integer average of two integers. - */ - public static final int average(final int x, final int y) { + // ========================================================================== + // INTEGER MATH + // ========================================================================== + /** + * Computes the integer average of two integers. + */ + public static final int average(final int x, final int y) { + // Hacker's delight 2-5 (3) + return (x & y) + ((x ^ y) >> 1); + } - // Hacker's delight 2-5 (3) - return (x & y) + ((x ^ y) >> 1); - } - - /** - * Computes the long average of two long values. - */ - public static final long average(final long x, final long y) { - - // Hacker's delight 2-5 (3) - return (x & y) + ((x ^ y) >> 1); - } + /** + * Computes the long average of two long values. + */ + public static final long average(final long x, final long y) { + // Hacker's delight 2-5 (3) + return (x & y) + ((x ^ y) >> 1); + } - /** - * Computes the floor of the base-two logarith of the specified integer. - */ - public static final int log2Int(final int n) { - if (n <= 0) { - throw new IllegalArgumentException(); - } - return 31 - Integer.numberOfLeadingZeros(n); + /** + * Computes the floor of the base-two logarith of the specified integer. + */ + public static final int log2Int(final int n) { + if (n <= 0) { + throw new IllegalArgumentException(); } + return 31 - Integer.numberOfLeadingZeros(n); + } - // ========================================================================== - // FLOATING POINT MATH - // ========================================================================== - public static final double[] D1MACH = { Double.MIN_VALUE, Double.MAX_VALUE, pow(2.0, -52), pow(2.0, -51), - Math.log(2.0) / Math.log(10.0) }; + // ========================================================================== + // FLOATING POINT MATH + // ========================================================================== + public static final double[] D1MACH = {Double.MIN_VALUE, Double.MAX_VALUE, pow(2.0, -52), + pow(2.0, -51), Math.log(2.0) / Math.log(10.0)}; - /** - * Applies the sign of b to a. - */ - public static final double sign(final double a, final double b) { - return b >= 0.0 ? Math.abs(a) : -Math.abs(a); - } - - /** - * Computes the exponent of x raised to y, using exponentiation by squaring. - */ - public static final double pow(double x, int y) { + /** + * Applies the sign of b to a. + */ + public static final double sign(final double a, final double b) { + return b >= 0.0 ? Math.abs(a) : -Math.abs(a); + } - // negative power - if (y < 0) { - return pow(1.0 / x, -y); - } + /** + * Computes the exponent of x raised to y, using exponentiation by squaring. + */ + public static final double pow(double x, int y) { - // trivial cases - switch (y) { - case 0: - return 1.0; - case 1: - return x; - case 2: - return x * x; - default: - break; - } + // negative power + if (y < 0) { + return pow(1.0 / x, -y); + } - // non trivial case - double res = 1.0; - while (y != 0) { - switch (y & 1) { - case 0: - x *= x; - y >>>= 1; - break; - default: - res *= x; - --y; - break; - } - } - return res; + // trivial cases + switch (y) { + case 0: + return 1.0; + case 1: + return x; + case 2: + return x * x; + default: + break; } - private SimpleMath() { + // non trivial case + double res = 1.0; + while (y != 0) { + switch (y & 1) { + case 0: + x *= x; + y >>>= 1; + break; + default: + res *= x; + --y; + break; + } } + return res; + } + + private SimpleMath() {} }