我必须对栅格中每个网格多边形的一个点进行1000次迭代迭代，网格大小从5到25。 对于光栅50 x 50（2500个单元格），使用以下代码进行处理时间超过1小时：
library(raster)
library(dplyr)
# This is the script for random sampling inside the grid cells
sample_grid <- function(r, w, n){
grid <- raster(extent(r))
res(grid) <- w
proj4string(grid) <- proj4string(r)
gridpolygon <- rasterToPolygons(grid)
pickpts <- sapply(gridpolygon@polygons, spsample, n = n, type = "random")
sapply(pickpts, FUN = extract, x = r)
}
# Let's make a raster
r <- raster(ncol = 50, nrow = 50, xmn = 0, xmx = 50, ymn = 0, ymx = 50)
values(r) <- runif(ncell(r))
# Repeat the random sampling process 1000 times for different grid sizes
sapply(5:25, function(x) replicate(1000, sample_grid(r, x, 1) %>%
mean(., na.rm = TRUE)))
我想让它更快。合理的目标是大约15分钟。 你有什么建议吗？
这是Rprof
Rprof(tmp <- tempfile())
sample_grid(r, 10, 1) %>% mean(., na.rm = TRUE)
Rprof()
summaryRprof(tmp)
#################### summaryRprof output ####################
$by.self
self.time self.pct total.time total.pct
"eval" 0.02 14.29 0.14 100.00
"initialize" 0.02 14.29 0.06 42.86
"getClassDef" 0.02 14.29 0.04 28.57
".getClassFromCache" 0.02 14.29 0.02 14.29
"aperm" 0.02 14.29 0.02 14.29
"merge.data.frame" 0.02 14.29 0.02 14.29
"validityMethod" 0.02 14.29 0.02 14.29
$by.total
total.time total.pct self.time self.pct
"eval" 0.14 100.00 0.02 14.29
"%>%" 0.14 100.00 0.00 0.00
".local" 0.14 100.00 0.00 0.00
"FUN" 0.14 100.00 0.00 0.00
"lapply" 0.14 100.00 0.00 0.00
"sample_grid" 0.14 100.00 0.00 0.00
"sapply" 0.14 100.00 0.00 0.00
"standardGeneric" 0.14 100.00 0.00 0.00
"initialize" 0.06 42.86 0.02 14.29
"new" 0.06 42.86 0.00 0.00
"getClassDef" 0.04 28.57 0.02 14.29
".cellValues" 0.04 28.57 0.00 0.00
".readCells" 0.04 28.57 0.00 0.00
".xyValues" 0.04 28.57 0.00 0.00
"CRS" 0.04 28.57 0.00 0.00
"over" 0.04 28.57 0.00 0.00
"sample.Polygon" 0.04 28.57 0.00 0.00
"validObject" 0.04 28.57 0.00 0.00
".getClassFromCache" 0.02 14.29 0.02 14.29
"aperm" 0.02 14.29 0.02 14.29
"merge.data.frame" 0.02 14.29 0.02 14.29
"validityMethod" 0.02 14.29 0.02 14.29
".bboxCoords" 0.02 14.29 0.00 0.00
".uniqueNames" 0.02 14.29 0.00 0.00
"[" 0.02 14.29 0.00 0.00
"anyStrings" 0.02 14.29 0.00 0.00
"apply" 0.02 14.29 0.00 0.00
"as.matrix" 0.02 14.29 0.00 0.00
"identical" 0.02 14.29 0.00 0.00
"identicalCRS" 0.02 14.29 0.00 0.00
"is" 0.02 14.29 0.00 0.00
"match.arg" 0.02 14.29 0.00 0.00
"merge" 0.02 14.29 0.00 0.00
"merge.default" 0.02 14.29 0.00 0.00
"names" 0.02 14.29 0.00 0.00
"SpatialPolygons" 0.02 14.29 0.00 0.00
"stopifnot" 0.02 14.29 0.00 0.00
"t" 0.02 14.29 0.00 0.00
"table" 0.02 14.29 0.00 0.00
"validNames" 0.02 14.29 0.00 0.00
$sample.interval
[1] 0.02
$sampling.time
[1] 0.14
###############################################################