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
Stéphane Adjemia (Scylla) 2018-12-15 14:14:16 +01:00 committed by Stéphane Adjemian (Hermes)
parent d628b078ab
commit e32b87d4b3
Signed by untrusted user who does not match committer: stepan
GPG Key ID: A6D44CB9C64CE77B
1 changed files with 70 additions and 76 deletions

View File

@ -3,18 +3,19 @@ function rnd = gamrnd(a, b, method)
% This function produces independent random variates from the Gamma distribution.
%
% INPUTS
% a [double] n*1 vector of positive parameters.
% b [double] n*1 vector of positive parameters.
% method [string] 'BawensLubranoRichard' or anything else (see below).
% - a [double] n*1 vector of positive parameters.
% - b [double] n*1 vector of positive parameters.
% - method [struct] Specifies which algorithms must be used.
%
% 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.
%
% ALGORITHMS
% Described in Bauwens, Lubrano and Richard (1999, page 316) and Devroye (1986, chapter 9).
% REMARKS
% 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.
%
@ -31,103 +32,96 @@ function rnd = gamrnd(a, b, method)
% You should have received a copy of the GNU General Public License
% along with Dynare. If not, see <http://www.gnu.org/licenses/>.
if (nargin < 2)
%>
%> Set defaults
%> ------------
if nargin<2
b = ones(size(a));
end
if nargin<3
method= 'BauwensLubranoRichard';
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')
method = struct('large', 'Cheng', 'small', 'Johnk');
end
%>
%> Check inputs
%> ------------
[ma,na] = size(a);
[mb,nb] = size(b);
if ma~=mb || na~=nb
error('gamrnd:: Input arguments must have the same size!');
error('gamrnd:: Input arguments must have the same size.');
end
if na~=1
error('gamrnd:: Input arguments must be column vectors');
error('gamrnd:: Input arguments must be column vectors.');
end
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
[~,integer_idx,double_idx] = isint(a);
number_of_integer_a = length(integer_idx);
number_of_double_a = length(double_idx);
%>
%> Inititialize output
%> -------------------
rnd = NaN(ma,1);
if number_of_integer_a
small_idx = find(a(integer_idx)<30);
big_idx = find(a(integer_idx)>=30);
number_of_small_a = length(small_idx);
number_of_big_a = length(big_idx);
if number_of_small_a
% Exact sampling.
for i=1:number_of_small_a
rnd(integer_idx(small_idx(i))) = sum(exprnd(ones(a(integer_idx(small_idx(i))),1)))*b(integer_idx(small_idx(i)));
% Get indices of integer (idx) and non integer (ddx) for the first hyperparameter a.
[~, idx, ddx] = isint(a);
if ~isempty(idx)
% If the first hyperparameter (a) is an integer we can use the
% exponential random number generator or rely in a Gaussian
% approximation.
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
if number_of_big_a
if ~isempty(ldx)
% 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
if number_of_double_a
if strcmpi(method,'BauwensLubranoRichard')
% Algorithm given in Bauwens, Lubrano & Richard (1999) page 316.
rnd(double_idx) = gamrnd.knuth(a(double_idx),b(double_idx));
else% Algorithm given in Devroye (1986, chapter 9)
small_idx = find(a(double_idx)<1);
big_idx = find(a(double_idx)>1);
number_of_small_a = length(small_idx);
number_of_big_a = length(big_idx);
if number_of_small_a
if strcmpi(Devroye.small,'Weibull')
% Algorithm given in Devroye (1986, page 415) [Rejection from the Weibull density]
rnd(double_idx(small_idx)) = gamrnd.weibull_rejection(a(double_idx(small_idx)),b(double_idx(small_idx)));
elseif strcmpi(Devroye.small,'Johnk')
% Algorithm given in Devroye (1986, page 418) [Johnk's gamma generator]
rnd(double_idx(small_idx)) = gamrnd.johnk(a(double_idx(small_idx)),b(double_idx(small_idx)));
elseif strcmpi(Devroye.small,'Berman')
% 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
if ~isempty(ddx)
% The first hyperparameter is not an integer.
sdx = find(a(ddx)<1); % Indices for small a.
ldx = find(a(ddx)>1); % Indices for large a.
if ~isempty(sdx)
switch method.small
case 'Weibull-rejection'
rnd(ddx(sdx)) = gamrnd.weibull_rejection(a(ddx(sdx)),b(ddx(sdx)));
case 'Johnk'
rnd(ddx(sdx)) = gamrnd.johnk(a(ddx(sdx)),b(ddx(sdx)));
case 'Berman'
rnd(ddx(sdx)) = gamrnd.berman(a(ddx(sdx)),b(ddx(sdx)));
case 'Ahrens-Dieter'
rnd(ddx(sdx)) = gamrnd.ahrens_dieter(a(ddx(sdx)),b(ddx(sdx)));
case 'Best'
rnd(ddx(sdx)) = gamrnd.best_1983(a(ddx(sdx)),b(ddx(sdx)));
otherwise
error('Unknown algorithm for gamrnd.')
end
if number_of_big_a
if strcmpi(Devroye.big,'Cheng')
% Algorithm given in Devroye (1986, page 413) [Cheng's rejection algorithm GB]
rnd(double_idx(big_idx)) = gamrnd.cheng(a(double_idx(big_idx)),b(double_idx(big_idx)));
elseif strcmpi(Devroye.big,'Best')
% Algorithm given in Devroye (1986, page 410) [Best's rejection algorithm XG]
rnd(double_idx(big_idx)) = gamrnd.best_1978(a(double_idx(big_idx)),b(double_idx(big_idx)));
end
end
if ~isempty(ldx)
switch method.large
case 'Knuth'
rnd(ddx) = gamrnd.knuth(a(ddx),b(ddx));
case 'Best'
rnd(ddx(ldx)) = gamrnd.best_1978(a(ddx(ldx)),b(ddx(ldx)));
case 'Cheng'
rnd(ddx(ldx)) = gamrnd.cheng(a(ddx(ldx)),b(ddx(ldx)));
otherwise
error('Unknown algorithm for gamrnd.')
end
end
end