在重疊多邊形解散后保留“最早”多邊形的日期和 ID

Question

目前，我有兩個 MULTIPOLYGON 層，我通過以下方式將它們分解為一層：

sq = function(pt, sz = 1) st_polygon(list(rbind(c(pt - sz), c(pt[1] + sz, pt[2] - sz), c(pt + sz), c(pt[1] - sz, pt[2] + sz), c(pt - sz))))

# First Layer
flood1 = st_sf(box = 1:6, st_sfc(sq(c(4.2,4.2)), sq(c(0,0)), sq(c(1, -0.8)), sq(c(0.5, 1.7)), sq(c(3,3)), sq(c(-3, -3))))
plot(flood1)

flood1$id <- c("5001", "5002", "5792", "5029", "4802", "6783")
flood1$date <- as.Date(as.Date("2011-12-30"):as.Date("2012-01-04"), origin="1970-01-01")

# Second Layer
flood2 = st_sf(box = 1:6, st_sfc(sq(c(4.2,4.0)), sq(c(0,0.2)), sq(c(1.1, -0.6)), sq(c(0.8, 1.9)), sq(c(3.5,6)), sq(c(-3.4, -3.3))))
plot(flood2)

flood2$id <- c("5008", "6002", "7592", "5209", "1001", "4752")
flood2$date <- as.Date(as.Date("2014-12-30"):as.Date("2015-01-04"), origin="1970-01-01")

# Dissolving overlapping polygons together
flood_agg = sf::st_cast(st_union(flood1, flood2),"POLYGON")

現在，讓我們想象這些多邊形中的每一個都代表在季風季節發生的不同洪水，而每一層代表不同的季風季節。 在成功將重疊多邊形溶解到一個“洪水區域”后，我想保留作為已溶解組一部分的最早洪水的日期和 ID。 我正在使用的實際圖層包含大約 2000 個洪水，因此我需要弄清楚如何以編程方式執行此操作。 關於我如何 go 對此有何想法？

Answer 1

這是一個如何完成它的小例子。 讓我們構建一個三層的例子，並簡化日期/ID。

library(sf)
library(tidyverse)

# function to make squares as example
sq = function(pt, sz = 1){st_polygon(list(rbind(c(pt - sz), c(pt[1] + sz, pt[2] - sz), c(pt + sz), c(pt[1] - sz, pt[2] + sz), c(pt - sz))))}

# First Layer (2012)
flood1 = st_sf(box = 1:6, st_sfc(sq(c(4.2,4.2)), sq(c(0,0))))
st_geometry(flood1) <- "geometry"
flood1$id <- c("5001", "5002")
flood1$date <- as.Date("2012-01-01")

# Second Layer  (2013)
flood2 = st_sf(box = 1:6, st_sfc(sq(c(3.2, 5.2)), sq(c(1,0))))
st_geometry(flood2) <- "geometry"
flood2$id <- c("6001", "6002")
flood2$date <- as.Date("2013-01-01")

# Third Layer (2014)
flood3 = st_sf(box = 1:6, st_sfc(sq(c(4.2, 0.2)), sq(c(2,5))))
st_geometry(flood3) <- "geometry"
flood3$id <- c("7001", "7002")
flood3$date <- as.Date("2014-01-01")

# auxiliary function for clipping geometries
st_erase = function(x, y){st_difference(x, st_union(st_combine(y)))}

# clip what is left of 2013 on top of 2012
flood2_add = st_erase(flood2, flood1)

# clip what is left of 2014 on top of the sum of 2012 and 2013
flood3_add = st_erase(flood3, flood2_add)

# bring everything together in a single sf data.frame
d <- rbind(flood1, flood2_add, flood3_add)

# just to facilitate the graph lets create a column with the year
d$year <- as.factor(lubridate::year(d$date))

# show me the money
ggplot() +
  geom_sf(data = d,
          aes(fill = year),
          alpha = 0.3) +
  scale_fill_discrete(name = element_blank()) +
  theme_bw()

最年長的年份將居於首位。

請注意，它們確實沒有重疊：

ggplot() +
  geom_sf(data = d,
          aes(fill = year),
          alpha = 0.3) +
  facet_wrap(~year) +
  scale_fill_discrete(name = element_blank()) +
  theme_bw()

我們可以檢查 data.frame 看看我們是否得到了我們想要的結果：

Simple feature collection with 18 features and 4 fields
Geometry type: POLYGON
Dimension:     XY
Bounding box:  xmin: -1 ymin: -1 xmax: 5.2 ymax: 6.2
CRS:           NA
First 10 features:
   box   id       date                       geometry year
1    1 5001 2012-01-01 POLYGON ((3.2 3.2, 5.2 3.2,... 2012
2    2 5002 2012-01-01 POLYGON ((-1 -1, 1 -1, 1 1,... 2012
3    3 5001 2012-01-01 POLYGON ((3.2 3.2, 5.2 3.2,... 2012
4    4 5002 2012-01-01 POLYGON ((-1 -1, 1 -1, 1 1,... 2012
5    5 5001 2012-01-01 POLYGON ((3.2 3.2, 5.2 3.2,... 2012
6    6 5002 2012-01-01 POLYGON ((-1 -1, 1 -1, 1 1,... 2012
7    1 6001 2013-01-01 POLYGON ((2.2 4.2, 2.2 6.2,... 2013
8    2 6002 2013-01-01 POLYGON ((2 1, 2 -1, 1 -1, ... 2013
9    3 6001 2013-01-01 POLYGON ((2.2 4.2, 2.2 6.2,... 2013
10   4 6002 2013-01-01 POLYGON ((2 1, 2 -1, 1 -1, ... 2013

在我看來很好。 我們有來自裁剪特征的日期和 ID，現在，您仍然必須在自定義函數中對其進行調整，以便能夠使用它 2000 次（一個for loop ，一個apply function 或我最喜歡purrr ）。