R focus（栅格软件包）：如何将过滤器应用于背景数据的子集？

Question

I was wondering if any of you could help me with the following task dealing with the focal() function in the R raster package.

By default, the focal() function will run through each cell of a given raster ('background' raster hereafter) and apply a given function to the neighboring values as defined by a user-defined moving window. In order to optimize and speed up my computation on large rasters/study areas, I would like to apply this function (filter) only when the 'background' raster has some values (eg greater than zero) within the extent covered by the 'moving window' and skip all the other focal cells. This way, the filter would not spend time computing any focal value where there is no need to.

Below a reproducible small example and in-line comments:

library(raster)

x <- matrix(1:25, ncol=5)
x[c(1,2,3,6,7,8,11,12,13)] <- 0
r <- raster(x)

#Apply filter to focal cells and return values using a 3x3 moving window...ONLY IF 
#ALL values found within the window are > 0. Skip focal cell otherwise.

r3 <- focal(r, w=matrix(1/9,nrow=3,ncol=3), FUN=sum)

How should I change this function to have the desired outcome?

Answer 1

The windows slide operates @ all focal pixels locations. Skipping/Jumping locations is not possible. However, you can check, whether all the elements/matrix cells satisfy your threshold condition as below:

myfunc = function (x){
  if(all(x > threshold)){
    print(x)
    x = sum(x)
  }else{
    x = 0}
}
r3 <- focal(x=r>1, w=matrix(1/9,nrow=3,ncol=3), fun=sum)

Answer 2

I'm not sure it would be any faster, but you could also check if the center cell adheres to some criteria (eg is NA or >0). This way the focal calculation will only run when it meets those criteria.

w=matrix(1,5,5)

skipNA_avgFunc <- function(x) {

  # general definition of center cell for weight matrices with odd dims
  center <- x[ceiling(length(x)/2)]

  if (is.na(center)) { # handle NA values
    return(center)
  }

  else if (center >= 0) { # calculate mean
    mean(x, na.rm=TRUE)
  }
}
r3 <- focal(r, w=w, fun=skipNA_avgFunc, pad=TRUE, padValue=NA)