获取R中两个多边形之间的重叠百分比

时间:2021-02-04 10:59:38

标签: r geometry gis raster sf

我有两个 MULTYPOLYGONS,一个是选举区*年份对,另一个是洪水事件的集合。

 district.df
      year ward_ons     cycle                       geometry
    1 2007       E1   NA-2007 POLYGON ((527370.8 183470.7...
    2 2008       E1 2007-2008 POLYGON ((528891.1 182192.6...
    3 2009       E2   NA-2009 POLYGON ((370294.2 414678.7...
    4 2010       E3   NA-2010 POLYGON ((375025.4 414992.1...
    5 2011       E3 2010-2011 POLYGON ((375150.8 410809.8...
    6 2018       E3 2011-2018 POLYGON ((373286.3 414364.5...
    7 2007       E4   NA-2007 POLYGON ((373168.6 411597.8...
    8 2010       E4 2007-2010 POLYGON ((374783.2 406209.4...

洪水数据:

    flood.df
    Simple feature collection with 8 features and 2 fields
geometry type:  GEOMETRY
dimension:      XY
bbox:           xmin: 317656.2 ymin: 90783.2 xmax: 546460.6 ymax: 631125.7
projected CRS:  OSGB 1936 / British National Grid
  year            name                       geometry
1 2007      River 2007 POLYGON ((359637.7 268239.7...
2 2007       Tank 2007 POLYGON ((325444.1 92717.57...
3 2008  Yorkshire 2008 POLYGON ((318550.7 103058.8...
4 2009 Flood East 2009 POLYGON ((541472.6 112593, ...
5 2010  Occurence 2010 MULTIPOLYGON (((545863.4 11...
6 2012      Storm 2012 POLYGON ((473637.4 103927, ...
7 2011      Flood 2011 MULTIPOLYGON (((524617.6 42...
8 2017      River 2017 POLYGON ((393387.6 631125.7...

我想要做的是在选举区多多边形中获得一列,它是与洪水多多边形中任何多边形重叠的区域份额,其值为{ {1}}。

这是我尝试过的(受https://gis.stackexchange.com/questions/140504/extracting-intersection-areas-in-r影响)

year

然后试了一下

# Create function
overlap.fraction <- function(election, flood, yeari){
  flood.year <- flood[flood$year == yeari,]
  election.year <- election[election$year == yeari, ]
for (i in 1:nrow(election.year)){
  int.i <- as_tibble(st_intersection(i, flood.year))
  int.i$affected <- st_area(int.i$geoms)
  affected.by.county(paste0(yeari)) <- int.i%>%
  dplyr::group_by(code) %>%
  dplyr::summarise(affected.area = sum(affected))
}
}

但继续得到:

i.1990 <- overlap.fraction(district.df, flood.df, yeari = 1990)

我尝试对函数和其中的循环进行不同的修改。理想情况下,我什至会得到一个函数或循环,它可以立即执行,而不必每年都执行,就像我在这里尝试的情况一样。我这样做是因为我离这样做越来越近了,但我知道这不是最有效的方法。

任何帮助都会很棒。 谢谢!

1 个答案:

答案 0 :(得分:1)

让我们创建一个函数来按年

library(sf)

## storing years in a variable
years <- unique(district.df$year)

## creating an "auxiliary" geometry
flood.df$geom_2 <- st_geometry(flood.df)

## function to calculate this "proportion of intersection"
## inputs: y = year; dt1 = dataset1 (district); dt2 = dataset2(flood)
prop_intersect <- function(y, dt1, dt2) {
  ## filtering year
  out1 <- dt1[dt1$year == y,]
  out2 <- dt2[dt2$year == y,]

  ## calculating the areas for the first dataset
  out1 <- transform(out1, dist_area = as.numeric(st_area(geometry)))

  ## joining the datasets (polygons that intersect will be joined).
  ## It would be nice to have id variables for both datasets
  output <- st_join(
    x    = out1,
    y    = out2,
    join = st_intersects
  )

  ## calculating area of intersection
  output <- transform(output, 
                      inter_area = mapply(function(x, y) {
                                      as.numeric(sf::st_area(
                                           sf::st_intersection(x, y)
                                       ))}, x = geometry, y = geom_2))

  ## calculating proportion of intersected area
  output <- transform(output, prop_inter = inter_area/dist_area)

  return(output)
}

所以,现在我们有一个函数来执行您的请求。很可能存在更好(更有效和“更干净”)的方法来做到这一点。然而,这是我能想到的。此外,由于这不是 reprex,我很难知道这段代码是否有效。

话虽如此,现在我们可以按如下方式迭代“年份”

final_df <- lapply(years, prop_intersect, dt1 = district.df, dt2 = flood.df)

final_df <- do.call("rbind", final_df)