測試數據的 R 平方

Question

我在 75% 的數據集上擬合了線性回歸模型，其中包括 ~11000 個觀察值和 143 個變量：

gl.fit <- lm(y[1:ceiling(length(y)*(3/4))] ~ ., data= x[1:ceiling(length(y)*(3/4)),]) #3/4 for training

我得到了 0.43 的 R^2。 然后我嘗試使用其余數據預測我的測試數據：

ytest=y[(ceiling(length(y)*(3/4))+1):length(y)]
x.test <- cbind(1,x[(ceiling(length(y)*(3/4))+1):length(y),]) #The rest for test
yhat <- as.matrix(x.test)%*%gl.fit$coefficients  #Calculate the predicted values

我現在想計算我的測試數據的 R^2 值。 有什么簡單的計算方法嗎？

謝謝

Answer 1

這里有幾個問題。 首先，這不是使用lm(...)的好方法。 lm(...)旨在與數據框一起使用，公式表達式引用 df 中的列。 因此，假設您的數據位於兩個向量x和y ，

set.seed(1)    # for reproducible example
x <- 1:11000
y <- 3+0.1*x + rnorm(11000,sd=1000)

df <- data.frame(x,y)
# training set
train <- sample(1:nrow(df),0.75*nrow(df))   # random sample of 75% of data

fit <- lm(y~x,data=df[train,])

現在fit有了基於訓練集的模型。 以這種方式使用lm(...)可以讓您，例如，無需所有矩陣乘法即可生成預測。

第二個問題是R平方的定義。 傳統的定義是：

1 - SS.residuals/SS.total

對於訓練集和訓練集 ONLY ，

SS.total = SS.regression + SS.residual

所以

SS.regression = SS.total - SS.residual,

因此

R.sq = SS.regression/SS.total

所以 R.sq 是模型解釋的數據集中可變性的分數，並且總是介於 0 和 1 之間。

你可以在下面看到這一點。

SS.total      <- with(df[train,],sum((y-mean(y))^2))
SS.residual   <- sum(residuals(fit)^2)
SS.regression <- sum((fitted(fit)-mean(df[train,]$y))^2)
SS.total - (SS.regression+SS.residual)
# [1] 1.907349e-06
SS.regression/SS.total     # fraction of variation explained by the model
# [1] 0.08965502
1-SS.residual/SS.total     # same thing, for model frame ONLY!!! 
# [1] 0.08965502          
summary(fit)$r.squared     # both are = R.squared
# [1] 0.08965502

但這不適用於測試集（例如，當您從模型進行預測時）。

test <- -train
test.pred <- predict(fit,newdata=df[test,])
test.y    <- df[test,]$y

SS.total      <- sum((test.y - mean(test.y))^2)
SS.residual   <- sum((test.y - test.pred)^2)
SS.regression <- sum((test.pred - mean(test.y))^2)
SS.total - (SS.regression+SS.residual)
# [1] 8958890

# NOT the fraction of variability explained by the model
test.rsq <- 1 - SS.residual/SS.total  
test.rsq
# [1] 0.0924713

# fraction of variability explained by the model
SS.regression/SS.total 
# [1] 0.08956405

在這個人為的例子中，沒有太大區別，但很可能有一個 R-sq。 值小於 0（以這種方式定義時）。

例如，如果模型對測試集的預測效果非常差，那么殘差實際上可能大於測試集的總變異。 這相當於說測試集使用它的均值比使用從訓練集派生的模型更好地建模。

我注意到您使用數據的前四分之三作為訓練集，而不是隨機抽取樣本（如本例所示）。 如果y對x的依賴是非線性的，並且x是有序的，那么您可以使用測試集獲得負的 R-sq。

關於下面 OP 的評論，使用測試集評估模型的一種方法是比較模型內和模型外均方誤差 (MSE)。

mse.train <- summary(fit)$sigma^2
mse.test  <- sum((test.pred - test.y)^2)/(nrow(df)-length(train)-2)

如果我們假設訓練集和測試集都是具有相同方差的正態分布並且具有遵循相同模型公式的均值，那么該比率應該具有具有 (n.train-2) 和 (n.test- 2) 自由度。 如果基於 F 檢驗的 MSE 有顯着差異，則模型不能很好地擬合測試數據。

您是否繪制了 test.y 和 pred.y 與 x 的關系圖？ 僅此一項就會告訴你很多。

Answer 2

在測試數據上計算 R 平方有點棘手，因為您必須記住基線是什么。 您的基線預測是訓練數據的平均值。

因此，擴展上面@jlhoward 提供的示例：

SS.test.total      <- sum((test.y - mean(df[train,]$y))^2)
SS.test.residual   <- sum((test.y - test.pred)^2)
SS.test.regression <- sum((test.pred - mean(df[train,]$y))^2)
SS.test.total - (SS.test.regression+SS.test.residual)
# [1] 11617720 not 8958890

test.rsq <- 1 - SS.test.residual/SS.test.total  
test.rsq
# [1] 0.09284556 not 0.0924713

# fraction of variability explained by the model
SS.test.regression/SS.test.total 
# [1] 0.08907705 not 0.08956405

更新： miscTools::rSquared()函數假設 R-squared 是在相同的數據集上計算的，在該數據集上訓練模型，因為它計算

yy <- y - mean(y)

此處第 184 行的幕后花絮： https : //github.com/cran/miscTools/blob/master/R/utils.R

Answer 3

如果你想要一個函數， miscTools包有一個rSquared函數。

require(miscTools)
r2 <- rSquared(ytest, resid = ytest-yhat)

Answer 4

當您在（外）樣本上使用 R2 度量時，您會失去對 R2 解釋的某些方面：

• 等效 SSR 總數 = SSR 解釋 + SSR 誤差
• R2 等於 y 和預測 y 之間相關性的平方這一事實
• R2 在 [0,1] 中的事實

如果你想使用 R，我會推薦函數modelr::rsquare 。 請注意，這使用來自測試樣本的 SSR 總數，而不是訓練樣本（有些人似乎提倡）。

這里我舉一個例子，我們的訓練數據只有 3 個點，因此我們有一個不好的模型的風險很高，因此樣本外性能很差，事實上，你可以看到 R2 是負的！

library(modelr)

train <- mtcars[c(1,3,4),]
test  <- mtcars[-c(1,3,4),]

mod <- lm(carb ~ drat, data = train)

計算列車數據：

## train
y_train <- train$carb
SSR_y_train <- sum((y_train-mean(y_train))^2)

cor(fitted(mod), y_train)^2
#> [1] 0.2985092
rsquare(mod, train)
#> [1] 0.2985092
1-sum(residuals(mod)^2)/SSR_y_train
#> [1] 0.2985092

計算測試數據：

## test
pred_test <- predict(mod, newdata = test)
y_test <- test$carb
SSR_y_test <- sum((y_test-mean(y_test))^2)

cor(pred_test, y_test)^2
#> [1] 0.01737236
rsquare(mod, test)
#> [1] -0.6769549

1- 28* var(pred_test-y_test)/SSR_y_train
#> [1] -19.31621
1- 28* var(pred_test-y_test)/SSR_y_test
#> [1] -0.6769549