高效提取多多边形中自相交特征生成的所有子多边形

2024-01-28

从包含大量(大约 20000 个)可能部分重叠的多边形的 shapefile 开始,我需要提取通过相交不同“边界”而产生的所有子多边形。

在实践中,从一些模拟数据开始:

library(tibble)
library(dplyr)
library(sf)

ncircles <- 9
rmax     <- 120
x_limits <- c(-70,70)
y_limits <- c(-30,30)
set.seed(100) 
xy <- data.frame(
  id = paste0("id_", 1:ncircles), 
  x = runif(ncircles, min(x_limits), max(x_limits)),
  y = runif(ncircles, min(y_limits), max(y_limits))) %>% 
  as_tibble()

polys <- st_as_sf(xy, coords = c(2,3)) %>% 
  st_buffer(runif(ncircles, min = 1, max = 20)) 

plot(polys[1])  

我需要导出一个sf or sp包含所有且仅由相交生成的多边形的多重多边形,例如:

(请注意,颜色只是为了举例说明预期结果,其中每个“不同颜色”区域都是一个单独的多边形,不会覆盖任何其他多边形)

我知道我可以通过一次分析一个多边形,识别并保存其所有交点,然后“擦除”这些区域形成完整的多边形并循环进行来解决问题,但这非常慢。

我觉得应该有一个更有效的解决方案,但我无法弄清楚,所以任何帮助将不胜感激! (两个都sf and sp欢迎基于解决方案)

UPDATE:

最后,我发现即使是“一次一个多边形”,任务也远非简单!我真的在这个看似“简单”的问题上苦苦挣扎!有什么提示吗?即使是缓慢的解决方案或开始正确路径的提示也将受到赞赏!

UPDATE 2:

也许这会澄清一些事情:所需的功能将类似于此处描述的功能:

https://it.mathworks.com/matlabcentral/fileexchange/18173-polygon-intersection?requestedDomain=www.mathworks.com https://it.mathworks.com/matlabcentral/fileexchange/18173-polygon-intersection?requestedDomain=www.mathworks.com

UPDATE 3:

我将赏金授予了@shuiping-chen(谢谢!),他的答案正确地解决了所提供的示例数据集上的问题。然而,该“方法”必须推广到可能存在“四重”或“n重”交叉的情况。我将在接下来的几天里尝试解决这个问题,如果我能做到的话,我会发布一个更通用的解决方案!


Input

我稍微修改了模型数据,以说明处理多个属性的能力。

library(tibble)
library(dplyr)
library(sf)

ncircles <- 9
rmax     <- 120
x_limits <- c(-70,70)
y_limits <- c(-30,30)
set.seed(100) 
xy <- data.frame(
  id = paste0("id_", 1:ncircles), 
  val = paste0("val_", 1:ncircles),
  x = runif(ncircles, min(x_limits), max(x_limits)),
  y = runif(ncircles, min(y_limits), max(y_limits)),
  stringsAsFactors = FALSE) %>% 
  as_tibble()

polys <- st_as_sf(xy, coords = c(3,4)) %>% 
  st_buffer(runif(ncircles, min = 1, max = 20)) 
plot(polys[1])

基本操作

然后定义以下两个函数。

  • cur:基础多边形的当前索引
  • x:与 相交的多边形的索引cur
  • input_polys:多边形的简单特征
  • keep_columns:几何计算后需要保留的属性名称向量

get_difference_region()获取基础多边形与其他相交多边形之间的差异;get_intersection_region()获取相交多边形之间的交点。

library(stringr)
get_difference_region <- function(cur, x, input_polys, keep_columns=c("id")){
  x <- x[!x==cur] # remove self 
  len <- length(x)
  input_poly_sfc <- st_geometry(input_polys)
  input_poly_attr <- as.data.frame(as.data.frame(input_polys)[, keep_columns])

  # base poly
  res_poly <- input_poly_sfc[[cur]]
  res_attr <- input_poly_attr[cur, ]

  # substract the intersection parts from base poly
  if(len > 0){
    for(i in 1:len){
      res_poly <- st_difference(res_poly, input_poly_sfc[[x[i]]])
    }
  }
  return(cbind(res_attr, data.frame(geom=st_as_text(res_poly))))
}


get_intersection_region <- function(cur, x, input_polys, keep_columns=c("id"), sep="&"){
  x <- x[!x<=cur] # remove self and remove duplicated obj 
  len <- length(x)
  input_poly_sfc <- st_geometry(input_polys)
  input_poly_attr <- as.data.frame(as.data.frame(input_polys)[, keep_columns])

  res_df <- data.frame()
  if(len > 0){
    for(i in 1:len){
      res_poly <- st_intersection(input_poly_sfc[[cur]], input_poly_sfc[[x[i]]])
      res_attr <- list()
      for(j in 1:length(keep_columns)){
        pred_attr <- str_split(input_poly_attr[cur, j], sep, simplify = TRUE)
        next_attr <- str_split(input_poly_attr[x[i], j], sep, simplify = TRUE)
        res_attr[[j]] <- paste(sort(unique(c(pred_attr, next_attr))), collapse=sep)
      }
      res_attr <- as.data.frame(res_attr)
      colnames(res_attr) <- keep_columns
      res_df <- rbind(res_df, cbind(res_attr, data.frame(geom=st_as_text(res_poly))))
    }
  }
  return(res_df)
}

