正确的方法来绑定具有相同多边形ID的SpatialPolygonsDataFrames?


22

ID重叠时,将SPDF绑定在一起的正确习惯用法是什么?请注意,在这里(通常是这样),ID基本上是没有意义的,所以我不能仅使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"

Answers:


15

ID,广告位和套用型功能。我最不喜欢的三件事对我所做的一切都是必不可少的。我以为我会做出回应,只是针对该主题生成更多内容。

下面的代码有效,但是保留了“无用”的ID值。更好的代码将花费时间来解析事物,以便每个区域都将州FIPS,县FIPS和区域FIPS作为其ID。只有几行代码可以实现,但是由于您不关心ID,我们暂时将其省略。

#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方法rbindsp包?我想打开这样的代码放到一个的,deduplicateIDs=TRUE参数的方法....
阿里B.弗里德曼

实际上,该函数只有三行代码,并且要在行之前对其进行应用,但是处理您的问题确实需要一些时间。我一直发现在SPDF中处理ID是个问题(例如,任何时候我用rgdal加载东西),但是Roger Bivand似乎总是能够使它们表现出来,所以我只是认为这是我自己的缺点。我喜欢打补丁的想法,但想知道访问这些插槽是否会引起sp中其他事情的复杂化。
csfowler 2012年

好答案。只是想向其他人建议,当rbind卡在我的代码中时,通常是由于更早的错误(导致重复的ID)所致。因此错误是正确的。
克里斯

20

这是一个更简单的方法:

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

1
我希望在rbind帮助页面中对此进行了记录。每当我不记得他们为该参数使用的大小写规则时,我都必须看这里。肯定的最佳答案。我认为它不需要更多上下文,因此绝对不应删除!
JMT2080AD '16

文档建议“ make.row.names = TRUE)” ...似乎无效。复制粘贴该示例。
Mox

我认为帮助中未记录该信息的原因是,当您将sp对象传递给rbind时,您正在进行sp方法调用。请参阅methods(class = "SpatialLines")。我不确定,但这是我目前的最佳猜测。我很确定Edzer and co。本身并不维护rbind,因此rbind中缺少文档。
JMT2080AD '16

如果要合并的对象很长,该x1, x2, x3, ..., xn怎么办?有没有一种方法可以捕获整个列表而无需全部输入?
菲尔(Phil)

仅在列数相等时有效。
丹尼斯

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一样,我不太在乎ID的含义,但是下面的内容也可以用于嵌入更多信息的ID。

lst <- lapply(1:length(lst), function(i) spChFIDs(lst[[i]], paste0(as.character(i), '.', 1:length(lst[[i]]))))
By using our site, you acknowledge that you have read and understand our Cookie Policy and Privacy Policy.
Licensed under cc by-sa 3.0 with attribution required.