Maneira correta de vincular SpatialPolygonsDataFrames com IDs de polígono idênticos?


22

Qual é o idioma R adequado para vincular SPDFs juntos quando os IDs se sobrepõem? Observe que aqui (como costuma ser o caso) os IDs são basicamente sem sentido, por isso é muito irritante que eu não possa fazer o rbind ignorá-los ...

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"

Respostas:


15

IDs, slots e funções do tipo aplicar. Minhas três principais coisas menos favoritas que são absolutamente essenciais para tudo o que faço. Eu pensei em responder apenas para gerar mais conteúdo sobre esse tópico.

O código abaixo funciona, mas mantém os valores de ID "inúteis". Um código melhor levaria tempo para analisar as coisas, para que todos os setores tivessem o FIPS do estado, o FIPS do condado e o FIPS do trato como seu ID. Apenas mais algumas linhas para que isso aconteça, mas como você não se importa com IDs, deixaremos de fora por enquanto.

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

Obrigado. Estou planejando verificar isso há alguns dias, mas a vida interveio. Estou meio surpreso com tantas linhas de código. Você acha que vale a pena enviar um patch para o método SPDF rbinddo sppacote? Eu estava pensando em transformar algo como esse código em um ,deduplicateIDs=TRUEargumento para o método ....
Ari B. Friedman

Realmente, apenas três linhas de código para a função e uma para aplicá-la pré-ligação, mas leva algum tempo para processar o seu problema. Sempre achei o manuseio do ID nos SPDFs um problema (sempre que carrego algo com o rgdal, por exemplo), mas Roger Bivand sempre parece capaz de fazê-los se comportar, então, apenas assumi que é minha própria falha. Eu gosto da idéia de um patch, mas me pergunto se o acesso a esses slots causaria complicações para outras coisas no sp.
Csfowler

Ótima resposta. Só quero adicionar uma palavra de conselho para outras pessoas que, quando o rbind fica preso no meu código, geralmente isso ocorre devido a um erro anterior (resultando em IDs duplicados). Portanto, o erro está correto.
31512 Chris

20

Esta é uma abordagem ainda mais simples:

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

1
Eu gostaria que isso estivesse documentado na página de ajuda do rbind. Eu tenho que olhar aqui toda vez que não me lembro das regras de uso que eles usaram para esse argumento. Melhor resposta, com certeza. Não acho que precise de mais contexto e definitivamente não deve ser removido!
JMT2080AD

A documentação sugere "make.row.names = TRUE)" ... que parece não funcionar. Copiar e colar o exemplo fez.
Mox

Acho que a razão pela qual isso não está documentado na ajuda é porque você está fazendo uma chamada de método sp quando passa um objeto sp para rbind. Veja methods(class = "SpatialLines"). Não tenho certeza disso, mas é o meu melhor palpite no momento. Tenho certeza que Edzer e companhia. não estão mantendo o rbind propriamente dito, daí a falta de documentação no rbind.
JMT2080AD 30/11

E se houver uma longa lista de objetos para mesclar ( x1, x2, x3, ..., xn)? Existe um método para capturar a lista inteira sem digitar todas?
Phil

Só funciona se o número de colunas for igual.
Dennis

9

Tudo bem, aqui está a minha solução. Sugestões são bem-vindas. Provavelmente vou enviar isso como um patch parasp menos que alguém veja alguma omissão flagrante.

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

Apreciei os detalhes de outras respostas aqui e, com base nelas, a única linha que encontrei está abaixo. Como o OP, não me importo muito com o significado do ID, mas o seguinte também pode ser adaptado para incorporar um ID mais informativo.

lst <- lapply(1:length(lst), function(i) spChFIDs(lst[[i]], paste0(as.character(i), '.', 1:length(lst[[i]]))))
Ao utilizar nosso site, você reconhece que leu e compreendeu nossa Política de Cookies e nossa Política de Privacidade.
Licensed under cc by-sa 3.0 with attribution required.