วิธีที่เหมาะสมในการโยง SpatialPolygonsDataFrames ด้วยรหัสรูปหลายเหลี่ยมเหมือนกันหรือไม่


22

อะไรคือสำนวน R ที่เหมาะสมสำหรับการผูก SPDF เข้าด้วยกันเมื่อ ID ทับซ้อนกัน โปรดทราบว่าที่นี่ (ตามปกติแล้ว) 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"

คำตอบ:


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 rbindในspแพ็คเกจหรือไม่? ฉันคิดว่าการเปลี่ยนบางอย่างเช่นรหัสนี้เป็นวิธีการ,deduplicateIDs=TRUEโต้แย้ง ....
Ari B. Friedman

จริงๆแล้วมีเพียงสามบรรทัดของโค้ดสำหรับฟังก์ชั่นหนึ่งอันที่จะใช้มันก่อนการโยง แต่มันใช้เวลาพอสมควรในการประมวลผลสำหรับปัญหาของคุณ ฉันมักจะพบว่าการจัดการ ID ใน SPDF นั้นเป็นปัญหา (ทุกครั้งที่ฉันโหลดบางสิ่งด้วย rgdal ตัวอย่าง) แต่ Roger Bivand ดูเหมือนว่าจะสามารถทำให้พวกเขาทำงานได้เสมอดังนั้นฉันจึงสันนิษฐานว่าเป็นข้อบกพร่องของตัวเอง ฉันชอบความคิดเกี่ยวกับแพทช์ แต่สงสัยว่าการเข้าถึงสล็อตเหล่านั้นจะทำให้เกิดความยุ่งยากสำหรับสิ่งอื่น ๆ ใน sp
csfowler

คำตอบที่ดี เพียงแค่ต้องการเพิ่มคำแนะนำแก่ผู้อื่นว่าเมื่อ rbind ติดอยู่ในรหัสของฉันมันมักจะเป็นเพราะความผิดพลาดก่อนหน้านี้ (ส่งผลให้เกิดรหัสซ้ำกัน) ดังนั้นข้อผิดพลาดนั้นถูกต้อง
Chris

20

นี่เป็นวิธีที่ง่ายยิ่งขึ้น:

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

1
ฉันหวังว่านี่เป็นเอกสารในหน้าช่วยเหลือ rbind ฉันต้องดูที่นี่ทุกครั้งที่ฉันจำกฎปลอกไม่ได้ที่พวกเขาใช้สำหรับการโต้แย้งนี้ คำตอบที่ดีที่สุดแน่นอน ฉันไม่คิดว่ามันต้องการบริบทมากขึ้นและไม่ควรลบอย่างแน่นอน!
JMT2080AD

เอกสารแนะนำ "make.row.names = TRUE)" ... ซึ่งดูเหมือนจะไม่ทำงาน คัดลอกตัวอย่างที่วางไว้
Mox

ฉันคิดว่าเหตุผลที่ไม่ได้บันทึกไว้ในความช่วยเหลือเป็นเพราะคุณทำการโทรวิธี sp เมื่อคุณส่งวัตถุ sp เพื่อ rbind methods(class = "SpatialLines")ดู ฉันไม่แน่ใจเกี่ยวกับเรื่องนี้ แต่ตอนนี้ฉันเดาได้ดีที่สุดแล้ว ฉันค่อนข้างแน่ใจว่า Edzer และผู้ร่วม ไม่ได้รักษา rbind เองดังนั้นการขาดเอกสารใน rbind
JMT2080AD

เกิดอะไรขึ้นถ้ามีรายการของวัตถุที่จะผสาน ( x1, x2, x3, ..., xn) ยาว ๆ มีวิธีการจับภาพรายการทั้งหมดโดยไม่ต้องพิมพ์ออกทั้งหมดหรือไม่
Phil

ใช้ได้เฉพาะในกรณีที่จำนวนคอลัมน์เท่ากัน
Dennis

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]]))))
โดยการใช้ไซต์ของเรา หมายความว่าคุณได้อ่านและทำความเข้าใจนโยบายคุกกี้และนโยบายความเป็นส่วนตัวของเราแล้ว
Licensed under cc by-sa 3.0 with attribution required.