Question

我正在尝试对空间栅格的每个像元进行计算。

实际上，栅格表示一个数字高程模型，并且非常大（1280000000个像元），我使用潮汐高度来计算每个像元出现（暴露在空中）的比例。

示例：

潮汐数据

df <- c(3.879, 4.078, 4.211, 4.252, 4.204, 4.077, 3.872, 3.588, 3.259, 
2.883, 2.48, 2.065, 1.635, 1.199, 0.766999999999999, 0.339, 
-0.0840000000000005, 
-0.503, -0.906, -1.284, -1.649, -1.998, -2.326, -2.603, -2.801, 
-2.959, -3.108, -3.237, -3.329, -3.353, -3.343, -3.303, -3.199, 
-3.041, -2.803, -2.503, -2.173, -1.789, -1.348, -0.869000000000001, 
-0.373, 0.141999999999999, 0.657999999999999, 1.207, 1.728, 2.226, 
2.683, 3.055, 3.393, 3.655, 3.841, 3.956, 3.988, 3.938, 3.816, 
3.63, 3.365, 3.047, 2.69, 2.292, 1.871, 1.433, 0.981999999999999, 
0.524, 0.0759999999999996, -0.367, -0.805000000000001, -1.226, 
-1.637, -2.036, -2.422, -2.741, -2.956, -3.137, -3.322, -3.481, 
-3.593, -3.662, -3.727, -3.791, -3.79, -3.707, -3.557, -3.356, 
-3.077, -2.732, -2.354, -1.962, -1.515, -1.035, -0.515000000000001, 
0.00599999999999934, 0.532999999999999, 1.05, 1.563, 2.032, 2.462, 
2.794, 3.098, 3.313)

光栅

require(raster)

r1 <- raster(matrix(seq(-4, 1.5, 0.5), ncol = 3))

计算曝光量的功能

expo <- list()

for(i in 1:ncell(r1)){
    depth <- df - r1[i]
    expo[[i]] <- length(depth[depth < 0])/length(depth)
    }

转换回栅格

r2 <- raster(matrix(unlist(expo), ncol = ncol(r1), byrow = T))

在大型栅格上这需要很长时间，我想知道是否有人可以帮助加快它的速度。我试图编写一个可与raster :: calc一起使用的函数，但尚未使其正常工作。

谢谢

Answer 1

这是您可以尝试的方法

我将df重命名为v，只是为了清楚地表明它是一个数字矢量，而不是（也不应该是）data.frame。

v <- df
lv <- length(v)

f <- function(i) {
    depth <- v - rep(i, lv)
    mean(depth < 0) 
}

调试calc的技巧是用一个单元格测试功能。例如

f(r1[2])

现在使用它

x <- calc(r1, f)

或一行为：

x <- calc(r1, function(i) mean((v-rep(i,lv)) < 0) )

要加快速度，可以尝试

library(compiler)
ff <- cmpfun(f)
x <- calc(r1, ff)

或

library(Rcpp)

fcpp <- cppFunction('double flood(double x) {
    // [[Rcpp::plugins(cpp11)]] 
    if (std::isnan(x)) return(NAN);
    std::vector<double> v = {3.879, 4.078, 4.211, 4.252, 4.204, 4.077, 3.872, 3.588, 3.259, 2.883, 2.48, 2.065, 1.635, 1.199, 0.766999999999999, 0.339, -0.0840000000000005, -0.503, -0.906, -1.284, -1.649, -1.998, -2.326, -2.603, -2.801, -2.959, -3.108, -3.237, -3.329, -3.353, -3.343, -3.303, -3.199, -3.041, -2.803, -2.503, -2.173, -1.789, -1.348, -0.869000000000001, -0.373, 0.141999999999999, 0.657999999999999, 1.207, 1.728, 2.226, 2.683, 3.055, 3.393, 3.655, 3.841, 3.956, 3.988, 3.938, 3.816, 3.63, 3.365, 3.047, 2.69, 2.292, 1.871, 1.433, 0.981999999999999, 0.524, 0.0759999999999996, -0.367, -0.805000000000001, -1.226, -1.637, -2.036, -2.422, -2.741, -2.956, -3.137, -3.322, -3.481, -3.593, -3.662, -3.727, -3.791, -3.79, -3.707, -3.557, -3.356, -3.077, -2.732, -2.354, -1.962, -1.515, -1.035, -0.515000000000001, 0.00599999999999934, 0.532999999999999, 1.05, 1.563, 2.032, 2.462, 2.794, 3.098, 3.313};
    unsigned lv = v.size();
    unsigned depth = 0;
    for (size_t i=0; i<lv; i++) {
        depth += ((v[i] - x) < 0);
    }
    return (double(depth) / lv);
}')


x <- calc(r1, fcpp)

如果r1不太大，您也许可以通过以下方式进一步加快速度

r2 <- setValues(r1, sapply(values(r1),  fcpp))

或更妙的是：

library(Rcpp)
fcpp2 <- cppFunction('std::vector<double> flood(std::vector<double> x) {
    // [[Rcpp::plugins(cpp11)]] 
    unsigned sizex = x.size();
    std::vector<double> out(sizex);
    std::vector<double> v = {3.879, 4.078, 4.211, 4.252, 4.204, 4.077, 3.872, 3.588, 3.259, 2.883, 2.48, 2.065, 1.635, 1.199, 0.766999999999999, 0.339, -0.0840000000000005, -0.503, -0.906, -1.284, -1.649, -1.998, -2.326, -2.603, -2.801, -2.959, -3.108, -3.237, -3.329, -3.353, -3.343, -3.303, -3.199, -3.041, -2.803, -2.503, -2.173, -1.789, -1.348, -0.869000000000001, -0.373, 0.141999999999999, 0.657999999999999, 1.207, 1.728, 2.226, 2.683, 3.055, 3.393, 3.655, 3.841, 3.956, 3.988, 3.938, 3.816, 3.63, 3.365, 3.047, 2.69, 2.292, 1.871, 1.433, 0.981999999999999, 0.524, 0.0759999999999996, -0.367, -0.805000000000001, -1.226, -1.637, -2.036, -2.422, -2.741, -2.956, -3.137, -3.322, -3.481, -3.593, -3.662, -3.727, -3.791, -3.79, -3.707, -3.557, -3.356, -3.077, -2.732, -2.354, -1.962, -1.515, -1.035, -0.515000000000001, 0.00599999999999934, 0.532999999999999, 1.05, 1.563, 2.032, 2.462, 2.794, 3.098, 3.313};
    unsigned sizev = v.size();
    for (size_t j=0; j<sizex; j++) {
        if (std::isnan(x[j])) {
            out[j] = NAN;
        } else {
            unsigned depth = 0;
            for (size_t i=0; i<sizev; i++) {
                depth += ((v[i] - x[j]) < 0);
            }
            out[j] = (double(depth) / sizev);
        }
    }
    return(out);
}')

r2 <- setValues(r1, fcpp2(values(r1)))

如何基于数据框对空间栅格进行重新分类

1 个答案: