2016-06-01 18:22:51 +02:00
function [g, badg] = numgrad3_ ( fcn,f0,x,penalty,epsilon,varargin)
2013-09-20 23:15:00 +02:00
% Computes the gradient of the objective function fcn using a three points
% formula if possible.
%
% Adapted from Sims' numgrad routine.
%
% See section 25.3.4 in Abramovitz and Stegun (1972, Tenth Printing, December) Handbook of Mathematical Functions.
2014-01-22 17:35:31 +01:00
% http://www.math.sfu.ca/~cbm/aands/
2013-09-20 23:15:00 +02:00
% Original file downloaded from:
% http://sims.princeton.edu/yftp/optimize/mfiles/numgrad.m
% Copyright (C) 1993-2007 Christopher Sims
2014-01-22 17:35:31 +01:00
% Copyright (C) 2008-2014 Dynare Team
2013-09-20 23:15:00 +02:00
%
% This file is part of Dynare.
%
% Dynare is free software: you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation, either version 3 of the License, or
% (at your option) any later version.
%
% Dynare is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
% GNU General Public License for more details.
%
% You should have received a copy of the GNU General Public License
% along with Dynare. If not, see <http://www.gnu.org/licenses/>.
2014-01-29 12:35:55 +01:00
rescale_step_length = 0 ;
2013-09-20 23:15:00 +02:00
delta = epsilon ;
n = length ( x ) ;
g = zeros ( n , 1 ) ;
badg = 0 ;
2014-01-29 12:35:55 +01:00
if rescale_step_length
scale = [ ] ;
else
scale = ones ( n , 1 ) ;
end
2013-09-20 23:15:00 +02:00
for i = 1 : n
xiold = x ( i ) ;
h = step_length_correction ( xiold , scale , i ) * delta ;
x ( i ) = xiold + h ;
2018-11-13 17:58:42 +01:00
[ f1 , ~ , cost_flag1 ] = penalty_objective_function ( x , fcn , penalty , varargin { : } ) ;
2013-09-20 23:15:00 +02:00
if ~ cost_flag1
fprintf ( ' Gradient w.r.t. parameter number %3d (x=%16.8f,+h=%16.8f,f0=%16.8f,f1=%16.8f,f2=%16.8f,g0=%16.8f): penalty on the right!\n' , i , xiold , h , f0 , f1 , f2 , ( f1 - f2 ) / ( 2 * h ) )
end
x ( i ) = xiold - h ;
2018-11-13 17:58:42 +01:00
[ f2 , ~ , cost_flag2 ] = penalty_objective_function ( x , fcn , penalty , varargin { : } ) ;
2013-09-20 23:15:00 +02:00
if ~ cost_flag2
fprintf ( ' Gradient w.r.t. parameter number %3d (x=%16.8f,+h=%16.8f,f0=%16.8f,f1=%16.8f,f2=%16.8f,g0=%16.8f): penalty on the left!\n' , i , xiold , h , f0 , f1 , f2 , ( f1 - f2 ) / ( 2 * h ) )
end
if f0 < f1 && f0 < f2
fprintf ( ' Gradient w.r.t. parameter number %3d (x=%16.8f,h=%16.8f,f0=%16.8f,f1=%16.8f,f2=%16.8f,g0=%16.8f)\n' , i , xiold , h , f0 , f1 , f2 , ( f1 - f2 ) / ( 2 * h ) )
g0 = 0 ;
else
g0 = ( f1 - f2 ) / ( 2 * h ) ;
end
2014-01-22 17:35:31 +01:00
if abs ( g0 ) < 1e15
2013-09-20 23:15:00 +02:00
g ( i ) = g0 ;
else
disp ( ' Bad gradient -----------------------------------' )
fprintf ( ' Gradient w.r.t. parameter number %3d (x=%16.8f,h=%16.8f,g0=%16.8f)\n' , i , xiold , h , g0 )
g ( i ) = 0 ;
badg = 1 ;
end
x ( i ) = xiold ;
end