我正在从基于数千个多边形边界的栅格中提取不同土地利用类型的面积和覆​​盖率。我发现，如果我遍历每个单独的多边形并进行裁剪，然后将栅格蒙版减小到特定多边形的大小，则提取功能的运行速度会更快。尽管如此，它的运行速度很慢，我想知道是否有人对提高我的代码效率和速度有任何建议。

我发现与此相关的唯一的事情就是这个响应由Roger Bivand使用谁建议GDAL.open()，并GDAL.close()作为以及getRasterTable()和getRasterData()。我研究了这些内容，但过去在gdal上遇到过麻烦，并且对它的了解不够深，不知道如何实现它。

可重现的示例：

library(maptools)  ## For wrld_simpl
library(raster)

## Example SpatialPolygonsDataFrame
data(wrld_simpl) #polygon of world countries
bound <- wrld_simpl[1:25,] #name it this to subset to 25 countries and because my loop is set up with that variable  

## Example RasterLayer
c <- raster(nrow=2e3, ncol=2e3, crs=proj4string(wrld_simpl), xmn=-180, xmx=180, ymn=-90, ymx=90)
c[] <- 1:length(c)

#plot, so you can see it
plot(c)    
plot(bound, add=TRUE) 

迄今为止最快的方法

result <- data.frame() #empty result dataframe 

system.time(
     for (i in 1:nrow(bound)) { #this is the number of polygons to iterate through
      single <- bound[i,] #selects a single polygon
      clip1 <- crop(c, extent(single)) #crops the raster to the extent of the polygon, I do this first because it speeds the mask up
      clip2 <- mask(clip1,single) #crops the raster to the polygon boundary

      ext<-extract(clip2,single) #extracts data from the raster based on the polygon bound
      tab<-lapply(ext,table) #makes a table of the extract output
      s<-sum(tab[[1]])  #sums the table for percentage calculation
      mat<- as.data.frame(tab) 
      mat2<- as.data.frame(tab[[1]]/s) #calculates percent
      final<-cbind(single@data$NAME,mat,mat2$Freq) #combines into single dataframe
      result<-rbind(final,result)
      })

   user  system elapsed 
  39.39    0.11   39.52 

并行处理

并行处理将用户时间减少了一半，但通过将系统时间加倍却没有带来好处。栅格将其用于提取功能，但不幸的是，剪裁或遮罩功能不使用此功能。不幸的是，由于“ IO”的“等待”，这留下了相当大的总经过时间。

beginCluster( detectCores() -1) #use all but one core

在多个内核上运行代码：

  user  system elapsed 
  23.31    0.68   42.01 

然后结束集群

endCluster()

慢速方法： 直接从栅格函数提取数据的另一种方法花费的时间更长，而且我不确定数据管理是否可以将其转换为所需的形式：

system.time(ext<-extract(c,bound))
   user  system elapsed 
1170.64   14.41 1186.14 

我终于可以改善这个功能了。我发现出于我的目的，rasterize()首先对多边形最快，然后使用getValues()代替extract()。栅格化的速度并不比用于在小多边形中制表栅格值的原始代码快得多，但是当涉及到要裁剪大栅格并提取值的大型多边形区域时，栅格化就显得很有意思。我还发现getValues()它比该extract()功能快得多。

我还弄清楚了使用的多核处理foreach()。

我希望这对于希望使用R解决方案从多边形叠加层中提取栅格值的其他人有用。这类似于ArcGIS的“制表交叉点”，它对我而言效果不佳，在经过数小时的处理后像该用户一样返回空输出。

#initiate multicore cluster and load packages
library(foreach)
library(doParallel)
library(tcltk)
library(sp)
library(raster)

cores<- 7
cl <- makeCluster(cores, output="") #output should make it spit errors
registerDoParallel(cl)

功能如下：

multicore.tabulate.intersect<- function(cores, polygonlist, rasterlayer){ 
  foreach(i=1:cores, .packages= c("raster","tcltk","foreach"), .combine = rbind) %dopar% {

    mypb <- tkProgressBar(title = "R progress bar", label = "", min = 0, max = length(polygonlist[[i]]), initial = 0, width = 300) 

    foreach(j = 1:length(polygonlist[[i]]), .combine = rbind) %do% {
      final<-data.frame()
      tryCatch({ #not sure if this is necessary now that I'm using foreach, but it is useful for loops.

        single <- polygonlist[[i]][j,] #pull out individual polygon to be tabulated

        dir.create (file.path("c:/rtemp",i,j,single@data$OWNER), showWarnings = FALSE) #creates unique filepath for temp directory
        rasterOptions(tmpdir=file.path("c:/rtemp",i,j, single@data$OWNER))  #sets temp directory - this is important b/c it can fill up a hard drive if you're doing a lot of polygons

        clip1 <- crop(rasterlayer, extent(single)) #crop to extent of polygon
        clip2 <- rasterize(single, clip1, mask=TRUE) #crops to polygon edge & converts to raster
        ext <- getValues(clip2) #much faster than extract
        tab<-table(ext) #tabulates the values of the raster in the polygon

        mat<- as.data.frame(tab)
        final<-cbind(single@data$OWNER,mat) #combines it with the name of the polygon
        unlink(file.path("c:/rtemp",i,j,single@data$OWNER), recursive = TRUE,force = TRUE) #delete temporary files
        setTkProgressBar(mypb, j, title = "number complete", label = j)

      }, error=function(e){cat("ERROR :",conditionMessage(e), "\n")}) #trycatch error so it doesn't kill the loop

      return(final)
    }  
    #close(mypb) #not sure why but closing the pb while operating causes it to return an empty final dataset... dunno why. 
  }
}

因此，要使用它，请调整single@data$OWNER使其适合您所标识的多边形的列名（可能已经内置在函数中的猜测...），然后输入：

myoutput <- multicore.tabulate.intersect(cores, polygonlist, rasterlayer)

加快从点，XY或多边形中提取栅格（栅格堆栈）的速度

很好的回答，卢克。您必须是R向导！这是一个非常小的调整，可以简化您的代码（在某些情况下可能会稍微提高性能）。您可以通过使用cellFromPolygon（或对于点使用cellFromXY）来避免某些操作，然后裁剪和getValues。

从栅格堆栈中提取多边形或点数据------------------------

 library(raster)  
 library(sp)   

  # create polygon for extraction
  xys= c(76.27797,28.39791,
        76.30543,28.39761,
        76.30548,28.40236,
        76.27668,28.40489)
  pt <- matrix(xys, ncol=2, byrow=TRUE)
  pt <- SpatialPolygons(list(Polygons(list(Polygon(pt)), ID="a")));
  proj4string(pt) <-"+proj=longlat +datum=WGS84 +ellps=WGS84"
  pt <- spTransform(pt, CRS("+proj=sinu +a=6371007.181 +b=6371007.181 +units=m"))
  ## Create a matrix with random data & use image()
  xy <- matrix(rnorm(4448*4448),4448,4448)
  plot(xy)

  # Turn the matrix into a raster
  NDVI_stack_h24v06 <- raster(xy)
  # Give it lat/lon coords for 36-37°E, 3-2°S
  extent(NDVI_stack_h24v06) <- c(6671703,7783703,2223852,3335852)
  # ... and assign a projection
  projection(NDVI_stack_h24v06) <- CRS("+proj=sinu +a=6371007.181 +b=6371007.181 +units=m")
  plot(NDVI_stack_h24v06)
  # create a stack of the same raster
  NDVI_stack_h24v06 = stack( mget( rep( "NDVI_stack_h24v06" , 500 ) ) )


  # Run functions on list of points
  registerDoParallel(16)
  ptm <- proc.time()
  # grab cell number
  cell = cellFromPolygon(NDVI_stack_h24v06, pt, weights=FALSE)
  # create a raster with only those cells
  r = rasterFromCells(NDVI_stack_h24v06, cell[[1]],values=F)
  result = foreach(i = 1:dim(NDVI_stack_h24v06)[3],.packages='raster',.combine=rbind,.inorder=T) %dopar% {
     #get value and store
     getValues(crop(NDVI_stack_h24v06[[i]],r))
  }
  proc.time() - ptm
  endCluster()

用户系统已使用16.682 2.610 2.530

  registerDoParallel(16)
  ptm <- proc.time()
  result = foreach(i = 1:dim(NDVI_stack_h24v06)[3],.packages='raster',.inorder=T,.combine=rbind) %dopar% {
        clip1 <- crop(NDVI_stack_h24v06[[i]], extent(pt)) #crop to extent of polygon
        clip2 <- rasterize(pt, clip1, mask=TRUE) #crops to polygon edge & converts to raster
         getValues(clip2) #much faster than extract
  }
  proc.time() - ptm
  endCluster()

用户系统运行时间33.038 3.511 3.288

如果覆盖的精度损失不是很重要-假设开始时很精确-通常可以通过首先将多边形转换为栅格来实现更高的区域计算速度。该raster软件包包含该zonal()功能，该功能应该可以很好地完成预期的任务。但是，您始终可以使用标准索引对同一维的两个矩阵进行子集化。如果必须维护多边形并且不介意GIS软件，那么在区域统计中QGIS实际上必须比ArcGIS或ENVI-IDL更快。

我也为此挣扎了一段时间，试图在〜1kmx1km的网格中计算〜300mx300m网格图的土地覆盖类别的面积份额。后者是一个多边形文件。我尝试了多核解决方案，但是对于我拥有的网格单元数来说，这仍然太慢了。相反，我：

1. 栅格化1kmx1km的网格，为所有网格单元提供唯一的编号
2. 将gdalUtils软件包中的allign_rasters（或直接gdalwarp）与r =“ near”选项一起使用，可以将1kmx1km网格的分辨率提高到300mx300m，并且投影相同。
3. 使用栅格数据包将第2步中的300mx300m土地覆盖图和300mx300m网格进行堆叠：stack_file <-stack（lc，grid）。
4. 创建一个data.frame来合并这些地图：df <-as.data.frame（rasterToPoints（stack_file）），它将1kmx1km地图的网格像元编号映射到300mx300m土地覆盖图
5. 使用dplyr计算1kmx1km像元中土地覆盖类像元的份额。
6. 通过将其链接到原始1kmx1km网格，在步骤5的基础上创建一个新栅格。

当我在300mx300m上具有> 15毫米网格单元的土地覆盖图上尝试此过程时，该过程运行非常快，并且在我的PC上没有内存问题。

我认为，如果要合并具有不规则形状的多边形文件和栅格数据，上述方法也将起作用。也许，可以通过使用rasterize（光栅可能很慢）或gdal_rasterize将多边形文件直接光栅化为300mx300网格来组合步骤1＆2。就我而言，我也需要重新投影，因此我同时使用gdalwarp进行重新投影和分解。

我必须面对同样的问题才能从大型镶嵌图（50k x 50k）中提取多边形内部的值。我的多边形只有4个点。我发现最快的方法是crop镶嵌到多边形的边界中，将多边形三角划分为2个三角形，然后检查三角形中是否有点（我找到的最快算法）。与extract功能相比，运行时间从20 s减少到0.5 s。但是，该功能crop对于每个多边形仍然需要大约2 s。

抱歉，我无法提供完整的可复制示例。下面的R代码不包含输入文件。

此方法仅适用于简单的多边形。

par_dsm <- function(i, image_tif_name, field_plys2) {
    library(raster)
    image_tif <- raster(image_tif_name)
    coor <- field_plys2@polygons[[i]]@Polygons[[1]]@coords
    ext <- extent(c(min(coor[,1]), max(coor[,1]), min(coor[,2]), max(coor[,2])))

    extract2 <- function(u, v, us, vs) {
        u1 <- us[2]  - us[1]
        u2 <- us[3]  - us[2]
        u3 <- us[1]  - us[3]
        v1 <- vs[1]  - vs[2]
        v2 <- vs[2]  - vs[3]
        v3 <- vs[3]  - vs[1]
        uv1 <- vs[2] * us[1] - vs[1] * us[2]
        uv2 <- vs[3] * us[2] - vs[2] * us[3]
        uv3 <- vs[1] * us[3] - vs[3] * us[1]

        s1 <- v * u1 + u * v1 + uv1
        s2 <- v * u2 + u * v2 + uv2
        s3 <- v * u3 + u * v3 + uv3
        pos <- s1 * s2 > 0 & s2 * s3 > 0
        pos 
    }

    system.time({
        plot_rect <- crop(image_tif, ext, snap ='out')
        system.time({
        cell_idx <- cellFromXY(plot_rect, coor[seq(1,4),])
        row_idx <- rowFromCell(plot_rect, cell_idx)
        col_idx <- colFromCell(plot_rect, cell_idx)

        rect_idx <- expand.grid(lapply(rev(dim(plot_rect)[1:2]), function(x) seq(length.out = x)))

        pixel_idx1 <- extract2(
            rect_idx[,2], rect_idx[,1], 
            row_idx[c(1,2,3)], col_idx[c(1,2,3)])
        pixel_idx2 <- extract2(
            rect_idx[,2], rect_idx[,1], 
            row_idx[c(1,4,3)], col_idx[c(1,4,3)])
        pixel_idx <- pixel_idx1 | pixel_idx2
        })
    })
    mean(values(plot_rect)[pixel_idx])
}

# field_plys2: An object of polygons
# image_taf_name: file name of mosaic file
library(snowfall)
sfInit(cpus = 14, parallel = TRUE)
system.time(plot_dsm <- sfLapply(
    seq(along = field_plys2), par_dsm, image_tif_name, field_plys2))
sfStop()