R/set_x11_spec.R

In rjd3x13: Seasonal Adjustment with 'X-13' in 'JDemetra+' 3.x

#' @title 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;
#' `"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 backcasts (`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`).If `sigma.vector` is specified then `calendar.sigma` is set to
#' "Select"`.
#'
#' @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. 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.
#' @returns  a "JD3_X11_SPEC" object, containing all the parameters.
#' @seealso [x13_spec()] and [x11_spec()].
#'
#' @examplesIf rjd3jars::check_java_version(silent = TRUE)
#' 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"
#' )
#' @rdname x11_spec
#' @export
set_x11 <- 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")
) {
    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")
) {
    mode <- match.arg(
        toupper(mode[1]),
        c(
            NA,
            "UNDEFINED",
            "ADDITIVE",
            "MULTIPLICATIVE",
            "LOGADDITIVE",
            "PSEUDOADDITIVE"
        )
    )
    calendar.sigma <- match.arg(
        toupper(calendar.sigma[1]),
        c(NA, "NONE", "SIGNIF", "ALL", "SELECT")
    )
    seasonal.filter <- match.arg(
        toupper(seasonal.filter),
        choices = c(
            NA,
            "MSR",
            "STABLE",
            "X11DEFAULT",
            "S3X1",
            "S3X3",
            "S3X5",
            "S3X9",
            "S3X15"
        ),
        several.ok = TRUE
    )
    bias <- match.arg(
        toupper(bias),
        c(NA, "LEGACY")
    )
    if (!is.na(mode)) {
        x$mode <- switch(mode, UNDEFINED = "UNKNOWN", mode)
    }

    if (!is.na(seasonal.comp) && is.logical(seasonal.comp)) {
        x$seasonal <- seasonal.comp
    }

    if (!anyNA(seasonal.filter)) {
        x$sfilters <- sprintf("FILTER_%s", seasonal.filter)
    }
    if (!is.na(henderson.filter)) {
        if ((henderson.filter != 0) && (henderson.filter %% 2 == 0)) {
            warning(
                "The variable henderson.filter should be an odd number or equal to 0.",
                call. = FALSE
            )
        } else {
            x$henderson <- henderson.filter
        }
    }

    if (!is.na(lsigma)) {
        x$lsig <- lsigma
    }
    if (!is.na(usigma)) {
        x$usig <- usigma
    }

    if (!is.na(bcasts)) {
        x$nbcasts <- bcasts
    }
    if (!is.na(fcasts)) {
        x$nfcasts <- fcasts
    }
    if (!is.na(calendar.sigma)) {
        x$sigma <- calendar.sigma
    }
    if (!is.na(exclude.forecast) && is.logical(exclude.forecast)) {
        x$excludefcasts <- exclude.forecast
    }
    if (!anyNA(sigma.vector)) {
        if (all(sigma.vector %in% c(1, 2))) {
            x$sigma <- "SELECT"
            x$vsigmas <- as.integer(sigma.vector)
        } else {
            warning("sigma.vector must be equal to 1 or 2", call. = FALSE)
        }
    }
    if (!is.na(bias)) {
        x$bias <- bias
    }
    x
}

#' @export
set_x11.JD3_X13_SPEC <- function(x, ...) {
    x$x11 <- set_x11(x$x11, ...)
    x
}