如何用dplyr的across结合summarise计算多组向量点积？

问题背景 #

现有如下数据框：

set.seed(100)
n = 1000
data = data.frame(
  y1_a = rnorm(n),
  y1_b = abs(rnorm(n)),
  y2_a = rnorm(n),
  y2_b = abs(rnorm(n))
)

需要计算y1_a与y1_b的点积，以及y2_a与y2_b的点积。

尝试用mutate结合across可以得到元素级乘积：

data %>%
  mutate(
    (across(ends_with("a"), .names = '{.col}_b_dp') * across(ends_with("b")))
  )

但这只能生成元素级乘积列，还需要额外求和才能得到点积。尝试用summarise结合两次across的代码报错：

data %>%
  summarise(
    colSums(across(ends_with("a"), .names = '{.col}_b_dp') * across(ends_with("b")))
  )

原因是colSums返回的是长度为2的向量，被summarise解析为2行数据，不符合期望的2列结果格式。

可行解决方案 #

方法一：通过列名匹配直接计算点积 #

利用across遍历所有_a结尾的列，匹配对应的_b列后相乘求和，直接生成点积列：

library(stringr) # 需要加载stringr包处理列名替换

data %>%
  summarise(
    across(ends_with("a"), 
           ~ sum(.x * get(str_replace(cur_column(), "_a$", "_b"))),
           .names = "{.col}_b_dp")
  )

逻辑说明：

• 对每个以_a结尾的列，用str_replace把列名的_a替换为_b，找到对应的匹配列
• 将两列元素相乘后求和，得到该组的点积
• 通过.names参数设置输出列名，最终得到2列的点积结果

方法二：基于元素级乘积矩阵生成点积列 #

如果想保留先计算元素级乘积再求和的思路，可以将colSums返回的向量转译为summarise的多列：

library(stringr)

data %>%
  summarise(
    !!!set_names(
      colSums(across(ends_with("a")) * across(ends_with("b"))),
      str_c(names(across(ends_with("a"))), "_b_dp")
    )
  )

逻辑说明：

• 先计算所有_a列与_b列的元素级乘积矩阵，用colSums得到每组的点积向量
• 用set_names给向量设置目标列名
• 通过!!!（非标准求值操作符）将向量拆解为summarise的多个列，最终得到2列的结果

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