Changing internal messaging to cli

DESCRIPTION

@@ -49,7 +49,8 @@ Imports:
     stats,
     terra (>= 1.7-10), 
     tibble (>= 2.0.0),
-    uuid, 
+    uuid,
+    cli (>= 3.6.0),
     utils
 Depends:
     R (>= 4.1.0)

R/add_constraint.R

@@ -862,7 +862,7 @@ methods::setMethod(
     }
     assertthat::assert_that(is.Raster(ras))
     bb <- try({ terra::rasterize(layer, ras, 1)}, silent = TRUE)
-    if(inherits(bb, "try-error")) stop("Provide a rasterized layer of the boundary constraint!")
+    if(inherits(bb, "try-error")) cli::cli_abort("Provide a rasterized layer of the boundary constraint!")
 
     # Call again
     new <- mod$clone(deep = TRUE)

R/add_limits_extrapolation.R

@@ -165,9 +165,9 @@ methods::setMethod(
 
       # Ensure that limits is intersecting the background
       if(is.Raster(background)){
-        if(suppressMessages(length( sf::st_intersects(layer, terra::as.polygons(background) |> sf::st_as_sf()) )) == 0 ) { layer <- NULL; warning('Provided zones do not intersect the background!') }
+        if(suppressMessages(length( sf::st_intersects(layer, terra::as.polygons(background) |> sf::st_as_sf()) )) == 0 ) { layer <- NULL; cli::cli_alert_warning('Provided zones do not intersect the background!') }
       } else {
-        if(suppressMessages(length( sf::st_intersects(layer, background |> sf::st_as_sf()) )) == 0 ) { layer <- NULL; warning('Provided zones do not intersect the background!') }
+        if(suppressMessages(length( sf::st_intersects(layer, background |> sf::st_as_sf()) )) == 0 ) { layer <- NULL; cli::cli_alert_warning('Provided zones do not intersect the background!') }
       }
 
       # Get first column for zone description and rename
@@ -201,7 +201,7 @@ methods::setMethod(
                      "limits_clip" = limits_clip)
       y <- y$set_limits(x = limits)
     } else if(method == "shape"){
-      stop("Method not yet implemented")
+      cli::cli_abort("Method not yet implemented")
     }
 
     # Return the altered object

R/add_offset.R

