feat: use cli for errors and messaging

Author: m-muecke

DESCRIPTION

@@ -39,6 +39,7 @@ Depends:
     R (>= 3.4.0),
     fabletools (>= 0.3.0)
 Imports:
+    cli,
     Rcpp (>= 0.11.0),
     rlang (>= 0.4.6),
     stats,

R/00_specials.R

@@ -13,7 +13,7 @@ model_xreg <- function(...) {
 }
 
 no_xreg <- function(...) {
-  abort("Exogenous regressors are not supported for this model type.")
+  cli::cli_abort("Exogenous regressors are not supported for this model type.")
 }
 
 trend <- function(x, knots = NULL, origin = NULL) {
@@ -91,10 +91,10 @@ fourier.tbl_ts <- function(x, period, K, origin = NULL) {
 
 fourier.numeric <- function(x, period, K, origin = NULL) {
   if (length(period) != length(K)) {
-    abort("Number of periods does not match number of orders")
+    cli::cli_abort("Number of periods does not match number of orders")
   }
   if (any(2 * K > period)) {
-    abort("K must be not be greater than period/2")
+    cli::cli_abort("{.arg K} must be not be greater than period/2")
   }
 
   fourier_exprs <- map2(

R/VARIMA.R

@@ -3,7 +3,7 @@ train_varima <- function(.data, specials, identification = NULL, ...) {
   y <- invoke(cbind, lapply(unclass(.data)[measured_vars(.data)], as.double))
 
   if(any(colnames(specials$xreg[[1]]) != "(Intercept)")) {
-    stop("Exogenous regressors for VARIMA are not yet supported.")
+    cli::cli_abort("Exogenous regressors for VARIMA are not yet supported.")
   }
 
   p <- specials$pdq[[1]]$p
@@ -20,7 +20,7 @@ train_varima <- function(.data, specials, identification = NULL, ...) {
     }
   }
 
-  require_package("MTS")
+  check_installed("MTS")
   utils::capture.output(
     fit <- if (identification == "kronecker_indices") {
       MTS::Kronfit(
@@ -39,7 +39,7 @@ train_varima <- function(.data, specials, identification = NULL, ...) {
       )
     } else {
       if(length(p) != 1 || length(q) != 1) {
-        stop("Model selection is not yet supported, please specify `p` and `q` exactly.")
+        cli::cli_abort("Model selection is not yet supported, please specify {.arg p} and {.arg q} exactly.")
       }
       MTS::VARMA(
         yd,
@@ -72,7 +72,7 @@ specials_varima <- new_specials(
     as.list(environment())
   },
   PDQ = function(P, D, Q, period = NULL) {
-    stop("Seasonal VARIMA models are not yet supported.")
+    cli::cli_abort("Seasonal VARIMA models are not yet supported.")
   },
   common_xregs,
   xreg = special_xreg(default_intercept = TRUE),
@@ -580,4 +580,4 @@ IRF.VARIMA <- function(x, new_data, specials, impulse = NULL, orthogonal = FALSE
   irf[colnames(x$data)] <- split(irf$.sim, col(irf$.sim))
   irf$.innov <- irf$.sim <- NULL
   irf
-}
+}

R/ar.R

@@ -72,7 +72,7 @@ AR <- function(formula, ic = c("aicc", "aic", "bic"), ...) {
 specials_ar <- new_specials(
   order = function(p = 0:15, fixed = list()) {
     if (any(p < 0)) {
-      warn("The AR order must be non-negative. Only non-negative orders will be considered.")
+      cli::cli_warn("The AR order must be non-negative. Only non-negative orders will be considered.")
       p <- p[p >= 0]
     }
     list(p = p, fixed = fixed)
@@ -158,9 +158,9 @@ estimate_ar <- function(x, p, xreg, constant, fixed) {
   XX <- t(X_est) %*% X_est
   rank <- qr(XX)$rank
   if (rank != nrow(XX)) {
-    warning(paste("model order: ", p, "singularities in the computation of the projection matrix", 
-                  "results are only valid up to model order", 
-                  p - 1L), domain = NA)
+    cli::cli_warn(
+      "model order: {p} singularities in the computation of the projection matrix results are only valid up to model order {p - 1L}"
+    )
     return(NULL)
   }
   P <- if (ncol(XX) > 0) 

R/arima.R

@@ -8,12 +8,12 @@ train_arima <- function(.data, specials,
                         unitroot_spec = unitroot_options(), trace = FALSE,
                         fixed = NULL, method = NULL, ...) {
   if (length(measured_vars(.data)) > 1) {
-    abort("Only univariate responses are supported by ARIMA.")
+    cli::cli_abort("Only univariate responses are supported by ARIMA.")
   }
 
   # Get args
   if(length(specials$pdq) > 1 || length(specials$PDQ) > 1){
-    warn("Only one special for `pdq()` and `PDQ()` is allowed, defaulting to the first usage")
+    cli::cli_warn("Only one special for {.fn pdq} and {.fn PDQ} is allowed, defaulting to the first usage")
   }
   pdq <- specials$pdq[[1]]
   PDQ <- specials$PDQ[[1]]
@@ -24,7 +24,7 @@ train_arima <- function(.data, specials,
   y <- x <- ts(unclass(.data)[[measured_vars(.data)]], frequency = period)
 
   if (all(is.na(y))) {
-    abort("All observations are missing, a model cannot be estimated without data.")
+    cli::cli_abort("All observations are missing, a model cannot be estimated without data.")
   }
 
   # Get xreg
@@ -47,7 +47,7 @@ train_arima <- function(.data, specials,
 
       # Remove deficient regressors
       if(!is_empty(bad_regressors)){
-        warn(sprintf(
+        cli::cli_warn(sprintf(
           "Provided exogenous regressors are rank deficient, removing regressors: %s",
           paste("`", colnames(xreg)[bad_regressors], "`", sep = "", collapse = ", ")
         ))
@@ -72,8 +72,8 @@ train_arima <- function(.data, specials,
   if (NROW(model_opts) > 1) {
     model_opts <- filter(model_opts, !!enexpr(order_constraint))
     if (NROW(model_opts) == 0) {
-      if (mostly_specified) warn(mostly_specified_msg)
-      abort("There are no ARIMA models to choose from after imposing the `order_constraint`, please consider allowing more models.")
+      if (mostly_specified) cli::cli_warn(mostly_specified_msg)
+      cli::cli_abort("There are no ARIMA models to choose from after imposing the {.arg order_constraint}, please consider allowing more models.")
     }
     wrap_arima <- possibly(quietly(stats::arima), NULL)
   }
@@ -90,7 +90,7 @@ train_arima <- function(.data, specials,
 
   # Choose seasonal differencing
   if (length(seas_D <- unique(model_opts$D)) > 1) {
-    require_package("feasts")
+    rlang::check_installed("feasts")
     # Valid xregs
 
     if (!is.null(xreg)) {
@@ -111,7 +111,7 @@ train_arima <- function(.data, specials,
   x <- diff(x, lag = period, differences = seas_D)
   diff_xreg <- diff(xreg, lag = period, differences = seas_D)
   if (length(seas_d <- unique(model_opts$d)) > 1) {
-    require_package("feasts")
+    check_installed("feasts")
 
     # Valid xregs
     if (!is.null(xreg)) {
@@ -132,12 +132,12 @@ train_arima <- function(.data, specials,
   }
 
   # Check number of differences selected
-  if (length(seas_D) != 1) abort("Could not find appropriate number of seasonal differences.")
-  if (length(seas_d) != 1) abort("Could not find appropriate number of non-seasonal differences.")
+  if (length(seas_D) != 1) cli::cli_abort("Could not find appropriate number of seasonal differences.")
+  if (length(seas_d) != 1) cli::cli_abort("Could not find appropriate number of non-seasonal differences.")
   if (seas_D >= 2) {
-    warn("Having more than one seasonal difference is not recommended. Please consider using only one seasonal difference.")
+    cli::cli_warn("Having more than one seasonal difference is not recommended. Please consider using only one seasonal difference.")
   } else if (seas_D + seas_d > 2) {
-    warn("Having 3 or more differencing operations is not recommended. Please consider reducing the total number of differences.")
+    cli::cli_warn("Having 3 or more differencing operations is not recommended. Please consider reducing the total number of differences.")
   }
 
   # Find best model
@@ -236,7 +236,7 @@ train_arima <- function(.data, specials,
       method <- "CSS-ML"
     }
   } else {
-    if(isTRUE(approximation)) warn("Estimating ARIMA models with approximation is not supported when `method` is specified.")
+    if(isTRUE(approximation)) cli::cli_warn("Estimating ARIMA models with approximation is not supported when {.arg method} is specified.")
     approximation <- FALSE
   }
 
@@ -252,7 +252,7 @@ train_arima <- function(.data, specials,
   }
 
   if (any((model_opts$d + model_opts$D > 1) & model_opts$constant)) {
-    warn("Model specification induces a quadratic or higher order polynomial trend. 
+    cli::cli_warn("Model specification induces a quadratic or higher order polynomial trend. 
 This is generally discouraged, consider removing the constant or reducing the number of differences.")
   }
   constant <- unique(model_opts$constant)
@@ -337,8 +337,12 @@ This is generally discouraged, consider removing the constant or reducing the nu
   }
 
   if (is.null(best)) {
-    if (mostly_specified) warn(mostly_specified_msg)
-    abort("Could not find an appropriate ARIMA model.\nThis is likely because automatic selection does not select models with characteristic roots that may be numerically unstable.\nFor more details, refer to https://otexts.com/fpp3/arima-r.html#plotting-the-characteristic-roots")
+    if (mostly_specified) cli::cli_warn(mostly_specified_msg)
+    cli::cli_abort(c(
+      "Could not find an appropriate ARIMA model.",
+      "This is likely because automatic selection does not select models with characteristic roots that may be numerically unstable.",
+      "For more details, refer to {.url https://otexts.com/fpp3/arima-r.html#plotting-the-characteristic-roots}"
+    ))
   }
 
   # Compute ARMA roots
@@ -420,7 +424,7 @@ specials_arima <- new_specials(
     p_init <- p[which.min(abs(p - p_init))]
     q_init <- q[which.min(abs(q - q_init))]
     if(!all(grepl("^(ma|ar)\\d+", names(fixed)))){
-      abort("The 'fixed' coefficients for pdq() must begin with ar or ma, followed by a lag number.")
+      cli::cli_abort("The {.arg fixed} coefficients for {.fn pdq} must begin with ar or ma, followed by a lag number.")
     }
     as.list(environment())
   },
@@ -429,7 +433,7 @@ specials_arima <- new_specials(
                  fixed = list()) {
     period <- get_frequencies(period, self$data, .auto = "smallest")
     if (period < 1) {
-      abort("The seasonal period must be greater than or equal to 1.")
+      cli::cli_abort("The seasonal period must be greater than or equal to 1.")
     } else if (period == 1) {
       # Not seasonal
       P <- 0
@@ -440,13 +444,13 @@ specials_arima <- new_specials(
       P <- P[P <= floor(NROW(self$data) / 3 / period)]
       Q <- Q[Q <= floor(NROW(self$data) / 3 / period)]
       if(length(P) == 0 || length(Q) == 0) {
-        abort("Not enough data to estimate a model with those options of P and Q. Consider allowing smaller values of P and Q to be selected.")
+        cli::cli_abort("Not enough data to estimate a model with those options of P and Q. Consider allowing smaller values of P and Q to be selected.")
       }
     }
     P_init <- P[which.min(abs(P - P_init))]
     Q_init <- Q[which.min(abs(Q - Q_init))]
     if(!all(grepl("^(sma|sar)\\d+", names(fixed)))){
-      abort("The 'fixed' coefficients for PDQ() must begin with sar or sma, followed by a lag number.")
+      cli::cli_abort("The {.arg fixed} coefficients for {.fn PDQ} must begin with sar or sma, followed by a lag number.")
     }
     as.list(environment())
   },
@@ -716,7 +720,7 @@ residuals.ARIMA <- function(object, type = c("innovation", "regression"), ...) {
     object$est[[".regression_resid"]]
   }
   else {
-    abort(sprintf('Residuals of `type = "%s"` are not supported by ARIMA models', type))
+    cli::cli_abort("Residuals of {.code type = {.val type}} are not supported by ARIMA models")
   }
 }
 

R/checks.R

@@ -1,19 +1,19 @@
 check_gaps <- function(x) {
   if (any(tsibble::has_gaps(x)[[".gaps"]])) {
-    abort(sprintf("%s contains implicit gaps in time. You should check your data and convert implicit gaps into explicit missing values using `tsibble::fill_gaps()` if required.", deparse(substitute(x))))
+    cli::cli_abort(sprintf("%s contains implicit gaps in time. You should check your data and convert implicit gaps into explicit missing values using {.fn tsibble::fill_gaps} if required.", deparse(substitute(x))))
   }
 }
 
 check_regular <- function(x) {
   if (!is_regular(x)) {
-    abort(sprintf("%s is an irregular time series, which this model does not support. You should consider if your data can be made regular, and use `tsibble::update_tsibble(%s, regular = TRUE)` if appropriate.", deparse(substitute(x)), deparse(substitute(x))))
+    cli::cli_abort(sprintf("%s is an irregular time series, which this model does not support. You should consider if your data can be made regular, and use {.fn tsibble::update_tsibble(%s, regular = TRUE)} if appropriate.", deparse(substitute(x)), deparse(substitute(x))))
   }
 }
 
 check_ordered <- function(x) {
   if (!is_ordered(x)) {
-    abort(sprintf(
-      "%s is an unordered time series. To use this model, you first must sort the data in time order using `dplyr::arrange(%s, %s)`",
+    cli::cli_abort(sprintf(
+      "%s is an unordered time series. To use this model, you first must sort the data in time order using {.fn dplyr::arrange(%s, %s)}",
       deparse(substitute(x)), paste(c(deparse(substitute(x)), key_vars(x)), collapse = ", "), index_var(x)
     ))
   }
@@ -24,6 +24,6 @@ all_tsbl_checks <- function(.data) {
   check_regular(.data)
   check_ordered(.data)
   if (NROW(.data) == 0) {
-    abort("There is no data to model. Please provide a dataset with at least one observation.")
+    cli::cli_abort("There is no data to model. Please provide a dataset with at least one observation.")
   }
 }

R/croston.R

@@ -99,10 +99,10 @@ CROSTON <- function(
 specials_croston <- new_specials(
   demand = function(initial = NULL, param = NULL, param_range = c(0, 1)) {
     if (!is.null(initial) && initial < 0) {
-      abort("The initial demand for Croston's method must be non-negative")
+      cli::cli_abort("The initial demand for Croston's method must be non-negative")
     }
     if (param_range[1] > param_range[2]) {
-      rlang::abort("Lower param limits must be less than upper limits")
+      cli::cli_abort("Lower param limits must be less than upper limits")
     }
 
     as.list(environment())
@@ -111,11 +111,11 @@ specials_croston <- new_specials(
     method <- match.arg(method)
 
     if (!is.null(initial) && initial < 1) {
-      abort("The initial interval for Croston's method must be greater than (or equal to) 1.")
+      cli::cli_abort("The initial interval for Croston's method must be greater than (or equal to) 1.")
     }
 
     if (param_range[1] > param_range[2]) {
-      rlang::abort("Lower param limits must be less than upper limits")
+      cli::cli_abort("Lower param limits must be less than upper limits")
     }
 
     as.list(environment())
@@ -125,21 +125,21 @@ specials_croston <- new_specials(
 
 train_croston <- function(.data, specials, opt_crit = "mse", type = "croston", ...) {
   if (length(measured_vars(.data)) > 1) {
-    abort("Only univariate responses are supported by Croston's method.")
+    cli::cli_abort("Only univariate responses are supported by Croston's method.")
   }
 
   # Get response
   y <- unclass(.data)[[measured_vars(.data)]]
 
   # Check data
   if (any(y < 0)) {
-    abort("All observations must be non-negative for Croston's method.")
+    cli::cli_abort("All observations must be non-negative for Croston's method.")
   }
 
   non_zero <- which(y != 0)
 
   if (length(non_zero) < 2) {
-    abort("At least two non-zero values are required to use Croston's method.")
+    cli::cli_abort("At least two non-zero values are required to use Croston's method.")
   }
 
   # Get specials