如何加快R中多边形的绘制速度?


24

我想在描绘一些变量的栅格图像上绘制北美的国界,然后使用R在轮廓上方覆盖轮廓。我已经成功使用基本图形和点阵进行了此操作,但似乎绘制过程是太慢了!我还没有在ggplot2中完成此操作,但是我怀疑它在速度方面会更好。

我将数据保存在从grib文件创建的netcdf文件中。现在,我下载了加拿大,美国和墨西哥的国家边界,这些边界可以从GADM的RData文件中获得,这些文件作为SpatialPolygonsDataFrame对象读入R。

这是一些代码:

# Load packages
library(raster)
#library(ncdf) # If you cannot install ncdf4
library(ncdf4)

# Read in the file, get the 13th layer
# fn <- 'path_to_file'
r <- raster(fn, band=13)

# Set the projection and extent
p4 <- "+proj=lcc +lat_1=50.0 +lat_2=50.0 +units=km +x_0=32.46341 +y_0=32.46341 +lon_0=-107 +lat_0=1.0"
projection(r) <- CRS(p4)
extent(r) <- c(-5648.71, 5680.72, 1481.40, 10430.62)

# Get the country borders
# This will download the RData files to your working directory
can<-getData('GADM', country="CAN", level=1)
usa<-getData('GADM', country="USA", level=1)
mex<-getData('GADM', country="MEX", level=1)

# Project to model grid
can_p <- spTransform(can, CRS(p4))
usa_p <- spTransform(usa, CRS(p4))
mex_p <- spTransform(mex, CRS(p4))

### USING BASE GRAPHICS
par(mar=c(0,0,0,0))
# Plot the raster
bins <- 100
plot(r, axes=FALSE, box=FALSE, legend=FALSE,
     col=rev( rainbow(bins,start=0,end=1) ),
     breaks=seq(4500,6000,length.out=bins))
plot(r, legend.only=TRUE, col=rev( rainbow(bins,start=0,end=1)),
     legend.width=0.5, legend.shrink=0.75, 
     breaks=seq(4500,6000,length.out=bins),
     axis.args=list(at=seq(4500,6000,length.out=11),
                labels=seq(4500,6000,length.out=11),
                cex.axis=0.5),
     legend.args=list(text='Height (m)', side=4, font=2, 
                      line=2, cex=0.8))
# Plot the borders
# These are so slow!!
plot(can_p, add=TRUE, border='white', lwd=2)
plot(usa_p, add=TRUE, border='white', lwd=2)
plot(mex_p, add=TRUE, border='white', lwd=2)
# Add the contours
contour(r, add=TRUE, nlevel=5)

### USING LATTICE
library(rasterVis)

# Some settings for our themes
myTheme <- RdBuTheme()
myTheme$axis.line$col<-"transparent"
myTheme$add.line$alpha <- 1
myTheme2 <- myTheme
myTheme2$regions$col <- 'transparent'
myTheme2$add.text$cex <- 0.7
myTheme2$add.line$lwd <- 1
myTheme2$add.line$alpha <- 0.8

# Get JUST the contour lines
contours <- contourplot(r, margin=FALSE, scales=list(draw=FALSE),
                        par.settings=myTheme2, pretty=TRUE, key=NULL, cuts=5,
                        labels=TRUE)

# Plot the colour
levels <- levelplot(r, contour=FALSE, margin=FALSE, scales=list(draw=FALSE),
                    par.settings = myTheme, cuts=100)

# Plot!
levels +  
  layer(sp.polygons(can_p, col='green', lwd=2)) +
  layer(sp.polygons(usa_p, col='green', lwd=2)) +
  layer(sp.polygons(mex_p, col='green', lwd=2)) +
  contours

有没有办法加快多边形的绘制速度?在我正在使用的系统上,绘图需要几分钟。我最终希望创建一个可以轻松生成许多这些图进行检查的函数,并且我认为我将绘制许多这些图,因此我想提高绘制速度!

谢谢!


就是这样,您可以在多边形几何字段上创建索引吗?
低于雷达

@ Burton449对不起,我是R中与地图有关的事物的新手,包括多边形,投影等...我不明白您的问题
ialm 2013年

2
您可以尝试绘图到绘图窗口以外的设备。将绘图函数包装为pdf或jpeg(带有相关参数),然后输出其中一种格式。我发现这要快得多。
杰弗里·埃文斯

@JeffreyEvans哇,是的。我没有考虑。将三个形状文件绘制到绘图窗口大约需要60秒,而绘制到文件仅花费14秒。对于手头的任务来说仍然太慢,但是当与以下答案中的某些方法结合使用时,它可能会很有用。谢谢!
ialm

Answers:


30

我发现了三种提高从R的形状文件中绘制国家边界的速度的方法。我从这里这里发现了一些灵感和代码。

(1)我们可以从形状文件中提取坐标,以获取多边形的经度和纬度。然后,我们可以将它们放入数据框中,第一列包含经度,第二列包含纬度。不同的形状由NA分隔。

(2)我们可以从形状文件中删除一些多边形。形状文件非常非常详细,但是某些形状是不重要的小岛(无论如何,对于我的图而言)。我们可以设置最小多边形面积阈值以保留更大的多边形。

(3)我们可以使用Douglas-Peuker算法简化形状的几何形状。我们的多边形形状的边缘可以简化,因为它们在原始文件中非常复杂。幸运的是,有一个rgeos实现此功能的程序包。

设定:

# Load packages
library(rgdal)
library(raster)
library(sp)
library(rgeos)

# Load the shape files
can<-getData('GADM', country="CAN", level=0)
usa<-getData('GADM', country="USA", level=0)
mex<-getData('GADM', country="MEX", level=0)

方法1:从形状文件中提取坐标到数据框和绘图线

