CODEWITHSUNDEEP
rrlangr-micetidyeval
Roccer
Roccer

Reputation: 919

How to pass the response variable to lm which is inside an expression within my own function

I try to pass the repsonse variable tv as a function argument into lm within an expression. I hope the code below makes it clearer what I try to achieve.

I preferrably would like to do that using tidy evaluation.

Furthermore, I tried to replace expression from base R with tidyeval terminology but I did not succeed to do so.

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)

I would like to be able to pass tv via my own function.

choose_vars(predictor_vars = my_vars, response_var = tv)

The original code derives from Stef van Buuren's book 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)

Upvotes: 2

Views: 128

Answers (1)

Roccer
Roccer

Reputation: 919

Not exactly what I wanted but I found a way to pass the response variable into the function. The result is the same as in the example from the book.

library(tidyverse)
library(mice)

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

My code

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")

Book example

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)

Compare results

identical(my_table, stefs_table)
[1] TRUE

Upvotes: 1

Related Questions