r - 如何使用移动窗口迭代 R 中的裁剪栅格？

Question

我想使用 bbox 或已知范围(即行和列 10 个像素)裁剪栅格。

下面您可以看到一个可重现的示例:

library(terra)
r <- terra::set.ext(rast(volcano), terra::ext(0, nrow(volcano), 0, ncol(volcano)))
plot(r)

xmin <- xmin(r)
ymax <- ymax(r)
rs <- res(r)

n <- 10 # i.e. of rows and cols size
xmax <- xmin + n * rs[1] 
ymin <- ymax - n * rs[2]

x <- crop(r, c(xmin, xmax, ymin, ymax))
plot(x)

预期的循环是:

• 完成所有栅格 (r) 长度裁剪并将每个栅格片段临时保存到 data.frame(或 data.table、raster、spatraster、list)中

Answer 1

了解更多关于为什么要这样做的背景信息会很有用。从您的问题中也不清楚您是否希望裁剪区域重叠；我猜你不希望这样。

你可以这样:

library(terra)
r <- rast(volcano)
n <- 10

获取感兴趣的起始细胞

rows <- seq(1, nrow(r), by=n)
cols <- seq(1, ncol(r), by=n)    
cells <- cellFromRowColCombine(r, rows, cols)

获取坐标

# upper-left coordinates of the starting cells 
xy <- xyFromCell(r, cells)
rs <- res(r)
xy[,1] <- xy[,1] - rs[1]/2
xy[,2] <- xy[,2] + rs[2]/2

# add the lower-right coordinates of the end cell
xy <- cbind(xy[,1], xy[,1] + n*rs[1], xy[,2] - n*rs[2], xy[,2])

并循环

x <- lapply(1:nrow(xy), function(i) {
         crop(r, xy[i,])
       })
    

验证

e <- lapply(x, \(i) ext(i) |> as.polygons()) |> vect()
plot(r)
lines(e, col="blue", lwd=2)

sapply(x, dim) |> t() |> head()
#     [,1] [,2] [,3]
#[1,]   10   10    1
#[2,]   10   10    1
#[3,]   10   10    1
#[4,]   10   10    1
#[5,]   10   10    1
#[6,]   10   10    1

或者使用基于起始单元格和结束单元格编号的替代方法(为此，您需要 terra 1.5-25，目前您可以使用 install.packages('terra', repos='https://rspatial.r-universe.dev'))

srows <- seq(1, nrow(r), by=n)
scols <- seq(1, ncol(r), by=n)
erows <- pmin(nrow(r), srows+n-1)
ecols <- pmin(ncol(r), scols+n-1)
scell <- cellFromRowColCombine(r, srows, scols)
ecell <- cellFromRowColCombine(r, erows, ecols)
cells <- cbind(scell, ecell)

x <- lapply(1:nrow(cells), function(i) {
        e <- ext(r, cells[i,])
        crop(r, e)
    })