Streamlined gamrnd routine.
Give access to all the implemented algorithms through the third argument. The last argument is a structure with two fields `large` and `small`. The first field specifies the algorithm to be used for α>1 while the second field defines the algorithm to be used for α ∈ (0,1). Default algorithms are: - Cheng (1977) for α>1, - Johnk (1964) α ∈ (0,1).time-shift
parent
d628b078ab
commit
e32b87d4b3
|
@ -3,18 +3,19 @@ function rnd = gamrnd(a, b, method)
|
||||||
% This function produces independent random variates from the Gamma distribution.
|
% This function produces independent random variates from the Gamma distribution.
|
||||||
%
|
%
|
||||||
% INPUTS
|
% INPUTS
|
||||||
% a [double] n*1 vector of positive parameters.
|
% - a [double] n*1 vector of positive parameters.
|
||||||
% b [double] n*1 vector of positive parameters.
|
% - b [double] n*1 vector of positive parameters.
|
||||||
% method [string] 'BawensLubranoRichard' or anything else (see below).
|
% - method [struct] Specifies which algorithms must be used.
|
||||||
%
|
%
|
||||||
% OUTPUT
|
% OUTPUT
|
||||||
% rnd [double] n*1 vector of independent variates from the gamma(a,b) distribution.
|
% - rnd [double] n*1 vector of independent variates from the gamma(a,b) distribution.
|
||||||
% rnd(i) is gamma distributed with mean a(i)b(i) and variance a(i)b(i)^2.
|
% rnd(i) is gamma distributed with mean a(i)b(i) and variance a(i)b(i)^2.
|
||||||
%
|
%
|
||||||
% ALGORITHMS
|
% REMARKS
|
||||||
% Described in Bauwens, Lubrano and Richard (1999, page 316) and Devroye (1986, chapter 9).
|
% The third input is a structure with two fields named `large` and `small`.
|
||||||
|
% These fields define the algorithms to be used if a>1 (large) or a<1 (small).
|
||||||
|
|
||||||
% Copyright (C) 2006-2017 Dynare Team
|
% Copyright (C) 2006-2018 Dynare Team
|
||||||
%
|
%
|
||||||
% This file is part of Dynare.
|
% This file is part of Dynare.
|
||||||
%
|
%
|
||||||
|
@ -31,103 +32,96 @@ function rnd = gamrnd(a, b, method)
|
||||||
% You should have received a copy of the GNU General Public License
|
% You should have received a copy of the GNU General Public License
|
||||||
% along with Dynare. If not, see <http://www.gnu.org/licenses/>.
|
% along with Dynare. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
if (nargin < 2)
|
%>
|
||||||
|
%> Set defaults
|
||||||
|
%> ------------
|
||||||
|
|
||||||
|
if nargin<2
|
||||||
b = ones(size(a));
|
b = ones(size(a));
|
||||||
end
|
end
|
||||||
|
|
||||||
if nargin<3
|
if nargin<3
|
||||||
method= 'BauwensLubranoRichard';
|
method = struct('large', 'Cheng', 'small', 'Johnk');
|
||||||
if any(a<1)
|
|
||||||
method = 'Devroye';
|
|
||||||
Devroye.small = 'Best'; % 'Weibull' , 'Johnk' , 'Berman' , 'GS' , 'Best'
|
|
||||||
% REMARK: The first algorithm (Weibull) is producing too much extreme values.
|
|
||||||
end
|
|
||||||
if ~strcmpi(method,'BauwensLubranoRichard')
|
|
||||||
Devroye.big = 'Best'; % 'Cheng' , 'Best'
|
|
||||||
% REMARK 1: The first algorithm (Cheng) is still producing obviously wrong simulations.
|
|
||||||
% REMARK 2: The second algorithm seems slightly slower than the algorithm advocated by Bauwens,
|
|
||||||
% Lubrano and Richard, but the comparison depends on the value of a (this should be
|
|
||||||
% investigated further).
|
|
||||||
end
|
|
||||||
else
|
|
||||||
error('gamrnd:: Selection of method not yet implemented')
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
%>
|
||||||
|
%> Check inputs
|
||||||
|
%> ------------
|
||||||
|
|
||||||
|
|
||||||
[ma,na] = size(a);
|
[ma,na] = size(a);
|
||||||
[mb,nb] = size(b);
|
[mb,nb] = size(b);
|
||||||
|
|
||||||
if ma~=mb || na~=nb
|
if ma~=mb || na~=nb
|
||||||
error('gamrnd:: Input arguments must have the same size!');
|
error('gamrnd:: Input arguments must have the same size.');
|
||||||
end
|
end
|
||||||
|
|
||||||
if na~=1
|
if na~=1
|
||||||
error('gamrnd:: Input arguments must be column vectors');
|
error('gamrnd:: Input arguments must be column vectors.');
|
||||||
end
|
end
|
||||||
|
|
||||||
if (any(a<0)) || (any(b<0)) || (any(a==Inf)) || (any(b==Inf))
|
if (any(a<0)) || (any(b<0)) || (any(a==Inf)) || (any(b==Inf))
|
||||||
error('gamrnd:: Input arguments must be finite and positive!');
|
error('gamrnd:: Input arguments must be finite and positive.');
|
||||||
end
|
end
|
||||||
|
|
||||||
[~,integer_idx,double_idx] = isint(a);
|
%>
|
||||||
|
%> Inititialize output
|
||||||
number_of_integer_a = length(integer_idx);
|
%> -------------------
|
||||||
number_of_double_a = length(double_idx);
|
|
||||||
|
|
||||||
rnd = NaN(ma,1);
|
rnd = NaN(ma,1);
|
||||||
|
|
||||||
if number_of_integer_a
|
|
||||||
small_idx = find(a(integer_idx)<30);
|
% Get indices of integer (idx) and non integer (ddx) for the first hyperparameter a.
|
||||||
big_idx = find(a(integer_idx)>=30);
|
[~, idx, ddx] = isint(a);
|
||||||
number_of_small_a = length(small_idx);
|
|
||||||
number_of_big_a = length(big_idx);
|
if ~isempty(idx)
|
||||||
if number_of_small_a
|
% If the first hyperparameter (a) is an integer we can use the
|
||||||
% Exact sampling.
|
% exponential random number generator or rely in a Gaussian
|
||||||
for i=1:number_of_small_a
|
% approximation.
|
||||||
rnd(integer_idx(small_idx(i))) = sum(exprnd(ones(a(integer_idx(small_idx(i))),1)))*b(integer_idx(small_idx(i)));
|
sdx = find(a(idx)<30);
|
||||||
|
ldx = find(a(idx)>=30);
|
||||||
|
if ~isempty(sdx)
|
||||||
|
% Exact sampling using random deviates from an exponential distribution.
|
||||||
|
for i=1:length(sdx)
|
||||||
|
rnd(idx(sdx(i))) = sum(exprnd(ones(a(idx(sdx(i))),1)))*b(idx(sdx(i)));
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
if number_of_big_a
|
if ~isempty(ldx)
|
||||||
% Gaussian approximation.
|
% Gaussian approximation.
|
||||||
rnd(integer_idx(big_idx)) = sqrt(a(integer_idx(big_idx))).* b(integer_idx(big_idx)) .* randn(number_of_big_a, 1) + a(integer_idx(big_idx)) .* b(integer_idx(big_idx));
|
rnd(idx(ldx)) = sqrt(a(idx(ldx))).* b(idx(ldx)) .* randn(length(ldx), 1) + a(idx(ldx)) .* b(idx(ldx));
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
|
|
||||||
|
if ~isempty(ddx)
|
||||||
if number_of_double_a
|
% The first hyperparameter is not an integer.
|
||||||
if strcmpi(method,'BauwensLubranoRichard')
|
sdx = find(a(ddx)<1); % Indices for small a.
|
||||||
% Algorithm given in Bauwens, Lubrano & Richard (1999) page 316.
|
ldx = find(a(ddx)>1); % Indices for large a.
|
||||||
rnd(double_idx) = gamrnd.knuth(a(double_idx),b(double_idx));
|
if ~isempty(sdx)
|
||||||
else% Algorithm given in Devroye (1986, chapter 9)
|
switch method.small
|
||||||
small_idx = find(a(double_idx)<1);
|
case 'Weibull-rejection'
|
||||||
big_idx = find(a(double_idx)>1);
|
rnd(ddx(sdx)) = gamrnd.weibull_rejection(a(ddx(sdx)),b(ddx(sdx)));
|
||||||
number_of_small_a = length(small_idx);
|
case 'Johnk'
|
||||||
number_of_big_a = length(big_idx);
|
rnd(ddx(sdx)) = gamrnd.johnk(a(ddx(sdx)),b(ddx(sdx)));
|
||||||
if number_of_small_a
|
case 'Berman'
|
||||||
if strcmpi(Devroye.small,'Weibull')
|
rnd(ddx(sdx)) = gamrnd.berman(a(ddx(sdx)),b(ddx(sdx)));
|
||||||
% Algorithm given in Devroye (1986, page 415) [Rejection from the Weibull density]
|
case 'Ahrens-Dieter'
|
||||||
rnd(double_idx(small_idx)) = gamrnd.weibull_rejection(a(double_idx(small_idx)),b(double_idx(small_idx)));
|
rnd(ddx(sdx)) = gamrnd.ahrens_dieter(a(ddx(sdx)),b(ddx(sdx)));
|
||||||
elseif strcmpi(Devroye.small,'Johnk')
|
case 'Best'
|
||||||
% Algorithm given in Devroye (1986, page 418) [Johnk's gamma generator]
|
rnd(ddx(sdx)) = gamrnd.best_1983(a(ddx(sdx)),b(ddx(sdx)));
|
||||||
rnd(double_idx(small_idx)) = gamrnd.johnk(a(double_idx(small_idx)),b(double_idx(small_idx)));
|
otherwise
|
||||||
elseif strcmpi(Devroye.small,'Berman')
|
error('Unknown algorithm for gamrnd.')
|
||||||
% Algorithm given in Devroye (1986, page 418) [Berman's gamma generator]
|
|
||||||
rnd(double_idx(small_idx)) = gamrnd.berman(a(double_idx(small_idx)),b(double_idx(small_idx)));
|
|
||||||
elseif strcmpi(Devroye.small,'GS')
|
|
||||||
% Algorithm given in Devroye (1986, page 425) [Ahrens and Dieter, 1974]
|
|
||||||
rnd(double_idx(small_idx)) = gamrnd.ahrens_dieter(a(double_idx(small_idx)),b(double_idx(small_idx)));
|
|
||||||
elseif strcmpi(Devroye.small,'Best')
|
|
||||||
% Algorithm given in Devroye (1986, page 426) [Best, 1983]
|
|
||||||
rnd(double_idx(small_idx)) = gamrnd.best_1983(a(double_idx(small_idx)),b(double_idx(small_idx)));
|
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
if number_of_big_a
|
if ~isempty(ldx)
|
||||||
if strcmpi(Devroye.big,'Cheng')
|
switch method.large
|
||||||
% Algorithm given in Devroye (1986, page 413) [Cheng's rejection algorithm GB]
|
case 'Knuth'
|
||||||
rnd(double_idx(big_idx)) = gamrnd.cheng(a(double_idx(big_idx)),b(double_idx(big_idx)));
|
rnd(ddx) = gamrnd.knuth(a(ddx),b(ddx));
|
||||||
elseif strcmpi(Devroye.big,'Best')
|
case 'Best'
|
||||||
% Algorithm given in Devroye (1986, page 410) [Best's rejection algorithm XG]
|
rnd(ddx(ldx)) = gamrnd.best_1978(a(ddx(ldx)),b(ddx(ldx)));
|
||||||
rnd(double_idx(big_idx)) = gamrnd.best_1978(a(double_idx(big_idx)),b(double_idx(big_idx)));
|
case 'Cheng'
|
||||||
end
|
rnd(ddx(ldx)) = gamrnd.cheng(a(ddx(ldx)),b(ddx(ldx)));
|
||||||
|
otherwise
|
||||||
|
error('Unknown algorithm for gamrnd.')
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
end
|
end
|
Loading…
Reference in New Issue