CODEWITHSUNDEEP
rpurrrh2orlang
Ryan John
Ryan John

Reputation: 1430

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:

Upvotes: 2

Views: 568

Answers (1)

hplieninger
hplieninger

Reputation: 3494

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)

Upvotes: 2

Related Questions