如何将响应变量传递给我自己函数中表达式内部的lm

Question

我尝试将表达式变量tv作为函数参数传递给表达式中的lm。我希望下面的代码可以使我尝试实现的目标更加清晰。

我最好使用整洁的评估方法。

此外，我试图用tidyeval术语替换基R中的expression，但没有成功。

library(tidyverse)
library(mice)

data <- boys[boys$age >= 8, -4]
imp <- mice(data, seed = 28382, m = 10, print = FALSE)

choose_vars <- function(predictor_vars) {

    predictors <- my_vars %>% 
    str_c(collapse = " + ") %>% 
    str_c("~", .) %>% 
    rlang::parse_expr(.)

  scope <- list(upper = predictors, lower = ~1)

  my_expression <- expression(
    f1 <- lm(tv ~ 1),
    f2 <- step(f1, scope = scope))

  fit <- with(imp, my_expression)

  formulas <- lapply(fit$analyses, formula)
  terms <- lapply(formulas, terms)
  votes <- unlist(lapply(terms, labels))

  table(votes)

}

my_vars <- c("age", "hgt", "wgt", "hc", "gen", "phb", "reg")

choose_vars(predictor_vars = my_vars)

我希望能够通过自己的函数传递tv。

choose_vars(predictor_vars = my_vars, response_var = tv)

[原始代码来自Stef van Buuren的书Flexible Imputation of Missing Data。

data <- boys[boys$age >= 8, -4]
imp <- mice(data, seed = 28382, m = 10, print = FALSE)
scope <- list(upper = ~ age + hgt + wgt + hc + gen + phb + reg,
              lower = ~1)
expr <- expression(f1 <- lm(tv ~ 1),
                   f2 <- step(f1, scope = scope))
fit <- with(imp, expr)

formulas <- lapply(fit$analyses, formula)
terms <- lapply(formulas, terms)
votes <- unlist(lapply(terms, labels))
table(votes)

Answer 1

并不是我想要的，但我找到了一种将响应变量传递给函数的方法。结果与本书示例相同。

library(tidyverse)
library(mice)

data <- boys[boys$age >= 8, -4]
imp <- mice(data, seed = 28382, m = 10, print = FALSE)

我的代码

choose_vars <- function(imp_data, predictor_vars, response_var) {

  predictors <- predictor_vars %>%
    str_c(collapse = " + ") %>%
    str_c("~", .) %>%
    rlang::parse_expr(.)

  scope <- list(upper = predictors, lower = ~1)

  form <- str_c(response_var, " ~ 1")

  fit <- imp_data %>%
    mice::complete("all") %>%
    lapply(function(x) { step(lm(formula = as.formula(form), data = x), scope = scope) } )

  formulas <- lapply(fit, formula)
  terms <- lapply(formulas, terms)
  votes <- unlist(lapply(terms, labels))

  table(votes)

}

my_vars <- c("age", "hgt", "wgt", "hc", "gen", "phb", "reg")

my_table <- choose_vars(imp_data = imp, predictor_vars = my_vars, response_var = "tv")

图书示例

scope <- list(upper = ~ age + hgt + wgt + hc + gen + phb + reg,
              lower = ~1)
expr <- expression(f1 <- lm(tv ~ 1),
                   f2 <- step(f1, scope = scope))
fit <- with(imp, expr)

formulas <- lapply(fit$analyses, formula)
terms <- lapply(formulas, terms)
votes <- unlist(lapply(terms, labels))
stefs_table <- table(votes)

比较结果

identical(my_table, stefs_table)
[1] TRUE