Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Programming a function for "lm" using tidyeval

Tags:

r

tidyeval

lm

I am trying to write a function around "lm" using tidyeval (non-standard evaluation).Using base R NSE, it works:

lm_poly_raw <- function(df, y, x, degree = 1, ...){
  lm_formula <-
    substitute(expr = y ~ poly(x, degree, raw = TRUE),
               env = list(y = substitute(y),
                          x = substitute(x),
                          degree = degree))
  eval(lm(lm_formula, data = df, ...))
}

lm_poly_raw(mtcars, hp, mpg, degree = 2)

However, I have not figured out how to write this function using tidyeval and rlang. I assume that substitute should be replaced be enquo, and eval by !!. There are some hints in Hadley's Adv-R, but I could not figure it out.

like image 758
Sebastian Sauer Avatar asked Oct 21 '17 20:10

Sebastian Sauer


1 Answers

Here is the kind of formula constructor that might make its way in rlang in the future:

f <- function(x, y, flatten = TRUE) {
  x <- enquo(x)
  y <- enquo(y)

  # Environments should be the same
  # They could be different if forwarded through dots
  env <- get_env(x)
  stopifnot(identical(env, get_env(y)))

  # Flatten the quosures. This warns the user if nested quosures are
  # found. Those are not supported by functions like lm()
  if (flatten) {
    x <- quo_expr(x, warn = TRUE)
    y <- quo_expr(y, warn = TRUE)
  }

  new_formula(x, y, env = env)
}

# This can be used for unquoting symbols
var <- "cyl"
lm(f(disp, am + (!! sym(var))), data = mtcars)

The tricky parts are:

  • The LHS and RHS could come from different environments if forwarded through different layers of .... We need to check for this.

  • We need to check that the user doesn't unquote quosures. lm() and co do not support those. quo_expr() flattens all the quosures and optionally warns if some were found.

like image 77
Lionel Henry Avatar answered Oct 06 '22 07:10

Lionel Henry