R 自动从回归中排除单级因子变量

像这样的事情应该会奏效:

# For pipe operator
library(magrittr)

# Define function for updating the model
update_formula <- function(data, dep_var, model) {
  # Extract model variables
  model_vars <- stringr::str_split_1(model, '\\+|\\*|:') %>% 
    stringr::str_trim()
  
  model_terms <- stringr::str_split_1(model, '\\+') %>% 
    stringr::str_trim()
  
  # Get the number of levels for all factor variables
  lev_leng <- .data %>% 
    dplyr::select(where(is.factor) & any_of(model_vars)) %>% 
    purrr::map_int(
      ~ length(levels(droplevels(.x)))
    )
  
  # Check if length is one
  invalid <- names(which(lev_leng == 1))
  
  # If any is invalid, it will have length > 0
  if (length(invalid) != 0) {
    for (i in invalid) {
      if (any(stringr::str_detect(model_terms, paste0('\\*[:space:]?', i)))) {
        # Remove interactor from formula
        model_terms <- stringr::str_remove(
          model_terms,
          paste0('[\\*,:]?[:space:]?',i,'[:space:]?[\\*,:]?')
        )
      } else{
        # Remove entire term from formula
        model_terms <- model_terms[stringr::str_detect(model_terms, i, T)]
      }
    }
    model <- stringr::str_flatten(model_terms, '+')
  }
  # Define the new formula
  as.formula(glue::glue('{dep_var} ~ {model}'))
}


# Dep var defition
dep_var <- 'y'
# Model example
model <- "predictor_1 + predictor_2 * interactor"

# Example predictor_1
.data <- tibble::tibble(
  y = runif(10),
  predictor_1 = factor(1),
  predictor_2 = factor(letters[1:10]),
  interactor  = factor(letters[1:10])
)

# Update model
form <- update_formula(.data, dep_var, model)
form
#> y ~ predictor_2 * interactor
#> <environment: 0x0000015b95006a58>

# Fit the model
fit <- lm(form, .data)

# Example predictor_2
.data <- tibble::tibble(
  y = runif(10),
  predictor_1 = runif(10),
  predictor_2 = factor(letters[rep(1, 10)]),
  interactor  = factor(letters[1:10])
)

form <- update_formula(.data, dep_var, model)
form
#> y ~ predictor_1
#> <environment: 0x0000015b95cdd218>

# Example interactor
.data <- tibble::tibble(
  y = runif(10),
  predictor_1 = runif(10),
  predictor_2 = factor(letters[1:10]),
  interactor  = factor(letters[rep(1, 10)])
)

form <- update_formula(.data, dep_var, model)
form
#> y ~ predictor_1 + predictor_2
#> <environment: 0x0000015b96072878>

# Example predictor_1 & interactor
.data <- tibble::tibble(
  y = runif(10),
  predictor_1 = factor(10),
  predictor_2 = factor(letters[1:10]),
  interactor  = factor(letters[rep(1, 10)])
)

form <- update_formula(.data, dep_var, model)
form
#> y ~ predictor_2
#> <environment: 0x0000015b9669d448>

^{创建于2023-06-13年第reprex v2.0.2页}