Fix issue with predictor NA cells for each engine due to predictor integration loop

Author: mhesselbarth

R/engine_bart.R

@@ -95,6 +95,9 @@ engine_bart <- function(x,
   # Burn in the background
   template <- terra::rasterize(x$background, template, field = 0)
 
+  # mask template where all predictor layers are NA; change na.rm = FALSE for comeplete.cases
+  if (!is.Waiver(x$predictors)) template <- terra::mask(template, sum(x$predictors$get_data(), na.rm = TRUE))
+
   # Set up dbarts control with some parameters, rest default
   dc <- dbarts::dbartsControl(keepTrees	= TRUE, # Keep trees
                               n.burn = nburn,

R/engine_breg.R

@@ -81,6 +81,9 @@ engine_breg <- function(x,
   # Burn in the background
   template <- terra::rasterize(x$background, template, field = 0)
 
+  # mask template where all predictor layers are NA; change na.rm = FALSE for comeplete.cases
+  if (!is.Waiver(x$predictors)) template <- terra::mask(template, sum(x$predictors$get_data(), na.rm = TRUE))
+
   # Set up the parameter list
   params <- list(
     iter = iter,

R/engine_gdb.R

@@ -103,6 +103,9 @@ engine_gdb <- function(x,
   # Burn in the background
   template <- terra::rasterize(background, template, field = 0)
 
+  # mask template where all predictor layers are NA; change na.rm = FALSE for comeplete.cases
+  if (!is.Waiver(x$predictors)) template <- terra::mask(template, sum(x$predictors$get_data(), na.rm = TRUE))
+
   # Set up boosting control
   bc <- mboost::boost_control(mstop = iter,
                               nu = learning_rate,

R/engine_glm.R

@@ -90,6 +90,9 @@ engine_glm <- function(x,
   # Burn in the background
   template <- terra::rasterize(x$background, template, field = 0)
 
+  # mask template where all predictor layers are NA; change na.rm = FALSE for comeplete.cases
+  if (!is.Waiver(x$predictors)) template <- terra::mask(template, sum(x$predictors$get_data(), na.rm = TRUE))
+
   # Specify default control
   if(is.null(control)){
     control <- stats::glm.control()

R/engine_glmnet.R

@@ -114,6 +114,9 @@ engine_glmnet <- function(x,
   # Burn in the background
   template <- terra::rasterize(x$background, template, field = 0)
 
+  # mask template where all predictor layers are NA; change na.rm = FALSE for comeplete.cases
+  if (!is.Waiver(x$predictors)) template <- terra::mask(template, sum(x$predictors$get_data(), na.rm = TRUE))
+
   # Set up the parameter list
   params <- list(
     alpha = alpha,

R/engine_scampr.R

@@ -98,6 +98,9 @@ engine_scampr <- function(x,
   # Burn in the background
   template <- terra::rasterize(x$background, template, field = 0)
 
+  # mask template where all predictor layers are NA; change na.rm = FALSE for comeplete.cases
+  if (!is.Waiver(x$predictors)) template <- terra::mask(template, sum(x$predictors$get_data(), na.rm = TRUE))
+
   # Set up the parameter list
   params <- list(
     type = type,

R/engine_stan.R

@@ -113,9 +113,13 @@ engine_stan <- function(x,
     # If predictor existing, use them
     template <- emptyraster(x$predictors$get_data() )
   }
+
   # Burn in the background
   template <- terra::rasterize(x$background, template, field = 0)
 
+  # mask template where all predictor layers are NA; change na.rm = FALSE for comeplete.cases
+  if (!is.Waiver(x$predictors)) template <- terra::mask(template, sum(x$predictors$get_data(), na.rm = TRUE))
+
   # Define new engine object of class
   eg <- Engine
 

R/engine_xgboost.R

@@ -115,6 +115,9 @@ engine_xgboost <- function(x,
   # Burn in the background
   template <- terra::rasterize(x$background, template, field = 0)
 
+  # mask template where all predictor layers are NA; change na.rm = FALSE for comeplete.cases
+  if (!is.Waiver(x$predictors)) template <- terra::mask(template, sum(x$predictors$get_data(), na.rm = TRUE))
+
   # Set up the parameter list
   params <- list(
     booster = booster,

R/train.R

@@ -1820,14 +1820,6 @@ methods::setMethod(
       }
       out$settings$set("has_limits", TRUE)
     } else {
-      if(settings$get('inference_only')==FALSE){
-      # set all NAs in prediction to NAs according in predictors
-        o <- tryCatch(expr = {terra::mask(out$get_data("prediction"), out$model$predictors_object$get_data()[[1]],
-                                          updatevalue = NA)}, error = function(e) NA)
-        if (inherits(x = o, what = "SpatRaster")) {
-          if(terra::hasValues(o)) {out <- out$set_data("prediction", o)} else {warning("Issue while masking prediction")}
-        } else {warning("Issue while fetching predictors object")}
-      }
       out$settings$set("has_limits", FALSE)
     }