Which rlang function should I use to evaluate a glue string as a variable name?-CodePudding

Suppose that I want to create a function to be used within dplyr::mutate(), and in which I feed a variable name, and within the function, it will extract a particular pattern in the variable name given and creates a new variable name out of it, like so:

library(rlang)
library(dplyr)
library(stringr)
library(glue)

myfun <- function(var) {
  y <- str_remove(ensym(var), "^.*\\.")
  other_var <- glue("Petal.{y}")
  
  if_else(var > 6 | other_var > 3, 1, 0) # What rlang function do I need to apply to other_var here?
}

The problem I'm running into, is how do I use rlang tools to evaluate the new variable name "other_var" within the data frame, such that when I make the call below, it would look at the data within iris$Sepal.Length and iris$Petal.Length?

mutate(iris, test = myfun(Sepal.Length))

EDIT: The following solves my immediate problem, but I feel like there's a more elegant way:

myfun <- function(df, x) {
  y <- str_remove(ensym(x), "^.*\\.")
  other_var <- glue("Petal.{y}")
  
  if_else(x > 6 | df[[other_var]] > 3, 0, 1) 
}

mutate(iris, test = myfun(iris, Sepal.Length))

CodePudding user response：

You can use the environment and call eval_tidy().

This uses caller_env(n = 1):

myfun <- function(var) {
  
  .var <- enexpr(var)
  var_name <- as_name(.var)
  
  y <- str_remove(var_name, "^.*\\.")
  other_var <- glue("Petal.{y}")
  
  .expr <- parse_expr(glue("if_else({var_name} > 6 | {other_var} > 3, 1, 0)"))

  eval_tidy(.expr, env = caller_env(n = 1))
}

This grabs the var as a quosure and uses that environment, which could be useful if you had nested functions down from the original mutate call.

myfun <- function(var) {
  
  .var <- enquo(var)
  var_name <- as_name(.var)
  
  y <- str_remove(var_name, "^.*\\.")
  other_var <- glue("Petal.{y}")
  
  .expr <- parse_expr(glue("if_else({var_name} > 6 | {other_var} > 3, 1, 0)"))
  .quo <- new_quosure(.expr, quo_get_env(.var))
  
  eval_tidy(.quo)
}

CodePudding user response：

We could get the data with cur_data_all()

library(dplyr)
library(rlang)
library(stringr)
myfun <- function(var) {
  dat <- cur_data_all()
  y <- as_string(ensym(var))
  other_var <- str_c("Petal.", str_remove(y, '^.*\\.'))
   (!((dat[[y]] > 6)|(dat[[other_var]] > 3)))
 
  }

-testing

> head(mutate(iris, test = myfun(Sepal.Length)))
  Sepal.Length Sepal.Width Petal.Length Petal.Width Species test
1          5.1         3.5          1.4         0.2  setosa    1
2          4.9         3.0          1.4         0.2  setosa    1
3          4.7         3.2          1.3         0.2  setosa    1
4          4.6         3.1          1.5         0.2  setosa    1
5          5.0         3.6          1.4         0.2  setosa    1
6          5.4         3.9          1.7         0.4  setosa    1

CodePudding user response：

You can fetch the variable from its call environment with rlang::caller_env (or parent.frame to avoid rlang dependency if that is desired) and get it. From there you just run the code you want with the new variable:

myfun <- function(x) {
  y <- paste0("Petal.", stringr::str_remove(substitute(x), "^.*\\."))
  other_var <- get(y, rlang::caller_env())
  dplyr::if_else(x > 6 | other_var > 3, 0, 1)
}

tibble::tibble(dplyr::mutate(iris, test = myfun(Sepal.Length)))
#> # A tibble: 150 x 6
#>    Sepal.Length Sepal.Width Petal.Length Petal.Width Species  test
#>           <dbl>       <dbl>        <dbl>       <dbl> <fct>   <dbl>
#>  1          5.1         3.5          1.4         0.2 setosa      1
#>  2          4.9         3            1.4         0.2 setosa      1
#>  3          4.7         3.2          1.3         0.2 setosa      1
#>  4          4.6         3.1          1.5         0.2 setosa      1
#>  5          5           3.6          1.4         0.2 setosa      1
#>  6          5.4         3.9          1.7         0.4 setosa      1
#>  7          4.6         3.4          1.4         0.3 setosa      1
#>  8          5           3.4          1.5         0.2 setosa      1
#>  9          4.4         2.9          1.4         0.2 setosa      1
#> 10          4.9         3.1          1.5         0.1 setosa      1
#> # ... with 140 more rows

^{Created on 2022-06-28 by the reprex package (v2.0.1)}