第一级

不同之处

让我们看看差异函数对模型数据的影响。

flag <- st_intersects(polys, polys)

first_diff <- data.frame()
for(i in 1:length(flag)) {
  cur_df <- get_difference_region(i, flag[[i]], polys, keep_column = c("id", "val"))
  first_diff <- rbind(first_diff, cur_df)
}
first_diff_sf <- st_as_sf(first_diff, wkt="geom")
first_diff_sf
plot(first_diff_sf[1])

路口

first_inter <- data.frame()
for(i in 1:length(flag)) {
  cur_df <- get_intersection_region(i, flag[[i]], polys, keep_column=c("id", "val"))
  first_inter <- rbind(first_inter, cur_df)
}
first_inter <- first_inter[row.names(first_inter %>% select(-geom) %>% distinct()),]
first_inter_sf <- st_as_sf(first_inter, wkt="geom")
first_inter_sf
plot(first_inter_sf[1])

第二级

使用第一级的交集作为输入,并重复相同的过程。

不同之处

flag <- st_intersects(first_inter_sf, first_inter_sf)
# Second level difference region
second_diff <- data.frame()
for(i in 1:length(flag)) {
  cur_df <- get_difference_region(i, flag[[i]], first_inter_sf, keep_column = c("id", "val"))
  second_diff <- rbind(second_diff, cur_df)
}
second_diff_sf <- st_as_sf(second_diff, wkt="geom")
second_diff_sf
plot(second_diff_sf[1])

路口

second_inter <- data.frame()
for(i in 1:length(flag)) {
  cur_df <- get_intersection_region(i, flag[[i]], first_inter_sf, keep_column=c("id", "val"))
  second_inter <- rbind(second_inter, cur_df)
}
second_inter <- second_inter[row.names(second_inter %>% select(-geom) %>% distinct()),]  # remove duplicated shape
second_inter_sf <- st_as_sf(second_inter, wkt="geom")
second_inter_sf
plot(second_inter_sf[1])

获取第二层的不同交集,并将它们用作第三层的输入。可以得到第三层的交集结果为NULL,那么该过程应该结束。

Summary

我们将所有差异结果放入 close 列表中,并将所有交集结果放入 open 列表中。然后我们有:

  • 当打开列表为空时,我们停止进程
  • 结果已接近列表

因此,我们在这里得到最终的代码(应该声明基本的两个函数):

# init
close_df <- data.frame()
open_sf <- polys

# main loop
while(!is.null(open_sf)) {
  flag <- st_intersects(open_sf, open_sf)
  for(i in 1:length(flag)) {
    cur_df <- get_difference_region(i, flag[[i]], open_sf, keep_column = c("id", "val"))
    close_df <- rbind(close_df, cur_df)
  }
  cur_open <- data.frame()
  for(i in 1:length(flag)) {
    cur_df <- get_intersection_region(i, flag[[i]], open_sf, keep_column = c("id", "val"))
    cur_open <- rbind(cur_open, cur_df)
  }
  if(nrow(cur_open) != 0) {
    cur_open <- cur_open[row.names(cur_open %>% select(-geom) %>% distinct()),]
    open_sf <- st_as_sf(cur_open, wkt="geom")
  }
  else{
    open_sf <- NULL
  }
}

close_sf <- st_as_sf(close_df, wkt="geom")
close_sf
plot(close_sf[1])
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

