快速調整的 r 平方提取

Question

.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 model 某處找到，但我不太清楚如何繼續。

在此先感謝您的任何建議。

Answer 1

1) R 平方等於因變量和擬合值之間相關性的平方。 我們可以使用 resid(tstslmf) 從 tstlmf 獲得殘差，並且擬合值等於 y 減去這些殘差。

調整后的 R 平方是通過將 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) 計算，在這種情況下我們寫：

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在崩潰package可能比.lm.fit稍微快一點。 它只返回系數。

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

Answer 2

以下 function 根據 .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