如何筛选并修改sf点数据集中末尾为000的坐标值

我有一个大型sf点数据集，需要对所有末尾为000的x或y坐标随机加减1（避免单个点与多个网格几何相交），能否直接筛选并编辑几何实现该需求？

原始代码示例 #

library(dplyr)
library(sf)

Data <- tibble(
    id=c("A00111", "A00112","A00113","A00211","A00212","A00213","A00214","A00311","A00312","A00472"),
    x=c(465000,455248,442525,445248,470825,460855,450433,474000,474000,488000),
    y=c(154897,284740,123000,123125,136000,175001,136600,150070,150070,176000))

sf <- st_as_sf(Data, coords = c("x","y"), crs=27700, na.fail=FALSE)

期望输出示例 #

Output <- tibble(
    id=c("A00111", "A00112","A00113","A00211","A00212","A00213","A00214","A00311","A00312","A00472"),
    x=c(465001,455248,442525,445248,470825,460855,450433,474001,473999,488001),
    y=c(154897,284740,122999,123125,136001,175001,136600,150070,150070,175999))

完全可以直接筛选并编辑sf对象的几何来实现需求，核心是提取坐标后针对性调整，再回写几何信息。以下是完整实现代码：

library(dplyr)
library(sf)

# 加载原始数据并转为sf对象
Data <- tibble(
    id=c("A00111", "A00112","A00113","A00211","A00212","A00213","A00214","A00311","A00312","A00472"),
    x=c(465000,455248,442525,445248,470825,460855,450433,474000,474000,488000),
    y=c(154897,284740,123000,123125,136000,175001,136600,150070,150070,176000))

sf <- st_as_sf(Data, coords = c("x","y"), crs=27700, na.fail=FALSE)

# 提取坐标矩阵
coords <- st_coordinates(sf)

# 定义调整函数：对末尾为000的坐标随机加减1
adjust_coord <- function(val) {
    if (val %% 1000 == 0) {
        val + sample(c(-1, 1), 1)
    } else {
        val
    }
}

# 批量处理x、y坐标
coords[, "X"] <- sapply(coords[, "X"], adjust_coord)
coords[, "Y"] <- sapply(coords[, "Y"], adjust_coord)

# 更新sf对象的几何信息，保留原属性和坐标系
sf_adj <- st_set_geometry(sf, st_sfc(st_multipoint(coords), crs = st_crs(sf)))

# 查看调整后的坐标（可选）
st_coordinates(sf_adj)

代码说明 #

• 用st_coordinates()提取sf对象的坐标矩阵，便于直接编辑
• adjust_coord()函数通过取模运算判断坐标是否为1000的整数倍（即末尾为000），符合条件则随机加1或减1
• 用sapply()批量处理所有坐标值，效率适配大型数据集
• 最后通过st_set_geometry()将调整后的坐标回写至sf对象，保留原数据的ID等属性和坐标系信息

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