【问题标题】：Tidyeval evaluate case_whenTidyeval 评估 case_when
【发布时间】：2020-05-04 21:18:50
【问题描述】：

与Tidy evaluation programming with dplyr::case_when 和Making tidyeval function inside case_when 有点相关，我想创建字符串（使用闪亮的应用程序）以便稍后在case_when 函数中解析。这是一个例子：

library(tidyverse)

# simulated shiny inputs
new_column = sym("COL_NAME")

number_of_categories = 3

col1_text = "Big"
col1_min = 7.0
col1_max = 8.0

col2_text = "Medium"
col2_min = 5.0
col2_max = 6.9

col3_text = "Small"
col3_max = 4.9
col3_min = 4.0

columninput = sym("Sepal.Length")

期望的输出

iris %>%
  mutate(new_column =
           case_when(
             !!columninput >= col1_min & !!columninput <= col1_max ~ col1_text,
             !!columninput  >= col2_min & !!columninput <= col2_max ~ col2_text,
             !!columninput  >= col3_min & !!columninput <= col3_max ~ col3_text
           )
  )

因为函数之间唯一改变的是索引，我在想我们可以使用通用模式来创建一个字符串

# create single string
my_string <-function(i) {
  paste0("!!", columninput, " >= col", i, "_min & ", "!!", columninput, " <= col", i, "_max ~ col", i, "_text")
}

然后重复字符串为动态案例数

mega_string <- map_chr(1:number_of_categories, ~ my_string(.x))

待办事项：

这是我无法拼凑起来的部分：使用这些字符串作为 case_when 中的参数。

# evaluate somehow?
iris %>%
  mutate(
    new_column = case_when(
      # tidyeval mega_string?
      paste(mega_string, collapse = "," )
      )
    )

这甚至是正确的方法吗？您将如何解决这个问题 - 任何高水平的帮助或其他方面的帮助都非常感谢！

【问题讨论】：

我猜你需要eval(parseiris %>% mutate(new_column = case_when(eval(parse(text = mega_string[1])))

标签： r tidyeval

【解决方案1】：

我们可以创建一个表达式并计算

library(dplyr)
library(stringr)
iris %>% 
   mutate(new_column = eval(rlang::parse_expr(str_c('case_when(', 
          str_c(mega_string, collapse=","), ')'))))
#    Sepal.Length Sepal.Width Petal.Length Petal.Width    Species new_column
#1            5.1         3.5          1.4         0.2     setosa     Medium
#2            4.9         3.0          1.4         0.2     setosa      Small
#3            4.7         3.2          1.3         0.2     setosa      Small
#4            4.6         3.1          1.5         0.2     setosa      Small
#5            5.0         3.6          1.4         0.2     setosa     Medium
#6            5.4         3.9          1.7         0.4     setosa     Medium
#7            4.6         3.4          1.4         0.3     setosa      Small
#8            5.0         3.4          1.5         0.2     setosa     Medium
#9            4.4         2.9          1.4         0.2     setosa      Small
#10           4.9         3.1          1.5         0.1     setosa      Small
# ...

或者使用parse_expr 和!!!

library(purrr)
iris %>%
   mutate(new_column = case_when(!!! map(mega_string, rlang::parse_expr)))
#    Sepal.Length Sepal.Width Petal.Length Petal.Width    Species new_column
#1            5.1         3.5          1.4         0.2     setosa     Medium
#2            4.9         3.0          1.4         0.2     setosa      Small
#3            4.7         3.2          1.3         0.2     setosa      Small
#4            4.6         3.1          1.5         0.2     setosa      Small
#5            5.0         3.6          1.4         0.2     setosa     Medium
#6            5.4         3.9          1.7         0.4     setosa     Medium
#7            4.6         3.4          1.4         0.3     setosa      Small
#8            5.0         3.4          1.5         0.2     setosa     Medium
#...

【讨论】：

【解决方案2】：

谢谢你的好问题和答案。我在相同的上下文中使用（闪亮）。

我想提一下另一种更适合我需要的方法，并且我发现更容易阅读逻辑：而不是在要评估的字符串中传递变量，而是直接传递来自字符串中的值tibble 和 str_glue_data

mega <- tribble(
    ~min, ~max, ~size,
    7, 8, "Big", 
    5, 6.9, "Medium",
    4.9, 4, "Small"
) %>% 
    str_glue_data("Sepal.Length >= {min} & Sepal.Length <= {max} ~ '{size}'")

iris %>% 
    mutate(new_column = case_when(!!! map(mega, rlang::parse_expr)))

【讨论】：