Mercurial > octave
changeset 30017:26bb2cbf6da2
betaincinv.m: Overhaul function for performance and accuracy (bug #60539).
Switch algorithm from using 10 cycles of bisection followed by 20 rounds
of Newton's Method, to a pure Newton's Method that stops when accuracy
criteria of 1*eps(y) is reached. Careful selection of initial starting
point to guarantee convergence is critical.
* betaincinv.m (bisection_method): Delete subfunction.
* betaincinv.m (newton_method): Remove stopping criteria based on max
iterations. Remove fix for bug #60528 which is no longer necessary.
* betaincinv.m: New algorithm for selecting starting point for Newton's Method.
Documentation of method is in code.
author | Michael Leitner <michael.leitner@frm2.tum.de>, Rik <rik@octave.org> |
---|---|
date | Thu, 19 Aug 2021 17:31:12 -0700 |
parents | ad6a57b215e8 |
children | 09d97b7bc904 |
files | scripts/specfun/betaincinv.m |
diffstat | 1 files changed, 87 insertions(+), 84 deletions(-) [+] |
line wrap: on
line diff
--- a/scripts/specfun/betaincinv.m Fri May 28 18:26:05 2021 +0200 +++ b/scripts/specfun/betaincinv.m Thu Aug 19 17:31:12 2021 -0700 @@ -123,112 +123,115 @@ b = single (b); endif - ## Initialize output array - x = zeros (size (y), class (y)); - - ## Parameters for the Newton's method search - maxit = 20; - tol = eps (class (y)); - if (strcmpi (tail, "lower")) - p = y; - q = 1 - y; - x(y == 0) = 0; - x(y == 1) = 1; + ys = y; elseif (strcmpi (tail, "upper")) - p = 1 - y; - q = y; - x(y == 0) = 1; - x(y == 1) = 0; + ys = 1 - y; # only for computation of initial points, no loss of accuracy else error ("betaincinv: invalid value for TAIL"); endif - ## Special values have been already computed. - todo = (y != 0) & (y != 1); + ## Choose starting point for Newton's Method to guarantee convergence. + ## If (a-1)*(b-1) > 0, F has a point of inflection at x = (a-1)/(a+b-2). + ## In this case, it is convex on (0,x) and concave on (x,1) if a>1; otherwise + ## it is the other way round. If (a-1)*(b-1) <= 0, there is no point of + ## inflection, and it is everywhere convex for a>1 and concave otherwise. + ## We thus choose our starting x for the Newton iterations so that we stay + ## within a region of constant sign of curvature and on the correct side of + ## the eventual solution, guaranteeing convergence. Curvatures above are to + ## be understood under the condition tail=="lower". - ## We will invert the lower version for p < 0.5 and the upper otherwise. - i_low = (p < 0.5); - i_upp = (! i_low); + ## Initialize output array + x = x_i = y_i = zeros (size (y), class (y)); - idx = todo & i_low; - if (any (idx)) - n = nnz (idx); - ## Function and derivative of the lower version. - F = @(x, a, b, y) y - betainc (x, a, b); - JF = @(x, a, b) -real (exp ((a-1) .* log (x) + (b-1) .* log1p (-x) + ... - gammaln (a+b) - gammaln (a) - gammaln (b))); + ## Have point of inflection + idx = find ((a - 1) .* (b - 1) > 0); + if (! isempty (idx)) + x_i(idx) = (a(idx) - 1) ./ (a(idx) + b(idx) - 2); + y_i(idx) = betainc (x_i(idx), a(idx), b(idx)); + end - ## Compute the initial guess with a bisection method of 10 steps. - x0 = bisection_method (F, zeros (n,1), ones (n,1), ... - a(i_low), b(i_low), p(i_low), 10); - - ## Use Newton's method to iteratively find solution. - x(i_low) = newton_method (F, JF, x0, a(i_low), b(i_low), p(i_low), ... - tol, maxit); + ## Converge outwards + tmpidx = find (a(idx) > 1); + if (! isempty (tmpidx)) + x(idx(tmpidx)) = x_i(idx(tmpidx)); + endif + ## Converge inwards + ## To the left of inflection point + tmpidx = idx(find ((a(idx) <= 1) & (y_i(idx) >= ys(idx)))); + if (! isempty (tmpidx)) + x(tmpidx) = (ys(tmpidx) ./ y_i(tmpidx)).^(1 ./ a(tmpidx)) .* x_i(tmpidx); + endif + ## To the right of inflection point + tmpidx = idx(find ((a(idx) <= 1) & (y_i(idx) < ys(idx)))); + if (! isempty (tmpidx)) + x(tmpidx) = 1 - ... + ((1 - ys(tmpidx)) ./ (1 - y_i(tmpidx))).^(1 ./ b(tmpidx)) ... + .* (1 - x_i(tmpidx)); endif - idx = todo & i_upp; - if (any (idx)) - n = nnz (idx); - ## Function and derivative of the upper version. - F = @(x, a, b, y) y - betainc (x, a, b, "upper"); - JF = @(x, a, b) real (exp ((a-1) .* log (x) + (b-1) .* log1p (-x) + ... - gammaln (a+b) - gammaln (a) - gammaln (b))); + ## Have no point of inflection + idx = find ((a - 1) .* (b - 1) <= 0); + + ## Negative curvature + tmpidx = idx(find (a(idx) < 1)); + if (! isempty (tmpidx)) + x(tmpidx) = (ys(tmpidx) .* beta (a(tmpidx), b(tmpidx)) .* a(tmpidx)) ... + .^ (1 ./ a(tmpidx)); + endif + ## Positive curvature + tmpidx = idx(find (a(idx) >= 1)); + if (! isempty (tmpidx)) + x(tmpidx) = 1 - ... + ((1 - ys(tmpidx)) .* beta (a(tmpidx), b(tmpidx)) .* b(tmpidx)) ... + .^ (1 ./ b(tmpidx)); + endif - ## Compute the initial guess with a bisection method of 10 steps. - x0 = bisection_method (F, zeros (n,1), ones (n,1), ... - a(i_upp), b(i_upp), q(i_upp), 10); + ## Cleanup memory before continuing + clear ys x_i y_i idx tmpidx - ## Use Newton's method to iteratively find solution. - x(i_upp) = newton_method (F, JF, x0, a(i_upp), b(i_upp), q(i_upp), ... - tol, maxit); + if (strcmpi (tail, "lower")) + x(y == 0) = 0; + x(y == 1) = 1; + F = @(x, a, b, y) y - betainc (x, a, b); + JF = @(x, a, b, Bln) -exp ((a-1) .* log (x) + (b-1) .* log1p (-x) - Bln); + else + x(y == 0) = 1; + x(y == 1) = 0; + F = @(x, a, b, y) y - betainc (x, a, b, "upper"); + JF = @(x, a, b, Bln) exp ((a-1) .* log (x) + (b-1) .* log1p (-x) - Bln); endif + x = newton_method (F, JF, x, a, b, y); + ## Restore original shape x = reshape (x, orig_sz); endfunction - -## subfunctions: Bisection and Newton Methods -function xc = bisection_method (F, xl, xr, a, b, y, maxit) - - F_l = F (xl, a, b, y); - F_r = F (xr, a, b, y); - for it = 1:maxit - xc = (xl + xr) / 2; - F_c = F (xc, a, b, y); - flag_l = ((F_c .* F_r) < 0); - flag_r = ((F_c .* F_l) < 0); - flag_c = (F_c == 0); - xl(flag_l) = xc(flag_l); - xr(flag_r) = xc(flag_r); - xl(flag_c) = xr(flag_c) = xc(flag_c); - F_l(flag_l) = F_c(flag_l); - F_r(flag_r) = F_c(flag_r); - F_l(flag_c) = F_r(flag_c) = 0; - endfor +function x = newton_method (F, JF, x, a, b, y); -endfunction - -function x = newton_method (F, JF, x0, a, b, y, tol, maxit); - - res = -F (x0, a, b, y) ./ JF (x0, a, b); - todo = (abs (res) >= tol * abs (x0)); - x = x0; - it = 0; - while (any (todo) && (it < maxit)) - it++; - x(todo) += res(todo); - ## Avoid intermediate values outside betainc() range of [0, 1], bug #60528 - x(x(todo) < 0) = eps; - x(x(todo) > 1) = 1-eps; - res(todo) = -F(x(todo), a(todo), b(todo), y(todo)) ... - ./ JF (x(todo), a(todo), b(todo)); - todo = (abs (res) >= tol * abs (x)); + Bln = betaln (a, b); + ## Exclude special values that have been already computed. + todo = find ((y != 0) & (y != 1)); + step = -F (x(todo), a(todo), b(todo), y(todo)) ./ ... + JF (x(todo), a(todo), b(todo), Bln(todo)); + x_old = x(todo); + x(todo) += step; + dx = x(todo) - x_old; + idx = (dx != 0); + todo = todo(idx); + dx_old = dx(idx); + while (! isempty (todo)) + step = -F (x(todo), a(todo), b(todo), y(todo)) ./ ... + JF (x(todo), a(todo), b(todo), Bln(todo)); + x_old = x(todo); + x(todo) += step; + dx = x(todo) - x_old; + idx = (abs (dx) < abs (dx_old)); # Converging if dx is getting smaller + todo = todo(idx); + dx_old = dx(idx); endwhile - x += res; endfunction