[英]Pairwise raster comparison in R: alternative to for-loop?
如何有效地比較成對的分布柵格(僅包含 0 和 1 的raster
圖層)? 我需要衡量大約 6500 個單獨的全球柵格之間的相似性。 SDMTools
Istat
應該可以完成這項工作。
這是我的代碼:
library(raster)
library(SDMTools)
創建可重現的示例數據:值為 0 和 1 的柵格
# first raster
r1 <- raster(nrow=1800, ncol=3600, xmn=-18000000, xmx=18000000, ymn=-9000000, ymx=9000000,
crs="+proj=moll +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +units=m +no_defs",
resolution=10000, vals=0)
r2 <- raster(nrow=1800, ncol=3600, xmn=-18000000, xmx=0, ymn=0, ymx=9000000,
crs="+proj=moll +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +units=m +no_defs",
resolution=10000, vals=2)
r12 <- mosaic(r1, r2, fun=mean)
# second raster
r3 <- raster(nrow=1800, ncol=3600, xmn=-18000000, xmx=18000000, ymn=-9000000, ymx=9000000,
crs="+proj=moll +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +units=m +no_defs",
resolution=10000, vals=0)
r4 <- raster(nrow=1800, ncol=3600, xmn=-12000000, xmx=15000000, ymn=2000000, ymx=3000000,
crs="+proj=moll +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +units=m +no_defs",
resolution=10000, vals=2)
r34 <- mosaic(r3, r4, fun=mean)
列出柵格
files_list <- list(r12, r34)
創建空矩陣以填充循環中的數據
ras_comp <- matrix(NA, nrow=length(files_list), ncol=length(files_list))
ras_comp
# label rows and columns of matrix
rownames(ras_comp) <- c("r12", "r34")
colnames(ras_comp) <- c("r12", "r34")
ras_comp
循環比較所有可能的矩陣/柵格對
for (i in 1:length(files_list)) {
# load raster i
ras_i <- as.matrix(files_list[[i]])
for (j in 1:length(files_list)) {
# load raster j
ras_j <- as.matrix(files_list[[j]])
# compare both rasters
ras_Istat <- Istat(ras_i, ras_j, old=F)
# write value into matrix
ras_comp[i,j] <- ras_Istat
}
}
檢查最終矩陣
ras_comp
> ras_comp
r12 r34
r12 1.0000000 0.1814437
r34 0.1814437 1.0000000
使用as.matrix
將柵格轉換為矩陣可以顯着減少計算時間,並且生成的最終表正是我所需要的,但是為數千個柵格執行此操作需要永遠完成。 如何優化代碼以便以更有效的方式比較柵格?
Istat
在進行簡單計算之前會進行大量測試和縮放。 如果您知道這些測試通過了,您可以一次性進行縮放並處理縮放后的值。 它確實:
if (length(which(dim(x) == dim(y))) != 2)
stop("matrix / raster objects must be of the same extent")
if (min(c(x, y), na.rm = T) < 0)
stop("all values must be positive")
然后它檢查兩個柵格的“有限”位置,其中包括NA
值:
pos = which(is.finite(x) & is.finite(y))
然后計算柵格的縮放值:
px = x[pos]/sum(x[pos])
py = y[pos]/sum(y[pos])
H = sqrt(sum((sqrt(px) - sqrt(py))^2))
如果old=FALSE
像你一樣,那么它返回:
return(1 - (H^2)/2)
> Istat(r12,r34)
[1] 0.1814437
如果我刪除測試並編寫一個適用於縮放值的函數,我可以將其歸結為:
fIstat = function(px,py){
1 - (sum((sqrt(px) - sqrt(py))^2))/2
}
通過縮放柵格並運行來測試:
r12px = r12[]/sum(r12[])
r34px = r34[]/sum(r34[])
fIstat(r12px, r34px)
# [1] 0.1814437
相同的價值。 很好,但它更快嗎?
> microbenchmark(fIstat(r12px, r34px), Istat(r12,r34))
Unit: milliseconds
expr min lq mean median uq
fIstat(r12px, r34px) 49.95867 78.28649 78.10863 79.45235 80.85234
Istat(r12, r34) 1084.84825 1181.31116 1217.64122 1212.93180 1263.50811
max neval
106.6803 100
1349.0239 100
是的,在很大程度上。
所以...如果你的數據沒有缺失值或無窮,創造files_list
這些縮放柵格值的,叫我fIstat
,僅比上三角循環,你應該10倍加速此。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.