You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
523 lines
16 KiB
523 lines
16 KiB
function [ x , Err , Rel, y] = rfejer( sgl, fun , varargin)
|
|
|
|
%RFEJER Semi-Automatic Rational Fejer Quadrature
|
|
% X = RFEJER(SGL) returns the nodes X(1,:) and weights X(2,:) in the
|
|
% (N+M+1)-point rational interpolatory Fejer quadrature rule on the
|
|
% interval [-1,1] based on the sequence of poles SGL, where
|
|
% N = lenghta(SGL) and M denotes the number of complex poles in SGL for
|
|
% which the complex conjugate was not included in SGL. (Hence, for each
|
|
% complex pole in SGL its complex conjugate will be inserted whenever the
|
|
% latter was not included in SGL.) The poles must be outside the interval
|
|
% [-1,1], may be infinite (which corresponds to polynomial interpolation
|
|
% upto degree DEGR == sum(SGL==inf) ), and complex poles do not need
|
|
% to be given in adjacent positions, as the order will be rearranged if
|
|
% necessary. X(3,1:end-1) contains the actual sequence of poles that is
|
|
% used (i.e., SGL with inclusion of the possible missing complex
|
|
% conjugates, and with the performed rearrangements).
|
|
%
|
|
% X = RFEJER(SGL,FUN) tries to approximate the integral of a
|
|
% (matrix-valued) function FUN over the interval [-1,1] as accurate as
|
|
% possible within a limited number of iterations - bounded by the length
|
|
% of SGL (after inclusion of possible missing complex conjugates) - over
|
|
% the number of nodes and weights in the rational interpolatory Fejer
|
|
% quadrature rule with poles among SGL. The function y=FUN(x) should
|
|
% accept a vector argument x.
|
|
%
|
|
% [X,ERR,REL] = RFEJER(...) also returns an accuracy estimate ERR and a
|
|
% parameter REL to indicate for each computed value in X why the
|
|
% iterations have stopped:
|
|
% REL == 1 ==> The iterations stopped due to numerical convergence
|
|
% REL == 2 ==> The iterations stopped due to the fact that the
|
|
% maximal number of iterations have been reached
|
|
% REL == 3 ==> The iterations stopped due to deterioration in the
|
|
% construction of the rational Fejer quadrature formulae
|
|
%
|
|
% [X,ERR,REL,Y] = RFEJER(...) also returns the nodes Y(1,:) and the
|
|
% weights Y(2,:), together with the actual sequence of poles
|
|
% Y(3,1:end-1), from the last iteration. In the case of a vector- or
|
|
% matrix-valued function FUN, recomputing X by means of Y and
|
|
% FUN may lead, however, to a result that differs from X due to detection
|
|
% of numerical convergence (REL == 1) for one or more functions at an
|
|
% earlier iteration.
|
|
%
|
|
% X = RFEJER(SGL,FUN,PARAM1,VAL1,PARAM2,VAL2,...) performs the
|
|
% integration with specified values of optional parameters. The available
|
|
% parameters are
|
|
%
|
|
% 'Array', which takes the value TRUE or FALSE and should be used
|
|
% whenever the function y=FUN(x) does not accept a vector argument x.
|
|
% By default ARRAY == FALSE.
|
|
% 'Tol', relative error tolerance. RFEJER attempts to satisfy
|
|
% ERR <= K*Tol, where K denotes the number of nodes and weights in
|
|
% the rational interpolatory Fejer quadrature formula. By default
|
|
% TOL == 5 * eps.
|
|
% 'Nmax', maximal number of nodes and weights that should be used in the
|
|
% rational interpolatory Fejer quadrature formula to approximate the
|
|
% integral. By default NMAX == N+M+1. Whenever it is used, the
|
|
% maximal number will be set to NMAX == min{'Nmax'+c,N+M+1}, where c
|
|
% is either 0 or 1 (depending on whether SGL contains complex poles).
|
|
% 'Nmin', minimal number of nodes and weights that should be used in the
|
|
% rational interpolatory Fejer quadrature formula to approximate the
|
|
% integral. By default NMIN == 1. Whenever it is used, the minimal
|
|
% number will be set to NMIN == min{'Nmin','Nmax'-2-d,N+M-1-d}, where
|
|
% d is either 0, 1 or 2 (depending on whether SGL contains complex
|
|
% poles) in order to ensure at least three iterations.
|
|
%
|
|
% Remark:
|
|
% Whenever FUN contains one or more constant functions, the
|
|
% parameter 'Array' should take the value TRUE.
|
|
%
|
|
% Example 1: A scalar-valued function on the interval [-1,1]
|
|
% omeg = 0.1;
|
|
% sgl = sqrt(-1)*omeg*[1:1:16];
|
|
% NumInt = rfejer(sgl,@(x)fx(x,omeg));
|
|
% where the file fx.m defines the function:
|
|
% %------------------------------%
|
|
% function y = fx(x,w)
|
|
% y = (pi*x/w)./sinh(pi*x/w);
|
|
% %------------------------------%
|
|
%
|
|
% Example 2: A matrix-valued function on the interval [0,1]
|
|
% fx = @(x) [1./(x+0.2),1./(x+0.2).^2; 1./(x+0.1).^3,1./(x.^2+0.01)];
|
|
% sgl = -0.1*[1,1,1,sqrt(-1),2,2];
|
|
% ival = [0,1];
|
|
% [fx2,sgl2] = transf(fx,sgl,ival);
|
|
% [NumInt,err] = rfejer(sgl2,fx2);
|
|
%
|
|
% Example 3: Combining rational and polynomial interpolation
|
|
% sgl = [0.2*sqrt(-1),inf*ones(1,10)];
|
|
% [X,err] = rfejer(sgl);
|
|
% fx = @(x) exp(x)./(25*x.^2+1);
|
|
% NumInt = fx(X(1,:))*X(2,:)';
|
|
% NumInt2 = rfejer(sgl,fx);
|
|
%
|
|
% See also RCHEB, ERRW, TRANSF.
|
|
|
|
% -------------------------------------------------------------------------
|
|
% Authors: Karl Deckers & Ahlem Mougaida & Hedi Belhadjsalah
|
|
%
|
|
% Reference: Extended Rational Fejer Quadrature Rules based on
|
|
% Chebyshev Orthogonal Rational Functions
|
|
%
|
|
% Software revision date: August 25, 2016
|
|
% -------------------------------------------------------------------------
|
|
|
|
% constants
|
|
pinf = 2 / eps; % poles >= pinf considered equal to inf
|
|
ptol = 2 * eps; % poles closer than ptol apart considered equal
|
|
itolw = eps; % tolerance on accuracy of the computed weights
|
|
itol = eps; % tolerance on the computed approximations
|
|
ni = 1; % initial iteration
|
|
ne = inf; % last iteration
|
|
|
|
% check input
|
|
if nargin < 1,
|
|
error('Not enough input arguments.');
|
|
else
|
|
if any(isnan([real(sgl),imag(sgl)])),
|
|
error('NaN is not a valid pole.');
|
|
elseif any((abs(imag(sgl)) <= ptol) & (abs(real(sgl)) <= 1 + ptol)),
|
|
error('SGL contains poles too close to the interval IVAL.');
|
|
else
|
|
sgl = sgl(:).';
|
|
end
|
|
if nargin > 1,
|
|
if ischar(fun),
|
|
F = str2func(fun);
|
|
else
|
|
F = fcnchk(fun);
|
|
end
|
|
sizeF = size(F(0));
|
|
|
|
% Process optional input.
|
|
p = inputParser;
|
|
p.addParamValue('Array',false,@validateArray);
|
|
p.addParamValue('Tol',5*eps,@validateTol);
|
|
p.addParamValue('Nmin',1,@validateNmin);
|
|
p.addParamValue('Nmax',inf,@validateNmax);
|
|
p.parse(varargin{:});
|
|
optionStruct = p.Results;
|
|
array = optionStruct.Array;
|
|
itol = optionStruct.Tol;
|
|
ni = optionStruct.Nmin;
|
|
ne = optionStruct.Nmax;
|
|
|
|
if ~array,
|
|
F([-0.1,0.1]);
|
|
end
|
|
end
|
|
end
|
|
|
|
% process poles
|
|
|
|
sgl=pcheck(sgl,ptol);
|
|
sgl(abs(sgl) >= pinf) = inf;
|
|
mint = length(sgl);
|
|
b = real(sgl)+sqrt(-1)*abs(imag(sgl));
|
|
b = 1 ./ (b + (2 * (real(b)>=0) - 1) .* sqrt(b.^2 - 1));
|
|
index = find(imag(sgl)<0);
|
|
b(index) = conj(b(index));
|
|
|
|
% minimal and maximal number of points
|
|
|
|
if (mint < 3) || ((mint == 3) && ~(isreal(sgl(end-1)))),
|
|
ni = 1; ne = mint;
|
|
else
|
|
index = 1+sum((imag(sgl(1:3)) ~= 0));
|
|
ne = min([max([ne-1,index,2]),mint]);
|
|
if (ne < 3),
|
|
ni = 1;
|
|
else
|
|
index = (imag(sgl(ne-2:ne)) ~= 0);
|
|
index = ne - max([1,sum(index)]); % we need at least 3 iterations
|
|
ni = min([ni,index]);
|
|
end
|
|
end
|
|
|
|
% initialise memory
|
|
|
|
vk = zeros(mint+1,1); % Kinv * Re{J(\varphi)}
|
|
vk(1) = 2/sqrt(pi);
|
|
k = 1;
|
|
if nargin > 1,
|
|
x = zeros(sizeF);
|
|
FQ = 2*F(0); % 1-point quadrature
|
|
else
|
|
x = zeros(3,mint+1);
|
|
end
|
|
Err = inf*ones(size(x));
|
|
Rel = zeros(size(x));
|
|
conv = min(Rel(:));
|
|
war = 0;
|
|
p1 = zeros(size(x));
|
|
p2 = p1;
|
|
mint2 = ne;
|
|
|
|
% compute rational Chebyshev nodes and weights
|
|
|
|
% warning('off', 'Octave:possible-matlab-short-circuit-operator');
|
|
[xM,LM,erc]=rcheb([sgl,inf]);
|
|
% warning('on', 'Octave:possible-matlab-short-circuit-operator');
|
|
RphiM = mQ(b,xM); % compute Re{Q}^T
|
|
|
|
% iterations
|
|
while conv==false && k<(mint2+1),
|
|
ak = sgl(k);
|
|
rc = 2-isreal(ak); % real/complex
|
|
|
|
% initial step for new pole
|
|
mk=length(find(ak==sgl(1:k)));
|
|
if mk==1,
|
|
pos=find(ak==sgl(k:end)); % multiplicity
|
|
m=length(pos);
|
|
if rc==2,
|
|
posc = pos;
|
|
pos = zeros(1,2*m);
|
|
pos(1:2:end) = posc;
|
|
pos(2:2:end) = find(conj(ak)==sgl(k:end));
|
|
end
|
|
vk(pos+k) = JnB(ak,m,rc,ptol); % integral non-orthogonal basis
|
|
end
|
|
|
|
% compute Kinv * Re{J(\varphi)}
|
|
|
|
vk(k+1:k+rc)= JoB(ak,mk,k+rc,xM,LM,vk(1:k+rc),RphiM,rc);
|
|
k = k+rc;
|
|
|
|
% approximate the integral
|
|
|
|
if (nargin > 1) && ~(k < ni),
|
|
if k < mint+1,
|
|
% warning('off', 'Octave:possible-matlab-short-circuit-operator');
|
|
[xi,lambda]=rcheb([sgl(1:k-1),inf]);
|
|
% warning('on', 'Octave:possible-matlab-short-circuit-operator');
|
|
Phi = mQ(b(1:k-1),xi);
|
|
else
|
|
xi = xM;
|
|
lambda = LM;
|
|
Phi = RphiM;
|
|
end
|
|
W = lambda.*(Phi*vk(1:k))';
|
|
war = 2*(abs(sum(W)-2)>k*itolw);
|
|
if (war > 0) && (k-rc > ni),
|
|
conv = true;
|
|
else
|
|
In1 = FQ;
|
|
|
|
% (k+rc)-point quadrature
|
|
FQ = evalquad(F,sizeF,xi,W,array);
|
|
index = find(Rel==1);
|
|
FQ(index)=In1(index);
|
|
|
|
% convergence criterion
|
|
In1 = abs(FQ-In1);
|
|
aFQ = abs(FQ);
|
|
index = find(aFQ > 0);
|
|
In1(index) = In1(index)./aFQ(index);
|
|
index = find(Rel==1);
|
|
In1(index) = Err(index);
|
|
Err = In1;
|
|
% Put `%' at the beginning of line 259 and 260 to force the
|
|
% iterations to continue until divergence has been detected
|
|
% at line 238
|
|
[Rel,p1,p2,mint2] = cvg(Err,p1,p2,k,itol,ne,mint2,Rel);
|
|
conv = min(Rel(:));
|
|
|
|
y = [xi;W;[sgl(1:k-1),inf]];
|
|
end
|
|
end
|
|
end
|
|
|
|
% output
|
|
|
|
if nargin == 1,
|
|
x = [xM; LM.*(RphiM*vk)';[sgl,inf]];
|
|
Err(1,:) = abs(erc);
|
|
Rel(1,:)=1;
|
|
Err(2,:)=abs(sum(x(2,:))-2);
|
|
war = 2*(Err(2,1)>k*itolw);
|
|
if ( ( war>0 ) || ( nargout>1 ) ),
|
|
Err(2,:)=errW(x(3,:),x(1:2,:));
|
|
end
|
|
Rel(2,:)=1+war;
|
|
Err(3,:)=0;
|
|
y = x;
|
|
else
|
|
x(1:end) = double(FQ);
|
|
Err(1:end) = double(Err);
|
|
index = find(Rel==0);
|
|
if ~isempty(index),
|
|
war = war + (k>mint2);
|
|
Rel(index)=1+min([war,2]);
|
|
end
|
|
Rel(1:end) = double(Rel);
|
|
end
|
|
%
|
|
% if nargout < 2,
|
|
% E = max(Err(:));
|
|
% if (war == 1) || ((war > 1) && (nargin == 1)),
|
|
% warning('The desired accuracy of 1.e-13 may not be achieved.')
|
|
% warning('Estimated relative error on the approximation: %d',E)
|
|
% elseif (war > 1),
|
|
% warning('The iterations failed to converge.')
|
|
% warning('Estimated relative error on the approximation: %d',E)
|
|
% end
|
|
% end
|
|
|
|
end
|
|
|
|
% -------------------------------------------------------------------------
|
|
function b=pcheck(a,tol)
|
|
%Check on complex conjugate pairs and on multiple poles
|
|
|
|
j=1;
|
|
m=length(a);
|
|
while(j<=m)
|
|
d = find(abs(1-a(j+1:m)/a(j))<tol);
|
|
if ~isempty(d)
|
|
a(d(1)+j)=a(j);
|
|
end
|
|
j=j+1;
|
|
if ~isreal(a(j-1))
|
|
d=find(abs(1-a(j:m)/conj(a(j-1)))<tol);
|
|
if ~isempty(d)
|
|
a(d(1)+j-1)=[];
|
|
m=m-1;
|
|
end
|
|
a(j:m+1)=[conj(a(j-1)),a(j:m)];
|
|
m=m+1;
|
|
j=j+1;
|
|
end
|
|
end
|
|
b=a;
|
|
|
|
end
|
|
|
|
% -------------------------------------------------------------------------
|
|
function J = JnB(a,M,N,tol)
|
|
% Compute int_{-1}^1 [h_{a}(x)]^j dx for j=1,...,M
|
|
% Construct a column vector of length N*M where either
|
|
% N=1 (a is real) or N=2 (a is complex)
|
|
|
|
c = abs(a)-1;
|
|
if isinf(a),
|
|
J=zeros(1,M);
|
|
J(2:2:end)=2./[3:2:M+1];
|
|
|
|
elseif (c<1e10*tol) || (log(10)*(4*M+50)+90*log(c)<0) || ((M<3) && (c<9)),
|
|
J = (a^2-1)*log((a+1)/(a-1))-2*a;
|
|
if M>1, %forward recurrence
|
|
F = 2;
|
|
for k=2:M,
|
|
F1 = (a^2-1)*(1-(-1)^(k-1))/(k-1)-2*a*J(end)-a^2*F;
|
|
F = J(end);
|
|
J = [J;F1];
|
|
end
|
|
end
|
|
else %series expansions
|
|
f = mod(M,2);
|
|
J=expansion(a,M,f,tol);
|
|
if M>1, %backward recurrence
|
|
F=J;
|
|
J=expansion(a,M-1,1-f,tol);
|
|
J=[J;F];
|
|
for k=M-2:-1:1,
|
|
F1=-((1/a)^2-1)*(1-(-1)^(k+1))/(k+1)-2*(1/a)*J(1)-(1/a)^2*F;
|
|
F=J(1);
|
|
J=[F1;J];
|
|
end
|
|
end
|
|
end
|
|
% complex case
|
|
if N == 2
|
|
F = zeros(2*M,1);
|
|
F(1:2:end) = J;
|
|
F(2:2:end) = sqrt(-1)*J;
|
|
J = real(F);
|
|
end
|
|
|
|
end
|
|
|
|
%--------------------------------------------------------------------------
|
|
function J=expansion(a,M,f,tol)
|
|
|
|
j = 1;
|
|
while(log(abs(a)^(2*j)*(2*j+M+3-f)*(2*j+M+1-f)*tol)<0),
|
|
j=j+1;
|
|
end
|
|
S = ([0:2:2*j]+M+3-f).*([0:2:2*j]+M+1-f).*a.^([0:2:2*j]);
|
|
S=sum(S.^(-1));
|
|
J = 2*(1-f)/(M+1)+(-1)^f*4*M/a^(2-f)*S;
|
|
|
|
end
|
|
|
|
% -------------------------------------------------------------------------
|
|
function Q = mQ(beta,x)
|
|
% Construct matrix Re{Q}^T
|
|
|
|
n=length(x);
|
|
Q = zeros(n);
|
|
Q(1,:) = 1/sqrt(pi)* ones(1,n);
|
|
z = x+sqrt(-1)*sqrt(1-x.^2);
|
|
N=sqrt(1/(2*pi))*sqrt(1-abs(beta).^2);
|
|
B(1,:)=ones(1,n);
|
|
Bc(1,:)=B(1,:);
|
|
Q(2,:)=N(1)*(z.*Bc(1,:)./(1-beta(1).*z)+ 1./((z-beta(1)).*B(1,:)));
|
|
for k=2:n-1,
|
|
B(k,:)=B(k-1,:).*(z-beta(k-1))./(1-conj(beta(k-1)).*z);
|
|
Bc(k,:)=Bc(k-1,:).*(z-conj(beta(k-1)))./(1-beta(k-1).*z);
|
|
Q(k+1,:)=N(k)*(z.*Bc(k,:)./(1-beta(k).*z)+ 1./((z-beta(k)).*B(k,:)));
|
|
end
|
|
Q=real(Q)';
|
|
|
|
end
|
|
|
|
% -------------------------------------------------------------------------
|
|
function J= JoB(a,m,k,x,lambda,Jf,Q,rc)
|
|
% Compute Kinv*int_{-1}^1 Re{phi_a(x)} dx
|
|
|
|
if isinf(a),
|
|
f = x.^m;
|
|
else
|
|
f=((1-a*x)./(x-a)).^m;
|
|
if rc==2,
|
|
f=[real(f);-imag(f)];
|
|
end
|
|
end
|
|
|
|
% Construct B
|
|
L=repmat(lambda,rc,1);
|
|
b = L.*f;
|
|
b = b*Q;
|
|
b = real(b(:,1:k));
|
|
|
|
%Compute J
|
|
|
|
beI=b(:,end-rc+1:end);
|
|
warning('off')
|
|
J = beI\(Jf(end+1-rc:end)-b(:,1:end-rc)*Jf(1:end-rc));
|
|
warning('on')
|
|
|
|
end
|
|
|
|
% -------------------------------------------------------------------------
|
|
function [Cn,p1,p2,mint2] = cvg(En,p1,p2,n,tol,mint,mint2,Co)
|
|
% Check convergence of approximation
|
|
|
|
p1 = p2;
|
|
p2 = Co;
|
|
Cn = p2;
|
|
index = find(En< sqrt(tol));
|
|
p2(index) = 1;
|
|
index = find((p1+p2)==2);
|
|
Cn(index) = (En(index) < n*tol);
|
|
pM = min(p2(:));
|
|
if pM == 1,
|
|
mint2 = min(max( n+8 , 2*n),mint);
|
|
else
|
|
mint2 = mint;
|
|
end
|
|
|
|
end
|
|
|
|
% -------------------------------------------------------------------------
|
|
function FQ = evalquad(F,sizeF,xi,W,Array)
|
|
% Evaluate quadrature formula
|
|
|
|
n = length(xi);
|
|
if ~Array,
|
|
mL = min([sizeF,n]);
|
|
if mL==sizeF(2),
|
|
G = F(xi);
|
|
for j = 1:mL,
|
|
FQ(:,j) = G(:,(j-1)*n+1:j*n)*W';
|
|
end
|
|
elseif mL==sizeF(1),
|
|
G = F(xi');
|
|
for j = 1:mL,
|
|
FQ(j,:) = W*G((j-1)*n+1:j*n,:);
|
|
end
|
|
else
|
|
Array = true;
|
|
end
|
|
end
|
|
if Array,
|
|
FQ = zeros(sizeF);
|
|
for j = 1:n,
|
|
FQ = FQ+F(xi(j))*W(j);
|
|
end
|
|
end
|
|
|
|
end
|
|
|
|
%--------------------------------------------------------------------------
|
|
function p = validateArray(x)
|
|
if ~(islogical(x))
|
|
error(message('MATLAB:rfejer:invalidArray'));
|
|
end
|
|
p = true;
|
|
end
|
|
|
|
%--------------------------------------------------------------------------
|
|
function p = validateTol(x)
|
|
if ~(isfloat(x) && isscalar(x) && isreal(x) && x >= 0)
|
|
error(message('MATLAB:rfejer:invalidTol'));
|
|
end
|
|
p = true;
|
|
end
|
|
|
|
%--------------------------------------------------------------------------
|
|
function p = validateNmin(x)
|
|
if ~(isfloat(x) && isscalar(x) && isreal(x) && x >= 0)
|
|
error(message('MATLAB:rfejer:invalidNmin'));
|
|
end
|
|
p = true;
|
|
end
|
|
|
|
%--------------------------------------------------------------------------
|
|
function p = validateNmax(x)
|
|
if ~(isfloat(x) && isscalar(x) && isreal(x) && x >= 0)
|
|
error(message('MATLAB:rfejer:invalidNmax'));
|
|
end
|
|
p = true;
|
|
end
|
|
|