dplyr across()中自定义函数处理成对列的实现方法

示例数据集 #

构建测试用数据集，设置随机种子保证结果可复现：

set.seed(3)
library(dplyr)
x <- tibble(Measure = c("Height","Weight","Width","Length"),
        AD1_1= rpois(4,10),
        AD1_2= rpois(4,9),
        AD2_1= rpois(4,10),
        AD2_2= rpois(4,9),
        AD3_1= rpois(4,10),
        AD3_2= rpois(4,9))

现有写法的适用边界 #

对于简单数值差值类运算，可通过两个across返回的tibble逐列对齐运算实现批量计算，无需逐组手写mutate逻辑：

可正常运行的差值计算代码 #

fun <- function(x,y){x-y}
x_minus <- x %>%
  mutate(fun(across(ends_with("_1"), .names = "{col}_minus"), across(ends_with("_2")))) %>%
  rename_with(~ sub("_\\d+", "", .), ends_with("_minus"))

运行结果 #

# A tibble: 4 x 10
  Measure AD1_1 AD1_2 AD2_1 AD2_2 AD3_1 AD3_2 AD1_minus AD2_minus AD3_minus
  <chr>   <int> <int> <int> <int> <int> <int>     <int>     <int>     <int>
1 Height      6    10    10     3    12     8        -4         7         4
2 Weight      8     9    13     6    14     7        -1         7         7
3 Width      10     9    11     5    12     8         1         6         4
4 Length      8     9     8     7     8    13        -1         1        -5

自定义分类函数的报错原因 #

当替换为带分支判断的自定义函数时，原有写法会触发类型不匹配错误：

# 自定义分类判断函数
fun <- function(x,y){
  case <- case_when(
    x == y ~ "Agree",
    x == 0 & y != 0 ~ "Disagreement",
    x != 0 & y == 0 ~ "Disagreement",
    x-y <= 1 & x-y >= -1 ~ "Agree",
    TRUE ~ "Disagree"
  )
  return(case)
}

# 原有调用写法（触发报错）
x_case <- x %>%
  mutate(fun(across(ends_with("_1"), .names = "{col}_case"), across(ends_with("_2")))) %>%
  rename_with(~ sub("_\\d+", "", .), ends_with("_case"))

这种写法本质是对两个数据集做整体比较：一个是所有以_1结尾的变量组成的数据集，另一个是所有以_2结尾的变量组成的数据集，等价于dat %>% select(ends_with("_1")) - dat %>% select(ends_with("_2"))，而这类结构为列表的对象无法直接按这种方式运算。之所以差值场景可正常运行，是因为二元减号运算符本身内置了tibble逐列对齐的运算逻辑，但自定义函数没有这类内置适配，直接传入多列tibble作为参数时，无法实现逐对列的计算。

兼容任意自定义函数的调整方案 #

核心调整逻辑：将跨列配对的逻辑嵌入到across的逐列迭代过程中，每次传入自定义函数的都是两个单独的数值向量，而非整体tibble结构，即可完全兼容带分支判断、非数值返回值的自定义函数。

调整后可运行的代码 #

x_case <- x %>%
  mutate(
    # 遍历所有以_1结尾的列作为配对组的第一列
    across(
      .cols = ends_with("_1"),
      .fns = function(col1) {
        # 基于列名规则自动匹配同组的_2列
        paired_col2_name = sub("_1$", "_2", cur_column())
        col2 = .data[[paired_col2_name]]
        # 调用自定义函数，逐行计算两列的对应值
        fun(col1, col2)
      },
      # 临时命名输出列，后续统一调整为目标格式
      .names = "{col}_tmp_res"
    )
  ) %>%
  # 批量调整列名，生成AD1fun、AD2fun、AD3fun格式的结果列
  rename_with(
    ~ sub("_1_tmp_res$", "fun", .),
    ends_with("_tmp_res")
  )

运行后生成的结果结构 #

# A tibble: 4 x 10
  Measure AD1_1 AD1_2 AD2_1 AD2_2 AD3_1 AD3_2 AD1fun    AD2fun    AD3fun   
  <chr>   <int> <int> <int> <int> <int> <int> <chr>     <chr>     <chr>    
1 Height      6    10    10     3    12     8 Disagree  Disagree  Disagree 
2 Weight      8     9    13     6    14     7 Agree     Disagree  Disagree 
3 Width      10     9    11     5    12     8 Agree     Disagree  Disagree 
4 Length      8     9     8     7     8    13 Agree     Agree     Disagree 

内容的提问来源于stack exchange，提问作者aiorr