如何基于R中的点相交对栅格子集执行栅格计算(例如,方面)

时间:2019-05-22 21:30:40

标签: optimization r-raster

我正在使用raster包在R中处理一些栅格数据。我想从栅格中计算和提取一些地理信息(例如,坡度,坡向),但是仅在特定点(我也有一些数据作为SpatialPointsDataFrame,我要在其中计算坡度/坡度/等。 )。我正在为几个高分辨率栅格执行此操作,并且当我仅需要5-10%的栅格栅格时,似乎很少使用资源来为每个栅格像元进行计算。

我以为raster::stackApply函数可能有用,但这似乎是对rasterBrick的子集执行计算,而不是根据点位置对单个栅格的子集执行计算(如果我错了,请纠正我) 。我还认为我可以做一个for循环,从中提取每个感兴趣点附近的周围单元,然后以这种方式迭代计算斜率/纵横比。这似乎很笨拙,我希望有一个更优雅或内置的解决方案,但它应该可以工作。

到目前为止,这是我在for循环上的想法,但是我不确定如何最好地做到这一点。

# Attach packages
library(rgdal)
library(raster)

# Generate example raster data
r = raster()
set.seed(0)
values(r) = runif(ncell(r), min = 0, max = 1000)

# Generate example point data
df.sp = SpatialPoints(
  coords = cbind(runif(25, min = -100, max = 100),  
                 runif(25, min = -50, max = 50)), 
  proj4string = crs(r))

# Iterate on each row of SpatialPoints
for (i in 1:nrow(df.sp)) {

  # Find cell index of current SpatialPoint
  cell.idx = raster::extract(r, df.sp[i,], cellnumbers = TRUE)[1]

  # Find indices of cells surrounding point of interest
  neighbors.idx = raster::adjacent(r, cell.idx, directions = 16)

  # Get DEM values for cell and surrounding cells
  vals.local = r[c(cell.idx, neighbors.idx[,2])]

  # Somehow convert this back to an appropriate georeferenced matrix
  #r.local = ...

  # Perform geometric calculations on local raster
  #r.stack = terrain(r.local, opt = c('slope', 'aspect'))

  # Remaining data extraction, etc. (I can take it from here...)
}

总而言之,我需要一种仅根据SpatialPoints对象给定的特定点从DEM栅格计算坡度和坡向的方法。如果您知道预建或更优雅的解决方案,那就太好了!如果没有,那么对完成for循环(如何最好地提取周围单元格的邻域并对其进行计算)的一些帮助也将是最受赞赏的。

1 个答案:

答案 0 :(得分:0)

有趣的问题。这是一种可能的方法。

library(raster)

r <- raster()
set.seed(0)
values(r) <- runif(ncell(r), min = 0, max = 1000)
coords <- cbind(runif(25, min = -100, max = 100),  
               runif(25, min = -50, max = 50))

x <- rasterize(coords, r)
f <- focal(x, w=matrix(1, nc=3, nr=3), na.rm=TRUE)             
rr <- mask(r, f)
slope <- terrain(rr, "slope")

extract(slope, coords)
# [1] 0.0019366236 0.0020670699 0.0006305257 0.0025334280 0.0023480935 0.0007527267 0.0002699272 0.0004699626
# [9] 0.0004869054 0.0025651333 0.0010415805 0.0008574920 0.0010664869 0.0017700297 0.0001666226 0.0008405391
#[17] 0.0017682167 0.0009854172 0.0015350466 0.0017714466 0.0012994945 0.0016563132 0.0003276584 0.0020499529
#[25] 0.0006582073

效率提升可能不大,因为它仍然处理所有NA

也许像这样,更多地沿着您的思路:

cells <- cellFromXY(r, coords)
ngbs <- raster::adjacent(r, cells, pairs=TRUE)

slope <- rep(NA, length(cells))
for (i in 1:length(cells)) {
   ci <- ngbs[ngbs[,1] == cells[i], 2]
   e <- extentFromCells(r, ci)
   x <- crop(r, e)
   slope[i] <- terrain(x, "slope")[5]
}
slope
#[1] 0.0019366236 0.0020670699 0.0006305257 0.0025334280 0.0023480935 0.0007527267 0.0002699272 0.0004699626
#[9] 0.0004869054 0.0025651333 0.0010415805 0.0008574920 0.0010664869 0.0017700297 0.0001666226 0.0008405391
#[17] 0.0017682167 0.0009854172 0.0015350466 0.0017714466 0.0012994945 0.0016563132 0.0003276584 0.0020499529
#[25] 0.0006582073

但是我发现那种蛮力

slope <- terrain(r, "slope")
extract(slope, coords)

最快,比我的第一种快9倍,比第二种快4倍