Создание функции R, которая может принимать как наборы данных и имена объектов, так и эти имена как строковый объект

Question

Я могу сделать функцию, которая принимает имена объектов в качестве аргументов (это просто нормальная функция).

Теперь я также могу сделать функцию, которая получает свои данные и аргументы столбца через именованный вектор (используя dataset <- eval(sym(dataset)) и date_col <- sym(date_col)).

Однако я хотел бы функцию, которая может обрабатывать оба типа входов.

Шаг первый - определить класс входа.

Для аргумента набора данных это (ниже) прекрасно работает как для именованного вектора, так и для фактического имени объекта.

 if (is.character(dataset)) {
    dataset <- eval(sym(dataset)) }

Я не могу найти подходящий способ обработки Аргументы столбцов, однако.

Когда я использую для них элементы именованных векторов, процесс (ниже) работает нормально.

  if (is.character(date_col)) {
    date_col <- sym(date_col) } 

Но я не уверен, как обращаться с фактическим именем столбца (ie путем добавления компонента else, выше). По сути, я хочу превратить его в sym, чтобы я все еще мог использовать {{}} (или !!) в шагах функции.

Вот минимальный воспроизводимый пример того, что я хочу. Как вы увидите, работает именованная векторная версия, но не фактический набор данных и имена столбцов.

Возможно ли то, что я хочу после? Может ли функция быть динамической c таким образом, или мне нужно сделать две отдельные функции?

[отредактировано: сделал более простой пример, согласно комментарию]

library(dplyr)
library(rlang)


new_table <- tibble(
  Date = seq.Date(as.Date("2016-01-01"), as.Date("2019-12-31"), 1)) %>% 
  mutate(total_sales = rnorm(n()))


f_arguments <- c("dataset" = "new_table",
                        "date_col" = "Date",
                        "sales_col" = "total_sales")


f <- function(data, x, envir = parent.frame()) {

  if (is.character(data)) {
    data <- get(data, envir)}


  if (is.character(x)) {
    x <- sym(x) }

  data %>% 
    mutate(year_month = lubridate::floor_date(!!ensym(x), "months"),
           year = lubridate::year(!!ensym(x)))

}


# this (below) works per the above code, but not if I comment out 
# the if (is.character(x)) line

f(f_arguments[["dataset"]], 
  f_arguments[["date_col"]])


# this (below) does not work with the above code, but it will work if I comment out 
# the if (is.character(x)) line

f(new_table, Date)

Answer 1

Пересмотрели пример в соответствии с пересмотренным вопросом.

library(dplr)
library(lubridate)

f <- function(data, x, envir = parent.frame()) {
  if (is.character(data)) data <- get(data, envir)
  x <- eval(substitute(x), data, envir)
  if (is.character(x)) x <- data[[x]]
  data %>% mutate(year = year(x)) %>% slice(1:2)
}

давая

f(f_arguments[["dataset"]], f_arguments[["date_col"]])  # test 1
## # A tibble: 2 x 3
##   Date       total_sales  year
##   <date>           <dbl> <dbl>
## 1 2016-01-01      -0.975  2016
## 2 2016-01-02       0.120  2016

f("new_table", "Date") # test 2
## # A tibble: 2 x 3
##   Date       total_sales  year
##   <date>           <dbl> <dbl>
## 1 2016-01-01      -0.975  2016
## 2 2016-01-02       0.120  2016

f(new_table, Date)  # test 3
## # A tibble: 2 x 3
##   Date       total_sales  year
##   <date>           <dbl> <dbl>
## 1 2016-01-01      -0.975  2016
## 2 2016-01-02       0.120  2016

f(new_table, f_arguments[["date_col"]]) # test 4
## # A tibble: 2 x 3
##   Date       total_sales  year
##   <date>           <dbl> <dbl>
## 1 2016-01-01      -0.975  2016
## 2 2016-01-02       0.120  2016

# test 5
g <- function(...) { new_tab <- new_table; f(...) }
g("new_tab", "Date") 
## # A tibble: 2 x 3
##   Date       total_sales  year
##   <date>           <dbl> <dbl>
## 1 2016-01-01      -0.975  2016
## 2 2016-01-02       0.120  2016

Примечание

Лично я бы не делал вышеизложенного и избегал бы аргументы без оценки и передают первый аргумент как объект, а второй как строку символов. Два приведенных ниже примера все еще будут работать.

f2 <- function(data, x) {
  data %>% mutate(year = year(.[[x]])) %>% slice(1:2)
}

f2(new_table, "Date")
f2(get(f_arguments[["dataset"]]), f_arguments[["date_col"]])

Альтернативно разрешить передачу данных в виде символьной строки с использованием S3:

f3 <- function(data, x, ...) UseMethod("f3")
f3.default <- function(data, x, ...)  {
  data %>% mutate(year = year(.[[x]])) %>% slice(1:2)
}
f3.character <- function(data, x, envir = parent.frame(), ...) {
   data <- get(data, envir)
   NextMethod()
}

f3(new_table, "Date")
f3(f_arguments[["dataset"]], f_arguments[["date_col"]])

Answer 2

Цель состоит в том, чтобы иметь функцию, которая может принимать либо «строковые» аргументы, либо обычный набор данных и ссылки на столбцы. И чтобы сделать это с минимальными изменениями исходной функции.

ie, потребуется "data", а также data. И "column_x", а также обычные column_x.

Проблема в том, что вам нужно включить в функцию rlang !!, чтобы «строковые» значения работали, но это мешает обычному аргументу версии.

Следующее решение определяет, является ли первый (набор данных) аргумент строкой или нет, и затем применяет правильные преобразования к аргументам, чтобы функция могла продолжить работу, используя rlang !!. * 1013. *

f <- function(data, column_x) {

  if (is.character(data)) {
    data <- eval(sym(data))
    column_x <- sym(column_x) }

  data %>% 
    mutate(year_month = lubridate::floor_date(!! ensym(column_x), "months"),
           year = lubridate::year(!! ensym(column_x))) %>% 
    head(2)
}


# let's test

f(f_arguments[["dataset"]], 
  f_arguments[["date_col"]])


f(new_table, Date)

Конечно, я бы не смог добраться до этого без щедрой помощи @ G.Grothendieck и @andrew_reece (из моего предыдущего вопроса).