R 浮点与零比较

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

在编程方面，这通常如下所示（这是来自evd:qgev的一个片段，与lmomco:：quagev中的类似）：

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

如果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  

查看

all.equal

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

当然，这种接近零的奇怪行为通常不是问题，但在我的例子中，我使用优化/根查找来确定已知分位数的参数，因此我担心我的代码需要健壮

---

问题：使用

all.equal（target，0）

是否是处理此问题的适当方法？为什么不经常使用这种方法？

某些函数在以浮点表示的明显方式实现时，在某些点上表现不好。当函数必须在一个点上手动定义时，这种情况尤其可能发生：当事情在某一点上完全未定义时，当它们接近时，很可能会死命地等待

在这种情况下，这是来自卡帕分母与卡帕负指数的对抗。哪一方赢得这场战斗取决于一点一点的基础，每一方有时都会赢得“四舍五入到一个更强大的规模”的比赛

---

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

根据斯奈夫特尔的建议，我计算k=-1e-7和k=1e-7处的分位数，并在k参数介于这些限制之间时进行插值。这似乎奏效了

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

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

函数Qgev是有问题的版本（图上的黑线），而Qgev_interp插值接近零（图上的绿线）

---

Qgev自学成才。阅读有关数值精度的R-FAQ（Mac上的链接：），搜索等以测试精确相等，还可以阅读
？all.equal
以及该页面上的所有示例和链接。链接到关于数值精度的R-FAQ有一篇有趣的文章
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')

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

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)