diff --git a/.lintr b/.lintr index d640649..4596275 100644 --- a/.lintr +++ b/.lintr @@ -1,28 +1,9 @@ linters: linters_with_defaults( indentation_linter = lintr::indentation_linter(indent = 4L), # line_length_linter = lintr::line_length_linter(80L), - line_length_linter = lintr::line_length_linter(500L), - indentation_linter = NULL, - assignment_linter = NULL, - trailing_blank_lines_linter = NULL, - trailing_whitespace_linter = NULL, - whitespace_linter = NULL, - brace_linter = NULL, - infix_spaces_linter = NULL, - paren_body_linter = NULL, - indentation_linter = NULL, - function_left_parentheses_linter = NULL, - spaces_left_parentheses_linter = NULL, - commas_linter = NULL, - quotes_linter = NULL, - spaces_inside_linter = NULL, - vector_logic_linter = NULL, - seq_linter = NULL, - object_length_linter = NULL, - semicolon_linter = NULL, - cyclocomp_linter = NULL, - object_usage_linter = NULL, - object_name_linter = NULL, - commented_code_linter = NULL + line_length_linter = lintr::line_length_linter(150L), + # cyclocomp_linter = lintr::cyclocomp_linter(complexity_limit = 15L), + cyclocomp_linter = lintr::cyclocomp_linter(complexity_limit = 50L), + object_name_linter = NULL ) encoding: "UTF-8" diff --git a/R/deprecated.R b/R/deprecated.R index 8410a1c..595cd25 100644 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -22,13 +22,19 @@ spec_x11 <- function() { } #' @name deprecated-rjd3x13 #' @export -fast_x13 <- function(ts, spec = c("rsa4", "rsa0", "rsa1", "rsa2c", "rsa3", "rsa5c"), context = NULL, userdefined = NULL) { +fast_x13 <- function(ts, + spec = c("rsa4", "rsa0", "rsa1", "rsa2c", "rsa3", "rsa5c"), + context = NULL, + userdefined = NULL) { .Deprecated("x13_fast") x13_fast(ts, spec, context, userdefined) } #' @name deprecated-rjd3x13 #' @export -fast_regarima <- function(ts, spec = c("rg4", "rg0", "rg1", "rg2c", "rg3", "rg5c"), context = NULL, userdefined = NULL) { +fast_regarima <- function(ts, + spec = c("rg4", "rg0", "rg1", "rg2c", "rg3", "rg5c"), + context = NULL, + userdefined = NULL) { .Deprecated("regarima_fast") regarima_fast(ts, spec, context, userdefined) } diff --git a/R/print.R b/R/print.R index 70d1d3e..ca886e2 100644 --- a/R/print.R +++ b/R/print.R @@ -92,7 +92,10 @@ summary.JD3_X13_OUTPUT <- function(object, ...) { } #' @export -print.summary.JD3_X13_RSLTS <- function(x, digits = max(3L, getOption("digits") - 3L), signif.stars = getOption("show.signif.stars"), ...) { +print.summary.JD3_X13_RSLTS <- function(x, + digits = max(3L, getOption("digits") - 3L), + signif.stars = getOption("show.signif.stars"), + ...) { cat("Model: X-13\n") print(x$preprocessing, digits = digits, signif.stars = signif.stars, ...) cat("\n", "Decomposition", "\n", sep = "") @@ -105,7 +108,9 @@ print.summary.JD3_X13_RSLTS <- function(x, digits = max(3L, getOption("digits") } #' @export -print.JD3_X13_OUTPUT <- function(x, digits = max(3L, getOption("digits") - 3L), summary_info = getOption("summary_info"), +print.JD3_X13_OUTPUT <- function(x, + digits = max(3L, getOption("digits") - 3L), + summary_info = getOption("summary_info"), ...) { print(x$result, digits = digits, summary_info = summary_info, ...) return(invisible(x)) @@ -365,11 +370,25 @@ print.JD3_X13_SPEC <- function(x, ...) { cat("Is enabled: No\n") } else { cat("Enabled: Yes\n", sep = "") - cat("Target: ", x$benchmarking$target, ifelse(x$benchmarking$target == "TARGET_CALENDARADJUSTED", " (Auto)", ""), "\n", sep = "") - cat("Lambda: ", x$benchmarking$lambda, ifelse(x$benchmarking$lambda == 1, " (Auto)", ""), "\n", sep = "") - cat("Rho: ", x$benchmarking$rho, ifelse(x$benchmarking$rho == 1, " (Auto)", ""), "\n", sep = "") - cat("Bias: ", x$benchmarking$bias, ifelse(x$benchmarking$bias == "BIAS_NONE", " (Auto)", ""), "\n", sep = "") - cat("Use forecast: ", ifelse(x$benchmarking$forecast, "Yes", "No (Auto)"), "\n", sep = "") + cat("Target: ", x$benchmarking$target, + ifelse( + test = x$benchmarking$target == "TARGET_CALENDARADJUSTED", + yes = " (Auto)", + no = "" + ), + "\n", sep = "") + cat("Lambda: ", x$benchmarking$lambda, + ifelse(test = x$benchmarking$lambda == 1, yes = " (Auto)", no = ""), + "\n", sep = "") + cat("Rho: ", x$benchmarking$rho, + ifelse(test = x$benchmarking$rho == 1, yes = " (Auto)", no = ""), + "\n", sep = "") + cat("Bias: ", x$benchmarking$bias, + ifelse(test = x$benchmarking$bias == "BIAS_NONE", yes = " (Auto)", no = ""), + "\n", sep = "") + cat("Use forecast: ", + ifelse(test = x$benchmarking$forecast, yes = "Yes", no = "No (Auto)"), + "\n", sep = "") } return(invisible(x)) diff --git a/R/regarima_outliers.R b/R/regarima_outliers.R index 62fe660..4c6cea2 100644 --- a/R/regarima_outliers.R +++ b/R/regarima_outliers.R @@ -8,11 +8,13 @@ NULL #' @param mean Boolean to include or not the mean. #' @param X user defined regressors (other than calendar). #' @param X.td calendar regressors. -#' @param ao,ls,so,tc Boolean to indicate which type of outliers should be detected. -#' @param cv `numeric`. The entered critical value for the outlier detection procedure. -#' If equal to 0 the critical value for the outlier detection procedure is automatically determined -#' by the number of observations. -#' @param clean Clean missing values at the beginning/end of the series. Regression variables are automatically resized, if need be. +#' @param ao,ls,so,tc Boolean to indicate which type of outliers should be +#' detected. +#' @param cv `numeric`. The entered critical value for the outlier detection +#' procedure. If equal to 0 the critical value for the outlier detection +#' procedure is automatically determined by the number of observations. +#' @param clean Clean missing values at the beginning/end of the series. +#' Regression variables are automatically resized, if need be. #' #' @return a `"JD3_REGARIMA_OUTLIERS"` object, containing input variables and results #' @@ -20,21 +22,32 @@ NULL #' regarima_outliers(rjd3toolkit::ABS$X0.2.09.10.M) #' #' @export -regarima_outliers <- function(y, order = c(0L, 1L, 1L), seasonal = c(0L, 1L, 1L), mean = FALSE, - X = NULL, X.td = NULL, ao = TRUE, ls = TRUE, tc = FALSE, so = FALSE, cv = 0, clean = FALSE) { +regarima_outliers <- function(y, + order = c(0L, 1L, 1L), + seasonal = c(0L, 1L, 1L), + mean = FALSE, + X = NULL, + X.td = NULL, + ao = TRUE, + ls = TRUE, + tc = FALSE, + so = FALSE, + cv = 0, + clean = FALSE) { if (!is.ts(y)) { stop("y must be a time series") } if (!is.null(X.td)) { - sy <- start(y) td <- rjd3toolkit::td(s = y, groups = X.td) X <- cbind(X, td) } jregarima <- .jcall( - "jdplus/x13/base/r/RegArimaOutliersDetection", "Ljdplus/x13/base/r/RegArimaOutliersDetection$Results;", "process", - rjd3toolkit::.r2jd_tsdata(y), as.integer(order), as.integer(seasonal), mean, rjd3toolkit::.r2jd_matrix(X), + "jdplus/x13/base/r/RegArimaOutliersDetection", + "Ljdplus/x13/base/r/RegArimaOutliersDetection$Results;", "process", + rjd3toolkit::.r2jd_tsdata(y), as.integer(order), as.integer(seasonal), + mean, rjd3toolkit::.r2jd_matrix(X), ao, ls, tc, so, cv, clean ) model <- list( diff --git a/R/revisions.R b/R/revisions.R index d70ea5f..3d36058 100644 --- a/R/revisions.R +++ b/R/revisions.R @@ -79,7 +79,8 @@ x13_revisions <- function(ts, spec, data_ids = NULL, ts_ids = NULL, cmp_ids = NU lts <- NULL if (!is.null(ts_ids)) { lts <- lapply(ts_ids, function(ts_id) { - w <- .jcall(jr, "Ljdplus/toolkit/base/api/timeseries/TsData;", "tsHistory", ts_id$id, ts_id$period, ts_id$start) + w <- .jcall(jr, "Ljdplus/toolkit/base/api/timeseries/TsData;", + "tsHistory", ts_id$id, ts_id$period, ts_id$start) return(rjd3toolkit::.jd2r_tsdata(w)) }) names(lts) <- sapply(ts_ids, `[[`, "id") @@ -87,7 +88,8 @@ x13_revisions <- function(ts, spec, data_ids = NULL, ts_ids = NULL, cmp_ids = NU lcmp <- NULL if (!is.null(cmp_ids)) { lcmp <- lapply(cmp_ids, function(cmp_id) { - w <- .jcall(jr, "Ljdplus/toolkit/base/api/timeseries/TsDataTable;", "tsSelect", cmp_id$id, cmp_id$start, cmp_id$end) + w <- .jcall(jr, "Ljdplus/toolkit/base/api/timeseries/TsDataTable;", + "tsSelect", cmp_id$id, cmp_id$start, cmp_id$end) return(rjd3toolkit::.jd2r_mts(w)) }) names(lcmp) <- sapply(cmp_ids, `[[`, "id") diff --git a/R/set_x11_spec.R b/R/set_x11_spec.R index 8b83c8e..bb9c26f 100644 --- a/R/set_x11_spec.R +++ b/R/set_x11_spec.R @@ -1,35 +1,57 @@ #' Set X-11 Specification #' -#' @param x the specification to be modified, object of class "JD3_X11_SPEC", default X11 spec can be obtained as 'x=x11_spec()' -#' @param mode character: the decomposition mode. Determines the mode of the seasonal adjustment decomposition to be performed: -#' `"Undefined"` - no assumption concerning the relationship between the time series components is made; +#' @param x the specification to be modified, object of class "JD3_X11_SPEC", +#' default X11 spec can be obtained as 'x=x11_spec()' +#' @param mode character: the decomposition mode. Determines the mode of the +#' seasonal adjustment decomposition to be performed: +#' `"Undefined"` - no assumption concerning the relationship between the time +#' series components is made; #' `"Additive"` - assumes an additive relationship; #' `"Multiplicative"` - assumes a multiplicative relationship; -#' `"LogAdditive"` - performs an additive decomposition of the logarithms of the series being adjusted; -#' `"PseudoAdditive"` - assumes an pseudo-additive relationship. Could be changed by the program, if needed. -#' @param seasonal.comp logical: if `TRUE`, the program computes a seasonal component. Otherwise, the seasonal component -#' is not estimated and its values are all set to 0 (additive decomposition) or 1 (multiplicative decomposition). -#' @param lsigma numeric: the lower sigma boundary for the detection of extreme values, > 0.5, default=1.5. -#' @param usigma numeric: the upper sigma boundary for the detection of extreme values, > lsigma, default=2.5. -#' @param henderson.filter numeric: the length of the Henderson filter (odd number between 3 and 101). If `henderson.filter = 0` an automatic selection of the Henderson filter's length -#' for the trend estimation is enabled. -#' @param seasonal.filter a vector of character(s) specifying which seasonal moving average (i.e. seasonal filter) -#' will be used to estimate the seasonal factors for the entire series. The vector can be of length: -#' 1 - the same seasonal filter is used for all periods (e.g.: `seasonal.filter = "Msr"` or `seasonal.filter = "S3X3"` ); -#' or have a different value for each quarter (length 4) or each month (length 12) - (e.g. for quarterly series: `seasonal.filter = c("S3X3", "Msr", "S3X3", "Msr")`). -#' Possible filters are: `"Msr"`, `"Stable"`, `"X11Default"`, `"S3X1"`, `"S3X3"`, `"S3X5"`, `"S3X9"`, `"S3X15"`. -#' `"Msr"` - the program chooses the final seasonal filter automatically. -#' @param bcasts,fcasts numeric: the number of backasts (`bcasts`) or forecasts (`fcasts`) generated by the RegARIMA model in periods (positive values) or years (negative values).Default values: fcasts=-1 and bcasts=0. -#' @param calendar.sigma character to specify if the standard errors used for extreme values detection and adjustment are computed: -#' from 5 year spans of irregulars (`"None"`, default value); -#' separately for each calendar period (`"All"`); -#' separately for each period only if Cochran's hypothesis test determines that the irregular component is heteroskedastic -#' by calendar month/quarter (`"Signif"`); -#' separately for two complementary sets of calendar months/quarters specified by the x11.sigmaVector parameter (`"Select"`, -#' see parameter `sigma.vector`). -#' @param sigma.vector a vector to specify one of the two groups of periods for which standard errors used for extreme values -#' detection and adjustment will be computed separately. Only used if `calendar.sigma = "Select"`. Possible values are: `1` or `2`. -#' @param exclude.forecast Boolean to exclude forecasts and backcasts. If `TRUE`, the RegARIMA model forecasts and backcasts are not used during the detection of extreme values in the seasonal adjustment routines.Default= FALSE. +#' `"LogAdditive"` - performs an additive decomposition of the logarithms of the +#' series being adjusted; +#' `"PseudoAdditive"` - assumes an pseudo-additive relationship. Could be +#' changed by the program, if needed. +#' @param seasonal.comp logical: if `TRUE`, the program computes a seasonal +#' component. Otherwise, the seasonal component is not estimated and its values +#' are all set to 0 (additive decomposition) or 1 (multiplicative +#' decomposition). +#' @param lsigma numeric: the lower sigma boundary for the detection of extreme +#' values, > 0.5, default=1.5. +#' @param usigma numeric: the upper sigma boundary for the detection of extreme +#' values, > lsigma, default=2.5. +#' @param henderson.filter numeric: the length of the Henderson filter (odd +#' number between 3 and 101). If `henderson.filter = 0` an automatic selection +#' of the Henderson filter's length for the trend estimation is enabled. +#' @param seasonal.filter a vector of character(s) specifying which seasonal +#' moving average (i.e. seasonal filter) will be used to estimate the seasonal +#' factors for the entire series. The vector can be of length: 1 - the same +#' seasonal filter is used for all periods (e.g.: `seasonal.filter = "Msr"` or +#' `seasonal.filter = "S3X3"` ); or have a different value for each quarter +#' (length 4) or each month (length 12) - (e.g. for quarterly series: +#' `seasonal.filter = c("S3X3", "Msr", "S3X3", "Msr")`). Possible filters are: +#' `"Msr"`, `"Stable"`, `"X11Default"`, `"S3X1"`, `"S3X3"`, `"S3X5"`, `"S3X9"`, +#' `"S3X15"`. `"Msr"` - the program chooses the final seasonal filter +#' automatically. +#' @param bcasts,fcasts numeric: the number of backasts (`bcasts`) or forecasts +#' (`fcasts`) generated by the RegARIMA model in periods (positive values) or +#' years (negative values).Default values: fcasts=-1 and bcasts=0. +#' @param calendar.sigma character to specify if the standard errors used for +#' extreme values detection and adjustment are computed: from 5 year spans of +#' irregulars (`"None"`, default value); separately for each calendar period +#' (`"All"`); separately for each period only if Cochran's hypothesis test +#' determines that the irregular component is heteroskedastic by calendar +#' month/quarter (`"Signif"`); separately for two complementary sets of calendar +#' months/quarters specified by the x11.sigmaVector parameter (`"Select"`, see +#' parameter `sigma.vector`). +#' @param sigma.vector a vector to specify one of the two groups of periods for +#' which standard errors used for extreme values detection and adjustment will +#' be computed separately. Only used if `calendar.sigma = "Select"`. Possible +#' values are: `1` or `2`. +#' @param exclude.forecast Boolean to exclude forecasts and backcasts. If +#' `TRUE`, the RegARIMA model forecasts and backcasts are not used during the +#' detection of extreme values in the seasonal adjustment routines. +#' Default = FALSE. #' @param bias TODO. #' @return a "JD3_X11_SPEC" object, containing all the parameters. #' @seealso [x13_spec()] and [x11_spec()]. @@ -67,19 +89,20 @@ set_x11 <- function(x, UseMethod("set_x11", x) } #' @export -set_x11.JD3_X11_SPEC <- function(x, - mode = c(NA, "Undefined", "Additive", "Multiplicative", "LogAdditive", "PseudoAdditive"), - seasonal.comp = NA, - seasonal.filter = NA, - henderson.filter = NA, - lsigma = NA, - usigma = NA, - fcasts = NA, - bcasts = NA, - calendar.sigma = c(NA, "None", "Signif", "All", "Select"), - sigma.vector = NA, - exclude.forecast = NA, - bias = c(NA, "LEGACY")) { +set_x11.JD3_X11_SPEC <- function( + x, + mode = c(NA, "Undefined", "Additive", "Multiplicative", "LogAdditive", "PseudoAdditive"), + seasonal.comp = NA, + seasonal.filter = NA, + henderson.filter = NA, + lsigma = NA, + usigma = NA, + fcasts = NA, + bcasts = NA, + calendar.sigma = c(NA, "None", "Signif", "All", "Select"), + sigma.vector = NA, + exclude.forecast = NA, + bias = c(NA, "LEGACY")) { mode <- match.arg( toupper(mode[1]), c( diff --git a/R/udvar.R b/R/udvar.R index 5f50d9d..f00ecc3 100644 --- a/R/udvar.R +++ b/R/udvar.R @@ -20,35 +20,34 @@ #' Display a list of all the available output objects #' #' @description -#' Function generating a comprehensive list of available output variables (series, parameters, diagnostics) from the estimation process -#' by the `x13()`, `regarima()` and `x11()` functions. -#' Some items are available in the default estimation output but the remainder can be added -#' using the `userdefined` parameter. -#' User-defined objects can the be retrieved from the list of lists generated by the estimation process +#' Function generating a comprehensive list of available output variables +#' (series, parameters, diagnostics) from the estimation process by the +#' `x13()`, `regarima()` and `x11()` functions. Some items are available in the +#' default estimation output but the remainder can be added using the +#' `userdefined` parameter. User-defined objects can the be retrieved from the +#' list of lists generated by the estimation process #' -#' @param x a character to indicate the estimation function for which the output items list will be displayed. +#' @param x a character to indicate the estimation function for which the output +#' items list will be displayed. #' #' @examples #' userdefined_variables_x13("x13") #' userdefined_variables_x13("regarima") #' userdefined_variables_x13("x11") -#' @return a vector containing the names of all the available output objects (series, diagnostics, parameters) +#' +#' @return a vector containing the names of all the available output objects +#' (series, diagnostics, parameters) +#' #' @references #' More information and examples related to 'JDemetra+' features in the online documentation: #' \url{https://jdemetra-new-documentation.netlify.app/} +#' #' @export +#' userdefined_variables_x13 <- function(x = c("X-13", "RegArima", "X-11")) { x <- match.arg(gsub("-", "", tolower(x)), choices = c("x13", "regarima", "x11") ) - - # library(rjd3x13) - # jts<-rjd3toolkit::.r2jd_tsdata(rjd3toolkit::ABS$X0.2.09.10.M) - # jrslt<- rJava::.jcall("jdplus/x13/base/r/X13", "Ljdplus/x13/base/core/x13/X13Output;", "fullProcess", jts, "RSA3") - # rjd3toolkit::dictionary(rjd3toolkit::.jd3_object(jrslt$getResult(), result = TRUE)) |> - # sort() |> - # dput() - sa_x13 <- c( "adjust", "arima.bd", "arima.bp", "arima.bphi(*)", "arima.bq", "arima.btheta(*)", "arima.d", "arima.p", "arima.phi(*)", "arima.q", @@ -143,12 +142,6 @@ userdefined_variables_x13 <- function(x = c("X-13", "RegArima", "X-11")) { "ycal", "ycal_f(?)" ) - # jts<-rjd3toolkit::.r2jd_tsdata(rjd3toolkit::ABS$X0.2.09.10.M) - # jrslt<- rJava::.jcall("jdplus/x13/base/r/RegArima", "Ljdplus/x13/base/core/x13/regarima/RegArimaOutput;", "fullProcess", jts, "RG3") - # rjd3toolkit::dictionary(rjd3toolkit::.jd3_object(jrslt$getResult(), result = TRUE)) |> - # sort() |> - # dput() - sa_regarima <- c( "adjust", "arima.bd", "arima.bp", "arima.bphi(*)", "arima.bq", "arima.btheta(*)", "arima.d", "arima.p", "arima.phi(*)", "arima.q", @@ -185,13 +178,6 @@ userdefined_variables_x13 <- function(x = c("X-13", "RegArima", "X-11")) { "y_eb(?)", "y_ef(?)", "y_f(?)", "yc", "ycal", "ycal_f(?)" ) - # jts<-rjd3toolkit::.r2jd_tsdata(rjd3toolkit::ABS$X0.2.09.10.M) - # jrslt<- rJava::.jcall("jdplus/x13/base/r/X11", "Ljdplus/x13/base/core/x11/X11Results;", "process", jts, - # rjd3x13::.r2jd_spec_x11(rjd3x13::spec_x11())) - # rjd3toolkit::dictionary(rjd3toolkit::.jd3_object(jrslt, result = TRUE)) |> - # sort() |> - # dput() - sa_x11 <- c( "b1", "b10", "b11", "b13", "b17", "b2", "b20", "b3", "b4", "b5", "b6", "b7", "b8", "b9", "c1", "c10", "c11", "c13", "c17", diff --git a/R/x13.R b/R/x13.R index 4796150..9fa15c0 100644 --- a/R/x13.R +++ b/R/x13.R @@ -4,11 +4,17 @@ NULL #' RegARIMA model, pre-adjustment in X13 #' #' @param ts an univariate time series. -#' @param spec the model specification. Can be either the name of a predefined specification or a user-defined specification. -#' @param context list of external regressors (calendar or other) to be used for estimation -#' @param userdefined a vector containing additional output variables (see [x13_dictionary()]). +#' @param spec the model specification. Can be either the name of a predefined +#' specification or a user-defined specification. +#' @param context list of external regressors (calendar or other) to be used for +#' estimation +#' @param userdefined a vector containing additional output variables +#' (see [x13_dictionary()]). #' -#' @return the `regarima()` function returns a list with the results (`"JD3_REGARIMA_RSLTS"` object), the estimation specification and the result specification, while `regarima_fast()` is a faster function that only returns the results. +#' @return the `regarima()` function returns a list with the results +#' (`"JD3_REGARIMA_RSLTS"` object), the estimation specification and the result +#' specification, while `regarima_fast()` is a faster function that only returns +#' the results. #' #' @examples #' y <- rjd3toolkit::ABS$X0.2.09.10.M @@ -28,14 +34,17 @@ NULL #' sp <- rjd3toolkit::set_outlier(sp, outliers.type = c("AO")) #' regarima_fast(y, spec = sp) #' @export -regarima <- function(ts, spec = c("rg4", "rg0", "rg1", "rg2c", "rg3", "rg5c"), context = NULL, userdefined = NULL) { +regarima <- function(ts, spec = c("rg4", "rg0", "rg1", "rg2c", "rg3", "rg5c"), + context = NULL, userdefined = NULL) { jts <- rjd3toolkit::.r2jd_tsdata(ts) if (is.character(spec)) { spec <- gsub("sa", "g", tolower(spec), fixed = TRUE) spec <- match.arg(spec[1], choices = c("rg0", "rg1", "rg2c", "rg3", "rg4", "rg5c") ) - jrslt <- .jcall("jdplus/x13/base/r/RegArima", "Ljdplus/x13/base/core/x13/regarima/RegArimaOutput;", "fullProcess", jts, spec) + jrslt <- .jcall("jdplus/x13/base/r/RegArima", + "Ljdplus/x13/base/core/x13/regarima/RegArimaOutput;", + "fullProcess", jts, spec) } else { jspec <- .r2jd_spec_regarima(spec) if (is.null(context)) { @@ -43,7 +52,9 @@ regarima <- function(ts, spec = c("rg4", "rg0", "rg1", "rg2c", "rg3", "rg5c"), c } else { jcontext <- rjd3toolkit::.r2jd_modellingcontext(context) } - jrslt <- .jcall("jdplus/x13/base/r/RegArima", "Ljdplus/x13/base/core/x13/regarima/RegArimaOutput;", "fullProcess", jts, jspec, jcontext) + jrslt <- .jcall("jdplus/x13/base/r/RegArima", + "Ljdplus/x13/base/core/x13/regarima/RegArimaOutput;", + "fullProcess", jts, jspec, jcontext) } if (is.jnull(jrslt)) { return(NULL) @@ -54,14 +65,19 @@ regarima <- function(ts, spec = c("rg4", "rg0", "rg1", "rg2c", "rg3", "rg5c"), c } #' @export #' @rdname regarima -regarima_fast <- function(ts, spec = c("rg4", "rg0", "rg1", "rg2c", "rg3", "rg5c"), context = NULL, userdefined = NULL) { +regarima_fast <- function(ts, + spec = c("rg4", "rg0", "rg1", "rg2c", "rg3", "rg5c"), + context = NULL, + userdefined = NULL) { jts <- rjd3toolkit::.r2jd_tsdata(ts) if (is.character(spec)) { spec <- gsub("sa", "g", tolower(spec), fixed = TRUE) spec <- match.arg(spec[1], choices = c("rg0", "rg1", "rg2c", "rg3", "rg4", "rg5c") ) - jrslt <- .jcall("jdplus/x13/base/r/RegArima", "Ljdplus/toolkit/base/core/regsarima/regular/RegSarimaModel;", "process", jts, spec) + jrslt <- .jcall("jdplus/x13/base/r/RegArima", + "Ljdplus/toolkit/base/core/regsarima/regular/RegSarimaModel;", + "process", jts, spec) } else { jspec <- .r2jd_spec_regarima(spec) if (is.null(context)) { @@ -69,7 +85,9 @@ regarima_fast <- function(ts, spec = c("rg4", "rg0", "rg1", "rg2c", "rg3", "rg5c } else { jcontext <- rjd3toolkit::.r2jd_modellingcontext(context) } - jrslt <- .jcall("jdplus/x13/base/r/RegArima", "Ljdplus/toolkit/base/core/regsarima/regular/RegSarimaModel;", "process", jts, jspec, jcontext) + jrslt <- .jcall("jdplus/x13/base/r/RegArima", + "Ljdplus/toolkit/base/core/regsarima/regular/RegSarimaModel;", + "process", jts, jspec, jcontext) } if (is.jnull(jrslt)) { return(NULL) @@ -125,20 +143,31 @@ regarima_fast <- function(ts, spec = c("rg4", "rg0", "rg1", "rg2c", "rg3", "rg5c #' ) #' x13_fast(y, spec = sp) #' -#' @return the `x13()` function returns a list with the results, the estimation specification and the result specification, while `x13_fast()` is a faster function that only returns the results. -#' The `.jx13()` functions only returns results in a java object which will allow to customize outputs in other packages (use [rjd3toolkit::dictionary()] to -#' get the list of variables and [rjd3toolkit::result()] to get a specific variable). -#' In the estimation functions `x13()` and `x13_fast()` you can directly use a specification name (string). -#' If you want to customize a specification you have to create a specification object first. +#' @return the `x13()` function returns a list with the results, the estimation +#' specification and the result specification, while `x13_fast()` is a faster +#' function that only returns the results. The `.jx13()` functions only returns +#' results in a java object which will allow to customize outputs in other +#' packages (use [rjd3toolkit::dictionary()] to get the list of variables and +#' [rjd3toolkit::result()] to get a specific variable). In the estimation +#' functions `x13()` and `x13_fast()` you can directly use a specification name +#' (string). If you want to customize a specification you have to create a +#' specification object first. +#' #' @export -x13 <- function(ts, spec = c("rsa4", "rsa0", "rsa1", "rsa2c", "rsa3", "rsa5c"), context = NULL, userdefined = NULL) { +#' +x13 <- function(ts, + spec = c("rsa4", "rsa0", "rsa1", "rsa2c", "rsa3", "rsa5c"), + context = NULL, + userdefined = NULL) { jts <- rjd3toolkit::.r2jd_tsdata(ts) if (is.character(spec)) { spec <- gsub("g", "sa", tolower(spec), fixed = TRUE) spec <- match.arg(spec[1], choices = c("rsa0", "rsa1", "rsa2c", "rsa3", "rsa4", "rsa5c") ) - jrslt <- .jcall("jdplus/x13/base/r/X13", "Ljdplus/x13/base/core/x13/X13Output;", "fullProcess", jts, spec) + jrslt <- .jcall("jdplus/x13/base/r/X13", + "Ljdplus/x13/base/core/x13/X13Output;", + "fullProcess", jts, spec) } else { jspec <- .r2jd_spec_x13(spec) if (is.null(context)) { @@ -146,7 +175,9 @@ x13 <- function(ts, spec = c("rsa4", "rsa0", "rsa1", "rsa2c", "rsa3", "rsa5c"), } else { jcontext <- rjd3toolkit::.r2jd_modellingcontext(context) } - jrslt <- .jcall("jdplus/x13/base/r/X13", "Ljdplus/x13/base/core/x13/X13Output;", "fullProcess", jts, jspec, jcontext) + jrslt <- .jcall("jdplus/x13/base/r/X13", + "Ljdplus/x13/base/core/x13/X13Output;", + "fullProcess", jts, jspec, jcontext) } if (is.jnull(jrslt)) { return(NULL) @@ -159,7 +190,10 @@ x13 <- function(ts, spec = c("rsa4", "rsa0", "rsa1", "rsa2c", "rsa3", "rsa5c"), #' @export #' @rdname x13 -x13_fast <- function(ts, spec = c("rsa4", "rsa0", "rsa1", "rsa2c", "rsa3", "rsa5c"), context = NULL, userdefined = NULL) { +x13_fast <- function(ts, + spec = c("rsa4", "rsa0", "rsa1", "rsa2c", "rsa3", "rsa5c"), + context = NULL, + userdefined = NULL) { jts <- rjd3toolkit::.r2jd_tsdata(ts) if (is.character(spec)) { spec <- gsub("g", "sa", tolower(spec), fixed = TRUE) @@ -174,7 +208,9 @@ x13_fast <- function(ts, spec = c("rsa4", "rsa0", "rsa1", "rsa2c", "rsa3", "rsa5 } else { jcontext <- rjd3toolkit::.r2jd_modellingcontext(context) } - jrslt <- .jcall("jdplus/x13/base/r/X13", "Ljdplus/x13/base/core/x13/X13Results;", "process", jts, jspec, jcontext) + jrslt <- .jcall("jdplus/x13/base/r/X13", + "Ljdplus/x13/base/core/x13/X13Results;", + "process", jts, jspec, jcontext) } if (is.jnull(jrslt)) { return(NULL) @@ -201,7 +237,9 @@ x13_fast <- function(ts, spec = c("rsa4", "rsa0", "rsa1", "rsa2c", "rsa3", "rsa5 } else { jcontext <- rjd3toolkit::.r2jd_modellingcontext(context) } - jrslt <- .jcall("jdplus/x13/base/r/X13", "Ljdplus/x13/base/core/x13/X13Output;", "fullProcess", jts, jspec, jcontext) + jrslt <- .jcall("jdplus/x13/base/r/X13", + "Ljdplus/x13/base/core/x13/X13Output;", + "fullProcess", jts, jspec, jcontext) } if (is.jnull(jrslt)) { return(NULL) @@ -255,44 +293,66 @@ x11 <- function(ts, spec = x11_spec(), userdefined = NULL) { #' Refresh a specification with constraints #' #' @description -#' Function allowing to create a new specification by updating a specification used for a previous estimation. -#' Some selected parameters will be kept fixed (previous estimation results) while others will be freed for re-estimation -#' in a domain of constraints. See details and examples. +#' Function allowing to create a new specification by updating a specification +#' used for a previous estimation. Some selected parameters will be kept fixed +#' (previous estimation results) while others will be freed for re-estimation in +#' a domain of constraints. See details and examples. #' #' @details -#' The selection of constraints to be kept fixed or re-estimated is called a revision policy. -#' User-defined parameters are always copied to the new refreshed specifications. -#' In X-13 only the reg-arima part can be refreshed. X-11 decomposition will be completely re-run, -#' keeping all the user-defined parameters from the original specification. +#' The selection of constraints to be kept fixed or re-estimated is called a +#' revision policy. User-defined parameters are always copied to the new +#' refreshed specifications. In X-13 only the reg-arima part can be refreshed. +#' X-11 decomposition will be completely re-run, keeping all the user-defined +#' parameters from the original specification. #' #' Available refresh policies are: #' -#' \strong{Current}: applying the current pre-adjustment reg-arima model and handling the new raw data points, or any sub-span of the series as Additive Outliers (defined as new intervention variables) +#' \strong{Current}: applying the current pre-adjustment reg-arima model and +#' handling the new raw data points, or any sub-span of the series as Additive +#' Outliers (defined as new intervention variables) #' -#' \strong{Fixed}: applying the current pre-adjustment reg-arima model and replacing forecasts by new raw data points. +#' \strong{Fixed}: applying the current pre-adjustment reg-arima model and +#' replacing forecasts by new raw data points. #' -#' \strong{FixedParameters}: pre-adjustment reg-arima model is partially modified: regression coefficients will be re-estimated but regression variables, Arima orders -#' and coefficients are unchanged. +#' \strong{FixedParameters}: pre-adjustment reg-arima model is partially +#' modified: regression coefficients will be re-estimated but regression +#' variables, Arima orders and coefficients are unchanged. #' -#' \strong{FixedAutoRegressiveParameters}: same as FixedParameters but Arima Moving Average coefficients (MA) are also re-estimated, Auto-regressive (AR) coefficients are kept fixed. +#' \strong{FixedAutoRegressiveParameters}: same as FixedParameters but Arima +#' Moving Average coefficients (MA) are also re-estimated, Auto-regressive (AR) +#' coefficients are kept fixed. #' -#' \strong{FreeParameters}: all regression and Arima model coefficients are re-estimated, regression variables and Arima orders are kept fixed. +#' \strong{FreeParameters}: all regression and Arima model coefficients are +#' re-estimated, regression variables and Arima orders are kept fixed. #' -#' \strong{Outliers}: regression variables and Arima orders are kept fixed, but outliers will be re-detected on the defined span, thus all regression and Arima model coefficients are re-estimated +#' \strong{Outliers}: regression variables and Arima orders are kept fixed, but +#' outliers will be re-detected on the defined span, thus all regression and +#' Arima model coefficients are re-estimated #' -#' \strong{Outliers_StochasticComponent}: same as "Outliers" but Arima model orders (p,d,q)(P,D,Q) can also be re-identified. +#' \strong{Outliers_StochasticComponent}: same as "Outliers" but Arima model +#' orders (p,d,q)(P,D,Q) can also be re-identified. #' #' @param spec the current specification to be refreshed (`"result_spec"`). -#' @param refspec the reference specification used to define the domain considered for re-estimation (`"domain_spec"`). +#' @param refspec the reference specification used to define the domain +#' considered for re-estimation (`"domain_spec"`). #' By default this is the `"RG5c"` or `"RSA5"` specification. #' @param policy the refresh policy to apply (see details). -#' @param period,start,end additional parameters used to specify the span on which additive outliers (AO) are introduced when `policy = "Current"` -#' or to specify the span on which outliers will be re-detected when `policy = "Outliers"` or `policy = "Outliers_StochasticComponent"`, -#' is this case \code{end} is unused. -#' If \code{start} is not specified, outliers will be re-identified on the whole series. -#' Span definition: \code{period}: numeric, number of observations in a year (12, 4...). -#' \code{start} and \code{end}: defined as arrays of two elements: year and first period (for example, `period = 12` and `c(1980, 1)` stands for January 1980) -#' The dates corresponding \code{start} and \code{end} are included in the span definition. +#' +#' @param period,start,end additional parameters used to specify the span on +#' which additive outliers (AO) are introduced when `policy = "Current"` or to +#' specify the span on which outliers will be re-detected when +#' `policy = "Outliers"` or `policy = "Outliers_StochasticComponent"`, is this +#' case \code{end} is unused. +#' If \code{start} is not specified, outliers will be re-identified on the whole +#' series. +#' Span definition: \code{period}: numeric, number of observations in a year +#' (12, 4...). +#' \code{start} and \code{end}: defined as arrays of two elements: year and +#' first period (for example, `period = 12` and `c(1980, 1)` stands for January +#' 1980) +#' The dates corresponding \code{start} and \code{end} are included in the span +#' definition. +#' #' @return a new specification, an object of class `"JD3_X13_SPEC"` or #' `"JD3_REGARIMA_SPEC"`. #' @@ -346,14 +406,24 @@ x11 <- function(ts, spec = x11_spec(), userdefined = NULL) { #' @name refresh #' @rdname refresh #' @export -regarima_refresh <- function(spec, refspec = NULL, policy = c("FreeParameters", "Complete", "Outliers_StochasticComponent", "Outliers", "FixedParameters", "FixedAutoRegressiveParameters", "Fixed", "Current"), period = 0, start = NULL, end = NULL) { +regarima_refresh <- function(spec, + refspec = NULL, + policy = c("FreeParameters", "Complete", + "Outliers_StochasticComponent", + "Outliers", "FixedParameters", + "FixedAutoRegressiveParameters", + "Fixed", "Current"), + period = 0, + start = NULL, + end = NULL) { policy <- match.arg(policy) if (!inherits(spec, "JD3_REGARIMA_SPEC")) { stop("Invalid specification type") } jspec <- .r2jd_spec_regarima(spec) if (is.null(refspec)) { - jrefspec <- .jcall("jdplus/x13/base/api/regarima/RegArimaSpec", "Ljdplus/x13/base/api/regarima/RegArimaSpec;", "fromString", "rg4") + jrefspec <- .jcall("jdplus/x13/base/api/regarima/RegArimaSpec", + "Ljdplus/x13/base/api/regarima/RegArimaSpec;", "fromString", "rg4") } else { if (!inherits(refspec, "JD3_REGARIMA_SPEC")) { stop("Invalid specification type") @@ -368,19 +438,24 @@ regarima_refresh <- function(spec, refspec = NULL, policy = c("FreeParameters", } else { jdom <- jdom <- rjd3toolkit::.jdomain(0, NULL, NULL) } - jnspec <- .jcall("jdplus/x13/base/r/RegArima", "Ljdplus/x13/base/api/regarima/RegArimaSpec;", "refreshSpec", jspec, jrefspec, jdom, policy) + jnspec <- .jcall("jdplus/x13/base/r/RegArima", + "Ljdplus/x13/base/api/regarima/RegArimaSpec;", + "refreshSpec", jspec, jrefspec, jdom, policy) return(.jd2r_spec_regarima(jnspec)) } #' @rdname refresh #' @export -x13_refresh <- function(spec, refspec = NULL, policy = c( - "FreeParameters", "Complete", - "Outliers_StochasticComponent", "Outliers", - "FixedParameters", - "FixedAutoRegressiveParameters", "Fixed", - "Current" - ), period = 0, start = NULL, end = NULL) { +x13_refresh <- function(spec, + refspec = NULL, + policy = c("FreeParameters", "Complete", + "Outliers_StochasticComponent", "Outliers", + "FixedParameters", + "FixedAutoRegressiveParameters", "Fixed", + "Current"), + period = 0, + start = NULL, + end = NULL) { policy <- match.arg(policy) if (!inherits(spec, "JD3_X13_SPEC")) { stop("Invalid specification type") diff --git a/R/x13_spec.R b/R/x13_spec.R index 01fe88e..c631e09 100644 --- a/R/x13_spec.R +++ b/R/x13_spec.R @@ -2,17 +2,22 @@ NULL -#' RegARIMA/X-13 Default Specifications +#' @title RegARIMA/X-13 Default Specifications #' -#' Set of functions to create default specification objects associated with the X-13ARIMA seasonal adjustment method. +#' @description +#' Set of functions to create default specification objects associated with the +#' X-13ARIMA seasonal adjustment method. #' -#' Specification setting of sheer X-11 decomposition method (without reg-arima pre-adjustment) is supported by the `x11_spec()` function only -#' and doesn't appear among the possible X13-Arima default specifications +#' Specification setting of sheer X-11 decomposition method (without reg-arima +#' pre-adjustment) is supported by the `x11_spec()` function only and doesn't +#' appear among the possible X13-Arima default specifications. #' -#' Specification setting can be restricted to the reg-arima part with the `regarima_spec()` function, -#' without argument `regarima_spec()` yields a RG5c specification +#' Specification setting can be restricted to the reg-arima part with the +#' `regarima_spec()` function, without argument `regarima_spec()` yields a RG5c +#' specification. #' -#' When setting a complete X13-Arima spec, `x13_spec()` without argument yields a RSA5c specification +#' When setting a complete X13-Arima spec, `x13_spec()` without argument yields +#' a RSA5c specification. #' #' #' @param name the name of a predefined specification. @@ -39,7 +44,14 @@ NULL #' RSA5c/RG5c |\tab automatic |\tab AO/LS/TC |\tab 7 td vars + Easter |\tab automatic #' } #' @seealso -#' - To set the pre-processing parameters: [rjd3toolkit::set_arima()], [rjd3toolkit::set_automodel()], [rjd3toolkit::set_basic()], [rjd3toolkit::set_easter()], [rjd3toolkit::set_estimate()], [rjd3toolkit::set_outlier()], [rjd3toolkit::set_tradingdays()], [rjd3toolkit::set_transform()], [rjd3toolkit::add_outlier()], [rjd3toolkit::remove_outlier()], [rjd3toolkit::add_ramp()], [rjd3toolkit::remove_ramp()], [rjd3toolkit::add_usrdefvar()]. +#' - To set the pre-processing parameters: +#' [rjd3toolkit::set_arima()], [rjd3toolkit::set_automodel()], +#' [rjd3toolkit::set_basic()], [rjd3toolkit::set_easter()], +#' [rjd3toolkit::set_estimate()], [rjd3toolkit::set_outlier()], +#' [rjd3toolkit::set_tradingdays()], [rjd3toolkit::set_transform()], +#' [rjd3toolkit::add_outlier()], [rjd3toolkit::remove_outlier()], +#' [rjd3toolkit::add_ramp()], [rjd3toolkit::remove_ramp()], +#' [rjd3toolkit::add_usrdefvar()]. #' - To set the decomposition parameters: [set_x11()]. #' - To set the benchmarking parameters: [rjd3toolkit::set_benchmarking()]. #' @name x13_spec @@ -50,7 +62,9 @@ regarima_spec <- function(name = c("rg4", "rg0", "rg1", "rg2c", "rg3", "rg5c")) name <- match.arg(name[1], choices = c("rg0", "rg1", "rg2c", "rg3", "rg4", "rg5c") ) - return(.jd2r_spec_regarima(.jcall("jdplus/x13/base/api/regarima/RegArimaSpec", "Ljdplus/x13/base/api/regarima/RegArimaSpec;", "fromString", name))) + return(.jd2r_spec_regarima(.jcall("jdplus/x13/base/api/regarima/RegArimaSpec", + "Ljdplus/x13/base/api/regarima/RegArimaSpec;", + "fromString", name))) } @@ -61,7 +75,9 @@ x13_spec <- function(name = c("rsa4", "rsa0", "rsa1", "rsa2c", "rsa3", "rsa5c")) name <- match.arg(name[1], choices = c("rsa0", "rsa1", "rsa2c", "rsa3", "rsa4", "rsa5c") ) - return(.jd2r_spec_x13(.jcall("jdplus/x13/base/api/x13/X13Spec", "Ljdplus/x13/base/api/x13/X13Spec;", "fromString", name))) + return(.jd2r_spec_x13(.jcall("jdplus/x13/base/api/x13/X13Spec", + "Ljdplus/x13/base/api/x13/X13Spec;", + "fromString", name))) } diff --git a/man/refresh.Rd b/man/refresh.Rd index 4345a44..45603e2 100644 --- a/man/refresh.Rd +++ b/man/refresh.Rd @@ -29,88 +29,111 @@ x13_refresh( \arguments{ \item{spec}{the current specification to be refreshed (\code{"result_spec"}).} -\item{refspec}{the reference specification used to define the domain considered for re-estimation (\code{"domain_spec"}). +\item{refspec}{the reference specification used to define the domain +considered for re-estimation (\code{"domain_spec"}). By default this is the \code{"RG5c"} or \code{"RSA5"} specification.} \item{policy}{the refresh policy to apply (see details).} -\item{period, start, end}{additional parameters used to specify the span on which additive outliers (AO) are introduced when \code{policy = "Current"} -or to specify the span on which outliers will be re-detected when \code{policy = "Outliers"} or \code{policy = "Outliers_StochasticComponent"}, -is this case \code{end} is unused. -If \code{start} is not specified, outliers will be re-identified on the whole series. -Span definition: \code{period}: numeric, number of observations in a year (12, 4...). -\code{start} and \code{end}: defined as arrays of two elements: year and first period (for example, \code{period = 12} and \code{c(1980, 1)} stands for January 1980) -The dates corresponding \code{start} and \code{end} are included in the span definition.} +\item{period, start, end}{additional parameters used to specify the span on +which additive outliers (AO) are introduced when \code{policy = "Current"} or to +specify the span on which outliers will be re-detected when +\code{policy = "Outliers"} or \code{policy = "Outliers_StochasticComponent"}, is this +case \code{end} is unused. +If \code{start} is not specified, outliers will be re-identified on the whole +series. +Span definition: \code{period}: numeric, number of observations in a year +(12, 4...). +\code{start} and \code{end}: defined as arrays of two elements: year and +first period (for example, \code{period = 12} and \code{c(1980, 1)} stands for January +1980) +The dates corresponding \code{start} and \code{end} are included in the span +definition.} } \value{ a new specification, an object of class \code{"JD3_X13_SPEC"} or \code{"JD3_REGARIMA_SPEC"}. } \description{ -Function allowing to create a new specification by updating a specification used for a previous estimation. -Some selected parameters will be kept fixed (previous estimation results) while others will be freed for re-estimation -in a domain of constraints. See details and examples. +Function allowing to create a new specification by updating a specification +used for a previous estimation. Some selected parameters will be kept fixed +(previous estimation results) while others will be freed for re-estimation in +a domain of constraints. See details and examples. } \details{ -The selection of constraints to be kept fixed or re-estimated is called a revision policy. -User-defined parameters are always copied to the new refreshed specifications. -In X-13 only the reg-arima part can be refreshed. X-11 decomposition will be completely re-run, -keeping all the user-defined parameters from the original specification. +The selection of constraints to be kept fixed or re-estimated is called a +revision policy. User-defined parameters are always copied to the new +refreshed specifications. In X-13 only the reg-arima part can be refreshed. +X-11 decomposition will be completely re-run, keeping all the user-defined +parameters from the original specification. Available refresh policies are: -\strong{Current}: applying the current pre-adjustment reg-arima model and handling the new raw data points, or any sub-span of the series as Additive Outliers (defined as new intervention variables) +\strong{Current}: applying the current pre-adjustment reg-arima model and +handling the new raw data points, or any sub-span of the series as Additive +Outliers (defined as new intervention variables) -\strong{Fixed}: applying the current pre-adjustment reg-arima model and replacing forecasts by new raw data points. +\strong{Fixed}: applying the current pre-adjustment reg-arima model and +replacing forecasts by new raw data points. -\strong{FixedParameters}: pre-adjustment reg-arima model is partially modified: regression coefficients will be re-estimated but regression variables, Arima orders -and coefficients are unchanged. +\strong{FixedParameters}: pre-adjustment reg-arima model is partially +modified: regression coefficients will be re-estimated but regression +variables, Arima orders and coefficients are unchanged. -\strong{FixedAutoRegressiveParameters}: same as FixedParameters but Arima Moving Average coefficients (MA) are also re-estimated, Auto-regressive (AR) coefficients are kept fixed. +\strong{FixedAutoRegressiveParameters}: same as FixedParameters but Arima +Moving Average coefficients (MA) are also re-estimated, Auto-regressive (AR) +coefficients are kept fixed. -\strong{FreeParameters}: all regression and Arima model coefficients are re-estimated, regression variables and Arima orders are kept fixed. +\strong{FreeParameters}: all regression and Arima model coefficients are +re-estimated, regression variables and Arima orders are kept fixed. -\strong{Outliers}: regression variables and Arima orders are kept fixed, but outliers will be re-detected on the defined span, thus all regression and Arima model coefficients are re-estimated +\strong{Outliers}: regression variables and Arima orders are kept fixed, but +outliers will be re-detected on the defined span, thus all regression and +Arima model coefficients are re-estimated -\strong{Outliers_StochasticComponent}: same as "Outliers" but Arima model orders (p,d,q)(P,D,Q) can also be re-identified. +\strong{Outliers_StochasticComponent}: same as "Outliers" but Arima model +orders (p,d,q)(P,D,Q) can also be re-identified. } \examples{ -y<- rjd3toolkit::ABS$X0.2.08.10.M +y <- rjd3toolkit::ABS$X0.2.08.10.M # raw series for first estimation -y_raw <-window(y,end = c(2016,12)) +y_raw <- window(y, end = c(2016, 12)) # raw series for second (refreshed) estimation -y_new <-window(y,end = c(2017,6)) +y_new <- window(y, end = c(2017, 6)) # specification for first estimation -spec_x13_1<-x13_spec("rsa5c") +spec_x13_1 <- x13_spec("rsa5c") # first estimation -sa_x13<- x13(y_raw, spec_x13_1) +sa_x13 <- x13(y_raw, spec_x13_1) # refreshing the specification current_result_spec <- sa_x13$result_spec current_domain_spec <- sa_x13$estimation_spec # policy = "Fixed" spec_x13_ref <- x13_refresh(current_result_spec, # point spec to be refreshed - current_domain_spec, #domain spec (set of constraints) - policy = "Fixed") + current_domain_spec, # domain spec (set of constraints) + policy = "Fixed" +) # 2nd estimation with refreshed specification sa_x13_ref <- x13(y_new, spec_x13_ref) # policy = "Outliers" spec_x13_ref <- x13_refresh(current_result_spec, - current_domain_spec, - policy = "Outliers", - period=12, - start=c(2017,1)) # outliers will be re-detected from January 2017 included + current_domain_spec, + policy = "Outliers", + period = 12, + start = c(2017, 1) +) # outliers will be re-detected from January 2017 included # 2nd estimation with refreshed specification sa_x13_ref <- x13(y_new, spec_x13_ref) # policy = "Current" spec_x13_ref <- x13_refresh(current_result_spec, - current_domain_spec, - policy = "Current", - period=12, - start=c(2017,1), - end=end(y_new)) - # points from January 2017 (included) until the end of the series will be treated - # as Additive Outliers, the previous reg-Arima model being otherwise kept fixed + current_domain_spec, + policy = "Current", + period = 12, + start = c(2017, 1), + end = end(y_new) +) +# points from January 2017 (included) until the end of the series will be treated +# as Additive Outliers, the previous reg-Arima model being otherwise kept fixed # 2nd estimation with refreshed specification sa_x13_ref <- x13(y_new, spec_x13_ref) diff --git a/man/regarima.Rd b/man/regarima.Rd index 94f346c..f1f1fdb 100644 --- a/man/regarima.Rd +++ b/man/regarima.Rd @@ -22,32 +22,39 @@ regarima_fast( \arguments{ \item{ts}{an univariate time series.} -\item{spec}{the model specification. Can be either the name of a predefined specification or a user-defined specification.} +\item{spec}{the model specification. Can be either the name of a predefined +specification or a user-defined specification.} -\item{context}{list of external regressors (calendar or other) to be used for estimation} +\item{context}{list of external regressors (calendar or other) to be used for +estimation} -\item{userdefined}{a vector containing additional output variables (see \code{\link[=x13_dictionary]{x13_dictionary()}}).} +\item{userdefined}{a vector containing additional output variables +(see \code{\link[=x13_dictionary]{x13_dictionary()}}).} } \value{ -the \code{regarima()} function returns a list with the results (\code{"JD3_REGARIMA_RSLTS"} object), the estimation specification and the result specification, while \code{regarima_fast()} is a faster function that only returns the results. +the \code{regarima()} function returns a list with the results +(\code{"JD3_REGARIMA_RSLTS"} object), the estimation specification and the result +specification, while \code{regarima_fast()} is a faster function that only returns +the results. } \description{ RegARIMA model, pre-adjustment in X13 } \examples{ -y = rjd3toolkit::ABS$X0.2.09.10.M -sp = regarima_spec("rg5c") -sp = rjd3toolkit::add_outlier(sp, - type = c("AO"), c("2015-01-01", "2010-01-01")) +y <- rjd3toolkit::ABS$X0.2.09.10.M +sp <- regarima_spec("rg5c") +sp <- rjd3toolkit::add_outlier(sp, + type = c("AO"), c("2015-01-01", "2010-01-01") +) regarima_fast(y, spec = sp) -sp = rjd3toolkit::set_transform( - rjd3toolkit::set_tradingdays( - rjd3toolkit::set_easter(sp, enabled = FALSE), - option = "workingdays" - ), - fun = "None" +sp <- rjd3toolkit::set_transform( + rjd3toolkit::set_tradingdays( + rjd3toolkit::set_easter(sp, enabled = FALSE), + option = "workingdays" + ), + fun = "None" ) regarima_fast(y, spec = sp) -sp = rjd3toolkit::set_outlier(sp, outliers.type = c("AO")) +sp <- rjd3toolkit::set_outlier(sp, outliers.type = c("AO")) regarima_fast(y, spec = sp) } diff --git a/man/regarima_outliers.Rd b/man/regarima_outliers.Rd index d0df004..ed972bd 100644 --- a/man/regarima_outliers.Rd +++ b/man/regarima_outliers.Rd @@ -30,13 +30,15 @@ regarima_outliers( \item{X.td}{calendar regressors.} -\item{ao, ls, so, tc}{Boolean to indicate which type of outliers should be detected.} +\item{ao, ls, so, tc}{Boolean to indicate which type of outliers should be +detected.} -\item{cv}{\code{numeric}. The entered critical value for the outlier detection procedure. -If equal to 0 the critical value for the outlier detection procedure is automatically determined -by the number of observations.} +\item{cv}{\code{numeric}. The entered critical value for the outlier detection +procedure. If equal to 0 the critical value for the outlier detection +procedure is automatically determined by the number of observations.} -\item{clean}{Clean missing values at the beginning/end of the series. Regression variables are automatically resized, if need be.} +\item{clean}{Clean missing values at the beginning/end of the series. +Regression variables are automatically resized, if need be.} } \value{ a \code{"JD3_REGARIMA_OUTLIERS"} object, containing input variables and results diff --git a/man/userdefined_variables_x13.Rd b/man/userdefined_variables_x13.Rd index 69c669e..f8b3c41 100644 --- a/man/userdefined_variables_x13.Rd +++ b/man/userdefined_variables_x13.Rd @@ -7,22 +7,26 @@ userdefined_variables_x13(x = c("X-13", "RegArima", "X-11")) } \arguments{ -\item{x}{a character to indicate the estimation function for which the output items list will be displayed.} +\item{x}{a character to indicate the estimation function for which the output +items list will be displayed.} } \value{ -a vector containing the names of all the available output objects (series, diagnostics, parameters) +a vector containing the names of all the available output objects +(series, diagnostics, parameters) } \description{ -Function generating a comprehensive list of available output variables (series, parameters, diagnostics) from the estimation process -by the \code{x13()}, \code{regarima()} and \code{x11()} functions. -Some items are available in the default estimation output but the remainder can be added -using the \code{userdefined} parameter. -User-defined objects can the be retrieved from the list of lists generated by the estimation process +Function generating a comprehensive list of available output variables +(series, parameters, diagnostics) from the estimation process by the +\code{x13()}, \code{regarima()} and \code{x11()} functions. Some items are available in the +default estimation output but the remainder can be added using the +\code{userdefined} parameter. User-defined objects can the be retrieved from the +list of lists generated by the estimation process } \examples{ userdefined_variables_x13("x13") userdefined_variables_x13("regarima") userdefined_variables_x13("x11") + } \references{ More information and examples related to 'JDemetra+' features in the online documentation: diff --git a/man/x11.Rd b/man/x11.Rd index 294e7d5..8dc20fe 100644 --- a/man/x11.Rd +++ b/man/x11.Rd @@ -11,7 +11,8 @@ x11(ts, spec = x11_spec(), userdefined = NULL) \item{spec}{the specification.} -\item{userdefined}{a vector containing additional output variables (see \code{\link[=x13_dictionary]{x13_dictionary()}}).} +\item{userdefined}{a vector containing additional output variables +(see \code{\link[=x13_dictionary]{x13_dictionary()}}).} } \description{ X-11 Decomposition Algorithm diff --git a/man/x11_spec.Rd b/man/x11_spec.Rd index 94f170d..b5a5929 100644 --- a/man/x11_spec.Rd +++ b/man/x11_spec.Rd @@ -22,46 +22,68 @@ set_x11( ) } \arguments{ -\item{x}{the specification to be modified, object of class "JD3_X11_SPEC", default X11 spec can be obtained as 'x=x11_spec()'} +\item{x}{the specification to be modified, object of class "JD3_X11_SPEC", +default X11 spec can be obtained as 'x=x11_spec()'} -\item{mode}{character: the decomposition mode. Determines the mode of the seasonal adjustment decomposition to be performed: -\code{"Undefined"} - no assumption concerning the relationship between the time series components is made; +\item{mode}{character: the decomposition mode. Determines the mode of the +seasonal adjustment decomposition to be performed: +\code{"Undefined"} - no assumption concerning the relationship between the time +series components is made; \code{"Additive"} - assumes an additive relationship; \code{"Multiplicative"} - assumes a multiplicative relationship; -\code{"LogAdditive"} - performs an additive decomposition of the logarithms of the series being adjusted; -\code{"PseudoAdditive"} - assumes an pseudo-additive relationship. Could be changed by the program, if needed.} +\code{"LogAdditive"} - performs an additive decomposition of the logarithms of the +series being adjusted; +\code{"PseudoAdditive"} - assumes an pseudo-additive relationship. Could be +changed by the program, if needed.} -\item{seasonal.comp}{logical: if \code{TRUE}, the program computes a seasonal component. Otherwise, the seasonal component -is not estimated and its values are all set to 0 (additive decomposition) or 1 (multiplicative decomposition).} +\item{seasonal.comp}{logical: if \code{TRUE}, the program computes a seasonal +component. Otherwise, the seasonal component is not estimated and its values +are all set to 0 (additive decomposition) or 1 (multiplicative +decomposition).} -\item{seasonal.filter}{a vector of character(s) specifying which seasonal moving average (i.e. seasonal filter) -will be used to estimate the seasonal factors for the entire series. The vector can be of length: -1 - the same seasonal filter is used for all periods (e.g.: \code{seasonal.filter = "Msr"} or \code{seasonal.filter = "S3X3"} ); -or have a different value for each quarter (length 4) or each month (length 12) - (e.g. for quarterly series: \code{seasonal.filter = c("S3X3", "Msr", "S3X3", "Msr")}). -Possible filters are: \code{"Msr"}, \code{"Stable"}, \code{"X11Default"}, \code{"S3X1"}, \code{"S3X3"}, \code{"S3X5"}, \code{"S3X9"}, \code{"S3X15"}. -\code{"Msr"} - the program chooses the final seasonal filter automatically.} +\item{seasonal.filter}{a vector of character(s) specifying which seasonal +moving average (i.e. seasonal filter) will be used to estimate the seasonal +factors for the entire series. The vector can be of length: 1 - the same +seasonal filter is used for all periods (e.g.: \code{seasonal.filter = "Msr"} or +\code{seasonal.filter = "S3X3"} ); or have a different value for each quarter +(length 4) or each month (length 12) - (e.g. for quarterly series: +\code{seasonal.filter = c("S3X3", "Msr", "S3X3", "Msr")}). Possible filters are: +\code{"Msr"}, \code{"Stable"}, \code{"X11Default"}, \code{"S3X1"}, \code{"S3X3"}, \code{"S3X5"}, \code{"S3X9"}, +\code{"S3X15"}. \code{"Msr"} - the program chooses the final seasonal filter +automatically.} -\item{henderson.filter}{numeric: the length of the Henderson filter (odd number between 3 and 101). If \code{henderson.filter = 0} an automatic selection of the Henderson filter's length -for the trend estimation is enabled.} +\item{henderson.filter}{numeric: the length of the Henderson filter (odd +number between 3 and 101). If \code{henderson.filter = 0} an automatic selection +of the Henderson filter's length for the trend estimation is enabled.} -\item{lsigma}{numeric: the lower sigma boundary for the detection of extreme values, > 0.5, default=1.5.} +\item{lsigma}{numeric: the lower sigma boundary for the detection of extreme +values, > 0.5, default=1.5.} -\item{usigma}{numeric: the upper sigma boundary for the detection of extreme values, > lsigma, default=2.5.} +\item{usigma}{numeric: the upper sigma boundary for the detection of extreme +values, > lsigma, default=2.5.} -\item{bcasts, fcasts}{numeric: the number of backasts (\code{bcasts}) or forecasts (\code{fcasts}) generated by the RegARIMA model in periods (positive values) or years (negative values).Default values: fcasts=-1 and bcasts=0.} +\item{bcasts, fcasts}{numeric: the number of backasts (\code{bcasts}) or forecasts +(\code{fcasts}) generated by the RegARIMA model in periods (positive values) or +years (negative values).Default values: fcasts=-1 and bcasts=0.} -\item{calendar.sigma}{character to specify if the standard errors used for extreme values detection and adjustment are computed: -from 5 year spans of irregulars (\code{"None"}, default value); -separately for each calendar period (\code{"All"}); -separately for each period only if Cochran's hypothesis test determines that the irregular component is heteroskedastic -by calendar month/quarter (\code{"Signif"}); -separately for two complementary sets of calendar months/quarters specified by the x11.sigmaVector parameter (\code{"Select"}, -see parameter \code{sigma.vector}).} +\item{calendar.sigma}{character to specify if the standard errors used for +extreme values detection and adjustment are computed: from 5 year spans of +irregulars (\code{"None"}, default value); separately for each calendar period +(\code{"All"}); separately for each period only if Cochran's hypothesis test +determines that the irregular component is heteroskedastic by calendar +month/quarter (\code{"Signif"}); separately for two complementary sets of calendar +months/quarters specified by the x11.sigmaVector parameter (\code{"Select"}, see +parameter \code{sigma.vector}).} -\item{sigma.vector}{a vector to specify one of the two groups of periods for which standard errors used for extreme values -detection and adjustment will be computed separately. Only used if \code{calendar.sigma = "Select"}. Possible values are: \code{1} or \code{2}.} +\item{sigma.vector}{a vector to specify one of the two groups of periods for +which standard errors used for extreme values detection and adjustment will +be computed separately. Only used if \code{calendar.sigma = "Select"}. Possible +values are: \code{1} or \code{2}.} -\item{exclude.forecast}{Boolean to exclude forecasts and backcasts. If \code{TRUE}, the RegARIMA model forecasts and backcasts are not used during the detection of extreme values in the seasonal adjustment routines.Default= FALSE.} +\item{exclude.forecast}{Boolean to exclude forecasts and backcasts. If +\code{TRUE}, the RegARIMA model forecasts and backcasts are not used during the +detection of extreme values in the seasonal adjustment routines. +Default = FALSE.} \item{bias}{TODO.} } @@ -74,18 +96,19 @@ Set X-11 Specification \examples{ init_spec <- x11_spec() new_spec <- set_x11(init_spec, - mode = "LogAdditive", - seasonal.comp = 1, - seasonal.filter = "S3X9", - henderson.filter = 7, - lsigma = 1.7, - usigma = 2.7, - fcasts = -1, - bcasts = -1, - calendar.sigma ="All", - sigma.vector = NA, - exclude.forecast = FALSE, - bias = "LEGACY") + mode = "LogAdditive", + seasonal.comp = 1, + seasonal.filter = "S3X9", + henderson.filter = 7, + lsigma = 1.7, + usigma = 2.7, + fcasts = -1, + bcasts = -1, + calendar.sigma = "All", + sigma.vector = NA, + exclude.forecast = FALSE, + bias = "LEGACY" +) } \seealso{ \code{\link[=x13_spec]{x13_spec()}} and \code{\link[=x11_spec]{x11_spec()}}. diff --git a/man/x13.Rd b/man/x13.Rd index 9379c0a..7d45eb6 100644 --- a/man/x13.Rd +++ b/man/x13.Rd @@ -30,42 +30,51 @@ x13_fast( \arguments{ \item{ts}{an univariate time series.} -\item{spec}{the model specification. Can be either the name of a predefined specification or a user-defined specification.} +\item{spec}{the model specification. Can be either the name of a predefined +specification or a user-defined specification.} -\item{context}{list of external regressors (calendar or other) to be used for estimation} +\item{context}{list of external regressors (calendar or other) to be used for +estimation} -\item{userdefined}{a vector containing additional output variables (see \code{\link[=x13_dictionary]{x13_dictionary()}}).} +\item{userdefined}{a vector containing additional output variables +(see \code{\link[=x13_dictionary]{x13_dictionary()}}).} } \value{ -the \code{x13()} function returns a list with the results, the estimation specification and the result specification, while \code{x13_fast()} is a faster function that only returns the results. -The \code{.jx13()} functions only returns results in a java object which will allow to customize outputs in other packages (use \code{\link[rjd3toolkit:dictionary]{rjd3toolkit::dictionary()}} to -get the list of variables and \code{\link[rjd3toolkit:dictionary]{rjd3toolkit::result()}} to get a specific variable). -In the estimation functions \code{x13()} and \code{x13_fast()} you can directly use a specification name (string). -If you want to customize a specification you have to create a specification object first. +the \code{x13()} function returns a list with the results, the estimation +specification and the result specification, while \code{x13_fast()} is a faster +function that only returns the results. The \code{.jx13()} functions only returns +results in a java object which will allow to customize outputs in other +packages (use \code{\link[rjd3toolkit:dictionary]{rjd3toolkit::dictionary()}} to get the list of variables and +\code{\link[rjd3toolkit:dictionary]{rjd3toolkit::result()}} to get a specific variable). In the estimation +functions \code{x13()} and \code{x13_fast()} you can directly use a specification name +(string). If you want to customize a specification you have to create a +specification object first. } \description{ Seasonal Adjustment with X13-ARIMA } \examples{ -y = rjd3toolkit::ABS$X0.2.09.10.M -x13_fast(y,"rsa3") -x13(y,"rsa5c") -regarima_fast(y,"rg0") -regarima(y,"rg3") +y <- rjd3toolkit::ABS$X0.2.09.10.M +x13_fast(y, "rsa3") +x13(y, "rsa5c") +regarima_fast(y, "rg0") +regarima(y, "rg3") -sp = x13_spec("rsa5c") -sp = rjd3toolkit::add_outlier(sp, - type = c("AO"), c("2015-01-01", "2010-01-01")) -sp = rjd3toolkit::set_transform( - rjd3toolkit::set_tradingdays( - rjd3toolkit::set_easter(sp, enabled = FALSE), - option = "workingdays" - ), - fun = "None" +sp <- x13_spec("rsa5c") +sp <- rjd3toolkit::add_outlier(sp, + type = c("AO"), c("2015-01-01", "2010-01-01") +) +sp <- rjd3toolkit::set_transform( + rjd3toolkit::set_tradingdays( + rjd3toolkit::set_easter(sp, enabled = FALSE), + option = "workingdays" + ), + fun = "None" +) +x13(y, spec = sp) +sp <- set_x11(sp, + henderson.filter = 13 ) -x13(y,spec=sp) -sp = set_x11(sp, - henderson.filter = 13) x13_fast(y, spec = sp) } diff --git a/man/x13_revisions.Rd b/man/x13_revisions.Rd index 63ae810..9319031 100644 --- a/man/x13_revisions.Rd +++ b/man/x13_revisions.Rd @@ -48,19 +48,22 @@ Compute revisions history s <- rjd3toolkit::ABS$X0.2.09.10.M sa_mod <- x13(s) data_ids <- list( - # Get the coefficient of the trading-day coefficient from 2005-jan - list(start = "2005-01-01", id = "regression.td(1)"), - # Get the ljung-box statistics on residuals from 2010-jan - list(start = "2010-01-01", id = "residuals.lb")) + # Get the coefficient of the trading-day coefficient from 2005-jan + list(start = "2005-01-01", id = "regression.td(1)"), + # Get the ljung-box statistics on residuals from 2010-jan + list(start = "2010-01-01", id = "residuals.lb") +) ts_ids <- list( - # Get the SA component estimates of 2010-jan from 2010-jan - list(period = "2010-01-01", start = "2010-01-01", id = "sa"), - # Get the irregular component estimates of 2010-jan from 2015-jan - list(period = "2010-01-01", start = "2015-01-01", id = "i")) + # Get the SA component estimates of 2010-jan from 2010-jan + list(period = "2010-01-01", start = "2010-01-01", id = "sa"), + # Get the irregular component estimates of 2010-jan from 2015-jan + list(period = "2010-01-01", start = "2015-01-01", id = "i") +) cmp_ids <- list( - # Get the SA component estimates (full time series) 2010-jan to 2020-jan - list(start = "2010-01-01", end = "2020-01-01", id = "sa"), - # Get the trend component estimates (full time series) 2010-jan to 2020-jan - list(start = "2010-01-01", end = "2020-01-01", id = "t")) + # Get the SA component estimates (full time series) 2010-jan to 2020-jan + list(start = "2010-01-01", end = "2020-01-01", id = "sa"), + # Get the trend component estimates (full time series) 2010-jan to 2020-jan + list(start = "2010-01-01", end = "2020-01-01", id = "t") +) rh <- x13_revisions(s, sa_mod$result_spec, data_ids, ts_ids, cmp_ids) } diff --git a/man/x13_spec.Rd b/man/x13_spec.Rd index b4fa5ee..a53de71 100644 --- a/man/x13_spec.Rd +++ b/man/x13_spec.Rd @@ -21,17 +21,21 @@ an object of class \code{"JD3_X13_SPEC"} (\code{x13_spec()}), \code{"JD3_X11_SPEC"} (\code{x11_spec()}). } \description{ -Set of functions to create default specification objects associated with the X-13ARIMA seasonal adjustment method. -} -\details{ -Specification setting of sheer X-11 decomposition method (without reg-arima pre-adjustment) is supported by the \code{x11_spec()} function only -and doesn't appear among the possible X13-Arima default specifications +Set of functions to create default specification objects associated with the +X-13ARIMA seasonal adjustment method. -Specification setting can be restricted to the reg-arima part with the \code{regarima_spec()} function, -without argument \code{regarima_spec()} yields a RG5c specification +Specification setting of sheer X-11 decomposition method (without reg-arima +pre-adjustment) is supported by the \code{x11_spec()} function only and doesn't +appear among the possible X13-Arima default specifications. -When setting a complete X13-Arima spec, \code{x13_spec()} without argument yields a RSA5c specification +Specification setting can be restricted to the reg-arima part with the +\code{regarima_spec()} function, without argument \code{regarima_spec()} yields a RG5c +specification. +When setting a complete X13-Arima spec, \code{x13_spec()} without argument yields +a RSA5c specification. +} +\details{ The available predefined 'JDemetra+' model specifications are described in the table below: \tabular{rrrrrrr}{ @@ -52,7 +56,14 @@ init_spec <- x13_spec("rsa5c") } \seealso{ \itemize{ -\item To set the pre-processing parameters: \code{\link[rjd3toolkit:set_arima]{rjd3toolkit::set_arima()}}, \code{\link[rjd3toolkit:set_automodel]{rjd3toolkit::set_automodel()}}, \code{\link[rjd3toolkit:set_basic]{rjd3toolkit::set_basic()}}, \code{\link[rjd3toolkit:set_easter]{rjd3toolkit::set_easter()}}, \code{\link[rjd3toolkit:set_estimate]{rjd3toolkit::set_estimate()}}, \code{\link[rjd3toolkit:set_outlier]{rjd3toolkit::set_outlier()}}, \code{\link[rjd3toolkit:set_tradingdays]{rjd3toolkit::set_tradingdays()}}, \code{\link[rjd3toolkit:set_transform]{rjd3toolkit::set_transform()}}, \code{\link[rjd3toolkit:add_outlier]{rjd3toolkit::add_outlier()}}, \code{\link[rjd3toolkit:add_outlier]{rjd3toolkit::remove_outlier()}}, \code{\link[rjd3toolkit:add_outlier]{rjd3toolkit::add_ramp()}}, \code{\link[rjd3toolkit:add_outlier]{rjd3toolkit::remove_ramp()}}, \code{\link[rjd3toolkit:add_usrdefvar]{rjd3toolkit::add_usrdefvar()}}. +\item To set the pre-processing parameters: +\code{\link[rjd3toolkit:set_arima]{rjd3toolkit::set_arima()}}, \code{\link[rjd3toolkit:set_automodel]{rjd3toolkit::set_automodel()}}, +\code{\link[rjd3toolkit:set_basic]{rjd3toolkit::set_basic()}}, \code{\link[rjd3toolkit:set_easter]{rjd3toolkit::set_easter()}}, +\code{\link[rjd3toolkit:set_estimate]{rjd3toolkit::set_estimate()}}, \code{\link[rjd3toolkit:set_outlier]{rjd3toolkit::set_outlier()}}, +\code{\link[rjd3toolkit:set_tradingdays]{rjd3toolkit::set_tradingdays()}}, \code{\link[rjd3toolkit:set_transform]{rjd3toolkit::set_transform()}}, +\code{\link[rjd3toolkit:add_outlier]{rjd3toolkit::add_outlier()}}, \code{\link[rjd3toolkit:add_outlier]{rjd3toolkit::remove_outlier()}}, +\code{\link[rjd3toolkit:add_outlier]{rjd3toolkit::add_ramp()}}, \code{\link[rjd3toolkit:add_outlier]{rjd3toolkit::remove_ramp()}}, +\code{\link[rjd3toolkit:add_usrdefvar]{rjd3toolkit::add_usrdefvar()}}. \item To set the decomposition parameters: \code{\link[=set_x11]{set_x11()}}. \item To set the benchmarking parameters: \code{\link[rjd3toolkit:set_benchmarking]{rjd3toolkit::set_benchmarking()}}. }