Julian Tagell
Julian Tagell

Reputation: 39

Creating an R function that can accept both datasets and object names as well as those names as a string object

I can make a function that takes object names as arguments (this is just a normal function).

I can also now make a function that get's its data and column arguments via a named vector (utilising dataset <- eval(sym(dataset)) and date_col <- sym(date_col)).

However I would like a function that can handle both types of inputs.

Step one is to detect the class of the input.

For the dataset argument, this (below) works fine for both the named vector and the actual object name.

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

I am not able to figure out the appropriate way to handle the column arguments, however.

When I use the named-vector elements for them, the process (below) works fine.

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

But I am unsure how to handle the actual column name (ie by adding in an else component, above). Essentially I want to turn it into a sym so I can still use the {{}} (or !!) in the function's steps.

Here is a minimum reproducible example for what I am after. As you will see the named vector version works but not the actual dataset and column names.

Is what I'm after even possible? Can a function be dynamic in this way or do I need to make two separate functions?

[edited: made a simpler example, as per comment]

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)

Upvotes: 1

Views: 132

Answers (2)

G. Grothendieck
G. Grothendieck

Reputation: 270248

Have revised the example in line with the revised question.

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

giving

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

Note

Personally I would not do the above and would avoid unevaluated arguments and would pass the first argument as an object and the second as a character string. The two examples shown below would still work.

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

Alternately allow data to be passed as a character string using 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"]])

Upvotes: 1

Julian Tagell
Julian Tagell

Reputation: 39

The goal is to have a function that can accept either "stringed" arguments or the regular dataset and column references. And to do this with minimal alterations to the original function.

ie, it will take "data" as well as just data. And "column_x" as well as the regular column_x.

The challenge is that you need to include rlang !! in the function in order for the "stringed" values to work but this prevents the regular argument versions.

The following solution detects whether the first (dataset) argument is a string or not and then applies the correct transformations to the arguments, so that the function can proceed, using the rlang !!.

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)

I certainly wouldn't have been able to get to this without the generous assistance of @G.Grothendieck and @andrew_reece (from my previous question).

Upvotes: 0

Related Questions