问题描述
我想“细化”用 sf::st_make_grid
制作的网格并获得高阶邻居的子集。
一阶邻居至少共享一侧,二阶邻居与一阶邻居共享一侧,以此类推。
这是一个例子:
require(sf)
require(ggplot2)
x = st_sfc(st_polygon(list(rbind(c(0,0),c(1,1),c(0,0)))))
g = st_make_grid(x,cellsize = .3,square = FALSE )
g = st_as_sf(g)
g$id = 1:nrow(g)
ggplot(g) + geom_sf() + geom_sf_text(aes(label = id))
二阶邻居的可能子集是:
gs = g[g$id %in% c(3:5,11:12,18:20),]
ggplot(gs) + geom_sf() + geom_sf_text(aes(label = id))
但其他样本也是可能的,例如c(1,2,9,8,10,16,17)
如何子集到任何更高阶的邻居?
解决方法
我会尝试如下解决您的问题。只有一个“免责声明”:我不确定以下方法是否 100% 正确,是否适用于所有情况。而且,正如前面评论中所讨论的,以下解决方案并不是唯一的,您可以根据起点和算法背后的选择得到不同的“细化”。
加载包
# packages
library(sf)
library(igraph)
library(ggplot2)
生成数据并绘制所有多边形
x = st_sfc(st_polygon(list(rbind(c(0,0),c(1,1),c(0,0)))))
g = st_make_grid(x,cellsize = .3,square = FALSE)
g = st_as_sf(g)
g$id = 1:nrow(g)
# plot all polygons
ggplot(g) +
geom_sf() +
geom_sf_text(aes(label = id))
提取单元格后面的图结构,并作图
my_graph <- graph_from_adj_list(st_touches(g))
plot(my_graph)
您可以注意到它与以前或多或少相同,没有任何地理结构。如果您将相同的代码应用于“现实世界问题”,您可能需要使用不同的空间谓词并调整 sf 对象的精度,因为坐标中可能存在舍入误差。
现在,从第一个单元格开始计算一阶邻居(应该被排除在外)的列表
id_to_be_ignored <- ego(my_graph,order = 1,nodes = 1)[[1]]
以及一阶和二阶邻居列表
all_second_order_neighbours <- ego(my_graph,order = 2,nodes = 1)[[1]]
最终样本应该包括这两个id之间的差异
final_sample <- difference(all_second_order_neighbours,id_to_be_ignored)
现在我需要对二阶单元重复这个操作
i <- 1
while (TRUE) {
# We need to end the loop sooner or later
if (i > length(final_sample)) break
# Extract the id of the node
id <- final_sample[[i]]
# Determine and exclude first order neighbours considering the id-th node
ego1_id <- ego(my_graph,nodes = id)[[1]]
id_to_be_ignored <- union(id_to_be_ignored,difference(ego1_id,V(my_graph)[id]))
# Determine and add second order neighbours considering the id-th node
ego2_id <- difference(
ego(my_graph,nodes = id)[[1]],ego1_id
)
final_sample <- difference(union(final_sample,ego2_id),id_to_be_ignored)
# Increment i
i <- i + 1
}
结果就是这样
ggplot(g[c(1,as.integer(final_sample)),]) +
geom_sf() +
geom_sf_text(aes(label = id))
现在我和 3 阶邻居重复
id_to_be_ignored <- ego(my_graph,nodes = 1)[[1]]
all_third_order_neighbours <- ego(my_graph,order = 3,nodes = 1)[[1]]
final_sample <- difference(all_third_order_neighbours,id_to_be_ignored)
i <- 1
while (TRUE) {
if (i > length(final_sample)) break
id <- final_sample[[i]]
ego2_id <- ego(my_graph,difference(ego2_id,V(my_graph)[id]))
ego3_id <- difference(
ego(my_graph,ego2_id
)
final_sample <- difference(union(final_sample,ego3_id),id_to_be_ignored)
# Increment i
i <- i + 1
}
再次,这是结果
ggplot(g[c(1,]) +
geom_sf() +
geom_sf_text(aes(label = id))
由 reprex package (v0.3.0) 于 2021 年 1 月 28 日创建
同样的代码也应该适用于不同的空间结构和社区秩序。