Warning: file_get_contents(/data/phpspider/zhask/data//catemap/4/r/74.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
R 光栅计算功能,用于查找符合标准的最大索引(即最新图层)_R_Raster_R Raster - Fatal编程技术网

R 光栅计算功能,用于查找符合标准的最大索引(即最新图层)

R 光栅计算功能,用于查找符合标准的最大索引(即最新图层),r,raster,r-raster,R,Raster,R Raster,对于rasterStack的每个单元,我希望找到值超过固定阈值的最新层。图层按时间顺序堆叠,因此这对应于最大索引。最后,我想知道1)该图层的年份(取自图层名称),以及2)该图层的值 我写了一个函数来做这件事,但得到了错误的结果。我以一种我认为不会改变它的方式修改了函数;我现在得到了正确的结果。我的问题是为什么这些函数会产生不同的结果 树立榜样: library(raster) library(rasterVis) ### Example raster stack: set.seed(12

对于rasterStack的每个单元,我希望找到值超过固定阈值的最新层。图层按时间顺序堆叠,因此这对应于最大索引。最后,我想知道1)该图层的年份(取自图层名称),以及2)该图层的值

我写了一个函数来做这件事,但得到了错误的结果。我以一种我认为不会改变它的方式修改了函数;我现在得到了正确的结果。我的问题是为什么这些函数会产生不同的结果

树立榜样:

library(raster)
library(rasterVis)

###   Example raster stack: 
set.seed(123123)
r1 <- raster(nrows = 10, ncols = 10)
r2 <- r3 <- r4 <- r1
r1[] <- rbinom(ncell(r1), 1, prob = .1)
r2[] <- rbinom(ncell(r1), 1, prob = .1)
r3[] <- rbinom(ncell(r1), 1, prob = .1)
r4[] <- rbinom(ncell(r1), 1, prob = .1)
rs <- stack(r1, r2, r3, r4)
names(rs) <- paste0("yr", 1:4)

获取我想要的最终层的代码:

###  Most recent year:
nameFromInd <- function(x) {
  yr <- as.integer(gsub(".*(\\d.*).*", "\\1", names(rs)[x]))
}
testYr <- calc(testFind2, nameFromInd)

###  Value in most recent year:
testYrValue <- stackSelect(rs, testFind2)

ifelse
可能有点令人惊讶,因为它返回的值与第一个参数的“形状”相同,长度为1。因此它只返回
结果的第一个值,该值(x>0)
。在使用
calc
之前,请务必检查您使用的函数

x <- c(-1:2, 1:-1)
ifelse(any(x > 0), which(x > 0), NA)
#[1] 3
ifelse(any(x > 0), max(which(x > 0)), NA)
#[1] 5
(并忽略警告)。或者压制他们:

options(warn=-1)
r <- calc(rs, function(x) max(which(x > 0)))
options(warn=0)
testYrValue <- stackSelect(rs, r)
或快捷方式变体:

f2 <- function(x) {
    i <- max(which(x > 0))
    cbind(i, x[i])
}

rr2 <- calc(rs, f2)
f2
x <- c(-1:2, 1:-1)
ifelse(any(x > 0), which(x > 0), NA)
#[1] 3
ifelse(any(x > 0), max(which(x > 0)), NA)
#[1] 5
r <- calc(rs, function(x) max(which(x > 0)))
y <- stackSelect(rs, r)
options(warn=-1)
r <- calc(rs, function(x) max(which(x > 0)))
options(warn=0)
testYrValue <- stackSelect(rs, r)
f1 <- function(x) {
    if (any(x>0)) {
        i <- max(which(x > 0))
        cbind(i, x[i])
    } else {
        cbind(NA, NA)
    }
}

rr1 <- calc(rs, f1)
f2 <- function(x) {
    i <- max(which(x > 0))
    cbind(i, x[i])
}

rr2 <- calc(rs, f2)
f3 <- function(x) {
    i <- max(which(x > 0))
    z <- cbind(i, x[i])
    z[!is.finite(z)] <- NA
    z
}

rr3 <- calc(rs, f3)