Question

我正在编写一个函数来计算GEV分布的分位数。该问题的相关方面是当其中一个参数（形状参数或kappa）为零时，需要使用不同形式的函数

以编程方式，这通常解决如下（这是evd：qgev的片段，在lmomco :: quagev中类似）：

（编辑：lmomco版本2.2.2解决了此问题中确定的问题）

if (shape == 0) 
        return(loc - scale * log(-log(p)))
    else return(loc + scale * ((-log(p))^(-shape) - 1)/shape)

如果shape / kappa完全等于零但是零附近有奇怪的行为，这样可以正常工作。

让我们看一个例子：

Qgev_zero <- function(shape){
  # p is an exceedance probability
  p= 0.01
  location=0
  scale=1

  if(shape == 0) return( location - scale*(log(-log(1-p) )))

  location + (scale/shape)*((-log(1-p))^-shape - 1)

}

Qgev_zero(0)
#[1] 4.600149

Qgev_zero(1e-8)
#[1] 4.600149

这看起来很好，因为在零附近和零处返回相同的答案。但看看接近零的情况。

k.seq <- seq(from =  -4e-16, to =  4e-16, length.out = 1000)
plot(k.seq, sapply(k.seq, Qgev_zero), type = 'l')

函数返回的值通常是不正确的。

如果我用all.equal替换与零的直接比较，例如

，这些问题就会消失

if(isTRUE(all.equal(shape, 0))) return( location - scale*(log(-log(1-p) )))

查看all.equal的帮助表明，对于默认值，任何小于1.5e-8的值都将被视为零。

当然，零附近的奇怪行为可能通常不是问题，但在我的情况下，我正在使用优化/根查找来确定已知分位数的参数，所以我担心我的代码需要健壮。

问题：是否正在使用all.equal(target, 0)一种适当的方法来处理这个问题？为什么这种方法不经常使用？

Answer 1

某些函数在使用浮点表示的明显方式实现时，在某些点上表现不佳。当函数必须在一个点上手动定义时，情况尤其如此：当某些事情在某个时刻完全未定义时，他们可能会为了亲爱的生活而徘徊当他们接近时。

在这种情况下，来自kappa分母与kappa负指数对抗。哪一个赢得了战斗是逐点确定的，每个人有时会赢得“更强的”＃34;比赛。

有各种方法来解决这些问题，所有问题都是根据具体情况设计的。一个经常有缺陷但易于实现的方法是在问题点附近切换到表现更好的表示（例如，关于kappa的泰勒展开）。这将在边界引入不连续性;如有必要，您可以尝试在两者之间进行插值。

Answer 2

按照Sneftel的建议，我在k = -1e-7和k = 1e-7处计算分位数，并在k参数落在这些限制之间进行插值。这似乎有效。

在这段代码中，我使用了来自lmomco :: quagev的gev分位数函数的参数化

（编辑：lmomco版本2.2.2已解决了此问题中确定的问题）

功能Qgev是有问题的版本（绘图上的黑线），而Qgev_interp，插值接近零（绘图上的绿线）。

Qgev <- function(K, f, XI, A){ 

# K = shape
# f = probability
# XI = location
# A = scale

  Y <- -log(-log(f))
  Y <- (1-exp(-K*Y))/K
  x <- XI + A*Y
  return(x)
}

Qgev_interp <- function(K, f, XI, A){

  .F <- function(K, f, XI, A){
    Y <- -log(-log(f))
    Y <- (1-exp(-K*Y))/K
    x <- XI + A*Y
    return(x)
  }


  k1 <- -1e-7
  k2 <- 1e-7
  y1 <- .F(k1, f, XI, A)
  y2 <- .F(k2, f, XI, A)

  F_nearZero <- approxfun(c(k1, k2), c(y1, y2))

  if(K > k1 & K < k2) {
    return(F_nearZero(K))
  } else {
    return(.F(K, f, XI, A))
  }
}



k.seq <- seq(from =  -1.1e-7, to =  1.1e-7, length.out = 1000)
plot(k.seq, sapply(k.seq, Qgev, f = 0.01, XI = 0, A = 1), col=1, lwd = 1, type = 'l')
lines(k.seq, sapply(k.seq, Qgev_interp, f = 0.01, XI = 0, A = 1), col=3, lwd = 2)

浮点比较为零

2 个答案: