¿Forma correcta de vincular SpatialPolygonsDataFrames con identificaciones de polígono idénticas?

22

¿Cuál es el idioma R apropiado para unir SPDF juntos cuando las ID se superponen? Tenga en cuenta que aquí (como suele ser el caso) los ID no tienen sentido, por lo que es bastante molesto que no pueda hacer que rbind los ignore ...

library(sp)
library(UScensus2000)
library(UScensus2000tract)

data(state) # for state names
states <- gsub( " ", "_", tolower(state.name) )
datanames <- paste(states,"tract", sep=".")
data( list=datanames )
lst <- lapply(datanames,get)

nation <- do.call( rbind, lst )
Error in validObject(res) : 
  invalid class SpatialPolygons object: non-unique Polygons ID slot values

# This non-exported function designed to solve this doesn't seem to work any more.
d <- sp:::makeUniqueIDs( list(arizona.tract,delaware.tract) )
Error in slot(i, "ID") : 
  no slot of name "ID" for this object of class "SpatialPolygonsDataFrame"
Ari B. Friedman
fuente

Respuestas:

15

ID, ranuras y funciones de tipo aplicación. Mis tres cosas menos favoritas que son absolutamente esenciales para todo lo que hago. Pensé que respondería solo para generar más contenido sobre este tema.

El siguiente código funciona, pero conserva los valores de ID "inútiles". Un mejor código se tomaría el tiempo de analizar las cosas para que cada sección tuviera el FIPS estatal, FIPS del condado y FIPS del tracto como su ID. Solo unas pocas líneas más para que eso suceda, pero como no te importan las identificaciones, lo dejaremos fuera por ahora.

#Your Original Code
library(sp)
library(UScensus2000)
library(UScensus2000tract)

data(state) # for state names
states <- gsub( " ", "_", tolower(state.name) )
datanames <- paste(states,"tract", sep=".")
data( list=datanames )
lst <- lapply(datanames,get)

#All good up to here, but we need to create unique ID's before rbind

#Modified from Roger Bivand's response at:
# https://stat.ethz.ch/pipermail/r-sig-geo/2007-October/002701.html

#For posterity: We can access the ID in two ways:
class(alaska.tract)
getSlots(class(alaska.tract))
class(slot(alaska.tract, "polygons")[[1]])
getSlots(class(slot(alaska.tract, "polygons")[[1]]))

#So to get all ID's
sapply(slot(alaska.tract, "polygons"), function(x) slot(x, "ID"))
#or
rownames(as(alaska.tract, "data.frame"))
#These should be the same, but they are quite different...sigh. Doesn't matter for
#what follows though

#To make them uniform we can write a function using the spChFIDs function from sp:
makeUniform<-function(SPDF){
  pref<-substitute(SPDF)  #just putting the file name in front.
  newSPDF<-spChFIDs(SPDF,as.character(paste(pref,rownames(as(SPDF,"data.frame")),sep="_")))
  return(newSPDF)
}

#now to do this for all of our state files
newIDs<-lapply(lst,function(x) makeUniform(x))

#back to your code...
nation <- do.call( rbind, newIDs )
csfowler
fuente
Gracias. He tenido la intención de comprobar esto durante unos días, pero la vida ha intervenido. Estoy un poco sorprendido de que haya tantas líneas de código. ¿Crees que valdría la pena enviar un parche al método SPDF rbinddel sppaquete? Estaba pensando en convertir algo como este código en un ,deduplicateIDs=TRUEargumento para el método ...
Ari B. Friedman
Realmente solo tres líneas de código para la función y una para aplicarla antes del rbind, pero lleva algún tiempo procesar su problema. Siempre he encontrado que el manejo de la ID en SPDF es un problema (cada vez que cargo algo con rgdal, por ejemplo), pero Roger Bivand siempre parece capaz de hacer que se comporten, así que simplemente asumí que era mi propia deficiencia. Me gusta la idea de un parche, pero me pregunto si acceder a esas ranuras podría causar complicaciones por otras cosas en sp.
csfowler
Gran respuesta. Solo quiero agregar una palabra de consejo a los demás que cuando rbind se atasca en mi código, generalmente se debe a un error anterior (que da como resultado identificaciones duplicadas). Entonces el error es correcto.
Chris
20

Este es un enfoque aún más simple:

