Cara yang tepat untuk mengikat SpatialPolygonsDataFrames dengan ID poligon identik?

22

Apa idiom R yang tepat untuk mengikat SPDF bersama ketika ID tumpang tindih? Perhatikan bahwa di sini (seperti yang sering terjadi) ID pada dasarnya tidak berarti sehingga cukup menjengkelkan bahwa saya tidak bisa membuat rbind mengabaikannya ....

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
sumber

Jawaban:

15

ID, slot, dan fungsi tipe-berlaku. Tiga hal favorit saya yang paling tidak penting yang sangat penting untuk semua yang saya lakukan. Saya pikir saya akan merespons hanya untuk menghasilkan lebih banyak konten pada topik ini.

Kode di bawah ini berfungsi, tetapi tetap mempertahankan nilai ID "tidak berguna". Kode yang lebih baik akan meluangkan waktu untuk menguraikan hal-hal sehingga setiap traktat memiliki negara FIPS, county FIPS, dan trak FIPS sebagai ID-nya. Hanya beberapa baris lagi untuk mewujudkannya, tetapi karena Anda tidak peduli dengan ID, kami akan mengabaikannya untuk saat ini.

#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
sumber
Terima kasih. Aku bermaksud memeriksa ini selama beberapa hari sekarang, tetapi hidup telah campur tangan. Saya agak kagum dengan banyaknya baris kode ini. Apakah Anda pikir perlu mengirimkan tambalan ke metode SPDF rbinddalam sppaket? Saya sedang berpikir untuk mengubah sesuatu seperti kode ini menjadi ,deduplicateIDs=TRUEargumen untuk metode ....
Ari B. Friedman
Benar-benar hanya tiga baris kode untuk fungsi dan satu untuk menerapkannya sebelum rbind, tetapi butuh beberapa waktu untuk memproses masalah Anda. Saya selalu menemukan penanganan ID di SPDF menjadi masalah (setiap kali saya memuat sesuatu dengan rgdal misalnya), tetapi Roger Bivand sepertinya selalu bisa membuat mereka berperilaku jadi saya hanya berasumsi itu adalah kekurangan saya sendiri. Saya suka ide tambalan, tetapi bertanya-tanya apakah mengakses slot itu akan menyebabkan komplikasi untuk hal-hal lain di sp.
csfowler
Jawaban yang bagus Hanya ingin menambahkan kata nasihat kepada orang lain bahwa ketika rbind terjebak dalam kode saya, biasanya karena kesalahan sebelumnya (menghasilkan duplikat ID). Jadi kesalahannya benar.
Chris
20

Ini adalah pendekatan yang lebih sederhana:

x <- rbind(x1, x2, x3, makeUniqueIDs = TRUE)  
Wraf
sumber
1
Saya berharap ini didokumentasikan di halaman bantuan rbind. Saya harus melihat di sini setiap kali saya tidak ingat aturan casing yang mereka gunakan untuk argumen ini. Jawaban terbaik pasti. Saya tidak berpikir itu membutuhkan lebih banyak konteks, dan tentunya tidak boleh dihapus!
JMT2080AD
Dokumentasi menyarankan "make.row.names = TRUE)" ... yang sepertinya tidak berfungsi. Copy-paste contoh tadi.
Mox
Saya pikir alasan ini tidak didokumentasikan dalam bantuan adalah karena Anda membuat panggilan metode sp ketika Anda melewatkan objek sp ke rbind. Lihat methods(class = "SpatialLines"). Saya tidak yakin tentang ini, tetapi ini adalah tebakan terbaik saya saat ini. Saya cukup yakin Edzer and co. tidak memelihara rbind itu sendiri, karenanya kurangnya dokumentasi di rbind.
JMT2080AD
Bagaimana jika ada daftar objek yang panjang untuk digabung ( x1, x2, x3, ..., xn)? Apakah ada metode untuk menangkap seluruh daftar tanpa mengetik semuanya?
Phil
Hanya berfungsi jika jumlah kolom sama.
Dennis
9

Baiklah, inilah solusi saya. Saran diterima. Saya mungkin akan mengirimkan ini sebagai tambalan spkecuali ada yang melihat kelalaian mencolok.

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

Saya menghargai detail jawaban lain di sini dan, berdasarkan jawaban itu, kalimat yang saya baca ada di bawah. Seperti OP, saya tidak terlalu peduli tentang arti ID, tetapi yang berikut ini juga dapat diadaptasi untuk menanamkan ID yang lebih informatif juga.

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