高效提取多多边形中自相交特征生成的所有子多边形 的相关文章

  • 计算一列中正数和负数的数量

    我想计算数据帧的一列中正值和负值的数量 我在 R 中该怎么做 例如 这里是数据框 logFC logCPM LR PValue FDR Bra15066 5 630822 5 184586 73 79927 8 647868e 18 4 0
  • par(mfrow=c(1,2)) 不显示并排密度图[重复]

    这个问题在这里已经有答案了 par mfrow c 1 2 plot 1 12 log y plot 1 2 xaxs i 然而 当我尝试做并排密度图时 图会单独输出 load the stud recs dataset library U
  • 将命名参数列表传递给函数?

    我想编写一个小函数来从适当的分布生成样本 例如 makeSample lt function n dist params values lt makeSample 100 unif list min 0 max 10 values lt m
  • 如何在R中计算文本中的句子数?

    我使用 R 将文本读入readChar 功能 我的目的是测试文本句子中字母 a 出现次数与字母 b 出现次数一样多的假设 我最近发现了 stringr 包 它帮助我对文本做很多有用的事情 例如计算字符数以及整个文本中每个字母出现的总数 现在
  • 基于服务器中的条件逻辑呈现闪亮的用户输入

    我正在尝试设置一个闪亮的导航栏面板页面 其中用户控制我根据一组单选按钮中所做的初始选择来显示更改 我直接在 ui 中渲染单选按钮 然后在 Server r 中的 观察到的 逻辑控制结构内构建条件控件 弹出错误是因为我的初始 if 语句计算结
  • 计算例如具有多列 data.frames 的列表中的平均值

    我有几个 data frames 的列表 每个 data frame 有几列 通过使用mean mylist first dataframe a我可以得到这个 data frame 中 a 的平均值 但是我不知道如何计算列表中存储的所有 d
  • kableExtra 中的 row_spec() 函数不会在 html 输出中创建水平线

    我想在 kableextra 表中的某一行下方添加一条水平线 row spec 函数的参数 hline after 应该在行下方添加水平线 row spec 文档 https www rdocumentation org packages
  • 如何在for循环中引用变量?

    我正在循环访问不同的 data tables 和 data table 中的变量 但我在引用内部变量时遇到问题for loop dt1 lt data table a1 c 1 2 3 a2 c 4 5 2 dt2 lt data tabl
  • 如何为多边形创建内部螺旋?

    对于任何形状 我如何在其内部创建类似形状的螺旋 这与边界 使用 Minkowski 和 类似 尽管它会是相同形状的螺旋 而不是在形状内部创建相同的形状 我找到了这个 http www cis upenn edu cis110 13su le
  • 删除ggplot2中的负图区域[重复]

    这个问题在这里已经有答案了 如何删除 ggplot2 中 x 轴和 y 轴下方的绘图区域 请参见下面的示例 我尝试了几个主题元素 panel border panel margin plot margin 但没有任何运气 p lt ggpl
  • 如何用外部图像填充地图边界?

    我正在创建一张带有州边界的巴西地图 这可以直接使用ggplot2 and geom sf 然而 这一次 我不想用数据填充每个状态的颜色 而是想用外部图像 png 填充每个状态的边界 类似于this https online olivet e
  • 计算每个唯一值出现的次数

    假设我有 v rep c 1 2 2 2 25 现在 我想计算每个唯一值出现的次数 unique v 返回唯一值是什么 但不返回它们的数量 gt unique v 1 1 2 我想要一些能给我的东西 length v v 1 1 25 le
  • R中的一元加/减是什么?

    来自 R 的详细信息部分Syntax http stat ethz ch R manual R patched library base html Syntax html帮助页面 定义了以下一元和二元运算符 他们被列出 在优先级组中 从最高
  • 纵向序列数据的三次样条方法?

    我有一个串行数据 格式如下 time milk Animal ID 30 25 6 1 31 27 2 1 32 24 4 1 33 17 4 1 34 33 6 1 35 25 4 1 33 29 4 2 34 25 4 2 35 24
  • 使用 purrr 迭代替换数据帧列中的字符串

    我想用purrr使用以下命令在数据框列上迭代运行多个字符串替换gsub 功能 这是示例数据框 df lt data frame Year 2019 Text c rep a aa 5 rep a bb 3 rep a cc 2 gt df
  • 多功能测试仪替代 system.time

    我已经看到 我认为是这样 使用了类似于 system time 的函数 它可以同时评估多个函数的时间并输出一个输出 我不记得它是什么 并且用我正在使用的术语进行互联网搜索并没有得到我想要的响应 有人知道我正在谈论的功能的名称 位置吗 你想要
  • 时间戳半小时窗口内字段的平均值

    我的数据框有列名Timestamp es看起来像 Timestamp es 2015 04 01 09 07 42 31 2015 04 01 09 08 01 29 5 2015 04 01 09 15 03 18 5 2015 04 0
  • 将绘图调用拆分为多个块

    我正在编写一个图的解释 其中我基本上将在第一个块中创建图 然后描述该输出 并在第二个块中添加一个轴 然而 似乎每个块都会强制一个新的绘图环境 因此当我们尝试使用以下命令运行块时会出现错误axis独自的 观察 output html docu
  • 为什么 dplyr filter() 不能在函数内工作(即使用变量作为列名)?

    使用 dplyr 函数对数据进行过滤 分组和变异的函数 基本管道序列在函数之外工作得很好 这就是我使用真实列名称的地方 将其放入一个函数中 其中列名称是一个变量 并且某些函数可以工作 但有些函数则不能 尤其是 dplyr filter 例如
  • API 请求和curl::curl_fetch_memory(url, handle = handle) 中的错误:SSL 证书问题:证书已过期

    几天前 我运行了代码几个月 没有任何问题 GET url myurl query 今天我遇到一个错误 Error in curl curl fetch memory url handle handle SSL certificate pro

随机推荐