如何使用移动窗口在 R 中迭代裁剪栅格

发布于04月03日

我想使用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.table、光栅、光栅、列表)

推荐答案

对于你为什么要这样做，有更多的背景知识是很有用的.从你的问题中也不清楚你是否希望裁剪区域重叠；我猜你不想那样.

你可以这样说:

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