Richtige Möglichkeit, SpatialPolygonsDataFrames mit identischen Polygon-IDs zu binden?


22

Was ist das richtige R-Idiom, um SPDFs zusammenzubinden, wenn sich die IDs überlappen? Beachten Sie, dass hier (wie so oft) die IDs im Grunde genommen bedeutungslos sind, so dass es ziemlich ärgerlich ist, dass ich rbind nicht dazu bringen kann, sie zu ignorieren ....

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"

Antworten:


15

IDs, Slots und Funktionen vom Typ "Anwenden". Die drei am wenigsten bevorzugten Dinge, die für alles, was ich tue, unbedingt erforderlich sind. Ich dachte, ich würde nur antworten, um mehr Inhalte zu diesem Thema zu generieren.

Der folgende Code funktioniert, behält aber die "nutzlosen" ID-Werte bei. Besserer Code würde die Zeit zum Analysieren von Dingen in Anspruch nehmen, sodass jedes Trakt den Status FIPS, County FIPS und Trakt FIPS als ID hat. Nur noch ein paar Zeilen, um das zu erreichen, aber da Sie sich nicht für Ausweise interessieren, lassen wir es für den Moment weg.

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

Vielen Dank. Ich habe vor, dies seit ein paar Tagen zu überprüfen, aber das Leben hat eingegriffen. Ich bin ein bisschen erstaunt, dass es so viele Codezeilen sind. Glauben Sie, dass es sich lohnen würde, einen Patch für die rbindim spPaket enthaltene SPDF-Methode einzureichen ? Ich dachte daran, so etwas wie diesen Code in ein ,deduplicateIDs=TRUEArgument für die Methode umzuwandeln ...
Ari B. Friedman,

Wirklich nur drei Codezeilen für die Funktion und eine, um sie vor dem Binden anzuwenden, aber es dauert einige Zeit, bis das Problem behoben ist. Ich habe die Handhabung der ID in SPDFs immer als Problem empfunden (jedes Mal, wenn ich etwas mit rgdal lade, zum Beispiel), aber Roger Bivand scheint immer in der Lage zu sein, sie zum Verhalten zu bringen, also habe ich einfach angenommen, dass es mein eigenes Manko ist. Ich mag die Idee eines Patches, frage mich aber, ob der Zugriff auf diese Slots Komplikationen für andere Dinge in SP verursachen würde.
csfowler

Gute Antwort. Ich möchte anderen nur einen Ratschlag geben: Wenn rbind in meinem Code stecken bleibt, liegt dies normalerweise an einem früheren Fehler (der zu doppelten IDs führt). Der Fehler ist also richtig.
Chris

20

Dies ist ein noch einfacherer Ansatz:

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

1
Ich wünschte, dies wäre auf der rbind-Hilfeseite dokumentiert. Ich muss hier jedes Mal nachsehen, wenn ich mich nicht an die für dieses Argument verwendeten Schreibregeln erinnern kann. Beste Antwort sicher. Ich denke nicht, dass es mehr Kontext braucht und definitiv nicht entfernt werden sollte!
JMT2080AD

Die Dokumentation schlägt "make.row.names = TRUE)" vor ... was anscheinend nicht funktioniert. Kopieren-Einfügen des Beispiels hat.
Mox

Ich denke, der Grund, warum dies nicht in der Hilfe dokumentiert ist, ist, dass Sie einen sp-Methodenaufruf ausführen, wenn Sie ein sp-Objekt an rbind übergeben. Sehen methods(class = "SpatialLines"). Ich bin mir nicht sicher, aber es ist meine beste Vermutung im Moment. Ich bin mir ziemlich sicher, dass Edzer und Co. rbind selbst nicht beibehalten, daher die fehlende Dokumentation in rbind.
JMT2080AD

Was ist, wenn es eine lange Liste von Objekten gibt, die zusammengeführt werden sollen ( x1, x2, x3, ..., xn)? Gibt es eine Methode, um die gesamte Liste zu erfassen, ohne sie alle auszutippen?
Phil

Funktioniert nur, wenn die Anzahl der Spalten gleich ist.
Dennis

9

Okay, hier ist meine Lösung. Vorschläge sind willkommen. Ich werde dies wahrscheinlich als Patch an senden, es spsei denn, jemand sieht irgendwelche offensichtlichen Auslassungen.

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

Ich habe die Einzelheiten anderer Antworten hier sehr geschätzt und darauf aufbauend ist der Einzeiler, zu dem ich gekommen bin, unten. Wie bei OP interessiert mich die Bedeutung der ID nicht sonderlich, aber das Folgende könnte auch angepasst werden, um eine aussagekräftigere ID einzubetten.

lst <- lapply(1:length(lst), function(i) spChFIDs(lst[[i]], paste0(as.character(i), '.', 1:length(lst[[i]]))))
Durch die Nutzung unserer Website bestätigen Sie, dass Sie unsere Cookie-Richtlinie und Datenschutzrichtlinie gelesen und verstanden haben.
Licensed under cc by-sa 3.0 with attribution required.