R的{pracma}和{numDeriv}库中的grad函数给出了错误的结果

Ye *_*ian 5 r gradient-descent

我感兴趣的是pTgh_y(q,g,h)关于q 的自定义函数的一阶数值导数.对于特殊情况,pTgh_y(q,0,0)= pnorm(q).换句话说pTgh_y(q,g,h),当g = h = 0时,降低到标准法线的CDF(见下图).

在此输入图像描述

这意味着d pTgh_y(0,0,0)/ dq应等于以下

dnorm(0)
Run Code Online (Sandbox Code Playgroud)

0.3989423

grad(pnorm,0)
Run Code Online (Sandbox Code Playgroud)

0.3989423

以下是我在{pracma}库中使用grad函数的一些尝试.

library(pracma)
# load pTgh and all relevant functions
grad(function(x){pTgh_y(x,0,0)},0)
Run Code Online (Sandbox Code Playgroud)

0

grad(function(x){pTgh_y(x,0,0)},0,heps=1e-10)
Run Code Online (Sandbox Code Playgroud)

0

以下是我在{numDeriv}库中使用grad函数的一些尝试.

library(numDeriv)
# load pTgh and all relevant functions
grad(function(x){pTgh_y(x,0,0)},0,method='simple')
Run Code Online (Sandbox Code Playgroud)

0.3274016

grad(function(x){pTgh_y(x,0,0)},0,method='Richardson')
Run Code Online (Sandbox Code Playgroud)

-0.02505431

grad(function(x){pTgh_y(x,0,0)},0,method='complex')
Run Code Online (Sandbox Code Playgroud)

pmin中的错误(x,.Machine $ double.xmax):无效的输入类型grad.default中的错误(函数(x){:函数不接受方法'complex'所需的复杂参数.

这些功能都没有给出正确的结果.

我的pTgh_y(q,g,h)功能定义如下

qTgh_y = function(p,g,h){                             
  zp = qnorm(p)
  if(g==0) q = zp                                    
  else     q = (exp(g*zp)-1)*exp(0.5*h*zp^2)/g       
  q[p==0] = -Inf
  q[p==1] = Inf
  return(q)
}

pTgh_y = function(q,g,h){                      
  if (q==-Inf) return(0)
  else if (q==Inf) return(1)
  else { 
    p = uniroot(function(t){qTgh_y(t,g,h)-q},interval=c(0,1))
    return(p$root)
  } 
}
Run Code Online (Sandbox Code Playgroud)

Han*_* W. 1

您的函数在 0 附近平坦,因此计算 0 的导数是正确的:

f = function(x){pTgh_y(x,0,0)}
h = 0.00001; f(0+h); f(0-h)
# [1] 0.5
# [1] 0.5

library(pracma)
grad(f, 0, heps=1e-02); grad(f, 0, heps=1e-03);
grad(f, 0, heps=1e-04); grad(f, 0, heps=1e-05)
# [1] 0.3989059
# [1] 0.399012
# [1] 0.4688766
# [1] 0
Run Code Online (Sandbox Code Playgroud)

您需要提高函数的准确性pTgh_y

pTgh_y = function(q,g,h){                      
    if (q==-Inf) return(0)
    else if (q==Inf) return(1)
    else { 
        p = uniroot(function(t){qTgh_y(t,g,h)-q},interval=c(0,1),
                    tol = .Machine$double.eps)
        return(p$root)
    } 
}
Run Code Online (Sandbox Code Playgroud)

现在你得到了你想要的结果:

f = function(x){pTgh_y(x,0,0)}
grad(f, 0)
[1] 0.3989423
Run Code Online (Sandbox Code Playgroud)