Search code examples
rpurrrh2orlang

R Pass Variables into a custom function purrr


How do I format a custom function to pass variables into an h2o function? I can't figure out the proper quo/expr/ensym syntax.

Here is a small example of the syntax that I can't figure out:

suppressMessages(library(h2o))
#> Warning: package 'h2o' was built under R version 3.6.2

suppressMessages(library(rlang))
h2o.init()
#>  Connection successful!

data_h2o <- as.h2o(iris)

h2o.cor(data_h2o$Sepal.Length, data_h2o$Sepal.Width, use = "everything", method = "Pearson")
#> [1] -0.1175698



# function to take two variables and return the correlation

## in a larger data set I only care about how the target variable
## relates to the dependent variables
cor_function <- function(var1, var2) {
  var_1 = deparse(substitute(var1))
  var_2 = deparse(substitute(var2))
  r = h2o::h2o.cor(data_h2o[[var_1]], data_h2o[[var_2]], use = "complete.obs", na.rm = TRUE, method = "spearman")
  out <-  tibble::enframe(r, name = NULL)
  out$var1 = var_1
  out$var2 = var_2
  return(r)
}

# this works
cor_function(Sepal.Length, Sepal.Width)
#> [1] -0.1795433

params_to_run <- expand.grid(var1 = "Sepal.Length", var2 = c("Sepal.Width", "Petal.Width"))

suppressMessages(library(purrr))

purrr::map(params_to_run, cor_funtion)
#> Error in if ((nrow(x) == 1L || (ncol(x) == 1L && ncol(y) == 1L))) .eval.scalar(expr) else .fetch.data(expr, : missing value where TRUE/FALSE needed

Created on 2020-02-03 by the reprex package (v0.3.0)

This is similar to other questions w/o answers:


Solution

  • I think there are several problems here, the most important one is mixing tidy and standard evaluation. In cor_function(Sepal.Length, Sepal.Width), the arguments are passed as expressions, whereas the elements in params_to_run are strings (or factors, actually).

    Since I don't see that tidy evaluation is really necessary here, and mapping over strings feels more natural, I propose a solution without tidy evaluation.

    library("h2o")
    
    library("purrr")
    library("dplyr")
    
    h2o.init()
    
    data_h2o <- as.h2o(iris)
    
    params_to_run <- expand.grid(var1 = "Sepal.Length", var2 = c("Sepal.Width", "Petal.Width"))
    params_to_run
    #>           var1        var2
    #> 1 Sepal.Length Sepal.Width
    #> 2 Sepal.Length Petal.Width
    
    cor_fun <- function(data, x, y, FUN, ...) {
        # as.character() because expand.grid() produces factors
        r <- FUN(x = data[, as.character(x)], y = data[, as.character(y)], ...)
        return(r)
    }
    
    cor_fun(iris,     "Sepal.Length", "Sepal.Width", cor)
    #> [1] -0.1175698
    cor_fun(data_h2o, "Sepal.Length", "Sepal.Width", h2o.cor)
    #> [1] -0.1175698
    mutate(params_to_run, res = map2(var1, var2, ~cor_fun(data_h2o, .x, .y, h2o.cor)))
    #>           var1        var2        res
    #> 1 Sepal.Length Sepal.Width -0.1175698
    #> 2 Sepal.Length Petal.Width  0.8179411
    

    👆 Note also that params_to_run is a data frame and you want to loop across rows. map() would loop across columns (like lapply()), so I use mutate() to apply map() to every row. Note further that cor_fun() needs two arguments, so map2() is used.

    In the end, one may even do it without the custom function cor_fun():

    mutate(params_to_run, 
           res = map2(var1, var2, ~h2o.cor(x = data_h2o[, as.character(.x)],
                                           y = data_h2o[, as.character(.y)])))
    #>           var1        var2        res
    #> 1 Sepal.Length Sepal.Width -0.1175698
    #> 2 Sepal.Length Petal.Width  0.8179411
    

    Below, you find a soluation with tidy eval. However, this won't work with params_to_run, which contains strings (or factors, actually).

    cor_fun2 <- function(data, x, y, FUN, ...) {
        x <- rlang::enquo(x)
        y <- rlang::enquo(y)
        r <- FUN(x = data[, quo_name(x)], y = data[, quo_name(y)], ...)
        return(r)
    }
    cor_fun2(data_h2o, Sepal.Length, Sepal.Width, h2o::h2o.cor)
    #> [1] -0.1175698
    

    Created on 2020-02-04 by the reprex package (v0.3.0)