如何在dplyr中程序化识别sf对象特殊列并简化调用？

需求说明 #

像sf这类对象会通过属性标记特殊列（比如geometry列），在dplyr中做计算时，要是能不用手动写列名、也不用rlang的!!!拼接运算符，直接用一个函数自动识别这个特殊列，用起来会高效很多。目标是让下面的代码能正常运行：

df %>% mutate(d=st_distance(geometry_name(), geometry_name()[row_number()==1]))

现有实现示例 #

先准备测试数据：

library(sf)
library(dplyr)

n <- 4
df <- st_as_sf(data.frame(x = 1:n, y = 1:n, cat=gl(2,2)), coords = 1:2, crs = 3857) %>% 
  group_by(cat)

现有几种写法：

1. 固定列名写法：但缺点是geometry列名不固定时会失效

df %>% mutate(d=st_distance(geometry, geometry[row_number()==1]))

2. 可读性差的写法：能适配动态列名，但代码繁琐

df %>% mutate(d=st_distance(!!!syms(attr(., "sf_column")), (!!!syms(attr(., "sf_column")))[row_number()==1]))

3. 优化后仍需!!!的写法：封装了列名获取，但还是得手动加拼接运算符

geometry_name <- function(x) syms(attr(x, 'sf_column'))
df %>% mutate(d=st_distance(!!!geometry_name(.), (!!!geometry_name(.))[row_number()==1]))

最终解决方案 #

直接实现一个支持tidy eval的geometry_name函数，不用传参也不用加!!!：

geometry_name <- function() {
  # 获取mutate上下文里的当前数据框
  current_df <- rlang::caller_env()$.data
  # 读取sf列属性并转为符号
  rlang::sym(attr(current_df, "sf_column"))
}

现在就能用目标写法直接运行：

df %>% mutate(d=st_distance(geometry_name(), geometry_name()[row_number()==1]))

原理：函数通过rlang::caller_env()$.data自动获取dplyr动词（比如mutate）上下文里的当前数据对象，读取其sf_column属性拿到geometry列的名称，再转成tidy eval能识别的符号，这样就不用手动传递数据框或者加拼接运算符了。

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