Como acelerar a plotagem de polígonos em R?

Eu quero plotar as fronteiras dos países da América do Norte sobre uma imagem rasterizada representando algumas variáveis ​​e, em seguida, sobrepor contornos no topo da plotagem usando R. muito lento! Ainda não o fiz no ggplot2, mas duvido que ele se sairá melhor em termos de velocidade.

Eu tenho os dados em um arquivo netcdf criado a partir de um arquivo grib. Por enquanto, baixei as fronteiras do país para o Canadá, EUA e México, que estavam disponíveis nos arquivos RData do GADM, que eram lidos em R como objetos SpatialPolygonsDataFrame.

Aqui está um código:

# 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

Existe uma maneira de acelerar a plotagem dos polígonos? No sistema em que estou trabalhando, a plotagem leva vários minutos. Eu quero, eventualmente, criar uma função que gerará facilmente um número desses gráficos para inspeção, e eu acho que traçarei muitos desses mapas, então quero aumentar a velocidade dos gráficos!

Obrigado!

Encontrei 3 maneiras de aumentar a velocidade de plotagem das fronteiras do país a partir de arquivos de formas para R. Encontrei alguma inspiração e código aqui e aqui .

(1) Podemos extrair as coordenadas dos arquivos de formas para obter a longitude e latitudes dos polígonos. Em seguida, podemos colocá-los em um quadro de dados com a primeira coluna contendo as longitudes e a segunda coluna contendo latitudes. As diferentes formas são separadas por NAs.

(2) Podemos remover alguns polígonos do nosso arquivo de formas. O arquivo de formas é muito, muito detalhado, mas algumas das formas são pequenas ilhas que não são importantes (para minhas plotagens, de qualquer maneira). Podemos definir um limite mínimo de área de polígono para manter os polígonos maiores.

(3) Podemos simplificar a geometria de nossas formas usando o algoritmo Douglas-Peuker . As arestas de nossas formas poligonais podem ser simplificadas, pois são muito complexas no arquivo original. Felizmente, existe um pacote rgeosque implementa isso.

Configuração:

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

Método 1: extrair as coordenadas dos arquivos de forma em um quadro de dados e linhas de plotagem

A principal desvantagem é que perdemos algumas informações aqui quando comparadas à manutenção do objeto como um objeto SpatialPolygonsDataFrame, como a projeção. No entanto, podemos transformá-lo novamente em um objeto sp e adicionar novamente as informações da projeção, e ainda é mais rápido do que plotar os dados originais.

Observe que esse código é executado muito lentamente no arquivo original porque há muitas formas e o quadro de dados resultante tem aproximadamente 2 milhões de linhas.

Código:

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

Método 2: Remover polígonos pequenos

Existem muitas pequenas ilhas que não são muito importantes. Se você verificar alguns dos quantis das áreas para os polígonos, veremos que muitos deles são minúsculos. Para a trama do Canadá, passei de plotar mais de mil polígonos para apenas centenas de polígonos.

Quantiles para o tamanho de polígonos no Canadá:

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

Código:

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

Método 3: simplificar a geometria das formas de polígono

Podemos reduzir o número de vértices em nossas formas poligonais usando a gSimplifyfunção do rgeospacote

Código:

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

Alguns benchmarks:

Eu costumava system.timepassar para comparar meus tempos de plotagem. Observe que estes são apenas os horários para traçar os países, sem as linhas de contorno e outras coisas extras. Para os objetos sp, eu apenas usei a plotfunção Para os objetos do quadro de dados, usei a plotfunção com type='l'e a linesfunção

Traçando os polígonos originais do Canadá, EUA e México:

73.009 segundos

Usando o método 1:

2,444 segundos

Usando o método 2:

17.660 segundos

Usando o método 3:

16,695 segundos

Usando o método 2 + 1:

1.729 segundos

Usando o método 2 + 3:

0.445 segundos

Usando o Método 2 + 3 + 1:

0,172 segundos

Outras observações:

Parece que a combinação dos métodos 2 + 3 fornece acelerações suficientes para a plotagem de polígonos. O uso dos métodos 2 + 3 + 1 adiciona o problema de perder as boas propriedades dos spobjetos, e minha principal dificuldade é aplicar projeções. Eu hackeei algo juntos para projetar um objeto de quadro de dados, mas ele é bastante lento. Eu acho que o uso do método 2 + 3 fornece acelerações suficientes para mim até que eu consiga entender o uso do método 2 + 3 + 1.

Todos devem procurar transferir para o pacote sf (recursos espaciais) em vez de sp. É significativamente mais rápido (1/60º neste caso) e mais fácil de usar. Aqui está um exemplo de leitura em um shp e plotagem via ggplot2.

Nota: Você precisa reinstalar o ggplot2 da versão mais recente do github (veja abaixo)

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 

Os dados do GADM têm uma resolução espacial muito alta das costas. Se você não precisar, pode usar um conjunto de dados mais generalizado. As abordagens de ialm são muito interessantes, mas uma alternativa simples é usar os dados 'wrld_simpl' que vêm com 'maptools'

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