快速调整的 r 平方提取

Fast adjusted r-squared extraction

.lm.fit 由于在多个地方记录的原因比 lm 快得多,但是获得调整后的 r 平方值并不那么直接,所以我希望得到一些帮助。

使用 lm() 然后使用 summary() 得到调整后的 r 平方。

tstlm <- lm(cyl ~ hp + wt, data = mtcars)

summary(tstlm)$adj.r.squared

使用.lm.fit

mtmatrix <- as.matrix(mtcars)

tstlmf <- .lm.fit(cbind(1,mtmatrix [,c("hp","wt")]), mtmatrix [,"cyl"])

我卡在这里了。我怀疑我需要计算调整后的 r 平方的信息在某个地方的 .lm.fit 模型中找到,但我不太清楚如何继续。

提前感谢您的任何建议。

以下函数根据 .lm.fit 返回的对象和响应向量 y.

计算调整后的 R2
adj_r2_lmfit <- function(object, y){
  ypred <- y - resid(object)
  mss <- sum((ypred - mean(ypred))^2)
  rss <- sum(resid(object)^2)
  rdf <- length(resid(object)) - object$rank
  r.squared <- mss/(mss + rss)
  adj.r.squared <- 1 - (1 - r.squared)*(NROW(y) - 1)/rdf
  adj.r.squared
}

tstlm <- lm(cyl ~ hp + wt, data = mtcars)
tstlmf <- .lm.fit(cbind(1,mtmatrix [,c("hp","wt")]), mtmatrix [,"cyl"])

summary(tstlm)$adj.r.squared
#[1] 0.7753073
adj_r2_lmfit(tstlmf, mtmatrix [,"cyl"])
#[1] 0.7753073

1) R 平方等于因变量和拟合值之间的 squared correlation。我们可以使用 resid(tstslmf) 从 tstlmf 获得残差,拟合值等于 y 减去这些残差。

Adjusted R squared 是将 R 的平方乘以仅使用 X 的行数和列数的表达式。

请注意,如果没有截距,公式会发生变化。

X <- with(mtcars, cbind(1, hp, wt))
y <- mtcars$cyl

testlmf <- .lm.fit(X, y)

rsq <- cor(y, y - resid(tstlmf))^2; rsq
## [1] 0.7898

adj <- 1 - (1-rsq) * (nrow(X) - 1) / -diff(dim(X)); adj
## [1] 0.7753


# check
tstlm <- lm(cyl ~ hp + wt, mtcars)
s <- summary(tstlm)
s$r.squared
## [1] 0.7898
s$adj.r.squared
## [1] 0.7753

2) R 平方也可以计算为比率 var(fitted) / var(y),如上面的 link 那样,在这种情况下我们写:

testlmf <- .lm.fit(X, y)

rsq <- var(y - resid(tstlmf)) / var(y); rsq
## [1] 0.7898

adj <- 1 - (1-rsq) * (nrow(X) - 1) / -diff(dim(X)); adj
## [1] 0.7753

崩溃

崩溃包中的flm可能比.lm.fit稍快。它 returns 只有系数。

library(collapse)

tstflm <- flm(y, X)
rsq <- c(cor(y, X %*% tstflm)^2); rsq
## [1] 0.7898
adj <- 1 - (1-rsq) * (nrow(X) - 1) / -diff(dim(X)); adj
## [1] 0.7753

tstflm <- flm(y, X)

rsq <- var(X %*% tstflm) / var(y); rsq
## [1] 0.7898
adj <- 1 - (1-rsq) * (nrow(X) - 1) / -diff(dim(X)); adj
## [1] 0.7753