@@ -450,7 +450,7 @@ methods::setMethod(
 
     # Check that background and range align, otherwise raise error
     if(is_comparable_raster(layer, x$background)){
-      warning('Supplied range does not align with background! Aligning them now...')
+      cli::cli_alert_warning('Supplied range does not align with background! Aligning them now...')
       layer <- alignRasters(layer, x$background, method = 'bilinear', func = mean, cl = FALSE)
       names(layer) <- ori.name # In case the layer name got lost
     }
@@ -554,7 +554,7 @@ methods::setMethod(
     if(isTRUE(point) || is.null(point)){
       assertthat::assert_that(length(x$get_biodiversity_types()) > 0)
       #TODO: Collate point from x
-      stop("Automatic point collation not yet implemented. Please supply a sf layer to point!")
+      cli::cli_abort("Automatic point collation not yet implemented. Please supply a sf layer to point!")
     } else if(inherits(point, 'sf')){
       assertthat::assert_that( assertthat::has_name(point, field_occurrence),
                                nrow(point)>1)
@@ -642,7 +642,7 @@ methods::setMethod(
         ras_range <-  abs( dis / terra::global(ras_range, "sum", na.rm = TRUE)[,1]) * -1
         ras_range[is.na(ras_range)] <- terra::global(ras_range, "min", na.rm = TRUE)[,1]
       } else {
-        stop("Distance method not yet implemented.")
+        cli::cli_abort("Distance method not yet implemented.")
       }
 
     } else {
@@ -833,7 +833,7 @@ methods::setMethod(
   }
 
   # Get the coefficients of the best model
-  if(inherits(logisticParam, "try-error")) stop("Offset calculating failed...")
+  if(inherits(logisticParam, "try-error")) cli::cli_abort("Offset calculating failed...")
   co <- logisticParam$coefficients
   names(co) <- c("upper", "lower", "rate", "shift", "skew")
   return(co)
@@ -922,7 +922,7 @@ methods::setMethod(
 
     # Check that background and range align, otherwise raise error
     if(is_comparable_raster(elev, x$background)){
-      warning('Supplied range does not align with background! Aligning them now...')
+      cli::cli_alert_warning('Supplied range does not align with background! Aligning them now...')
       elev <- alignRasters(elev, x$background, method = 'bilinear', func = mean, cl = FALSE)
     }
 

R/add_predictors.R

@@ -159,15 +159,15 @@ methods::setMethod(
     # Check that background and range align, otherwise raise error
     if(is.Raster(env)){
       if(!is_comparable_raster(env, x$background)){
-        warning('Supplied range does not align with background! Aligning them now...')
+        cli::cli_alert_warning('Supplied range does not align with background! Aligning them now...')
         env <- alignRasters(env, x$background, method = 'bilinear', func = mean, cl = FALSE)
       }
     }
 
     # Check that all names allowed
     problematic_names <- grep("offset|w|weight|spatial_offset|observed|Intercept|spatial.field", names(env),fixed = TRUE)
     if( length(problematic_names)>0 ){
-      stop(paste0("Some predictor names are not allowed as they might interfere with model fitting:", paste0(names(env)[problematic_names],collapse = " | ")))
+      cli::cli_abort(paste0("Some predictor names are not allowed as they might interfere with model fitting:", paste0(names(env)[problematic_names],collapse = " | ")))
     }
 
     # Make a clone copy of the object
@@ -351,7 +351,7 @@ methods::setMethod(
       if(is.Raster(x$background)){
         # Check that background and range align, otherwise raise error
         if(!is_comparable_raster(layer, x$background)){
-          warning('Supplied range does not align with background! Aligning them now...')
+          cli::cli_alert_warning('Supplied range does not align with background! Aligning them now...')
           layer <- alignRasters(layer, x$background, method = 'bilinear', func = mean, cl = FALSE)
         }
       }
@@ -481,7 +481,7 @@ methods::setMethod(
     # Check that background and range align, otherwise raise error
     if(is.Raster(layer)){
       if(!is_comparable_raster(layer, x$background)){
-        warning('Supplied range does not align with background! Aligning them now...')
+        cli::cli_alert_warning('Supplied range does not align with background! Aligning them now...')
         layer <- alignRasters(layer, x$background, method = 'bilinear', func = mean, cl = FALSE)
       }
     }
@@ -808,7 +808,7 @@ methods::setMethod(
           )
           state <- model$predictors_object$get_transformed_params()
           if(!all(is.null(state))){
-            warning("State variable of transformation not found?")
+            cli::cli_alert_warning("State variable of transformation not found?")
           } else {
             # Subset again to be sure
             state <- state[,which(colnames(state) %in% names(env))]
@@ -833,7 +833,7 @@ methods::setMethod(
 
     # Harmonize NA values
     if(harmonize_na){
-      stop('Missing data harmonization for stars not yet implemented!') #TODO
+      cli::cli_abort('Missing data harmonization for stars not yet implemented!') #TODO
       if(getOption('ibis.setupmessages', default = TRUE)) myLog('[Setup]','green','Harmonizing missing values...')
       env <- predictor_homogenize_na(env, fill = FALSE)
     }

R/add_predictors_globiom.R

@@ -114,7 +114,7 @@ methods::setMethod(
     # Check that all names allowed
     problematic_names <- grep("offset|w|weight|spatial_offset|Intercept|spatial.field", names(env),fixed = TRUE)
     if( length(problematic_names)>0 ){
-      stop(paste0("Some predictor names are not allowed as they might interfere with model fitting:", paste0(names(env)[problematic_names],collapse = " | ")))
+      cli::cli_abort(paste0("Some predictor names are not allowed as they might interfere with model fitting:", paste0(names(env)[problematic_names],collapse = " | ")))
     }
 
     # Make a clone copy of the object
@@ -222,7 +222,7 @@ methods::setMethod(
 
     # Harmonize NA values
     if(harmonize_na){
-      stop('Missing data harmonization for stars not yet implemented!') #TODO
+      cli::cli_abort('Missing data harmonization for stars not yet implemented!') #TODO
       if(getOption('ibis.setupmessages', default = TRUE)) myLog('[Setup]','green','Harmonizing missing values...')
       env <- predictor_homogenize_na(env, fill = FALSE)
     }
@@ -259,7 +259,7 @@ methods::setMethod(
       # Format to Posix. Assuming years only
       timeperiod <- as.POSIXct(paste0(timeperiod,"-01-01"))
     }
-    if(anyNA(timeperiod)) stop('Third dimension is not a time value!')
+    if(anyNA(timeperiod)) cli::cli_abort('Third dimension is not a time value!')
 
     # Check whether predictors already exist, if so overwrite
     if(!is.Waiver(x$predictors)) myLog('[Setup]','yellow','Overwriting existing predictors.')
@@ -472,14 +472,14 @@ formatGLOBIOM <- function(fname, oftype = "raster", ignore = NULL,
     assertthat::assert_that(length(names(full_dis))==3)
     stars::st_dimensions(sc) <- full_dis # Target dimensions
 
-  } else { stop("Fileformat not recognized!")}
+  } else { cli::cli_abort("Fileformat not recognized!")}
 
   # Get time dimension (without applying offset) so at the centre
   times <- stars::st_get_dimension_values(sc, "time", center = TRUE)
 
   # Make checks on length of times and if equal to one, drop. check.
   if(length(times)==1){
-    if(period == "projection") stop("Found only a single time slot. Projections not possible.")
+    if(period == "projection") cli::cli_abort("Found only a single time slot. Projections not possible.")
     if(verbose) myLog('[Setup]','yellow','Found only a single time point in file. Dropping time dimension.')
     # Drop the time dimension
     sc <- stars:::adrop.stars(sc, drop = which(names(stars::st_dimensions(sc)) == "time") )

R/check.R

@@ -154,7 +154,7 @@ methods::setMethod(
     if(stoponwarning){
       # Check if there are any warnings
       if(any(length(ms$Warnings)>0)){
-        stop("Warning raised during checks!")
+        cli::cli_abort("Warning raised during checks!")
       }
     }
     # Compile

R/class-biodiversitydataset.R

@@ -236,7 +236,7 @@ BiodiversityDatasetCollection <- R6::R6Class(
                        'polpa' = 'Polygon - Presence absence'
         )
       }
-      if(is.null(type)) stop('Dataset type not found!')
+      if(is.null(type)) cli::cli_abort('Dataset type not found!')
       w <- which(self$get_types() %in% type)
       self$get_types()[w]
     },

R/class-biodiversitydistribution.R

@@ -179,7 +179,7 @@ BiodiversityDistribution <- R6::R6Class(
       if(inherits(self$predictors, "PredictorDataset")) {
         self$predictors$get_names()
       } else {
-        stop("feature data is of an unrecognized class")
+        cli::cli_abort("feature data is of an unrecognized class")
       }
     },
 
@@ -283,7 +283,7 @@ BiodiversityDistribution <- R6::R6Class(
     #' @return This object.
     set_engine = function(x) {
       assertthat::assert_that(inherits(x, "Engine"))
-      if(!is.Waiver(self$engine)) warning("Overwriting previously defined engine.")
+      if(!is.Waiver(self$engine)) cli::cli_alert_warning("Overwriting previously defined engine.")
       self$engine <- x
       return(self)
     },

R/class-biodiversityscenario.R

@@ -180,7 +180,7 @@ BiodiversityScenario <- R6::R6Class(
       if(inherits(self$predictors, "PredictorDataset")) {
         self$predictors$get_names()
       } else {
-        stop("Feature data is of an unrecognized class")
+        cli::cli_abort("Feature data is of an unrecognized class")
       }
     },
 
@@ -537,7 +537,7 @@ BiodiversityScenario <- R6::R6Class(
       thresh_reference <- grep('threshold',obj$show_rasters(),value = T)
       # If there is more than one threshold only use the one from variable
       if(base::length(thresh_reference)>1) {
-        warning('More than one baseline threshold. Using the first one.')
+        cli::cli_alert_warning('More than one baseline threshold. Using the first one.')
         thresh_reference <- grep(variable, thresh_reference,value = T)[1]
       }
       # Check that baseline and scenarios are all there
@@ -674,7 +674,7 @@ BiodiversityScenario <- R6::R6Class(
           times <- stars::st_get_dimension_values(scenario, which = 'band')
         } else {
           times <- NULL
-          stop("Summary without time dimension not yet implemented!")
+          cli::cli_abort("Summary without time dimension not yet implemented!")
         }
         # Get area
         ar <- stars:::st_area.stars(scenario)
@@ -888,7 +888,7 @@ BiodiversityScenario <- R6::R6Class(
                             'INT2S','INT2U','INT4S',
                             'INT4U','FLT4S','FLT8S'), several.ok = FALSE )
 
-      if(file.exists(fname)) warning('Overwritting existing file...')
+      if(file.exists(fname)) cli::cli_alert_warning('Overwritting existing file...')
 
       # Respecify type if output filename has already been set
       if(gsub('\\.','', tools::file_ext(fname)) != type) type <- gsub('\\.','', tools::file_ext(fname))

R/class-log.R

@@ -53,7 +53,7 @@ Log <- R6::R6Class(
       try({output = base::file( self$filename, open = 'wt', method = 'default') },
           silent = TRUE)
 
-      if(class(output)[1]=='try-error') { stop('Log file could not be opened!')}
+      if(class(output)[1]=='try-error') { cli::cli_abort('Log file could not be opened!')}
 
       # For each type append
       # Writing console or message output to log file

R/distribution.R

@@ -211,9 +211,9 @@ methods::setMethod(
       if(sf::st_crs(limits) != sf::st_crs(background)) limits <- sf::st_transform(limits, background)
       # Ensure that limits is intersecting the background
       if(is.Raster(background)){
-        if(suppressMessages(length( sf::st_intersects(limits, terra::as.polygons(background) |> sf::st_as_sf()) )) == 0 ) { limits <- NULL; warning('Provided limits do not intersect the background!') }
+        if(suppressMessages(length( sf::st_intersects(limits, terra::as.polygons(background) |> sf::st_as_sf()) )) == 0 ) { limits <- NULL; cli::cli_alert_warning('Provided limits do not intersect the background!') }
       } else {
-        if(suppressMessages(length( sf::st_intersects(limits, background |> sf::st_as_sf()) )) == 0 ) { limits <- NULL; warning('Provided limits do not intersect the background!') }
+        if(suppressMessages(length( sf::st_intersects(limits, background |> sf::st_as_sf()) )) == 0 ) { limits <- NULL; cli::cli_alert_warning('Provided limits do not intersect the background!') }
       }
 
       # Rename geometry just to be sure

R/engine_bart.R

@@ -581,7 +581,7 @@ engine_bart <- function(x,
       assertthat::assert_that(all(x.var %in% attr(fit$fit$data@x,'term.labels')),
                               msg = 'Variable not in predicted model' )
 
-      if( model$biodiversity[[1]]$family != 'binomial' && transform) warning('Check whether transform should not be set to False!')
+      if( model$biodiversity[[1]]$family != 'binomial' && transform) cli::cli_alert_warning('Check whether transform should not be set to False!')
 
       # Calculate
       p <- bart_partial_space(fit, predictors, x.var, equal, smooth, transform)

R/engine_glm.R

@@ -348,7 +348,7 @@ engine_glm <- function(x,
         )
       },silent = FALSE)
     )
-    if(inherits(fit_glm, "try-error")) stop("Model failed to converge with provided input data!")
+    if(inherits(fit_glm, "try-error")) cli::cli_abort("Model failed to converge with provided input data!")
     if( (settings$get('optim_hyperparam')) ){
       if(getOption('ibis.setupmessages', default = TRUE)) myLog('[Estimation]','green',
                                                                 'Running step-wise AIC selection for glm!')
@@ -436,7 +436,7 @@ engine_glm <- function(x,
         prediction <- terra::mask(prediction, self$get_data("template"))
 
       } else {
-        stop("GLM prediction failed!")
+        cli::cli_abort("GLM prediction failed!")
       }
       try({rm(out, full)},silent = TRUE)
     } else {

R/engine_inla.R

@@ -293,7 +293,7 @@ engine_inla <- function(x,
   },overwrite = TRUE)
   # Generic plotting function for the mesh
   eg$set("public", "plot", function(assess = FALSE){
-    if(is.Waiver(self$get_data('mesh'))) stop("No mesh found!")
+    if(is.Waiver(self$get_data('mesh'))) cli::cli_abort("No mesh found!")
 
     if(assess){
       # For an INLA mesh assessment
@@ -783,7 +783,7 @@ engine_inla <- function(x,
                                   num.threads = getOption('ibis.nthread')
       )
       },silent = FALSE)
-      if(inherits(fit_pred,'try-error')) { print(fit_pred); stop('Model did not converge. Try to simplify structure and check priors!') }
+      if(inherits(fit_pred,'try-error')) { print(fit_pred); cli::cli_abort('Model did not converge. Try to simplify structure and check priors!') }
       # Create a spatial prediction
       index.pred <- INLA::inla.stack.index(stk_full, 'stk_pred')$data
       # Which type of prediction (linear predictor or response scale)
@@ -858,7 +858,7 @@ engine_inla <- function(x,
                               mode %in% c('coef','sim','full'),
                               assertthat::has_name(newdata,c('x','y'))
       )
-      stop("Projection using engine INLA is deprecated. Use engine_inlabru !")
+      cli::cli_abort("Projection using engine INLA is deprecated. Use engine_inlabru !")
 
       # Try and guess backtransformation
       if(is.null(backtransf)){
@@ -875,9 +875,9 @@ engine_inla <- function(x,
         )
       } else if(mode == 'sim'){
         # Simulate from posterior. Not yet coded
-        stop('Simulation from posterior not yet implemented. Use inlabru instead!')
+        cli::cli_abort('Simulation from posterior not yet implemented. Use inlabru instead!')
       } else {
-        stop('Full prediction not yet added.')
+        cli::cli_abort('Full prediction not yet added.')
       }
       # Return result
       return(out)
@@ -891,7 +891,7 @@ engine_inla <- function(x,
       # model.matrix(~ vars, data = newDummydata) fed to make.lincomb
       # provide via lincomb = M to an INLA call.
       # Both should be identical
-      stop("Partial function not implemented. Consider using inlabru instead!")
+      cli::cli_abort("Partial function not implemented. Consider using inlabru instead!")
       # Check that provided model exists and variable exist in model
       mod <- self$get_data('fit_best')
       assertthat::assert_that(inherits(mod,'inla'),