如何在 R 中编写一个函数来实现 "best subsets" 模型选择方法？

Question

所以我需要编写一个以 data-frame 作为输入的函数。这些列是我的解释变量（最后 column/right 大多数列除外，它是响应变量）。我正在尝试拟合线性模型并跟踪每个模型的调整后 r-square 作为用于选择最佳模型的标准。

模型将使用所有列作为解释变量（right-most 列除外，它将作为响应变量）。

该函数应该创建一个小标题，其中包含模型编号的单列（我不知道这是什么意思）、解释变量的子集以及响应变量、模型公式、拟合结果线性模型，以及其他需要的模型。

该函数应该输出：模型编号，模型中的解释变量，调整后的值r-square，以及一个图表（图表我可以自己算出来）。我有一张 table 的图像，以帮助可视化结果应该是什么样子。

我发现这段代码会得到解释变量和响应变量：

  cols <- colnames(data)
  # Get the response variable.
  y <- tail(cols, 1)
  # Get a list of the explanatory variables.
  xs <- head(cols, length(cols) - 1)

我知道我可以得到一个类似这样的模型（暂时忽略变量名）：

model <- final_data %>%
  group_by(debt) %>%
  lm(debt ~ distance, data = .) %>%
  glance()

我也知道我将不得不以某种方式将该模型映射到我尝试创建的小标题中的每一行。

我坚持的是弄清楚如何将所有这些放在一起并创建完整的功能。我希望我能提供更多细节，但我完全被困住了。我今天花了大约 10 个小时来研究这个......我向我的教授寻求帮助，他只是告诉我 post 这里。

作为参考，我做了一个非常早的尝试（根本没有用）：

best_subsets <- function(data) {
  cols <- colnames(data)
  # Get the response variable.
  y <- tail(cols, 1)
  # Get a list of the explanatory variables.
  xs <- head(cols, length(cols) - 1)

  # Create the formula as a string and then later in the lm function
  # have it turned into a real formula.
  form <- paste(y, "~", xs, sep = " ")
  data %>%
    lm(as.formula(form), data = .) %>%
    glance()
}

Answer 1

我不完全理解你的描述，但我想我理解你的目标。也许这能以某种方式提供帮助？:

library(tidyverse)
library(broom)
library(data.table)

lm_func <- function(df){
  fit1 <- lm(df[, 1] ~ df[, 2], data = df)
  fit2 <- lm(df[, 1] ~ df[, 3], data = df)
  fit3 <- lm(df[, 1] ~ df[, 2], df[, 3], data = df)
  results <- list(fit1, fit2, fit3)
  names(results) <- paste0("explanitory_variables_", 1:3)
  r_sq <- lapply(results, function(x){
    glance(x)
  })
  r_sq_df <- rbindlist(r_sq, idcol = "df_name")
  r_sq_df

}
lm_func(iris)

这为您提供了所有重要输出的 dataframe，您可以从中 select adj.r.squared。也可以实现自动化。作为旁注，select基于 R 平方的模型看起来很奇怪，过度拟合的危险？更高的 R 平方并不一定意味着更好的模型，是否也考虑研究 AIC？

让我知道这是否有帮助，或者我是否可以针对您的目标进一步完善答案。

更新：

lm_func <- function(df) {
  lst <- c()
  for (i in 2:ncol(df)) {
    ind <- i
    form_df <- df[, 1:ind]
    form <- DF2formula(form_df)
    fit <- lm(form, data = df)
    lst[[i - 1]] <- glance(fit)
  }
  lst
  names(lst) <- paste0("explanitory_variables_", 1:length(lst))
  lst <- rbindlist(lst, idcol = "df_name")
  lst
}
lm_func(iris)

这假设您的第一列是 y 并且您希望每个附加列都有一个模型。

好的，再更新一次：我认为这会尽一切可能，但可能有点矫枉过正：

library(combinat)
library(data.table)
library(tidyverse)
library(broom)

#First function takes a dataframe containing only the dependent and independent variables. Specify them by variable name or column position.
#The function then returns a list of dataframes of every possible order of independent variables (y ~ x1 + x2...) (y ~ x2 + x1...).
#So you can run your model on every possible sequence of explanatory variables
formula_func <- function(df, dependent = df["Sepal.Length"], independents = df[c("Sepal.Width", "Petal.Length", "Petal.Width", "Species")]) {
  independents_df_list <- permn(independents) #length of output should be the factorial of the number of independent variables
  df_list <- lapply(independents_df_list, function(x){ #this just pastes your independent variable as the first column of each df
    cbind(dependent, x)
  })
  df_list
}
permd_df_list <- formula_func(iris) # voila

# This function takes the output from the previous function and runs the lm building in one variable each time (y ~ x1), (y ~ x1 + x2) and so on
# So the result is many lms building in one one independent variable at a time in every possible order
# If that is as confusing to you as it is to me then check final output. You will see what model formula is used per row and in what order each explanatory variable was added
lm_func <- function(form_df_list, df) {
 mega_lst <- c()
 mega_lst <-  lapply(form_df_list, function(x) {
   lst <- vector(mode = "list", length = length(2:ncol(x)))
   for (i in 2:ncol(x)) {
      ind <- i
      form_df <- x[, 1:ind]
      form <- DF2formula(form_df)
      fit <- lm(form, data = x)
      lst[[i - 1]] <- glance(fit)
      names(lst)[[i-1]] <- deparse(form)
    }
   lst <- rbindlist(lst, idcol = "Model_formula")
   return(lst)
   })
 return(mega_lst)
}
everything_list <- lm_func(permd_df_list, iris) # VOILA!!!
#Remove duplicates and return single df
everything_list_distinct <- everything_list %>% 
  rbindlist() %>% 
  distinct()


## You can now subset and select whichever column you want from the final output

我将此作为编码练习发布，所以如果有人发现任何错误，请告诉我。只是一个警告，此代码并不代表统计上合理的方法，只是一个编码实验，因此请务必先了解统计信息！

如何在 R 中编写一个函数来实现 "best subsets" 模型选择方法？

How to write a function in R that will implement the "best subsets" approach to model selection?

r

dataframe

tibble