Mercurial > hg > octave-lyh
changeset 17379:f9e8544ce66d
ellipke.m: Overhaul function.
* scripts/specfun/ellipke.m: Use do/until loop to simplify code. Use in-place
operators for performance. Use logical indexing to re-use indices and avoid
duplicate computations. Add %!test for negative values. Document that negative
values are accepted in ellipke.
author | Rik <rik@octave.org> |
---|---|
date | Wed, 04 Sep 2013 11:44:18 -0700 |
parents | c7c0dad2f9ac |
children | 63b53ea33a8b |
files | scripts/specfun/ellipke.m |
diffstat | 1 files changed, 54 insertions(+), 38 deletions(-) [+] |
line wrap: on
line diff
--- a/scripts/specfun/ellipke.m +++ b/scripts/specfun/ellipke.m @@ -25,7 +25,7 @@ ## Compute complete elliptic integrals of the first K(@var{m}) and second ## E(@var{m}) kind. ## -## @var{m} must be a scalar or real array with 0 @leq{} @var{m} @leq{} 1. +## @var{m} must be a scalar or real array with -Inf @leq{} @var{m} @leq{} 1. ## ## The optional input @var{tol} is currently ignored (@sc{matlab} uses this ## to allow a faster, less accurate approximation). @@ -48,55 +48,54 @@ print_usage (); endif - k = e = zeros (size (m)); m = m(:); - if (any (!isreal (m))) - error ("ellipke must have real m"); - endif - if (any (m > 1)) - error ("ellipke must have m <= 1"); + if (! isreal (m)) + error ("ellipke: M must be real"); + elseif (any (m > 1)) + error ("ellipke: M must be <= 1"); endif - Nmax = 16; - idx = find (m == 1); - if (!isempty (idx)) - k(idx) = Inf; - e(idx) = 1; - endif + k = e = zeros (size (m)); - idx = find (m == -Inf); - if (!isempty (idx)) - k(idx) = 0; - e(idx) = Inf; - endif + ## Handle extreme values + idx_1 = (m == 1); + k(idx_1) = Inf; + e(idx_1) = 1; + + idx_neginf = (m == -Inf); + k(idx_neginf) = 0; + e(idx_neginf) = Inf; ## Arithmetic-Geometric Mean (AGM) algorithm ## ( Abramowitz and Stegun, Section 17.6 ) - idx = find (m != 1 & m != -Inf); - if (!isempty (idx)) - idx_neg = find (m < 0 & m != -Inf); + Nmax = 16; + idx = !idx_1 & !idx_neginf; + if (any (idx)) + idx_neg = find (m < 0 & !idx_neginf); mult_k = 1./sqrt (1 - m(idx_neg)); mult_e = sqrt (1 - m(idx_neg)); - m(idx_neg) = -m(idx_neg)./(1 - m(idx_neg)); - a = ones (length (idx), 1); + m(idx_neg) = -m(idx_neg) ./ (1 - m(idx_neg)); + a = ones (sum (idx), 1); b = sqrt (1 - m(idx)); c = sqrt (m(idx)); f = 0.5; - sum = f*c.*c; - for n = 2:Nmax + sum = f*c.^2; + n = 2; + do t = (a + b)/2; c = (a - b)/2; b = sqrt (a.*b); a = t; - f = f * 2; - sum = sum + f*c.*c; - if (all (c./a < eps)) break; endif - endfor - if (n >= Nmax) error ("ellipke: not enough workspace"); endif - k(idx) = 0.5*pi./a; - e(idx) = 0.5*pi.*(1 - sum)./a; - k(idx_neg) = mult_k.*k(idx_neg); - e(idx_neg) = mult_e.*e(idx_neg); + f *= 2; + sum += f*c.^2; + until (all (c./a < eps) || (++n > Nmax)) + if (n >= Nmax) + error ("ellipke: algorithm did not converge in %d iterations", Nmax); + endif + k(idx) = 0.5*pi ./ a; + e(idx) = 0.5*pi*(1 - sum) ./ a; + k(idx_neg) = mult_k .* k(idx_neg); + e(idx_neg) = mult_e .* e(idx_neg); endif endfunction @@ -105,17 +104,16 @@ ## Test complete elliptic functions of first and second kind ## against "exact" solution from Mathematica 3.0 %!test -%! m = [0.0; 0.01; 0.1; 0.5; 0.9; 0.99; 1.0 ]; +%! m = [0.0; 0.01; 0.1; 0.5; 0.9; 0.99; 1.0]; %! [k,e] = ellipke (m); %! -%! ## K(1.0) is really infinity - see below %! k_exp = [1.5707963267948966192; %! 1.5747455615173559527; %! 1.6124413487202193982; %! 1.8540746773013719184; %! 2.5780921133481731882; %! 3.6956373629898746778; -%! 0.0 ]; +%! Inf ]; %! e_exp = [1.5707963267948966192; %! 1.5668619420216682912; %! 1.5307576368977632025; @@ -123,7 +121,6 @@ %! 1.1047747327040733261; %! 1.0159935450252239356; %! 1.0 ]; -%! if (k(7)==Inf), k(7)=0; endif; %! assert (k, k_exp, 8*eps); %! assert (e, e_exp, 8*eps); @@ -156,6 +153,25 @@ %! assert (k, k_exp, 1e-15); %! assert (e, e_exp, 1e-8); +## Test negative values against "exact" solution from Mathematica. +%! m = [-0.01; -1; -5; -100; -1000; -Inf]; +%! [k,e] = ellipke (m); +%! +%! k_exp = [1.5668912730681963584; +%! 1.3110287771460599052; +%! 0.9555039270640439337; +%! 0.3682192486091410329; +%! 0.1530293349884987857; +%! 0]; +%! e_exp = [1.5747159850169884130; +%! 1.9100988945138560089; +%! 2.8301982463458773125; +%! 10.209260919814572009; +%! 31.707204053711259719; +%! Inf ]; +%! assert (k, k_exp, 8*eps); +%! assert (e, e_exp, 8*eps (e_exp)); + ## Test input validation %!error ellipke () %!error ellipke (1,2,3)