在 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

有一篇很好的文章（关于非线性回归中的离群值检测），其中帽子矩阵是通过在估计点计算的梯度矩阵来近似的。

在你的情况下：

# 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)

如果您遵循这篇文章，您可以计算得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)
}