Modo corretto di associare SpatialPolygonsDataFrames con ID poligonali identici?


22

Qual è il linguaggio R corretto per associare SPDF insieme quando gli ID si sovrappongono? Nota che qui (come spesso accade) gli ID sono sostanzialmente privi di significato, quindi è abbastanza fastidioso che non riesco a far ignorare a 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"

Risposte:


15

ID, slot e funzioni di tipo applica. Le mie prime tre cose preferite che sono assolutamente essenziali per tutto ciò che faccio. Ho pensato di rispondere solo per generare più contenuti su questo argomento.

Il codice seguente funziona, ma conserva i valori ID "inutili". Un codice migliore richiederebbe il tempo necessario per analizzare le cose in modo che ogni tratto avesse lo stato FIPS, contea FIPS e tratto FIPS come ID. Solo qualche altra riga per far sì che ciò accada, ma poiché non ti interessano gli ID, per ora lo lasceremo fuori.

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

Grazie. Intendo verificarlo da qualche giorno, ma la vita è intervenuta. Sono un po 'stupito che ci siano molte righe di codice. Pensi che varrebbe la pena inviare una patch al metodo SPDF rbindnel sppacchetto? Stavo pensando di trasformare qualcosa di simile a questo codice in un ,deduplicateIDs=TRUEargomento per il metodo ....
Ari B. Friedman,

In realtà solo tre righe di codice per la funzione e una per applicarla pre-rbind, ma ci vuole del tempo per elaborare il problema. Ho sempre trovato la gestione dell'ID in SPDF un problema (ogni volta che carico qualcosa con rgdal per esempio), ma Roger Bivand sembra sempre essere in grado di farli comportare, quindi ho appena pensato che fosse il mio difetto. Mi piace l'idea di una patch, ma mi chiedo se l'accesso a quelle slot causerebbe complicazioni per altre cose in sp.
csfowler,

Bella risposta. Voglio solo aggiungere una parola di avviso agli altri che quando rbind si blocca nel mio codice, di solito è a causa di un errore precedente (risultante in ID duplicati). Quindi l'errore è corretto.
Chris,

20

Questo è un approccio ancora più semplice:

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

1
Vorrei che questo fosse documentato nella pagina di aiuto di rbind. Devo guardare qui ogni volta che non ricordo le regole del case utilizzate per questo argomento. La migliore risposta di sicuro. Non penso che abbia bisogno di più contesto e sicuramente non dovrebbe essere rimosso!
JMT2080AD

La documentazione suggerisce "make.row.names = TRUE)" ... che non sembra funzionare. Copia e incolla l'esempio ha fatto.
Mox,

Penso che la ragione per cui questo non sia documentato nella guida sia perché stai facendo una chiamata al metodo sp quando passi un oggetto sp a rbind. Vedere methods(class = "SpatialLines"). Non ne sono sicuro, ma è la mia ipotesi migliore in questo momento. Sono abbastanza sicuro che Edzer e i suoi amici. non mantengono rbind stesso, quindi la mancanza di documentazione in rbind.
JMT2080AD

Cosa succede se esiste un lungo elenco di oggetti da unire ( x1, x2, x3, ..., xn)? Esiste un metodo per acquisire l'intero elenco senza digitarli tutti?
Phil

Funziona solo se il numero di colonne è uguale.
Dennis,

9

Bene, ecco la mia soluzione. Suggerimenti benvenuti. Probabilmente lo invierò come patch a spmeno che qualcuno non veda omissioni lampanti.

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

Ho apprezzato il dettaglio di altre risposte qui e, basandomi su di esse, il one-liner a cui sono arrivato è sotto. Come OP, non mi interessa molto il significato dell'ID, ma anche i seguenti potrebbero essere adattati per incorporare anche un ID più informativo.

lst <- lapply(1:length(lst), function(i) spChFIDs(lst[[i]], paste0(as.character(i), '.', 1:length(lst[[i]]))))
Utilizzando il nostro sito, riconosci di aver letto e compreso le nostre Informativa sui cookie e Informativa sulla privacy.
Licensed under cc by-sa 3.0 with attribution required.