Используйте NSE для построения формулы

ProgramBox

Используйте NSE для построения формулы

Post author:admin
Запись опубликована:9 апреля, 2023
Post category:Вопросы по программированию

#r #tidyeval #non-standard-evaluation

#r #tidyeval #нестандартная оценка

Вопрос:

Я пытаюсь создать формулу с использованием 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(...) , а фактически не заменяет в пользовательских объектах для оценки, как мне бы тоже хотелось. Но я не могу понять, как заставить это работать так, как задумано.

Ответ №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

Одним из больших преимуществ работы с выражениями является то, что он устойчив к небольшим таблицам bobby (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("~"))

1. Одним из вариантов этого было бы разрешить произвольные выражения с помощью enexprs(...) вместо ensyms(...) . Обратите внимание, что enquos() здесь это не сработает, потому что функции моделирования не поддерживают запросы. Это означает, что ... все должны поступать из среды вызывающего, они не могут быть перенаправлены на разные уровни.

2. Это здорово! Спасибо. Каждый день я потихоньку разбираюсь в NSE.

3.Я добавил параметр, вызываемый group = NULL в функцию, а затем добавил следующий после вашего оператора else: if(deparse(substitute(group)) != "NULL") { group <- rlang::ensym(group) rhs <- purrr::reduce(c(rhs, group), function(out, new) call("|", out, new)) } Это позволяет создать формулу с | помощью, которую некоторые пакеты используют для фасетирования при создании таблиц / графиков. Является ли это безопасным способом достижения этой цели?

4. deparse() Это не очень хорошо. Одна вещь, которую вы могли бы сделать, это удалить NULL значение по умолчанию и проверить, было ли оно предоставлено missing() . Или вы можете взять его с собой enexpr() и проверить наличие NULL , а затем проверить, был ли указан символ. Это позволяет пользователям отменять кавычки NULL , что может упростить составление функций.

5. Также может быть разумно отказаться от требования ввода символов и разрешить произвольные выражения с enexpr() и enexprs() , в зависимости от ваших требований. Это может быть иногда полезно для ваших пользователей и может упростить вашу реализацию. Просто должно быть ясно, что все эти выражения будут вычисляться в одной среде, поскольку запросы не поддерживаются. Кстати, вы также могли бы разрешить {{ (что обычно снимает кавычки с вопроса), используя quo_squash() для захваченных выражений.

Ответ №2:

Я бы предложил использовать rlang::enquo (ы) и 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"

1. Если вы собираетесь использовать as_name() для очищенного выражения, лучше использовать ensym() чем enquo() . Последнее отвлекает (позволяет использовать сложные выражения и перенаправляет среду).

2. Обратите внимание, что вставка подобных строк является хрупкой и потенциально опасной, если строки поступают из приложения shiny, см. Мой ответ для примера.

3. @LionelHenry Привет, Лайонел, спасибо за разъяснение. Вздох. Теперь я вижу, что мне еще предстоит пройти долгий путь, чтобы лучше и глубже понять тему. Время для еще одного чтения расширенного R. (; Лучший S.

Ответ №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"

Ответ №4:

Я воспользовался советом @LionelHenry выше и создал следующую функцию с некоторыми дополнительными функциями, которые не были запрошены в моем первоначальном вопросе.

 #' Create a formula
#'
#' Creates a new formula object to be used anywhere formulas are used (i.e, `glm`).
#'
#' @param ... any number of arguments to compose the formula
#' @param lhs a boolean indicating if the formula has a left hand side of the argument
#' @param op the operand acting upon the arguments of the right side of the formula.
#' @param group an argument to use as a grouping variable to facet by
#'
#' @return a formula
#'
#' @details If `lhs` is `TRUE`, the first argument provided is used as the left hand side of the formula.
#' The `group` paramenter will add `| group` to the end of the formula. This is useful for packages that support faceting by grouping variables for the purposes of tables or graphs.
#'
#' @export
#'
#' @examples
#' make_formula(var1, var2, var3)
#' make_formula(var1, var2, var3, lhs = FALSE)
#' make_formula(var1, var2, var3, lhs = FALSE, group = var4)
#'
make_formula <- function(..., lhs = TRUE, op = " ", group = NULL) {
  args <- rlang::ensyms(...)
  n <- length(args)
  group <- rlang::enexpr(group)

  if(lhs) {
    left <- args[[1]]
    if (n == 1) {
      right <- 1
    } else if (n == 2) {
      right <- args[[2]]
    } else {
      right <- purrr::reduce(args[-1], function(out, new) call(op, out, new))
    }
  } else {
    left <- NULL
    if (n == 1) {
      right <- args[[1]]
    } else {
      right <- purrr::reduce(args, function(out, new) call(op, out, new))
    }
  }

  if(!is.null(group)) {
    group <- rlang::ensym(group)
    right <- purrr::reduce(c(right, group), function(out, new) call("|", out, new))
  }

  rlang::new_formula(left, right, env = rlang::caller_env()) # Forward to the caller environment
}