Question

我有一个栅格对象，其中包含数值和NA，我想知道每个带有值的栅格像元到半径内其他数字像元的距离。结果是一个矩阵/栅格，其中包含每个非NA的数字栅格像元的总距离。未考虑的细胞获得NA。现在的问题是计算需要相对较长的时间，因为我必须对所有栅格像元进行循环以测试它们是否为数字，然后计算距离。然后，我必须选择所有数字栅格单元，并选择特定半径内的所有数字像元，因为accCost函数不考虑带有NA的像元来计算距离。有没有一种更快的方法来计算特定半径内栅格像元的总距离？

首先，我有一个栅格，必须修改它，因为我只想知道特定区域内像元的总距离。由于accCost函数不考虑NA，因此我需要给它们一个值。然后，我定义“ foreach”功能的核心。当我使用“ accCost”函数计算从一个栅格像元到其他栅格像元的距离时，我需要进行一些默认设置并计算像元的xy坐标。要选择非NA的距离，我要进行boolena查询。然后，我遍历每个栅格像元以测试它们是否具有特定值。如果是，则使用“ accCost”函数计算到每个网格单元的距离。然后，我将结果栅格化。否则，栅格像元将获得NA。

#load library
library(doParallel)
library(foreach)
library(gdistance)
library(raster)

#Create a raster
mraster<-matrix(nrow=15,ncol = 15)
mraster[c(5,10,9,15,13,5),c(4,8,9,7,7,15)]<-1
builtupraster<-raster(mraster, xmn=1, xmx=1500, ymn=1, ymx=1500)
proj4string(builtupraster) <- CRS("+proj=somerc +lat_0=46.952405555556 +lon_0=7.439583333333 +x_0=600000 +y_0=200000 +ellps=bessel +towgs84=674.374,15.056,405.346,0,0,0,0 +units=m +no_defs")
builtupraster[is.na(builtupraster)]<-0

#define parallel function
cores<-detectCores()
cl<-makeCluster(cores-2)
doParallel::registerDoParallel(cl)

#calculate the distance between cells fast
r <- builtupraster
r2 <- transition(r, transitionFunction = function(x){1}, directions = 16)
r2 <- geoCorrection(r2,  scl=FALSE)
siedlungsfl<-as.matrix(r>0)

xcord<-xFromCol(r,1:ncol(r))
ycord<-yFromRow(r,1:nrow(r))

testrow<-1:nrow(r)
testcol<-1:ncol(r)

distmat<-foreach(row= testrow, .combine = "rbind" ,.packages = "gdistance") %:%
 foreach(col= testcol, .combine="c",.packages = "gdistance") %dopar%{
 if(r[row,col]>0){
   d <- accCost(r2,c(xcord[row],ycord[col]))
   d2 <- d[which(siedlungsfl)]
   d3 <- d2[d2<=2000]
   d4 <- sum(sqrt(2*d3+1)-1)/length(d3)+(sqrt(0.97428*30+1.46)-0.996249)

 } else{

   d4 <- NA 

 }
}

结果类似于：Result

Answer 1

我简化了您的脚本---删除了并行化，因此更易于优化。我删除了循环和if语句，并进行了其他一些更改；这可能会有所帮助，但可能不会很大。

library(gdistance)

r <- raster(nrow=15,ncol = 15, xmn=1, xmx=1500, ymn=1, ymx=1500, vals=0, crs = "+proj=somerc +lat_0=46.952405555556 +lon_0=7.439583333333 +x_0=600000 +y_0=200000 +ellps=bessel +towgs84=674.374,15.056,405.346,0,0,0,0 +units=m"
)
r[c(5,10,9,15,13,5),c(4,8,9,7,7,15)] <- 1

tr <- transition(r, transitionFunction = function(x){1}, directions = 16)
tr <- geoCorrection(tr,  scl=FALSE)

cells <- Which(r > 0, cells=TRUE)
xy <- xyFromCell(r, cells)

constant <- sqrt(0.97428 * 30 + 1.46) - 0.996249
d <- rep(NA, length(cells))
for(i in 1:length(cells)) {
    dst <- accCost(tr, xy[i,])[cells]
    dst <- dst[dst <= 1000] # 2000 is too high for this example
    d[i] <- mean(sqrt(2 * dst + 1) - 1)
}

result <- raster(r)
result[cells] <- d + constant
plot(result)
text(result)

另一种可能更慢的方法是这样的：

library(raster)
r <- raster(nrow=15,ncol = 15, xmn=1, xmx=1500, ymn=1, ymx=1500, crs = "+proj=somerc +lat_0=46.952405555556 +lon_0=7.439583333333 +x_0=600000 +y_0=200000 +ellps=bessel +towgs84=674.374,15.056,405.346,0,0,0,0 +units=m"
)
r[c(5,10,9,15,13,5),c(4,8,9,7,7,15)] <- 1
d <- distance(r)

cells <- Which(r > 0, cells=TRUE)
b <- buffer(SpatialPoints(xyFromCell(r, cells)), 1000, dissolve=FALSE)
e <- extract(d, b, fun=sum)

result2 <- raster(r)
result2[cells] <- e
plot(result2)
text(result2)

结果不一样，因为我总结了距离（根据您的描述），而您却constant + mean(sqrt(2 * dst + 1) - 1)

R栅格：计算半径内每个栅格像元到其他栅格像元的距离

1 个答案: