tampón y unión en R sin reducir a un polígono múltiple

9

Me gustaría realizar una superposición espacial para identificar el polígono dentro del cual cae un conjunto de puntos. Sin embargo, primero quiero amortiguar y disolver los polígonos, de modo que los puntos que caen en cualquier lugar dentro de los polígonos fusionados (pero no dentro de ningún agujero) se etiquetarán de manera similar por el procedimiento de superposición.

Desafortunadamente, el proceso de amortiguación y / o disolución que estoy usando está reduciendo el SpatialPolygonsobjeto a un polígono múltiple. El uso gBuffercrea un polígono múltiple cuando byid=FALSE, pero no une polígonos superpuestos cuando byid=TRUE. En el último caso, la disolución posterior de polígonos con gUnaryUnionnuevamente crea un polígono múltiple. La superposición SpatialPointsde estos resultados con múltiples polígonos hace que todos los puntos contenidos se informen como pertenecientes al polígono 1.

Aquí hay un ejemplo de juguete relacionado con puntos almacenados, donde me gustaría hacer una superposición de los puntos con los polígonos almacenados:

library(sp)
library(rgeos)
pts <- SpatialPoints(cbind(c(1, 1, 2, 3), c(1, 2, 1.5, 2.5))) 
plot(gBuffer(pts, width=0.6), lwd=2)
points(pts, pch=20, cex=2)
text(coordinates(pts), labels=seq_len(length(pts)), pos=4, font=2)

ingrese la descripción de la imagen aquí

Y los resultados de algunas superposiciones ...

  • Con byid=FALSE:

    b <- gBuffer(pts, width=0.6) 
    over(pts, b)
    # [1] 1 1 1 1
  • Con byid=TRUE:

    b2 <- gBuffer(pts, width=0.6, byid=TRUE) 
    over(pts, b2)
    # [1] 1 2 3 4
  • Con byid=TRUEy subsecuente gUnaryUnion:

    b3 <- gUnaryUnion(b2)
    over(pts, b3)
    # [1] 1 1 1 1

Estoy buscando el método correcto para lograr el resultado 1 1 1 2, es decir, los puntos 1, 2 y 3 caen dentro del polígono 1 (anteriormente polígonos 1, 2 y 3, que se han fusionado), y el punto 4 cae dentro del polígono 2 (originalmente polígono 4 )


EDITAR

Mis datos verdaderos incluyen agujeros, e idealmente me gustaría poder conservarlos. He actualizado los datos de ejemplo anteriores para incluir un agujero después del almacenamiento en búfer.

Aplicando el enfoque de @ JeffreyEvans a estas políticas:

polys <- b@polygons[[1]]@Polygons
pl <- vector("list", length(polys))
for (i in 1:length(polys)) { pl[i] <- Polygons(list(polys[[i]]), i) }
b.spolys <- SpatialPolygons(pl)
row.ids <- sapply(slot(b.spolys, "polygons"), function(i) slot(i, "ID"))    
b.exploded <- SpatialPolygonsDataFrame(b.spolys, data.frame(FID=as.numeric(row.ids))) 

resultados en:

over(pts, b.exploded)

#   FID
# 1   2
# 2   2
# 3   2
# 4   1

cuál es el resultado esperado (no estoy demasiado preocupado por el orden polivinílico - 2,2,2,1vs. 1,1,1,2), pero b.explodedha perdido la información sobre el agujero, en su lugar, lo representa como un polígono sin agujero. Obviamente, no afecta el resultado del ejemplo del juguete, pero una superposición que involucra puntos ubicados en el hoyo será engañosa, por ejemplo:

in_hole <- SpatialPoints(cbind(1.375, 1.5))
over(in_hole, b.exploded)
#   FID
# 1   2
jbaums
fuente

Respuestas:

7

Resulta que sp::disaggregatese puede usar para separar los polígonos de una sola parte.

pts <- SpatialPoints(cbind(c(1, 1, 2, 3), c(1, 2, 1.5, 2.5))) 
b <- gBuffer(pts, width=0.6) 
over(pts, disaggregate(b))

# [1] 1 1 1 2

in_hole <- SpatialPoints(cbind(1.375, 1.5))
over(in_hole, disaggregate(b))

# [1] NA

( raster::aggregatese puede usar para combinarlos nuevamente).

jbaums
fuente
3

Soy comprensivo, esto es un poco doloroso. Debe explotar las ranuras, del objeto polígono gBuffer, en polígonos individuales.

require(sp)
require(rgeos)
pts <- SpatialPoints(cbind(c(1, 1, 3), c(1, 2, 3))) 

b <- gBuffer(pts, width=0.6)

over(pts, b)

###########################################################
# explodes slots into individual polygons
polys <- b@polygons[[1]]@Polygons
  pl <- vector("list", length(polys))
    for (i in 1:length(polys)) { pl[i] <- Polygons(list(polys[[i]]), i) }
      b.spolys <- SpatialPolygons(pl)
        row.ids=sapply(slot(b.spolys, "polygons"), function(i) slot(i, "ID"))    
b <- SpatialPolygonsDataFrame(b.spolys, data.frame(FID=as.numeric(row.ids)) ) 
###########################################################

over(pts, b)
Jeffrey Evans
fuente
Acabo de probar y parece prometedor, pero mis agujeros ya no son agujeros :(. ¿Podemos adaptar esto para mantener los agujeros junto con los polys con los que están asociados? (Me dirigía a lo largo de líneas similares a su sugerencia, con n <- length(buff@polygons[[1]]@Polygons); SpatialPolygons(mapply(function(x, y) Polygons(list(x), y), buff@polygons[[1]]@Polygons, seq_len(n)))... Debería haber mencionado el problema del agujero en la publicación, lo siento.
jbaums