r - 在 R 中，如何从 `nls` 模型对象中提取帽子/投影/影响矩阵或值？

Question

对于 lm 或 glm 类型的对象，甚至 lmer 类型的对象，您可以使用 R 从模型中提取帽子值函数hatvalues()。但是，显然这不适用于 nls 对象。我用谷歌搜索了各种方法，但找不到获取这些值的方法。 nls 是否根本不创建帽子矩阵，或者非线性最小二乘模型生成的帽子值是否不可靠？

可重现的示例:

xs = rep(1:10, times = 10)
ys = 3 + 2*exp(-0.5*xs)
for (i in 1:100) {
xs[i] = rnorm(1, xs[i], 2)
}
df1 = data.frame(xs, ys)
nls1 = nls(ys ~ a + b*exp(d*xs), data=df1, start=c(a=3, b=2, d=-0.5))

Answer 1

有一个不错的article (关于非线性异常值检测回归)，其中帽子矩阵由计算的梯度矩阵近似在估计点。

就您而言:

# gradient of the model function at the current parameter values
V <- nls1$m$gradient()

# tangent plane leverage matrix (it plays a similar role as the Hat matrix)
H <- V %*% solve(t(V) %*% V) %*% t(V)

# 'hat' values for nls
nls1.hat_values <- diag(H)

如果您遵循此article您可以更快地计算 H:

Q1 <- qr.Q(qr(V)) # V is the same matrix as above
H <- Q1 %*% t(Q1)

由于 H 可能非常大，如果您只想要帽子值，则可以完全跳过矩阵乘法。我们只需要 H 矩阵的对角线。

###
#' Approximation of hat values for nls.
#'
#' @param model An 'nls' object
#' @param ... Additional parameters (ignored)
#' @return Vector of approximated hat values
###
hatvalues.nls <- function(model, ...) {
  stopifnot(is(model, 'nls'))
  list(...) # ignore additional parameters
  V <- model$m$gradient()
  Q1 <- qr.Q(qr(V))
  rowSums(Q1*Q1)
}