Правильный способ привязать SpatialPolygonsDataFrames с одинаковыми идентификаторами полигонов?


22

Какова правильная формулировка для связывания SPDF вместе, когда идентификаторы перекрываются? Обратите внимание, что здесь (как это часто бывает) идентификаторы в основном бессмысленны, поэтому довольно раздражает, что я не могу просто заставить rbind их игнорировать ....

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"

Ответы:


15

Идентификаторы, слоты и функции типа применения. Мои первые три наименее любимые вещи, которые абсолютно необходимы для всего, что я делаю. Я думал, что отвечу только, чтобы произвести больше контента на эту тему.

Код ниже работает, но он сохраняет «бесполезные» значения идентификатора. Для лучшего кода потребовалось бы время на анализ, чтобы каждый тракт имел идентификатор FIPS штата, округ FIPS и тракт FIPS в качестве своего идентификатора. Еще несколько строк, чтобы это произошло, но, так как вы не заботитесь об идентификаторах, мы оставим это пока.

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

Спасибо. Я хотел проверить это уже несколько дней, но жизнь вмешалась. Я немного удивлен, что это так много строк кода. Как вы думаете, что стоит подав патч к методе SPDF из rbindв spпакете? Я думал о том, чтобы превратить что-то вроде этого кода в ,deduplicateIDs=TRUEаргумент метода ...
Ари Б. Фридман

На самом деле всего три строки кода для функции и одна для ее применения pre-rbind, но для ее решения требуется некоторое время. Я всегда считал, что обработка идентификатора в SPDF является проблемой (каждый раз, когда я загружаю что-то с помощью rgdal, например), но Роджер Биванд всегда, кажется, способен заставить их вести себя, поэтому я просто предположил, что это мой собственный недостаток. Мне нравится идея патча, но мне интересно, не вызовет ли доступ к этим слотам осложнения для других вещей в sp.
csfowler

Отличный ответ. Просто хочу добавить совет другим, что когда rbind застревает в моем коде, это обычно происходит из-за более ранней ошибки (приводящей к дублированию идентификаторов). Так что ошибка верна.
Крис

20

Это еще более простой подход:

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

1
Я хотел бы, чтобы это было задокументировано на странице помощи rbind. Мне приходится искать здесь каждый раз, когда я не могу вспомнить правила, которые они использовали для этого аргумента. Лучший ответ наверняка. Я не думаю, что это требует большего контекста, и определенно не должно быть удалено!
JMT2080AD

Документация предлагает "make.row.names = TRUE)" ... который, похоже, не работает. Копировать-вставить пример сделал.
Мох

Я думаю, что причина этого не описана в справке, потому что вы делаете вызов метода sp, когда передаете объект sp в rbind. См methods(class = "SpatialLines"). Я не уверен в этом, но это мое лучшее предположение прямо сейчас. Я уверен, что Эдзер и Ко не поддерживает сам rbind, отсюда и отсутствие документации в rbind.
JMT2080AD

Что если существует длинный список объектов для слияния ( x1, x2, x3, ..., xn)? Есть ли способ захватить весь список, не печатая их все?
Фил

Работает только если количество столбцов равно.
Деннис

9

Хорошо, вот мое решение. Предложения приветствуются. Я, вероятно, отправлю это как исправление, spесли никто не видит каких-либо явных упущений.

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

Я оценил детали других ответов здесь и, опираясь на них, единственная строка, к которой я пришел, ниже. Как и OP, меня не волнует значение идентификатора, но следующее также может быть адаптировано для встраивания более информативного идентификатора.

lst <- lapply(1:length(lst), function(i) spChFIDs(lst[[i]], paste0(as.character(i), '.', 1:length(lst[[i]]))))
Используя наш сайт, вы подтверждаете, что прочитали и поняли нашу Политику в отношении файлов cookie и Политику конфиденциальности.
Licensed under cc by-sa 3.0 with attribution required.