x <- rbind(x1, x2, x3, makeUniqueIDs = TRUE)  
Wraf
fuente
1
Desearía que esto estuviera documentado en la página de ayuda de rbind. Tengo que mirar aquí cada vez que no recuerdo las reglas de la carcasa que usaron para este argumento. La mejor respuesta es segura. ¡No creo que necesite más contexto, y definitivamente no debería eliminarse!
JMT2080AD
La documentación sugiere "make.row.names = TRUE)" ... que no parece funcionar. Copiar y pegar el ejemplo lo hizo.
Mox
Creo que la razón por la que esto no está documentado en la ayuda es porque está haciendo una llamada al método sp cuando pasa un objeto sp a rbind. Ver methods(class = "SpatialLines"). No estoy seguro de esto, pero es mi mejor suposición en este momento. Estoy bastante seguro de que Edzer y compañía. no mantienen a rbind en sí mismo, de ahí la falta de documentación en rbind.
JMT2080AD
¿Qué pasa si hay una larga lista de objetos para fusionar ( x1, x2, x3, ..., xn)? ¿Hay algún método para capturar toda la lista sin escribirlos todos?
Phil
Solo funciona si el número de columnas es igual.
Dennis
9

Muy bien, aquí está mi solución. Sugerencias bienvenidas. Es probable que envíe esto como un parche a spmenos que alguien vea omisiones evidentes.

#' Get sp feature IDs
#' @aliases IDs IDs.default IDs.SpatialPolygonsDataFrame
#' @param x The object to get the IDs from
#' @param \dots Pass-alongs
#' @rdname IDs
IDs <- function(x,...) {
  UseMethod("IDs",x)
}
#' @method IDs default
#' @S3method IDs default
#' @rdname IDs
IDs.default <- function(x,...) {
  stop("Currently only SpatialPolygonsDataFrames are supported.")
}
#' @method IDs SpatialPolygonsDataFrame
#' @S3method IDs SpatialPolygonsDataFrame
#' @rdname IDs
IDs.SpatialPolygonsDataFrame <- function(x,...) {
  vapply(slot(x, "polygons"), function(x) slot(x, "ID"), "")
}

#' Assign sp feature IDs
#' @aliases IDs<- IDs.default<-
#' @param x The object to assign to
#' @param value The character vector to assign to the IDs
#' @rdname IDs<-
"IDs<-" <- function( x, value ) {
  UseMethod("IDs<-",x)
}
#' @method IDs<- SpatialPolygonsDataFrame
#' @S3method IDs<- SpatialPolygonsDataFrame
#' @rdname IDs<-
"IDs<-.SpatialPolygonsDataFrame" <- function( x, value) {
  spChFIDs(x,value)
}

#' rbind SpatialPolygonsDataFrames together, fixing IDs if duplicated
#' @param \dots SpatialPolygonsDataFrame(s) to rbind together
#' @param fix.duplicated.IDs Whether to de-duplicate polygon IDs or not
#' @return SpatialPolygonsDataFrame
#' @author Ari B. Friedman, with key functionality by csfowler on StackExchange
#' @method rbind.SpatialPolygonsDataFrame
#' @export rbind.SpatialPolygonsDataFrame
rbind.SpatialPolygonsDataFrame <- function(..., fix.duplicated.IDs=TRUE) {
  dots <- as.list(substitute(list(...)))[-1L]
  dots_names <- as.character(dots) # store names of objects passed in to ... so that we can use them to create unique IDs later on
  dots <- lapply(dots,eval)
  names(dots) <- NULL
  # Check IDs for duplicates and fix if indicated
  IDs_list <- lapply(dots,IDs)
  dups.sel <- duplicated(unlist(IDs_list))
  if( any(dups.sel) ) {
    if(fix.duplicated.IDs) {
      dups <- unique(unlist(IDs_list)[dups.sel])
      # Function that takes a SPDF, a string to prepend to the badID, and a character vector of bad IDs
      fixIDs <- function( x, prefix, badIDs ) {
        sel <-  IDs(x) %in% badIDs
        IDs(x)[sel] <- paste( prefix, IDs(x)[sel], sep="." )
        x
      }
      dots <- mapply(FUN=fixIDs , dots, dots_names, MoreArgs=list(badIDs=dups) )
    } else {
      stop("There are duplicated IDs, and fix.duplicated.IDs is not TRUE.")
    }
  }
  # One call to bind them all
  pl = do.call("rbind", lapply(dots, function(x) as(x, "SpatialPolygons")))
  df = do.call("rbind", lapply(dots, function(x) x@data))
  SpatialPolygonsDataFrame(pl, df)
}
Ari B. Friedman
fuente
1

He apreciado el detalle de otras respuestas aquí y, sobre la base de ellas, la frase con la que he llegado está a continuación. Al igual que OP, no me importa mucho el significado de la ID, pero lo siguiente también podría adaptarse para incrustar una ID más informativa.

lst <- lapply(1:length(lst), function(i) spChFIDs(lst[[i]], paste0(as.character(i), '.', 1:length(lst[[i]]))))
metasequoia
fuente