Une manière appropriée de lier des SpatialPolygonsDataFrames avec des ID de polygone identiques?


22

Quel est l'idiome R approprié pour relier les SPDF ensemble lorsque les ID se chevauchent? Notez qu'ici (comme c'est souvent le cas) les identifiants n'ont pratiquement aucun sens, donc c'est assez ennuyeux que je ne puisse pas simplement faire en sorte que rbind les 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"

Réponses:


15

ID, emplacements et fonctions de type d'application. Mes trois choses les moins préférées qui sont absolument essentielles à tout ce que je fais. J'ai pensé que je répondrais juste pour générer plus de contenu sur ce sujet.

Le code ci-dessous fonctionne, mais il conserve les valeurs d'ID "inutiles". Un meilleur code prendrait le temps d'analyser les choses afin que chaque tract ait pour identifiant FIPS d'état, FIPS de comté et FIPS de tract. Juste quelques lignes supplémentaires pour que cela se produise, mais comme vous ne vous souciez pas des identifiants, nous allons les laisser de côté pour l'instant.

#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 )

Merci. Je voulais vérifier cela depuis quelques jours, mais la vie est intervenue. Je suis un peu étonné que ce soit autant de lignes de code. Pensez-vous qu'il vaudrait la peine de soumettre un patch à la méthode SPDF de rbinddans le sppackage? Je pensais transformer quelque chose comme ce code en ,deduplicateIDs=TRUEargument pour la méthode ....
Ari B. Friedman

Vraiment juste trois lignes de code pour la fonction et une pour l'appliquer avant la liaison, mais cela prend un certain temps pour traiter votre problème. J'ai toujours trouvé que la gestion de l'ID dans les SPDF était un problème (chaque fois que je charge quelque chose avec rgdal par exemple), mais Roger Bivand semble toujours être en mesure de les faire se comporter, j'ai donc supposé que c'était ma propre lacune. J'aime l'idée d'un patch, mais je me demande si l'accès à ces emplacements entraînerait des complications pour d'autres choses dans sp.
csfowler

Très bonne réponse. Je veux juste ajouter un conseil aux autres: lorsque rbind est bloqué dans mon code, c'est généralement à cause d'une erreur antérieure (entraînant des identifiants en double). L'erreur est donc correcte.
Chris

20

Il s'agit d'une approche encore plus simple:

x <- rbind(x1, x2, x3, makeUniqueIDs = TRUE)  

1
Je souhaite que cela soit documenté dans la page d'aide de rbind. Je dois regarder ici chaque fois que je ne me souviens pas des règles de casse qu'ils ont utilisées pour cet argument. La meilleure réponse, c'est sûr. Je ne pense pas qu'il ait besoin de plus de contexte et ne devrait certainement pas être supprimé!
JMT2080AD

La documentation suggère "make.row.names = TRUE)" ... ce qui ne semble pas fonctionner. Le copier-coller de l'exemple l'a fait.
Mox

Je pense que la raison pour laquelle cela n'est pas documenté dans l'aide est que vous effectuez un appel de méthode sp lorsque vous passez un objet sp à rbind. Tu vois methods(class = "SpatialLines"). Je ne suis pas sûr de cela, mais c'est ma meilleure estimation en ce moment. Je suis quasiment sûr qu'Edzer et co. ne maintiennent pas rbind lui-même, d'où le manque de documentation dans rbind.
JMT2080AD du

Et s'il y a une longue liste d'objets à fusionner ( x1, x2, x3, ..., xn)? Existe-t-il une méthode pour capturer la liste entière sans les taper toutes?
Phil

Fonctionne uniquement si le nombre de colonnes est égal.
Dennis

9

D'accord, voici ma solution. Suggestions bienvenues. Je soumettrai probablement ceci en tant que patch à spmoins que quelqu'un ne voie des omissions flagrantes.

#' 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)
}

1

J'ai apprécié le détail des autres réponses ici et, en s'appuyant sur elles, le one-liner auquel je suis arrivé est ci-dessous. Comme OP, je ne me soucie pas beaucoup de la signification de l'ID, mais les éléments suivants pourraient également être adaptés pour intégrer également une ID plus informative.

lst <- lapply(1:length(lst), function(i) spChFIDs(lst[[i]], paste0(as.character(i), '.', 1:length(lst[[i]]))))
En utilisant notre site, vous reconnaissez avoir lu et compris notre politique liée aux cookies et notre politique de confidentialité.
Licensed under cc by-sa 3.0 with attribution required.