Извлечь количество растровых ячеек, включенных в SpatialPolygons

Question

Я хотел бы создать функцию для подсчета количества растровых ячеек в полигонах объекта SpatialPolygonsDataframe и добавления значения в качестве нового столбца без использования цикла. Я не могу найти, как это сделать...

Вот мой код:

library(sp)
library(raster)
# Create a SpatialPolygonsDataframe and a raster objets to overlay
# Polygons
p1 <- rbind(c(-180,-20), c(-140,55), c(-50, 0), c(-140,-60), c(-180,-20))
p2 <- rbind(c(-10,0), c(140,60), c(160,0), c(140,-55), c(-10,0))
p3 <- rbind(c(-125,0), c(0,60), c(40,5), c(15,-45), c(-125,0))
polys <- as(spPolygons(p1, p2, p3), "SpatialPolygonsDataFrame")
# Raster
p4 <- rbind(c(-180,10), c(0,90), c(40,90), c(145,-10),  
        c(-25, -15), c(-180,0), c(-180,10))
rpol <- spPolygons(p4)
r <- raster(ncol=90, nrow=45)
grd <- rasterize(rpol, r, fun=sum)

# Function to count the share of occupied cells per polygon
myFunction <- function(polys,grd){
    over <- crop(mask(grd, polys), polys)
    share <- length(over[!is.na(over)]) / ncell(over) * 100
  return(share)
}  

myFunction(polys,grd) 

Большое спасибо за вашу помощь!

Answer 1

Вы можете использовать функцию raster::extract, По умолчанию это извлекает информацию о ячейке для каждого многоугольника SpatialPolygonDataFrame. Вывод представляет собой список, так что вы можете подсчитать количество объектов в списке.

library(sp)
library(raster)
# Create a SpatialPolygonsDataframe and a raster objets to overlay
# Polygons
p1 <- rbind(c(-180,-20), c(-140,55), c(-50, 0), c(-140,-60), c(-180,-20))
p2 <- rbind(c(-10,0), c(140,60), c(160,0), c(140,-55), c(-10,0))
p3 <- rbind(c(-125,0), c(0,60), c(40,5), c(15,-45), c(-125,0))
polys <- as(spPolygons(p1, p2, p3), "SpatialPolygonsDataFrame")

# Create raster
r <- raster(ncol=90, nrow=45)
values(r) <- 1:ncell(r)
# Extract values
r.ext <- extract(r, polys)
# Count number of cell for each polygon
lengths(r.ext)

Answer 2

Стоит отметить, что это можно сделать существенно быстрее, используяterra. В моем случае запуск чего-то вроде этого будет примерно в 80 раз быстрее:

      p1 <- rbind(c(-180,-20), c(-140,55), c(-50, 0), c(-140,-60), c(-180,-20))
p2 <- rbind(c(-10,0), c(140,60), c(160,0), c(140,-55), c(-10,0))
p3 <- rbind(c(-125,0), c(0,60), c(40,5), c(15,-45), c(-125,0))
polys <- as(spPolygons(p1, p2, p3), "SpatialPolygonsDataFrame")
r <- raster(ncol=90, nrow=45)
values(r) <- 1:ncell(r)

v <- terra::vect(polys)
r <- terra::rast(r)
cells_per_poly <- terra::extract(r, v) %>% group_by(ID) %>% summarise(n=n())