Làm thế nào để tăng tốc độ âm mưu của đa giác trong R?

Tôi muốn vẽ đường biên giới quốc gia của Bắc Mỹ qua một hình ảnh raster mô tả một số biến và sau đó phủ các đường viền lên trên cốt truyện bằng R. Tôi đã thành công khi thực hiện điều này bằng cách sử dụng đồ họa và mạng cơ sở, nhưng có vẻ như quá trình vẽ đồ thị là quá chậm Tôi chưa làm điều này trong ggplot2, nhưng tôi nghi ngờ rằng nó sẽ tốt hơn về mặt tốc độ.

Tôi có dữ liệu trong tệp netcdf được tạo từ tệp grib. Hiện tại, tôi đã tải xuống biên giới quốc gia cho Canada, Hoa Kỳ và Mexico, có sẵn trong các tệp RData từ GADM đọc thành R dưới dạng đối tượng SpatialPolygonsDataFrame.

Đây là một số mã:

# 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

Có cách nào để tăng tốc độ âm mưu của đa giác không? Trên hệ thống mà tôi đang làm việc, âm mưu mất vài phút. Cuối cùng tôi muốn tạo ra một chức năng sẽ dễ dàng tạo ra một số các ô này để kiểm tra và tôi cho rằng tôi sẽ vẽ nhiều bản đồ này, vì vậy tôi muốn tăng tốc độ của các ô!

Cảm ơn!

Tôi tìm thấy 3 cách để tăng tốc độ vẽ đường viền quốc gia từ các tệp hình dạng cho R. Tôi tìm thấy một số nguồn cảm hứng và mã từ đây và đây .

(1) Chúng ta có thể trích xuất tọa độ từ các tệp hình dạng để có được kinh độ và vĩ độ của đa giác. Sau đó, chúng ta có thể đặt chúng vào một khung dữ liệu với cột đầu tiên chứa kinh độ và cột thứ hai chứa vĩ độ. Các hình dạng khác nhau được phân tách bằng NA.

(2) Chúng tôi có thể xóa một số đa giác khỏi tệp hình dạng của chúng tôi. Tệp hình dạng rất, rất chi tiết, nhưng một số hình dạng là những hòn đảo nhỏ không quan trọng (đối với lô của tôi, dù sao đi nữa). Chúng ta có thể đặt ngưỡng diện tích đa giác tối thiểu để giữ đa giác lớn hơn.

(3) Chúng ta có thể đơn giản hóa hình dạng của các hình dạng của mình bằng thuật toán Douglas-Peuker . Các cạnh của hình dạng đa giác của chúng ta có thể được đơn giản hóa, vì chúng rất phức tạp trong tệp gốc. May mắn thay, có một gói, rgeosthực hiện điều này.

Thiết lập:

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

Phương pháp 1: Trích xuất tọa độ từ các tệp hình dạng thành khung dữ liệu và đường biểu đồ

Nhược điểm chính là chúng ta mất một số thông tin ở đây khi so sánh với việc giữ đối tượng là đối tượng SpatialPolygonsDataFrame, chẳng hạn như phép chiếu. Tuy nhiên, chúng ta có thể biến nó trở lại thành một đối tượng sp và thêm lại thông tin chiếu, và nó vẫn nhanh hơn so với vẽ đồ thị dữ liệu gốc.

Lưu ý rằng mã này chạy rất chậm trên tệp gốc vì có rất nhiều hình dạng và khung dữ liệu kết quả dài ~ 2 triệu hàng.

Mã số:

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

Cách 2: Loại bỏ các đa giác nhỏ

Có nhiều hòn đảo nhỏ không quan trọng lắm. Nếu bạn kiểm tra một số lượng tử của các khu vực cho đa giác, chúng tôi thấy rằng nhiều trong số chúng là rất nhỏ. Đối với âm mưu Canada, tôi đã đi xuống từ âm mưu hơn một ngàn đa giác thành hàng trăm đa giác.

Số lượng cho kích thước của đa giác cho Canada:

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

Mã số:

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

Phương pháp 3: Đơn giản hóa hình dạng của các hình đa giác

Chúng ta có thể giảm số lượng đỉnh trong hình dạng đa giác của mình bằng cách sử dụng gSimplifyhàm từ rgeosgói

Mã số:

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

Một số điểm chuẩn:

Tôi đã sử dụng trôi qua system.timeđể điểm chuẩn thời gian âm mưu của tôi. Lưu ý rằng đây chỉ là thời gian để vẽ các quốc gia, không có các đường viền và các thứ khác. Đối với các đối tượng sp, tôi chỉ sử dụng plotchức năng. Đối với các đối tượng khung dữ liệu, tôi đã sử dụng plothàm với type='l'và lineshàm.

Vẽ sơ đồ đa giác Canada, Mỹ, Mexico:

73,009 giây

Sử dụng phương pháp 1:

2,449 giây

Sử dụng phương pháp 2:

17,660 giây

Sử dụng phương pháp 3:

16.695 giây

Sử dụng Phương pháp 2 + 1:

1.729 giây

Sử dụng Phương pháp 2 + 3:

0,445 giây

Sử dụng Phương pháp 2 + 3 + 1:

0,172 giây

Những chú ý khác:

Có vẻ như sự kết hợp của các phương pháp 2 + 3 giúp tăng tốc độ đủ cho âm mưu của đa giác. Sử dụng phương pháp 2 + 3 + 1 thêm vấn đề mất các thuộc tính đẹp của spcác đối tượng và khó khăn chính của tôi là áp dụng các phép chiếu. Tôi đã hack một cái gì đó cùng nhau để chiếu một đối tượng khung dữ liệu, nhưng nó chạy khá chậm. Tôi nghĩ rằng việc sử dụng phương pháp 2 + 3 cung cấp đủ tốc độ cho tôi cho đến khi tôi có thể thoát khỏi tình trạng sử dụng phương pháp 2 + 3 + 1.

Mọi người nên xem xét chuyển sang gói sf (tính năng không gian) thay vì sp. Nó nhanh hơn đáng kể (1/60 trong trường hợp này) và dễ sử dụng hơn. Dưới đây là một ví dụ về đọc trong shp và vẽ thông qua ggplot2.

Lưu ý: Bạn cần cài đặt lại ggplot2 từ bản dựng gần đây nhất trên github (xem bên dưới)

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 

Dữ liệu GADM có độ phân giải không gian rất cao của đường bờ biển. Nếu bạn không cần điều đó, bạn có thể sử dụng một bộ dữ liệu tổng quát hơn. Cách tiếp cận của ialm rất thú vị, nhưng một cách khác đơn giản là sử dụng dữ liệu 'wrld_simpl' đi kèm với 'maptools'

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