建立在Paul Regular的优秀工作基础上,这是一个版本,应该确保独占多边形(即没有重叠)。
我添加了一个新参数
fd
,用于
fairy dust,以解决我在使用UTM类型坐标时发现的问题。基本上,我理解算法是通过从轮廓线采样侧向点来确定哪一侧是多边形的
内部。如果样本点与线的距离在其他轮廓后面,可能会出现问题。因此,如果你的多边形看起来不正确,请尝试将
fd
设置为10^±n的值,直到它看起来非常错误或大致正确。
raster2contourPolys <- function(r, levels = NULL, fd = 1) {
levels <- sort(levels)
plevels <- c(min(values(r)-1, na.rm=TRUE), levels, max(values(r)+1, na.rm=TRUE))
llevels <- paste(plevels[-length(plevels)], plevels[-1], sep=" - ")
llevels[1] <- paste("<", min(levels))
llevels[length(llevels)] <- paste(">", max(levels))
xmin <- extent(r)@xmin
xmax <- extent(r)@xmax
ymin <- extent(r)@ymin
ymax <- extent(r)@ymax
rx <- seq(xmin, xmax, length.out=ncol(r))
ry <- seq(ymin, ymax, length.out=nrow(r))
rz <- t(as.matrix(r))
rz <- rz[,ncol(rz):1]
cat("Converting to contour lines...\n")
cl0 <- contourLines(rx, ry, rz, levels = levels)
cl <- ContourLines2SLDF(cl0)
xy <- coordinates(r)[which(!is.na(values(r))),]
i <- chull(xy)
b <- xy[c(i,i[1]),]
b <- SpatialPolygons(list(Polygons(list(Polygon(b, hole = FALSE)), "1")))
cat("Converting contour lines to polygons...\n")
bcl <- gBuffer(cl, width = fd*diff(bbox(r)[1,])/3600000)
cp <- gDifference(b, bcl)
polys <- list()
for(j in seq_along(cp@polygons[[1]]@Polygons)) {
polys[[j]] <- Polygons(list(cp@polygons[[1]]@Polygons[[j]]),j)
}
cp <- SpatialPolygons(polys)
cp <- SpatialPolygonsDataFrame(cp, data.frame(id=seq_along(cp)))
rc <- cut(r, breaks=plevels)
cat("Adding attributes to polygons...\n")
l <- character(length(cp))
for(j in seq_along(cp)) {
p <- cp[cp$id==j,]
bp <- gBuffer(p, width = -max(res(r)))
if(!is.null(bp)) {
xy <- SpatialPoints(coordinates(bp@polygons[[1]]@Polygons[[1]]))[1]
l[j] <- llevels[raster::extract(rc,xy)]
}
else {
xy <- coordinates(gCentroid(p))
l[j] <- llevels[raster::extract(rc,xy)]
}
}
cp$level <- factor(l, levels=llevels)
cp$min <- plevels[-length(plevels)][cp$level]
cp$max <- plevels[-1][cp$level]
cp <- cp[!is.na(cp$level),]
df <- unique(cp@data[,c("level","min","max")])
df <- df[order(df$min),]
row.names(df) <- df$level
llevels <- df$level
cat("Defining holes...\n")
spolys <- list()
p <- cp[cp$level==llevels[1],]
p <- gUnaryUnion(p)
spolys[[1]] <- Polygons(p@polygons[[1]]@Polygons, ID=llevels[1])
for(i in seq(length(llevels)-1)) {
p1 <- cp[cp$level==llevels[i+1],]
p2 <- cp[cp$level==llevels[i],]
x <- numeric(length(p2))
y <- numeric(length(p2))
id <- numeric(length(p2))
for(j in seq_along(p2)) {
xy <- coordinates(p2@polygons[[j]]@Polygons[[1]])[1,]
x[j] <- xy[1]; y[j] <- xy[2]
id[j] <- as.numeric(p2@polygons[[j]]@ID)
}
xy <- SpatialPointsDataFrame(cbind(x,y), data.frame(id=id))
holes <- over(xy, p1)$id
holes <- xy$id[which(!is.na(holes))]
if(length(holes)>0) {
p2 <- p2[p2$id %in% holes,]
p1 <- gUnaryUnion(p1)
p2 <- gUnaryUnion(p2)
p <- gDifference(p1, p2)
} else { p <- gUnaryUnion(p1) }
spolys[[i+1]] <- Polygons(p@polygons[[1]]@Polygons, ID=llevels[i+1])
}
cp <- SpatialPolygons(spolys, pO=seq_along(llevels), proj4string=CRS(proj4string(r)))
cpx = gDifference(cp[1,], cp[2,], id=cp[1,]@polygons[[1]]@ID)
for(i in 2:(length(cp)-1)) cpx = spRbind(cpx, gDifference(cp[i,], cp[i+1,], id=cp[i,]@polygons[[1]]@ID))
cp = spRbind(cpx, cp[length(cp),])
cp <- SpatialPolygonsDataFrame(cp, df)
cat("Done!")
cp
}
contour(volcano, add=TRUE)
已经解决了一部分问题,不是吗? - thijs van den berghCOLS
中的值。为了调试,请尝试一次只绘制一个cont[[k]]
,以查看是否有任何问题。 - Carl Witthoftfilled.contour
图。有几个问题:1.最低的等高线应该包括到角落的区域 - 我猜测你是对的,这可能是正确编码级别的问题。2.陨石坑的中心应该有一个150的水平面,但它被160覆盖了。 - Marc in the box