R：数值积分对于平滑函数返回错误结果，但不会完全失败

Question

使用内置的integrate函数在 R 中集成成千上万个性能良好的函数时，我遇到了非常不可能但非常危险的数值错误。

故事（可以跳过）。我的问题与最大似然有关，它基于一个高度非线性的函数（具有10-20个参数），而该函数不存在解析表达式，因此，一次评估需要计算数千个积分。我制作了包含此错误的MWE。为了优化此函数，由于存在多个局部最优解，我尝试1000个点进行1000次迭代（使用无导数方法，例如来自hydroPSO的粒子群和来自DEoptim的差分演化），因此一个模型，我必须计算十亿以上的积分（！），并且有200个候选模型，每个模型都需要稍后的热启动重新估计，因此积分的总数已超过一万亿。我想找到能够提供足够准确性的最快解决方案。

该函数是两个密度函数（伽马或类似函数）乘以某个正表达式的乘积，并且根据公式f_{X+Y}(z) = int_{supp Y} f_{X+Y}(z-y, y) dy计算接头密度。我无法使用卷积，因为在一般情况下X和Y不是独立的。在我的情况下，对Y的支持是(-Inf, 0]。分布的比例参数非常小（模型类似于GARCH），因此，标准积分例程经常无法在负线的很小一部分上积分非零函数（例如{{ 1}}需要巨大的值，而[-0.02, -0.01]则需要尝试计算正交的其他任何地方），R的0通常会返回机器epsilon，因为在该范围内找不到点该函数取的值远大于零。为了解决这个问题，我通过比例参数的倒数将函数扩展到零附近，计算积分，然后将其除以比例i。 e。 integrate。但是，有时，这种重新缩放也失败了，因此我实施了安全检查，以查看缩放函数的值是否可疑地低（即integrate(f(x/scale)/scale$value)），然后重新计算积分。重新缩放的函数就像一个咒语一样工作，在未缩放的函数失败时返回漂亮的值，在极少数情况下，重新缩放的函数返回一台机器epsilon，未缩放的函数起作用。

直到今天，重新缩放的函数的集成突然产生1.5而不是3.5的值。当然，该函数通过了安全检查（因为这是一个合理的值，不是机器epsilon，还有一些其他值均小于此值，因此处于通用范围内）。事实证明，<1e-8大约在所有情况的0.1％中都低估了该功能。 MWE在下面。

首先，我们定义integrate的功能和定义缩放比例的可选参数x。

numstab

接下来，我们将其绘制以确保缩放比例正确工作。

cons <- -0.020374721416129591
sc <- 0.00271245601724757383
sh <- 5.704
f <- function(x, numstab = 1) dgamma(cons - x * numstab, shape = sh, scale = sc) * dgamma(-x * numstab, shape = sh, scale = sc) * numstab

然后我们通过求和检查该积分：

curve(f, -0.06, 0, n = 501, main = "Unscaled f", bty = "n")
curve(f(x, sc), -0.06 / sc, 0, n = 501, main = "Scaled f", bty = "n")

它仅在两个细分处停止！现在，为了查看集成过程中发生的情况，我们创建了一个全局对象，并在每次集成例程执行某些操作时对其进行更新。

sum(f(seq(-0.08, 0, 1e-6))) * 1e-6 # True value, 3.575294
sum(f(seq(-30, 0, 1e-4), numstab = sc)) * 1e-4 # True value, 3.575294
str(integrate(f, -Inf, 0)) # Gives 3.575294
# $ value       : num 3.58
# $ abs.error   : num 1.71e-06
# $ subdivisions: int 10
str(integrate(f, -Inf, 0, numstab = sc))
# $ value       : num 1.5 # WTF?!
# $ abs.error   : num 0.000145 # WTF?!
# $ subdivisions: int 2

现在，我们将可视化此集成过程。

global.eval.f <- list()
f.trace <- function(x, numstab = 1) {
  this.f <- f(x, numstab)
  global.eval.f[[length(global.eval.f) + 1]] <<- list(x = x, f = this.f)
  return(this.f)
}
integrate(f.trace, -Inf, 0)

是同一件事，只是规模不同。

library(animation)
l <- length(global.eval.f)
mycols <- rainbow(l, end = 0.72, v = 0.8)
saveGIF({
  for (i in 1:l) {
    par(mar = c(4, 4, 2, 0.3))
    plot(xgrid <- seq(-0.1, -0.01, length.out = 301), f(xgrid), type = "l", bty = "n", xlab = "x", ylab = "f(x)", main = "Function without stabilisation")
    for (j in 1:(l2 <- length(this.x <- global.eval.f[[i]]$x))) lines(rep(this.x[j], 2), c(0, global.eval.f[[i]]$f[j]), col = mycols[i], type = "b", pch = 16, cex = 0.6)
    legend("topleft", paste0("Quadrature: ", i), bty = "n")
    text(rep(-0.1, l2), seq(325, 25, length.out = l2), labels = formatC(sort(this.x), format = "e", digits = 2), adj = 0, col = ifelse(sort(this.x) > -0.1 & sort(this.x) < -0.01, mycols[i], "black"), cex = 0.9)
  }
}, movie.name = "stab-off-quad.gif", interval = 1 / 3, ani.width = 400, ani.height = 300)

问题是，我无法为此功能尝试各种稳定乘数，因为我必须计算该整数一万亿次，因此即使在超级计算机集群中，也要花费数周的时间。除此之外，将global.eval.f <- list() integrate(f.trace, -Inf, 0, numstab = sc) l <- length(global.eval.f) mycols <- rainbow(l, end = 0.7, v = 0.8) saveGIF({ for (i in 1:l) { par(mar = c(4, 4, 2, 0.3)) plot(xgrid <- seq(-0.1 / sc, -0.01 / sc, length.out = 301), f(xgrid, sc), type = "l", bty = "n", xlab = "x", ylab = "f(x)", main = "Function with stabilisation") for (j in 1:(l2 <- length(this.x <- global.eval.f[[i]]$x))) lines(rep(this.x[j], 2), c(0, global.eval.f[[i]]$f[j]), col = mycols[i], type = "b", pch = 16, cex = 0.6) legend("topleft", paste0("Quadrature: ", i), bty = "n") text(rep(-0.1 / sc, l2), seq(325 * sc, 25 * sc, length.out = l2), labels = formatC(sort(this.x), format = "e", digits = 2), adj = 0, col = ifelse(sort(this.x) > -0.1 / sc & sort(this.x) < -0.01 / sc, mycols[i], "black"), cex = 0.9) } }, movie.name = "stab-on-quad.gif", interval = 1 / 3, ani.width = 400, ani.height = 300) 减少到rel.tol有所帮助，但是我不确定这是否可以保证成功（在某些情况下将其减少到1e-5会降低计算速度）。而且我已经看过正交的Fortran代码，只是看到了集成规则。

时间可以在下面看到（我添加了一个具有较低容差的额外尝试）。

如何确保集成例程不会针对此类功能产生如此错误的结果，并且集成仍将是快速的？