Question

我在R中有一个线性模型。

set.seed(1234)
x <- rnorm(100)
z <- rnorm(100)
y <- rnorm(100, x+z)
mydata <- data.frame(x,y,z)

fit <- lm(y ~ x + z, mydata)

我想获得样本r-square的估计值。我正在考虑使用某种形式的k-fold交叉验证。

R中的哪些代码采用线性模型拟合并返回交叉验证的r-square？
或者是否有其他方法可以使用R？

Answer 1

接下来是对the example that @NPR linked to from statsmethods的轻微改编。基本上我修改了这个例子，使其成为一个功能。

library(bootstrap)

k_fold_rsq <- function(lmfit, ngroup=10) {
    # assumes library(bootstrap)
    # adapted from http://www.statmethods.net/stats/regression.html
    mydata <- lmfit$model
    outcome <- names(lmfit$model)[1]
    predictors <- names(lmfit$model)[-1]

    theta.fit <- function(x,y){lsfit(x,y)}
    theta.predict <- function(fit,x){cbind(1,x)%*%fit$coef} 
    X <- as.matrix(mydata[predictors])
    y <- as.matrix(mydata[outcome]) 

    results <- crossval(X,y,theta.fit,theta.predict,ngroup=ngroup)
    raw_rsq <- cor(y, lmfit$fitted.values)**2 # raw R2 
    cv_rsq <- cor(y,results$cv.fit)**2 # cross-validated R2

    c(raw_rsq=raw_rsq, cv_rsq=cv_rsq)
}

所以使用之前的数据

# sample data
set.seed(1234)
x <- rnorm(100)
z <- rnorm(100)
y <- rnorm(100, x+z)
mydata <- data.frame(x,y,z)

我们可以拟合线性模型并调用交叉验证函数：

# fit and call function
lmfit <- lm(y ~ x + z, mydata)
k_fold_rsq(lmfit, ngroup=30)

得到最终的原始和交叉验证的r-square：

  raw_rsq    cv_rsq 
0.7237907 0.7050297

警告：虽然raw_rsq显然是正确的，cv_rsq在我所期望的球场，但请注意我还没有确切地检查{{1}功能呢。因此，使用风险自负，如果有人有任何反馈，那将是非常受欢迎的。它也仅适用于具有截距和标准主效符号的线性模型。

Answer 2

我为此做了一个函数。它也适用于名义预测器。它只适用于lm个对象（我认为），但很容易扩展到glm等。

# from
# http://stackoverflow.com/a/16030020/3980197
# via http://www.statmethods.net/stats/regression.html

#' Calculate k fold cross validated r2
#'
#' Using k fold cross-validation, estimate the true r2 in a new sample. This is better than using adjusted r2 values.
#' @param lmfit (an lm fit) An lm fit object.
#' @param folds (whole number scalar) The number of folds to use (default 10).
#' @export
#' @examples
#' fit = lm("Petal.Length ~ Sepal.Length", data = iris)
#' MOD_k_fold_r2(fit)
MOD_k_fold_r2 = function(lmfit, folds = 10, runs = 100, seed = 1) {
  library(magrittr)

  #get data
  data = lmfit$model

  #seed
  if (!is.na(seed)) set.seed(seed)

  v_runs = sapply(1:runs, FUN = function(run) {
    #Randomly shuffle the data
    data2 = data[sample(nrow(data)), ]

    #Create n equally size folds
    folds_idx <- cut(seq(1, nrow(data2)), breaks = folds, labels = FALSE)

    #Perform n fold cross validation
    sapply(1:folds, function(i) {
      #Segement your data by fold using the which() function

      test_idx = which(folds_idx==i, arr.ind=TRUE)
      test_data = data2[test_idx, ]
      train_data = data2[-test_idx, ]

      #weights
      if ("(weights)" %in% data) {
        wtds = train_data[["(weights)"]]
      } else {
        train_data$.weights = rep(1, nrow(train_data))
      }

      #fit
      fit = lm(formula = lmfit$call$formula, data = train_data, weights = .weights)

      #predict
      preds = predict(fit, newdata = test_data)

      #correlate to get r2
      cor(preds, test_data[[1]], use = "p")^2
    }) %>%
      mean()
  })

  #return
  c("raw_r2" = summary(lmfit)$r.squared, "cv_r2" = mean(v_runs))
}

测试它：

fit = lm("Petal.Length ~ Species", data = iris)
MOD_k_fold_r2(fit)
#>    raw_r2     cv_r2 
#> 0.9413717 0.9398156

关于OP样本：

> MOD_k_fold_r2(lmfit)
#raw_r2  cv_r2 
# 0.724  0.718

Answer 3

关于stats.stackexchange（例如link 1和link 2）的讨论认为应该使用均方误差（MSE）而不是R^2。

一次性交叉验证（k-folds cv的特殊情况，其中k = N）具有允许使用简单公式快速计算线性模型的CV MSE的属性。见“R中统计学习导论”第5.1.2节。以下代码应计算lm模型的RMSE值（使用同一部分的公式5.2）：

sqrt(sum((residuals(fit)/(1-hatvalues(fit)))^2)/length(fit$residuals))

您可以将其与“常规”RMSE进行比较：

summary(fit)$sigma

我认为

或RMSE从5倍或10倍交叉验证中获得。

如何从R中的线性模型中获得交叉验证的r-square？

3 个答案: