使用NSE构造公式

Question

我正在尝试使用NSE构造一个公式，以便我可以轻松地通过管道插入列。以下是我想要的用例：

df %>% make_formula(col1, col2, col3)

[1] "col1 ~ col2 + col3"

我首先创建了这个函数：

varstring <- function(...) {
 as.character(match.call()[-1])
}

无论是单个对象还是多个对象，这都非常有效：

varstring(col)

[1] "col"

varstring(col1, col2, col3)

[1] "col1" "col2" "col3"

接下来，我创建我的函数来创建公式：

formula <- function(df, col, ...) {
 group <- varstring(col)
 vars <- varstring(...)

 paste(group,"~", paste(vars, collapse = " + "), sep = " ")
}

但是，函数调用formula(df, col, col1, col2, col3)会生成[1] "group ~ ..1 + ..2 + ..3"。

我知道这个公式是从字面上计算varstring(group)和varstring(...)，而不是像我希望的那样在用户提供的对象中进行计算。但我想不出如何才能让它像预期的那样工作。

Answer 1

可以使用reduce()将任意数量的参数与二进制函数连接起来

make_formula <- function(lhs, ..., op = "+") {
  lhs <- ensym(lhs)
  args <- ensyms(...)

  n <- length(args)

  if (n == 0) {
    rhs <- 1
  } else if (n == 1) {
    rhs <- args[[1]]
  } else {
    rhs <- purrr::reduce(args, function(out, new) call(op, out, new))
  }

  # Don't forget to forward the caller environment
  new_formula(lhs, rhs, env = caller_env())
}

make_formula(disp)
#> disp ~ 1

make_formula(disp, cyl)
#> disp ~ cyl

make_formula(disp, cyl, am, drat)
#> disp ~ cyl + am + drat

make_formula(disp, cyl, am, drat, op = "*")
#> disp ~ cyl * am * drat

使用表达式的一大优势是它对小波比表(https://xkcd.com/327/)很健壮：

# User inputs are always interpreted as symbols (variable name)
make_formula(disp, `I(file.remove('~'))`)
#> disp ~ `I(file.remove('~'))`

# With `paste()` + `parse()` user inputs are interpreted as arbitrary code
reformulate(c("foo", "I(file.remove('~'))"))
#> ~foo + I(file.remove("~"))

Answer 2

我建议使用rlang::enquo(s)和rlang::as_name来实现这一点：

library(rlang)

formula <- function(df, col, ...) {
  group <- enquo(col)
  vars <- enquos(...)

  group_str <- rlang::as_name(group)
  vars_str <- lapply(vars, rlang::as_name)
  
  paste(group_str,"~", paste(vars_str, collapse = " + "), sep = " ")
}

formula(mtcars, col, col1, col2, col3)
#> [1] "col ~ col1 + col2 + col3"

Answer 3

我们可以使用reformulate

formula_fn <- function(dat, col, ...) {
           deparse(reformulate(purrr::map_chr(ensyms(...), rlang::as_string), 
                 response = rlang::as_string(ensym(col) )))
      
 }
formula_fn(mtcars, col, col1, col2, col3)
#[1] "col ~ col1 + col2 + col3"