@@ -151,15 +151,6 @@ function innerjacobi_rec!(n, x, α::T, β::T, P, PP) where {T <: AbstractFloat}
151151 nothing
152152end
153153
154- function innerjacobi_rec (n, x, α:: T , β:: T ) where {T <: AbstractFloat }
155- # EVALUATE JACOBI POLYNOMIALS AND ITS DERIVATIVE USING THREE-TERM RECURRENCE.
156- N = length (x)
157- P = Array {T} (undef,N)
158- PP = Array {T} (undef,N)
159- innerjacobi_rec! (n, x, α, β, P, PP)
160- return P, PP
161- end
162-
163154function weightsConstant (n, α, β)
164155 # Compute the constant for weights:
165156 M = min (20 , n - 1 )
@@ -185,12 +176,12 @@ function jacobi_asy(n::Integer, α::Float64, β::Float64)
185176 x, w = asy1 (n, α, β, nbdy)
186177
187178 # Boundary formula (right):
188- xbdy = boundary (n, α, β, nbdy)
179+ xbdy = asy2 (n, α, β, nbdy)
189180 x[bdyidx1], w[bdyidx1] = xbdy
190181
191182 # Boundary formula (left):
192183 if α ≠ β
193- xbdy = boundary (n, β, α, nbdy)
184+ xbdy = asy2 (n, β, α, nbdy)
194185 end
195186 x[bdyidx2] = - xbdy[1 ]
196187 w[bdyidx2] = xbdy[2 ]
@@ -264,9 +255,6 @@ function feval_asy1(n::Integer, α::Float64, β::Float64, t::AbstractVector, idx
264255 # Number of elements in t:
265256 N = length (t)
266257
267- # Some often used vectors/matrices:
268- onesM = ones (M)
269-
270258 # The sine and cosine terms:
271259 A = repeat ((2 n+ α+ β). + (1 : M),1 ,N).* repeat (t' ,M)/ 2 .- (α+ 1 / 2 )* π/ 2 # M × N matrix
272260 cosA = cos .(A)
@@ -350,10 +338,10 @@ function feval_asy1(n::Integer, α::Float64, β::Float64, t::AbstractVector, idx
350338 g = [1 , 1 / 12 , 1 / 288 , - 139 / 51840 , - 571 / 2488320 , 163879 / 209018880 ,
351339 5246819 / 75246796800 , - 534703531 / 902961561600 ,
352340 - 4483131259 / 86684309913600 , 432261921612371 / 514904800886784000 ]
353- f (g, z) = dot (g, [1 ;cumprod (ones (9 )./ z)])
341+ f (z) = dot (g, [1 ;cumprod (ones (9 )./ z)])
354342
355343 # Float constant C, C2
356- C = 2 * p2* (f (g, n+ α)* f (g, n+ β)/ f (g, 2 n+ α+ β))/ π
344+ C = 2 * p2* (f (n+ α)* f (n+ β)/ f (2 n+ α+ β))/ π
357345 C2 = C* (α+ β+ 2 n)* (α+ β+ 1 + 2 n)/ (4 * (α+ n)* (β+ n))
358346
359347 vals = C* S
@@ -367,39 +355,209 @@ function feval_asy1(n::Integer, α::Float64, β::Float64, t::AbstractVector, idx
367355 return vals, ders
368356end
369357
370- function boundary (n:: Integer , α:: Float64 , β:: Float64 , npts:: Integer )
371- # Algorithm for computing nodes and weights near the boundary.
358+ function asy2 (n:: Integer , α:: Float64 , β:: Float64 , npts:: Integer )
359+ # Algorithm for computing nodes and weights near the boundary.
372360
373361 # Use Newton iterations to find the first few Bessel roots:
374- smallK = min (30 , npts)
375- jk = approx_besselroots (α, smallK)
362+ jk = approx_besselroots (α, npts)
376363
377- # Approximate roots via asymptotic formula: (see Olver 1974)
364+ # Approximate roots via asymptotic formula: (see Olver 1974, NIST, 18.16.8 )
378365 phik = jk/ (n + .5 * (α + β + 1 ))
379- x = cos .( phik .+ ((α^ 2 - 0.25 ). * (1 .- phik.* cot .(phik)). / (8 * phik) .- 0.25 .* (α^ 2 - β^ 2 ). * tan .(0.5 .* phik)). / (n + 0.5 * (α + β + 1 ))^ 2 )
366+ t = phik .+ ((α^ 2 - 0.25 ). * (1 .- phik.* cot .(phik)). / (2 * phik) .- 0.25 .* (α^ 2 - β^ 2 ). * tan .(0.5 .* phik)). / (n + .5 * (α + β + 1 ))^ 2
367+
368+ # Compute higher terms:
369+ higherterms = asy2_higherterms (α, β, t)
380370
381371 # Newton iteration:
382372 for _ in 1 : 10
383- vals, ders = innerjacobi_rec (n, x, α, β) # Evaluate via asymptotic formula.
384- dx = - vals./ ders # Newton update.
385- x += dx # Next iterate.
386- if norm (dx ,Inf ) < sqrt (eps (Float64))/ 200
373+ vals, ders = feval_asy2 (n, α, β, t, higherterms ) # Evaluate via asymptotic formula.
374+ dt = vals./ ders # Newton update.
375+ t += dt # Next iterate.
376+ if norm (dt ,Inf ) < sqrt (eps (Float64))/ 200
387377 break
388378 end
389379 end
390- vals, ders = innerjacobi_rec (n, x, α, β) # Evaluate via asymptotic formula.
391- dx = - vals./ ders
392- x += dx
380+ vals, ders = feval_asy2 (n, α, β, t, higherterms ) # Evaluate via asymptotic formula.
381+ dt = vals./ ders
382+ t += dt
393383
394384 # flip:
395- x = reverse (x )
385+ t = reverse (t )
396386 ders = reverse (ders)
397387
398388 # Revert to x-space:
399- w = 1 ./ ((1 .- x.^ 2 ) .* ders.^ 2 )
389+ x = cos .(t)
390+ w = 1 ./ ders.^ 2
391+
400392 return x, w
401393end
402394
395+ """
396+ Evaluate the boundary asymptotic formula at x = cos(t).
397+ Assumption:
398+ * `length(t) == n ÷ 2`
399+ """
400+ function feval_asy2 (n:: Integer , α:: Float64 , β:: Float64 , t:: AbstractVector , higherterms:: HT ) where HT <: Tuple{<:Function, <:Function, <:Function, <:Function}
401+ rho = n + .5 * (α + β + 1 )
402+ rho2 = n + .5 * (α + β - 1 )
403+ A = (.25 - α^ 2 )
404+ B = (.25 - β^ 2 )
405+
406+ # Evaluate the Bessel functions:
407+ Ja = besselj .(α, rho* t)
408+ Jb = besselj .(α + 1 , rho* t)
409+ Jbb = besselj .(α + 1 , rho2* t)
410+ Jab = bessel_taylor (- t, rho* t, α)
411+
412+ # Evaluate functions for recursive definition of coefficients:
413+ gt = A* (cot .(t/ 2 ) .- (2 ./ t)) .- B* tan .(t/ 2 )
414+ gtdx = A* (2 ./ t.^ 2 .- .5 * csc .(t/ 2 ).^ 2 ) .- .5 * B* sec .(t/ 2 ).^ 2
415+ tB0 = .25 * gt
416+ A10 = α* (A+ 3 * B)/ 24
417+ A1 = gtdx/ 8 .- (1 + 2 * α)/ 8 * gt./ t .- gt.^ 2 / 32 .- A10
418+ # Higher terms:
419+ tB1, A2, tB2, A3 = higherterms
420+ tB1t = tB1 (t)
421+ A2t = A2 (t)
422+
423+ # VALS:
424+ vals = Ja + Jb.* tB0/ rho + Ja.* A1/ rho^ 2 + Jb.* tB1t/ rho^ 3 + Ja.* A2t/ rho^ 4
425+ # DERS:
426+ vals2 = Jab + Jbb.* tB0/ rho2 + Jab.* A1/ rho2^ 2 + Jbb.* tB1t/ rho2^ 3 + Jab.* A2t/ rho2^ 4
427+
428+ # Higher terms (not needed for n > 1000).
429+ tB2t = tB2 (t)
430+ A3t = A3 (t)
431+ vals .+ = Jb.* tB2t/ rho^ 5 + Ja.* A3t/ rho^ 6
432+ vals2 .+ = Jbb.* tB2t/ rho2^ 5 + Jab.* A3t/ rho2^ 6
433+
434+ # Constant out the front (Computed accurately!)
435+ ds = .5 * (α^ 2 )/ n
436+ s = ds
437+ jj = 1
438+ while abs (ds/ s) > eps (Float64)/ 10
439+ jj = jj+ 1
440+ ds = - (jj- 1 )/ (jj+ 1 )/ n* (ds* α)
441+ s = s + ds
442+ end
443+ p2 = exp (s)* sqrt ((n+ α)/ n)* (n/ rho)^ α
444+ g = [1 , 1 / 12 , 1 / 288 , - 139 / 51840 , - 571 / 2488320 , 163879 / 209018880 ,
445+ 5246819 / 75246796800 , - 534703531 / 902961561600 ,
446+ - 4483131259 / 86684309913600 , 432261921612371 / 514904800886784000 ]
447+ f (z) = dot (g, [1 ;cumprod (ones (9 )./ z)])
448+ C = p2* (f (n+ α)/ f (n))/ sqrt (2 )
449+
450+ # Scaling:
451+ valstmp = C* vals
452+ denom = sin .(t/ 2 ).^ (α+ .5 ). * cos .(t/ 2 ).^ (β+ .5 )
453+ vals = sqrt .(t).* valstmp./ denom
454+
455+ # Relation for derivative:
456+ C2 = C* n/ (n+ α)* (rho/ rho2)^ α
457+ ders = (n* (α- β .- (2 n+ α+ β)* cos .(t)). * valstmp .+ 2 * (n+ α)* (n+ β)* C2* vals2)/ (2 n+ α+ β)
458+ ders .*= sqrt .(t)./ (denom.* sin .(t))
459+
460+ return vals, ders
461+ end
462+
463+ function asy2_higherterms (α:: Float64 , β:: Float64 , theta:: AbstractVector )
464+ # Higher-order terms for boundary asymptotic series.
465+ # Compute the higher order terms in asy2 boundary formula. See [2].
466+
467+ # These constants are more useful than α and β:
468+ A = (0.25 - α^ 2 )
469+ B = (0.25 - β^ 2 )
470+
471+ # For now, just work on half of the domain:
472+ c = max (maximum (theta), .5 )
473+
474+ # Use 10 Chebyshev modes in order to use precomputed integration and
475+ # differentiation matrices
476+ N = 10
477+
478+ # Scaled 2nd-kind Chebyshev points and barycentric weights:
479+ t = .5 * c* (sin .(pi * (- (N- 1 ): 2 : (N- 1 ))/ (2 * (N- 1 ))) .+ 1 )
480+ v = [.5 ; ones (N- 1 )]
481+ v[2 : 2 : end ] .= - 1
482+ v[end ] *= .5
483+
484+ # The g's:
485+ g = A* (cot .(t/ 2 ) - 2 ./ t) - B* tan .(t/ 2 )
486+ gp = A* (2 ./ t.^ 2 - .5 * csc .(t/ 2 ).^ 2 ) - .5 * (.25 - β^ 2 )* sec .(t/ 2 ).^ 2
487+ gpp = A* (- 4 ./ t.^ 3 + .25 * sin .(t).* csc .(t/ 2 ).^ 4 ) - 4 * B* sin .(t/ 2 ).^ 4 .* csc .(t).^ 3
488+ g[1 ] = 0
489+ gp[1 ] = - A/ 6 - .5 * B
490+ gpp[1 ] = 0
491+
492+ # B0:
493+ B0 = .25 * g./ t
494+ B0p = .25 * (gp./ t - g./ t.^ 2 )
495+ B0[1 ] = .25 * (- A/ 6 - .5 * B)
496+ B0p[1 ] = 0
497+
498+ # A1:
499+ A10 = α* (A+ 3 * B)/ 24
500+ A1 = .125 * gp .- (1 + 2 * α)/ 2 * B0 .- g.^ 2 / 32 .- A10
501+ A1p = .125 * gpp .- (1 + 2 * α)/ 2 * B0p .- gp.* g/ 16
502+ A1p_t = A1p./ t
503+ A1p_t[1 ] = - A/ 720 - A^ 2 / 576 - A* B/ 96 - B^ 2 / 64 - B/ 48 + α* (A/ 720 + B/ 48 )
504+
505+ # Make f accurately: (Taylor series approx for small t)
506+ fcos = B./ (2 * cos .(t/ 2 )). ^ 2
507+ f = - A* (1 / 12 .+ t.^ 2 / 240 + t.^ 4 / 6048 + t.^ 6 / 172800 + t.^ 8 / 5322240 +
508+ 691 * t.^ 10 / 118879488000 + t.^ 12 / 5748019200 +
509+ 3617 * t.^ 14 / 711374856192000 + 43867 * t.^ 16 / 300534953951232000 )
510+ idx = t .> .5
511+ f[idx] = A.* (1 ./ t[idx]. ^ 2 - 1 ./ (2 * sin .(t[idx]/ 2 )). ^ 2 )
512+ f .- = fcos
513+
514+ # Integrals for B1: (Note that N isn't large, so we don't need to be fancy).
515+ C = (.5 * c)* CUMSUMMAT_10
516+ D = (2 / c)* DIFFMAT_10
517+ I = (C* A1p_t)
518+ J = (C* (f.* A1))
519+
520+ # B1:
521+ tB1 = - .5 * A1p - (.5 + α)* I + .5 * J
522+ tB1[1 ] = 0
523+ B1 = tB1./ t
524+ B1[1 ] = A/ 720 + A^ 2 / 576 + A* B/ 96 + B^ 2 / 64 + B/ 48 +
525+ α* (A^ 2 / 576 + B^ 2 / 64 + A* B/ 96 ) - α^ 2 * (A/ 720 + B/ 48 )
526+
527+ # A2:
528+ K = C* (f.* tB1)
529+ A2 = .5 * (D* tB1) - (.5 + α)* B1 - .5 * K
530+ A2 .- = A2[1 ]
531+
532+ # A2p:
533+ A2p = D* A2
534+ A2p .- = A2p[1 ]
535+ A2p_t = A2p./ t
536+ # Extrapolate point at t = 0:
537+ w = pi / 2 .- t[2 : end ]
538+ w[2 : 2 : end ] = - w[2 : 2 : end ]
539+ w[end ] = .5 * w[end ]
540+ A2p_t[1 ] = sum (w.* A2p_t[2 : end ])/ sum (w)
541+
542+ # B2:
543+ tB2 = - .5 * A2p - (.5 + α)* (C* A2p_t) + .5 * C* (f.* A2)
544+ B2 = tB2./ t
545+ # Extrapolate point at t = 0:
546+ B2[1 ] = sum (w.* B2[2 : end ])/ sum (w)
547+
548+ # A3:
549+ K = C* (f.* tB2)
550+ A3 = .5 * (D* tB2) - (.5 + α)* B2 - .5 * K
551+ A3 .- = A3[1 ]
552+
553+ tB1f (theta) = bary (theta, tB1, t, v)
554+ A2f (theta) = bary (theta, A2, t, v)
555+ tB2f (theta) = bary (theta, tB2, t, v)
556+ A3f (theta) = bary (theta, A3, t, v)
557+
558+ return tB1f, A2f, tB2f, A3f
559+ end
560+
403561function jacobi_jacobimatrix (n, α, β)
404562 s = α + β
405563 ii = 2 : n- 1
@@ -426,3 +584,71 @@ function jacobi_gw(n::Integer, α, β)
426584 w = V[1 ,:]. ^ 2 .* jacobimoment (α, β)
427585 return x, w
428586end
587+
588+ function bary (x:: AbstractVector , fvals:: AbstractVector , xk:: AbstractVector , vk:: AbstractVector )
589+ # simple barycentric interpolation routine adapted from chebfun/bary.m
590+
591+ # Initialise return value:
592+ fx = zeros (length (x))
593+
594+ # Loop:
595+ for j in eachindex (x)
596+ xx = vk ./ (x[j] .- xk)
597+ fx[j] = dot (xx, fvals) / sum (xx)
598+ end
599+
600+ # Try to clean up NaNs:
601+ for k in findall (isnan .(fx))
602+ index = findfirst (x[k] .== xk) # Find the corresponding node
603+ if ! isempty (index)
604+ fx[k] = fvals[index] # Set entries to the correct value
605+ end
606+ end
607+
608+ return fx
609+ end
610+
611+ function bessel_taylor (t:: AbstractVector , z:: AbstractVector , α:: Float64 )
612+ # Accurate evaluation of Bessel function J_A for asy2. (See [2].)
613+ # evaluates J_A(Z+T) by a Taylor series expansion about Z.
614+
615+ npts = length (t)
616+ kmax = min (ceil (Int64, abs (log (eps (Float64))/ log (norm (t, Inf )))), 30 )
617+ H = t' .^ (0 : kmax)
618+ # Compute coeffs in Taylor expansions about z (See NIST 10.6.7)
619+ nu = ones (Int64, length (z)) * (- kmax: kmax)'
620+ JK = z * ones (2 kmax+ 1 )'
621+ Bjk = besselj .(α .+ nu, JK)
622+ nck = nck_mat (floor (Int64, 1.25 * kmax)) # nchoosek
623+ AA = [Bjk[:,kmax+ 1 ] zeros (npts, kmax)]
624+ fact = 1
625+ for k = 1 : kmax
626+ sgn = 1
627+ for l = 0 : k
628+ AA[:,k+ 1 ] = AA[:,k+ 1 ] + sgn* nck[k,l+ 1 ]* Bjk[:,kmax+ 2 * l- k+ 1 ]
629+ sgn = - sgn
630+ end
631+ fact = k* fact
632+ AA[:,k+ 1 ] ./= 2 ^ k * fact
633+ end
634+ # Evaluate Taylor series:
635+ Ja = zeros (npts)
636+ for k = 1 : npts
637+ Ja[k] = dot (AA[k,:], H[:,k])
638+ end
639+
640+ return Ja
641+ end
642+
643+ function nck_mat (n:: Integer )
644+ # almost triangular matrix storing n choose k
645+ M = zeros (Int64, n- 1 , n)
646+ M[:,1 ] .= 1
647+ M[1 ,2 ] = 1
648+ for i= 2 : n- 1
649+ for j= 2 : i+ 1
650+ M[i,j] = M[i- 1 ,j- 1 ] + M[i- 1 ,j]
651+ end
652+ end
653+ return M
654+ end
0 commit comments