主要缺点是,与将对象保持为SpatialPolygonsDataFrame对象(例如投影)相比,我们在这里丢失了一些信息。但是,我们可以将其转换为sp对象并添加投影信息,它仍然比绘制原始数据更快。

请注意,由于存在很多形状,因此此代码在原始文件上的运行速度非常慢,结果数据帧的长度约为200万行。

码:

# Convert the polygons into data frames so we can make lines
poly2df <- function(poly) {
  # Convert the polygons into data frames so we can make lines
  # Number of regions
  n_regions <- length(poly@polygons)

  # Get the coords into a data frame
  poly_df <- c()
  for(i in 1:n_regions) {
    # Number of polygons for first region
    n_poly <- length(poly@polygons[[i]]@Polygons)
    print(paste("There are",n_poly,"polygons"))
    # Create progress bar
    pb <- txtProgressBar(min = 0, max = n_poly, style = 3)
    for(j in 1:n_poly) {
      poly_df <- rbind(poly_df, NA, 
                       poly@polygons[[i]]@Polygons[[j]]@coords)
      # Update progress bar
      setTxtProgressBar(pb, j)
    }
    close(pb)
    print(paste("Finished region",i,"of",n_regions))
  }
  poly_df <- data.frame(poly_df)
  names(poly_df) <- c('lon','lat')
  return(poly_df)
}

方法2:删除小多边形

有许多不是很重要的小岛。如果检查多边形区域的一些分位数,我们会发现其中许多都是很小的。对于加拿大图,我从绘制一千多个多边形下降到仅数百个多边形。

加拿大的多边形大小的分位数:

          0%          25%          50%          75%         100% 
4.335000e-10 8.780845e-06 2.666822e-05 1.800103e-04 2.104909e+02 

码:

# Get the main polygons, will determine by area.
getSmallPolys <- function(poly, minarea=0.01) {
  # Get the areas
  areas <- lapply(poly@polygons, 
                  function(x) sapply(x@Polygons, function(y) y@area))

  # Quick summary of the areas
  print(quantile(unlist(areas)))

  # Which are the big polygons?
  bigpolys <- lapply(areas, function(x) which(x > minarea))
  length(unlist(bigpolys))

  # Get only the big polygons and extract them
  for(i in 1:length(bigpolys)){
    if(length(bigpolys[[i]]) >= 1 && bigpolys[[i]] >= 1){
      poly@polygons[[i]]@Polygons <- poly@polygons[[i]]@Polygons[bigpolys[[i]]]
      poly@polygons[[i]]@plotOrder <- 1:length(poly@polygons[[i]]@Polygons)
    }
  }
  return(poly)
}

方法3:简化多边形形状的几何

我们可以使用包中的gSimplify函数来减少多边形形状中的顶点数量rgeos

码:

can <- getData('GADM', country="CAN", level=0)
can <- gSimplify(can, tol=0.01, topologyPreserve=TRUE)

一些基准:

我用过去system.time来衡量我的绘图时间。请注意,这些只是绘制国家/地区的时间,没有轮廓线和其他多余的东西。对于sp对象,我只是使用了该plot函数。对于数据框对象,我将plot函数与type='l'和函数一起使用lines

绘制原始的加拿大,美国,墨西哥多边形:

73.009秒

使用方法1:

2.449秒

使用方法2:

17.660秒

使用方法3:

16.695秒

使用方法2 + 1:

1.729秒

使用方法2 + 3:

0.445秒

使用方法2 + 3 + 1:

0.172秒

其他说明:

似乎方法2 + 3的组合可以为多边形绘制提供足够的速度。使用方法2 + 3 + 1会增加丢失sp对象的良好属性的问题,而我的主要困难是应用投影。我一起砍了一些东西来投影一个数据框对象,但是它运行起来很慢。我认为使用方法2 + 3可以为我提供足够的速度,直到我可以摆脱使用方法2 + 3 +1的麻烦为止。


3
+1写作,无疑这对将来的读者会有所帮助。
SlowLearner 2013年

3

每个人都应考虑转移到sf(空间特征)包而不是sp。它明显更快(在这种情况下为1/60)并且更易于使用。这是读取shp并通过ggplot2进行绘图的示例。

注意:您需要从github上的最新版本重新安装ggp​​lot2(请参见下文)

library(rgdal)
library(sp)
library(sf)
library(plyr)
devtools::install_github("tidyverse/ggplot2")
library(ggplot2)

# Load the shape files
can<-getData('GADM', country="CAN", level=0)
td <- file.path(tempdir(), "rgdal_examples"); dir.create(td)
st_write(st_as_sf(can),file.path(td,'can.shp'))


ptm <- proc.time()
  can = readOGR(dsn=td, layer="can")
  can@data$id = rownames(can@data)
  can.points = fortify(can, region="id")
  can.df = join(can.points, can@data, by="id")
  ggplot(can.df) +  geom_polygon(aes(long,lat,group=group,fill='NAME_ENGLISH'))
proc.time() - ptm

user  system elapsed 
683.344   0.980 684.51 

ptm <- proc.time()
  can2 = st_read(file.path(td,'can.shp'))  
  ggplot(can2)+geom_sf( aes(fill = 'NAME_ENGLISH' )) 
proc.time() - ptm

user  system elapsed 
11.340   0.096  11.433 

0

GADM数据具有非常高的海岸线空间分辨率。如果不需要,可以使用更通用的数据集。ialm的方法非常有趣,但是一个简单的替代方法是使用“ maptools”随附的“ wrld_simpl”数据

library(maptools)
data(wrld_simpl)
plot(wrld_simpl)

我想保留数据集中的形状,因为它包含了该国家/地区内部区域的边界(例如省和州)。否则,我会在地图数据包中使用这些地图!
ialm
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.