如何在多列中循环使用case_when并引用当前列名

问题背景 #

已通过以下代码生成包含_change、_change1、_change2后缀的衍生列：

library(tidyverse)

data <- data_frame(
  id = sample(letters[1:15], size = 60, replace = TRUE),
  age = round(runif(60, min = 48, max = 90)),
  a = runif(60),
  b = rnorm(60),
  c = rnorm(60),
  d = rnorm(60),
  e = rnorm(60),
  f = rnorm(60),
  g = rnorm(60),
  h = rnorm(60),
  i = rnorm(60),
  j = rnorm(60),
  k = rnorm(60),
  l = rnorm(60))

data <- data %>% 
  group_by(id) %>%
  arrange(age) %>%
  mutate(across(a:l, ~ .x - lag(.x, default = first(.x)),.names = "{col}_change")) %>%
  mutate(across(a:l, ~ .x - lag(.x, 2, default = first(.x)),.names = "{col}_change1")) %>%
  mutate(across(a:l, ~ .x - lag(.x, 3, default = first(.x)),.names = "{col}_change2")) 

需要对a至l列批量执行以下case_when逻辑，生成new_a_change至new_l_change列：

data$new_a_change <- case_when(data$age < 70 ~ data$a_change,
                               data$age >= 70 & data$age < 80 ~ data$a_change1,
                               data$age >= 80 ~ data$a_change2)

原尝试的mutate(across)写法执行失败：

data <- data %>% 
  mutate(across(a:l, ~ case_when(age <70 ~  which(colnames(data)== paste(.x,"_change") ),
                                 age >70 & age <= 80 ~  which(colnames(data)== paste(.x,"_change1") ),
                                 age >80 ~  which(colnames(data)== paste(.x,"_change2") )), 
                .names = "new_{col}_change") ) 

错误原因 #

1. across中的.x是当前迭代列的数值向量，不是列名，paste(.x, "_change")会把数值和字符串拼接，完全无法匹配目标列名；
2. which(colnames(data) == ...)返回的是列的索引位置，不是列的数值，不符合case_when需要返回数值的要求。

正确实现方法 #

方法1：使用.data代词+cur_column() #

利用cur_column()获取当前迭代的列名，结合.data[[列名]]引用对应的衍生列：

data <- data %>% 
  mutate(across(a:l, ~ case_when(
    age < 70 ~ .data[[paste0(cur_column(), "_change")]],
    age >= 70 & age < 80 ~ .data[[paste0(cur_column(), "_change1")]],
    age >= 80 ~ .data[[paste0(cur_column(), "_change2")]]
  ), .names = "new_{col}_change"))

方法2：使用rlang包的sym()+非标准求值 #

通过sym()将拼接后的列名转为符号，再用!!强制求值：

library(rlang)

data <- data %>% 
  mutate(across(a:l, ~ case_when(
    age < 70 ~ !!sym(paste0(cur_column(), "_change")),
    age >= 70 & age < 80 ~ !!sym(paste0(cur_column(), "_change1")),
    age >= 80 ~ !!sym(paste0(cur_column(), "_change2"))
  ), .names = "new_{col}_change"))

结果验证 #

可以对比手动生成的列和批量生成的列，确认结果一致：

# 手动生成new_a_change
manual_new_a <- case_when(
  data$age < 70 ~ data$a_change,
  data$age >=70 & data$age <80 ~ data$a_change1,
  data$age >=80 ~ data$a_change2
)

# 验证一致性
all.equal(data$new_a_change, manual_new_a)
# 输出TRUE表示结果一致

内容的提问来源于stack exchange，提问作者R and C.F