使用R的dplyr程序以编程方式识别列。

Question

对于某些对象，属性标识了一个特殊的列，例如在sf对象中的几何列。为了在dplyr中进行一些计算，很好能够轻松地确定这些列。我正在寻找一种创建帮助识别此列的函数的方法。在下面的示例中，我可以创建一个标识此列的函数，但仍需要使用rlang扩展运算符（!!!）。

require(sf)
require(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)
# this is the example I start from however the geometry column is not guaranteed to have that name
df %>% mutate(d=st_distance(geometry, geometry[row_number()==1]))
#> Simple feature collection with 4 features and 2 fields
#> Geometry type: POINT
#> Dimension:     XY
#> Bounding box:  xmin: 1 ymin: 1 xmax: 4 ymax: 4
#> Projected CRS: WGS 84 / Pseudo-Mercator
#> # A tibble: 4 × 3
#> # Groups:   cat [2]
#>   cat      geometry d[,1]
#> * <fct> <POINT [m]>   [m]
#> 1 1           (1 1)  0   
#> 2 1           (2 2)  1.41
#> 3 2           (3 3)  0   
#> 4 2           (4 4)  1.41
# this works, however the code does not get easier to read
df %>% mutate(d=st_distance(!!!syms(attr(., "sf_column")), (!!!syms(attr(., "sf_column")))[row_number()==1]))
#> Simple feature collection with 4 features and 2 fields
#> ...
#> 4 2           (4 4)  1.41
# this works and is already better:
geometry_name<-function(x) syms(attr(x, 'sf_column'))
df %>% mutate(d=st_distance(!!!geometry_name(.), (!!!geometry_name(.))[row_number()==1]))
#> Simple feature collection with 4 features and 2 fields
#> ...  
#> 4 2           (4 4)  1.41

理想情况下，我希望找到一个函数，使得下面的代码能够工作，这样对用户来说是最简单的:

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

- Bart

Answer 1

在没有参数的情况下调用这种函数需要假定符号在调用框架中存在（在本例中是 . 占位符和 .data 代词），因此它在 dplyr 动词之外的情况下不起作用，但如果适合您的工作流程，则可以执行以下操作：

geometry_name <- function() {
  .data <- eval(quote(.data), parent.frame())
  nms <- names(eval(quote(.), parent.frame()))
  geo <- which(sapply(nms, function(x) inherits(.data[[x]], 'sfc')))
  if(length(geo) == 0) {
    stop('No geometry column detected')
  }
  if(length(geo) > 1) {
    warning('More than one geometry column. Only the first will be used.')
    geo <- geo[1]
  }
  .data[[nms[geo]]]
}

使用您的示例，这允许您使用指定的语法：

df %>% 
  mutate(d = st_distance(geometry_name(), geometry_name()[row_number()==1]))
#> Simple feature collection with 4 features and 2 fields
#> Geometry type: POINT
#> Dimension:     XY
#> Bounding box:  xmin: 1 ymin: 1 xmax: 4 ymax: 4
#> Projected CRS: WGS 84 / Pseudo-Mercator
#> # A tibble: 4 x 3
#> # Groups:   cat [2]
#>   cat      geometry d[,1]
#> * <fct> <POINT [m]>   [m]
#> 1 1           (1 1)  0   
#> 2 1           (2 2)  1.41
#> 3 2           (3 3)  0   
#> 4 2           (4 4)  1.41

您可以通过允许函数接受一个名为data的参数来使其更加实用。如果该参数未提供，则运行上述代码（在检查.和.data是否存在之后），否则只从data中查找并返回sf列。这将允许在dplyr动词之外使用它，同时保留在dplyr中所需的行为。

例如：

geometry_name <- function(data) {
  if(missing(data)) {
    .data <- tryCatch( { 
      eval(quote(.data), parent.frame())
    }, error = function(e){ 
      stop("Argument 'data' missing, with no default")
    })
    plchlder <- tryCatch({
      eval(quote(.), parent.frame())
    }, error = function(e) {
      stop("geometry_name can only be used without a 'data' argument ",
           "inside dplyr verbs")
    })
    nms <- names(plchlder)
    geo <- which(sapply(nms, function(x) inherits(.data[[x]], 'sfc')))
    if(length(geo) == 0) {
      stop('No geometry column detected')
    }
    if(length(geo) > 1) {
      warning('More than one geometry column. Only the first will be used.')
      geo <- geo[1]
    }
    return(.data[[nms[geo]]])
  }
  
  geo <- which(sapply(data, function(x) inherits(x, 'sfc')))
  if(length(geo) == 0) stop('No geometry column detected')
  if(length(geo) > 1) {
    warning('More than one geometry column. Only the first will be used.')
    geo <- geo[1]
  }
  return(data[[geo]])
}

这将产生以下行为

geometry_name(df)
#> [1] "geometry"

geometry_name()
#> Error in value[[3L]](cond) : 
#>   geometry_name can only be used without a 'data' argument inside 
#>   dplyr verbs

df %>% 
  mutate(d = st_distance(geometry_name(), geometry_name()[row_number()==1]))
#> Simple feature collection with 4 features and 2 fields
#> Geometry type: POINT
#> Dimension:     XY
#> Bounding box:  xmin: 1 ymin: 1 xmax: 4 ymax: 4
#> Projected CRS: WGS 84 / Pseudo-Mercator
#> # A tibble: 4 x 3
#> # Groups:   cat [2]
#>   cat      geometry d[,1]
#> * <fct> <POINT [m]>   [m]
#> 1 1           (1 1)  0   
#> 2 1           (2 2)  1.41
#> 3 2           (3 3)  0   
#> 4 2           (4 4)  1.41

- Allan Cameron

---

这是一个很棒的解决方案！学到了不少东西。 我注意到它只能使用 magrittr 管道 (%>%)，而不能使用默认管道 (|>)。我尝试使用基本 R 管道的 _ 占位符来使其工作，但由于其功能完全不同且仅是占位符，我不确定是否可能实现。谢谢！ - Bart

Answer 2

在提取几何列名作为符号后，使用{{运算符。

gcol = sym(attr(df, "sf_column"))
df %>% 
    mutate(d = st_distance({{gcol}}, {{gcol}}[row_number() == 1]))

#> Simple feature collection with 4 features and 2 fields
#> Geometry type: POINT
#> Dimension:     XY
#> Bounding box:  xmin: 1 ymin: 1 xmax: 4 ymax: 4
#> Projected CRS: WGS 84 / Pseudo-Mercator
#> # A tibble: 4 × 3
#> # Groups:   cat [2]
#>   cat      geometry d[,1]
#> * <fct> <POINT [m]>   [m]
#> 1 1           (1 1)  0   
#> 2 1           (2 2)  1.41
#> 3 2           (3 3)  0   
#> 4 2           (4 4)  1.41

- talegari