计算R中500米缓冲区中的点数

Question

我可以使用以下函数得出 500m 缓冲区内的点数。但是，我想找到500m缓冲区中变量下具有相似值的点数。

例如在变量种族下：有3个值，白人、西班牙裔、黑人，我想找到500米内具有相似种族作为参考点的点的数量。

library(geosphere)

coordinates <- cbind(data$Y, data$X)
# Calculate distances between each point and all other points
distances <- distm(coordinates, fun =distHaversine)

# Count the number of points within 500 meters
data$proximity <- rowSums(distances <= 500)

Answer 1

您可以拆分数据集 (

split(data, ~Race)

) 并使用 3 个距离矩阵而不是一个。尽管使用

sf

和

dplyr

更方便，您可以根据某些属性对点进行分组，然后获取距每个位置的距离内的点数。

library(sf)
#> Linking to GEOS 3.11.2, GDAL 3.6.2, PROJ 9.2.0; sf_use_s2() is TRUE
library(dplyr)
library(ggplot2)

# generate example dataset
set.seed(42)
data <- data.frame(
  id = as.factor(1:7),
  X = runif(7, -.005, .005),
  Y = runif(7, -.005, .005),
  race = sample(c("white", "hispanic", "black"), 7, replace = TRUE))
data
#>   id             X             Y     race
#> 1  1  0.0041480604 -0.0036533340    white
#> 2  2  0.0043707541  0.0015699229    white
#> 3  3 -0.0021386047  0.0020506478 hispanic
#> 4  4  0.0033044763 -0.0004225822 hispanic
#> 5  5  0.0014174552  0.0021911225 hispanic
#> 6  6  0.0001909595  0.0043467225    black
#> 7  7  0.0023658831 -0.0024457118    black

# convert to sf object
data_sf <- 
  st_as_sf(data, coords = c("X", "Y"), crs = "WGS84")

# count points within distance, count includes origin point
# n_within : all points within 500m radius
# n_within_grouped : points from the same group within 500m radius
counts_sf <- 
  data_sf |>
  mutate(n_within = st_is_within_distance(geometry, dist = 500) |> lengths()) |>
  mutate(n_within_grouped = st_is_within_distance(geometry, dist = 500) |> lengths(), .by = race) 

结果数据集包含分组和未分组计数以及带有点缓冲区的可视化。

counts_sf
#> Simple feature collection with 7 features and 4 fields
#> Geometry type: POINT
#> Dimension:     XY
#> Bounding box:  xmin: -0.002138605 ymin: -0.003653334 xmax: 0.004370754 ymax: 0.004346722
#> Geodetic CRS:  WGS 84
#>   id     race                       geometry n_within n_within_grouped
#> 1  1    white POINT (0.00414806 -0.003653...        3                1
#> 2  2    white POINT (0.004370754 0.001569...        4                1
#> 3  3 hispanic POINT (-0.002138605 0.00205...        3                2
#> 4  4 hispanic POINT (0.003304476 -0.00042...        5                2
#> 5  5 hispanic POINT (0.001417455 0.002191...        5                3
#> 6  6    black POINT (0.0001909595 0.00434...        3                1
#> 7  7    black POINT (0.002365883 -0.00244...        4                1

ggplot(counts_sf) +
  # 500m buffers around points
  geom_sf(data = st_buffer(counts_sf, 500), aes(color = id, fill = id), alpha = .1) +
  geom_sf(aes(color = id, shape = race), size = 3) +
  geom_sf_text(aes(label = id), nudge_x = -.0004)+
  scale_color_brewer(palette = "Dark2") +
  scale_fill_brewer(palette = "Dark2") +
  ggspatial::annotation_scale() +
  theme_minimal()

^{创建于 2024-03-31，使用 reprex v2.1.0}