Właściwy sposób na powiązanie SpatialPolygonsDataFrames z identycznymi identyfikatorami wielokątów?


22

Jaki jest prawidłowy id R dla rbinding SPDF razem, gdy identyfikatory nakładają się? Zauważ, że tutaj (jak to często bywa) identyfikatory są w zasadzie bez znaczenia, więc denerwuje mnie to, że nie mogę po prostu zmusić ich do ignorowania ...

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"

Odpowiedzi:


15

Identyfikatory, gniazda i funkcje typu zastosuj. Moje trzy najpopularniejsze rzeczy, które są absolutnie niezbędne do wszystkiego, co robię. Myślałem, że odpowiem tylko po to, aby wygenerować więcej treści na ten temat.

Poniższy kod działa, ale zachowuje „bezużyteczne” wartości identyfikatora. Lepszy kod poświęciłby czas na przeanalizowanie rzeczy, tak aby każdy trakt miał stan FIPS, FIPS okręgowy i FIPS traktowany jako jego identyfikator. Jeszcze tylko kilka linijek, aby tak się stało, ale ponieważ nie obchodzi Cię dokument tożsamości, na razie to pomijamy.

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

Dzięki. Chciałem to sprawdzić od kilku dni, ale życie interweniowało. Jestem trochę zaskoczony, że to tyle linii kodu. Czy uważasz, że warto przesłać łatkę do metody SPDF rbindw sppakiecie? Myślałem o przekształceniu czegoś takiego w ten kod w ,deduplicateIDs=TRUEargument w metodzie ...
Ari B. Friedman,

Naprawdę tylko trzy wiersze kodu dla funkcji i jeden do zastosowania przed powiązaniem, ale przetworzenie problemu zajmuje trochę czasu. Zawsze uważałem, że obsługa ID w SPDF stanowi problem (za każdym razem, gdy ładuję coś z rgdalem), ale Roger Bivand zawsze wydaje się być w stanie sprawić, że się zachowują, więc po prostu założyłem, że to moja wada. Podoba mi się pomysł łatki, ale zastanawiam się, czy dostęp do tych gniazd spowodowałby komplikacje dla innych rzeczy w sp.
csfowler

Świetna odpowiedź. Chcę po prostu dodać radę innym, że gdy rbind utknie w moim kodzie, zwykle dzieje się tak z powodu wcześniejszego błędu (skutkującego zduplikowaniem identyfikatorów). Więc błąd jest poprawny.
Chris

20

To jest jeszcze prostsze podejście:

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

1
Chciałbym, żeby to zostało udokumentowane na stronie pomocy rbind. Muszę tu zajrzeć za każdym razem, gdy nie pamiętam reguł dotyczących obudów, które zastosowali w tym argumencie. Najlepsza odpowiedź na pewno. Nie sądzę, że potrzebuje więcej kontekstu i zdecydowanie nie należy go usuwać!
JMT2080AD

Dokumentacja sugeruje „make.row.names = TRUE)” ... co nie wydaje się działać. Skopiowanie skopiowało przykład.
Mox

Myślę, że powodem, dla którego nie jest to udokumentowane w pomocy, jest to, że wywołujesz metodę sp, gdy przekazujesz obiekt sp do rbind. Zobaczyć methods(class = "SpatialLines"). Nie jestem tego pewien, ale teraz najlepiej zgaduję. Jestem pewien, że Edzer i spółka. nie utrzymują samego rbind, stąd brak dokumentacji w rbind.
JMT2080AD

Co jeśli istnieje długa lista obiektów do scalenia ( x1, x2, x3, ..., xn)? Czy istnieje metoda przechwycenia całej listy bez wpisywania ich wszystkich?
Phil

Działa tylko wtedy, gdy liczba kolumn jest równa.
Dennis

9

Dobra, oto moje rozwiązanie. Sugestie mile widziane. Prawdopodobnie prześlę to jako poprawkę, spchyba że ktoś zauważy jakiekolwiek rażące przeoczenia.

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

Doceniam szczegółowość innych odpowiedzi tutaj i, bazując na nich, jeden linijka, do której przyszedłem, jest poniżej. Podobnie jak OP, nie dbam o znaczenie identyfikatora, ale poniższe elementy można również dostosować w celu osadzenia bardziej informacyjnego identyfikatora.

lst <- lapply(1:length(lst), function(i) spChFIDs(lst[[i]], paste0(as.character(i), '.', 1:length(lst[[i]]))))
Korzystając z naszej strony potwierdzasz, że przeczytałeś(-aś) i rozumiesz nasze zasady używania plików cookie i zasady ochrony prywatności.
Licensed under cc by-sa 3.0 with attribution required.