Applying a function to each cell in raster returns error

Question

I have a function that normalises a value

norm_formula <- function(x, min_value, max_value){
    if(is.na(x)){
      norm_x <- NA
    } else if(is.nan(x)) {
      norm_x <- NA
    } else {  
      if(x < min_value){
        norm_x <- 1
      } else if (x > max_value){
        norm_x <- 100
      } else {  
        norm_x <- (100-1)*((x - min_value)/(max_value - min_value)) + 1      
      }
    }  
    return(norm_x)
  }

I want to apply this function to each cell in a spatraster

library(terra)
r <- rast(ncol=3, nrow=2)
values(r) <- 1:ncell(r)
  
s <- app(r, fun= function(x) norm_formula(x, 0, 0.5))
Error in if (is.na(x)) { : the condition has length > 1

Answer 1

The problem with your function is that it is not vectorized

norm_formula(1:10, 1, 10)
#Error in if (is.na(x)) { : the condition has length > 1

Here are two vectorized versions

norm_vect1 <- function(x, min_value, max_value){
    norm_x <- 99 * ((x - min_value)/(max_value - min_value)) + 1      
    norm_x[x < min_value] <- 1
    norm_x[x > max_value] <- 100
    norm_x
}

norm_vect2 <- function(x, min_value, max_value){
    norm_x <- 99 * ((x - min_value)/(max_value - min_value)) + 1      
    norm_x[norm_x < 1] <- 1
    norm_x[norm_x > 100] <- 100
    norm_x
}

And you can see that it works

norm_vect1(c(NA, 1:10), 2, 5)
# [1]  NA   1   1  34  67 100 100 100 100 100 100
norm_vect2(c(NA, 1:10), 2, 5)
# [1]  NA   1   1  34  67 100 100 100 100 100 100

And use one of them with app

s <- app(r, fun=\(x) norm_vect1(x, 0, 4))

Here are two possible alternatives to using app. You would need to check if they indeed work as intended. If so, f2 is probably the most efficient.

f1 <- function(r, min_value, max_value) {  
    ifel(r < min_value, 1, 
       ifel(r > max_value, 100, 
         99 * ((r - min_value)/(max_value - min_value)) + 1))
}
                
a <- f1(r, 0, 4)

        
f2 <- function(r, min_value, max_value) {  
    y <- clamp(r, min_value, max_value)
    (100-1)*((y - min_value)/(max_value - min_value)) + 1
}

b <- f2(r, 0, 4)