基于子集选择模型的R语言足球观赛人数预测问题

我通过子集选择方法构建模型，目标是预测足球赛事的观赛人数（Tilskuere字段）。训练数据包含236条无缺失值的观测值，需预测3条Tilskuere为NA的未举办比赛。我将训练数据与这3条数据合并为239条的数据集，但调用预测函数时，结果仅覆盖前236条训练样本，未包含待预测的3条数据。

问题原因 #

自定义的predict.regsubsets函数中，model.matrix()默认会自动删除包含NA的行。待预测的3条数据中Tilskuere（模型的响应变量）为NA，因此被model.matrix过滤，导致预测结果仅返回完整的236条训练样本的预测值。

解决方法 #

修改自定义的predict.regsubsets函数，在生成model.matrix时添加na.action = na.pass参数，强制保留含NA的行。由于模型预测仅依赖自变量，只要待预测样本的自变量无缺失（你的代码已通过过滤保证这一点），就可以正常计算预测值。

修改后的完整代码 #

sl_klar = read.csv("data/fulldata 1.csv")

# 移除疫情期间数据
start_dato <- as.Date("2020-03-07")
slut_dato <- as.Date("2021-04-16")
sl_klar <- sl_klar[!(sl_klar$Dato >= start_dato & sl_klar$Dato <= slut_dato), ]

# 筛选Viborg FF主场数据并移除所有含NA的行
sl_klar <- sl_klar %>%
  filter(Hjemmehold == "Viborg FF") %>%
  na.omit()

# 删除无关变量
sl_klar = sl_klar %>%
  dplyr::select(-Fugtighed, -Fugtighed.den.sidste.time, -Vindhastighed, -Nedbør.sidste.time, 
                -Dagtype, -indbyggertal, -Populær.kanal,
                -Runde, -Helligd., -Temperatur, -ID, -Dato, -Tid,- Hjemmehold, -Udehold, -Hjemmeholdsmål, 
                -Udeholdsmål, -Ugedag, -Synlighed, -X, -Form)

# 修改后的predict.regsubsets函数：添加na.action = na.pass
predict.regsubsets <- function(object, newdata, id, ...) {
  form <- as.formula(object$call[[2]])
  # 关键修改：保留含NA的行
  mat <- model.matrix(form, newdata, na.action = na.pass)
  coefi <- coef(object, id = id)
  xvars <- names(coefi)
  mat[, xvars] %*% coefi
}

set.seed(5)
train <- sample(c(TRUE, FALSE), nrow(sl_klar), replace = TRUE)
test <- (!train)

sl_train = sl_klar[train,]
sl_test = sl_klar[test,]

# 训练子集选择模型
regfit.best <- regsubsets(Tilskuere ~ .,
                          data = sl_train, nvmax = 4)

# 10折交叉验证选择最优变量数
k <- 10
n <- nrow(sl_train)
set.seed(5)
folds <- sample(rep(1:k, length = n))
cv.errors <- matrix(NA, k, 4,
                    dimnames = list(NULL, paste(1:4)))

for (j in 1:k) { 
  best.fit <- regsubsets(Tilskuere ~ .,
                         data = sl_train[folds != j, ],
                         nvmax = 4)
  for (i in 1:4) {
    pred <- predict(best.fit, sl_train[folds == j, ], id = i)
    cv.errors[j, i] <- mean((sl_train$Tilskuere[folds == j] - pred)^2)
  }
}

mean.cv.errors <- apply(cv.errors, 2, mean)
plot(mean.cv.errors, type = "b")
best_nvar <- which.min(mean.cv.errors)

# 用最优变量数重新训练模型
reg.best <- regsubsets(Tilskuere ~ ., data = sl_train,
                       nvmax = best_nvar)
coef(reg.best, best_nvar)

# 测试集验证
pred_best_subset <- predict(reg.best, sl_test, id = best_nvar)
mse_best_subset <- mean((sl_klar[test,]$Tilskuere - pred_best_subset)^2)

# 准备待预测数据
pred.data = read.csv("data/fulldata 1.csv")

# 移除疫情期间数据
start_dato <- as.Date("2020-03-07")
slut_dato <- as.Date("2021-04-16")
pred.data <- pred.data[!(pred.data$Dato >= start_dato & pred.data$Dato <= slut_dato), ]

# 筛选Viborg FF主场数据，保留最后3条含NA的待预测样本
pred.data = pred.data %>%
  filter(Hjemmehold == "Viborg FF") %>%
  filter(
    !is.na(Tilskuere) | row_number() %in% (n() - 2):n(),
    across(everything(), ~!is.na(.) | row_number() %in% (n() - 2):n())
  )

# 删除无关变量，确保与训练数据结构一致
pred.data <- pred.data %>%
  dplyr::select(-Fugtighed, -Fugtighed.den.sidste.time, -Vindhastighed, -Nedbør.sidste.time, 
                -Dagtype, -indbyggertal, -Populær.kanal,
                -Runde, -Helligd., -Temperatur, -ID, -Dato, -Tid,- Hjemmehold, -Udehold, -Hjemmeholdsmål, 
                -Udeholdsmål, -Ugedag, -Synlighed, -X, -Form)

# 执行预测
predict_attendance <- predict(reg.best, pred.data, id = best_nvar)

# 查看完整预测结果中的最后3条待预测数据
tail(predict_attendance, 3)

结果验证 #

修改后运行predict_attendance会得到239条预测值，其中最后3条就是那3场待预测比赛的观赛人数，可通过tail(predict_attendance, 3)直接查看。

内容的提问来源于stack exchange，提问作者Phung Minh Le