如何用.lm.fit預測和提取R平方？

Question

正如標題所暗示的那樣，我看到一些用戶提到.lm.fit()函數具有比常規lm()更快的速度優勢，但是當我深入了解.lm.fit()的幫助時，它應該是作為一個更合適的函數，它返回一組列表而不是model ，這讓我認為是否仍然可以提取 R 平方、Adj R 平方等組件，最后從中進行predict() ？

以下是示例數據和執行：

test_dat <- data.frame(y = rnorm(780, 20, 10))
for(b in 1:300){
  name_var <- paste0("x",b)
  test_dat[[name_var]] <- rnorm(780, 0.01 * b, 5)
}

tic()
obj_lm <- lm(y ~ ., data = test_dat)
print(class(obj_lm))
print(summary(obj_lm)$r.squared)
print(summary(obj_lm)$adj.r.squared)
predict(obj_lm)
toc() #approximately 0.4 seconds

tic()
datm <- as.matrix(test_dat)
obj_lm_fit <- .lm.fit(cbind(1,datm[,-1]), datm[,1])
print(class(obj_lm_fit))
toc() #approximately 0.2 seconds

Answer 1

函數predict和resid是通用的，因為.lm.fit返回 object of class "list" ，你所要做的就是編寫實現你想要的定義的方法。 以下是計算擬合值、殘差和 R^2 的方法。

set.seed(2023)    # make the results reproducible
test_dat <- data.frame(y = rnorm(780, 20, 10))
for(b in 1:300){
  name_var <- paste0("x",b)
  test_dat[[name_var]] <- rnorm(780, 0.01 * b, 5)
}

obj_lm <- lm(y ~ ., data = test_dat)

datm <- as.matrix(test_dat)
obj_lm_fit <- .lm.fit(cbind(1,datm[,-1]), datm[,1])

#------------------------------------------------------------------------
# the methods for objects of class "list"
#
fitted.list <- function(object, X) {
  X %*% coef(object)
}
resid.list <- residuals.list <- function(object, X, y) {
  y_fitted <- fitted(object, X)
  y - y_fitted
}
rsquared <- function(x, ...) UseMethod("rsquared")
rsquared.default <- function(x, ...) {
  summary(x)$r.squared
}
rsquared.list <- function(object, X, y) {
  e <- resid.list(object, X, y)
  1 - sum(e^2)/sum( (y - mean(y))^2 )
}

rsquared(obj_lm_fit, cbind(1,datm[,-1]), datm[,1])
#> [1] 0.3948863
rsquared(obj_lm)
#> [1] 0.3948863

^{創建於 2023-01-03，使用reprex v2.0.2}

---

編輯 1

添加了計算 adj.R2 的方法

adj_rsquared_list <- function(object, X, y){
  r2 <- rsquared.list(object, X, y)
  k <- ncol(X) - 1
  n <- nrow(X)  
  rate_of_error <- (1 - r2) * (n - 1) / (n - k - 1)
  adj_r2 <- 1 - rate_of_error
  return(adj_r2)
}

adj_rsquared_list(obj_lm_fit, cbind(1,datm[,-1]), datm[,1])
#> [1] 0.01590061

---

編輯 2

在Jovan編輯之后，我將上面的fitted.list更改為使用coef() ，一個 function 提取第一個 arguments 列表成員"coefficients" （如果存在），並重寫rsquared的默認和列表方法以接受adj參數. 計算調整后的 R^2 的代碼是 Jovan 代碼的復制和粘貼。

rsquared <- function(x, ...) UseMethod("rsquared")
rsquared.default <- function(x, adj = FALSE, ...) {
  if(adj) {
    summary(x)$adj.r.squared
  } else summary(x)$r.squared
}
rsquared.list <- function(object, X, y, adj = FALSE) {
  e <- resid.list(object, X, y)
  r2 <- 1 - sum(e^2)/sum( (y - mean(y))^2 )
  if(adj) {
    k <- ncol(X) - 1
    n <- nrow(X)  
    rate_of_error <- (1 - r2) * (n - 1) / (n - k - 1)
    adj_r2 <- 1 - rate_of_error
    adj_r2
  } else r2
}

# same as above
rsquared(obj_lm_fit, cbind(1,datm[,-1]), datm[,1])
#> [1] 0.3948863
rsquared(obj_lm)
#> [1] 0.3948863

# new, `adj = TRUE`
rsquared(obj_lm_fit, cbind(1,datm[,-1]), datm[,1], adj = TRUE)
#> [1] 0.01590061
rsquared(obj_lm, adj = TRUE)
#> [1] 0.01590061

^{創建於 2023-01-03，使用reprex v2.0.2}