diff --git a/.lintr b/.lintr index 0a53596..0f087b2 100644 --- a/.lintr +++ b/.lintr @@ -1,14 +1,15 @@ -linters: linters_with_defaults( - indentation_linter = lintr::indentation_linter(indent = 4L), +linters: lintr::all_linters( + #indentation_linter = lintr::indentation_linter(indent = 4L), indentation_linter = NULL, - assignment_linter = NULL, + # line_length_linter = lintr::line_length_linter(80L), + line_length_linter = lintr::line_length_linter(200L), trailing_blank_lines_linter = NULL, trailing_whitespace_linter = NULL, + assignment_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, @@ -21,7 +22,15 @@ linters: linters_with_defaults( cyclocomp_linter = NULL, object_usage_linter = NULL, object_name_linter = NULL, - line_length_linter = NULL, - commented_code_linter = NULL + commented_code_linter = NULL, + extraction_operator_linter = NULL, + implicit_integer_linter = NULL, + nonportable_path_linter = NULL, + undesirable_function_linter = NULL, + numeric_leading_zero_linter = NULL, + todo_comment_linter = NULL, + fixed_regex_linter = NULL, + unnecessary_lambda_linter = NULL, + paste_linter = NULL ) encoding: "UTF-8" diff --git a/DESCRIPTION b/DESCRIPTION index c4ea214..39f874e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: rjd3x13 Type: Package Title: Seasonal Adjustment with X-13 in 'JDemetra+ 3.x' -Version: 3.2.3 +Version: 3.3.0 Authors@R: c( person("Jean", "Palate", role = c("aut"), email = "palatejean@gmail.com"), @@ -20,14 +20,14 @@ Depends: R (>= 4.1.0) Imports: rJava (>= 1.0-6), - rjd3toolkit (>= 3.2.2), + rjd3toolkit (>= 3.3.0), RProtoBuf (>= 0.4.17) Remotes: - github::rjdverse/rjd3toolkit@*release + github::rjdverse/rjd3toolkit SystemRequirements: Java (>= 17) -License: EUPL +License: file LICENSE URL: https://github.com/rjdverse/rjd3x13, https://rjdverse.github.io/rjd3x13/ -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.2 Roxygen: list(markdown = TRUE) BugReports: https://github.com/rjdverse/rjd3x13/issues Encoding: UTF-8 diff --git a/NAMESPACE b/NAMESPACE index 74050b8..d3eb6be 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -23,6 +23,7 @@ S3method(print,JD3_X11_SPEC) S3method(print,JD3_X13_OUTPUT) S3method(print,JD3_X13_RSLTS) S3method(print,JD3_X13_SPEC) +S3method(print,summary.JD3_X13_RSLTS) S3method(remove_outlier,JD3_X13_SPEC) S3method(remove_ramp,JD3_X13_SPEC) S3method(residuals,JD3_REGARIMA_OUTPUT) @@ -41,6 +42,8 @@ S3method(set_transform,JD3_X13_SPEC) S3method(set_x11,JD3_X11_SPEC) S3method(set_x11,JD3_X13_SPEC) S3method(summary,JD3_REGARIMA_OUTPUT) +S3method(summary,JD3_X13_OUTPUT) +S3method(summary,JD3_X13_RSLTS) S3method(vcov,JD3_REGARIMA_OUTPUT) S3method(vcov,JD3_X13_OUTPUT) export(.jd2r_spec_regarima) diff --git a/NEWS.md b/NEWS.md index 80d09b3..d9dd152 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,20 +2,27 @@ All notable changes to this project will be documented in this file. -The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/), and this project adheres -to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). ## [Unreleased] +## [3.3.0] - 2024-10-28 + +### Changed + +- New java libraries + ## [3.2.3] - 2024-07-12 +### Changed -* New .jar (related to release [3.2.4](https://github.com/jdemetra/jdplus-main/releases/tag/v3.2.4)) -* Some linting of R functions +- New .jar (related to release) +- Some linting of R functions ## [3.2.2] - 2024-03-15 -[Unreleased]: https://github.com/rjdverse/rjd3x13/compare/v3.2.3...HEAD + +[Unreleased]: https://github.com/rjdverse/rjd3x13/compare/v3.3.0...HEAD +[3.3.0]: https://github.com/rjdverse/rjd3x13/releases/tag/v3.2.3...v3.3.0 [3.2.3]: https://github.com/rjdverse/rjd3x13/releases/tag/v3.2.2...v3.2.3 [3.2.2]: https://github.com/rjdverse/rjd3x13/releases/tag/v3.2.2 - diff --git a/R/deprecated.R b/R/deprecated.R index aa95ea6..595cd25 100644 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -4,31 +4,37 @@ #' @param ts,spec,context,userdefined,name Parameters. #' @name deprecated-rjd3x13 #' @export -spec_x13<-function(name = c("rsa4","rsa0", "rsa1", "rsa2c", "rsa3", "rsa5c")){ - .Deprecated("x13_spec") - x13_spec(name) +spec_x13 <- function(name = c("rsa4", "rsa0", "rsa1", "rsa2c", "rsa3", "rsa5c")) { + .Deprecated("x13_spec") + x13_spec(name) } #' @name deprecated-rjd3x13 #' @export -spec_regarima<-function(name=c("rg4","rg0", "rg1", "rg2c", "rg3", "rg5c")){ - .Deprecated("regarima_spec") - regarima_spec(name) +spec_regarima <- function(name = c("rg4", "rg0", "rg1", "rg2c", "rg3", "rg5c")) { + .Deprecated("regarima_spec") + regarima_spec(name) } #' @name deprecated-rjd3x13 #' @export spec_x11 <- function() { - .Deprecated("x11_spec") - x11_spec() + .Deprecated("x11_spec") + x11_spec() } #' @name deprecated-rjd3x13 #' @export -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) +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){ - .Deprecated("regarima_fast") - regarima_fast(ts, spec, context, userdefined) +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 0f5829f..c1eab57 100644 --- a/R/print.R +++ b/R/print.R @@ -1,312 +1,417 @@ -#'@importFrom stats printCoefmat -#'@importFrom utils capture.output -print_x11_decomp <- function(x, digits = max(3L, getOption("digits") - 3L), ...){ - mstats <- matrix(unlist(x$mstats), - ncol = 1, - dimnames = list(names(x$mstats), "M stats")) - cat("Monitoring and Quality Assessment Statistics:", - "\n") - printCoefmat(mstats, digits = digits, P.values= FALSE, na.print = "NA", ...) - cat("\n") - cat("Final filters:","\n") - cat("Seasonal filter: ",x$decomposition$final_seasonal) - cat("\n") - cat(sprintf("Trend filter: %s terms Henderson moving average", x$decomposition$final_henderson)) - cat("\n") - return(invisible(x)) +#' @importFrom stats printCoefmat +#' @importFrom utils capture.output +print_x11_decomp <- function(x, digits = max(3L, getOption("digits") - 3L), ...) { + mstats <- matrix(unlist(x$mstats), + ncol = 1, + dimnames = list(names(x$mstats), "M stats") + ) + cat( + "Monitoring and Quality Assessment Statistics:", + "\n" + ) + printCoefmat(mstats, digits = digits, P.values = FALSE, na.print = "NA", ...) + cat("\n") + cat("Final filters:", "\n") + cat(sprintf("Seasonal filter: S3X%s", x$decomposition$final_seasonal)) + cat("\n") + cat(sprintf("Trend filter: %s terms Henderson moving average", x$decomposition$final_henderson)) + cat("\n") + return(invisible(x)) } print_diagnostics <- function(x, digits = max(3L, getOption("digits") - 3L), - ...){ - diagnostics <- rjd3toolkit::diagnostics(x) - variance_decomposition <- diagnostics$variance_decomposition - residual_tests <- diagnostics$residual_tests - - cat("Relative contribution of the components to the stationary", - "portion of the variance in the original series,", - "after the removal of the long term trend (in %)", - sep = "\n" - ) - cat("\n") - cat(paste0(" ", - capture.output( - printCoefmat(variance_decomposition*100, digits = digits, ...) - )), - sep ="\n") - cat("\n") - - cat("Residual seasonality tests") - cat("\n") - cat(paste0(" ", - capture.output( - printCoefmat(residual_tests[,"P.value", drop = FALSE], digits = digits, - na.print = "NA", ...) - ) - ), - sep ="\n") - cat("\n") - - return(invisible(x)) + ...) { + variance_decomposition <- x$variance_decomposition + residual_tests <- x$residual_tests + + cat("Relative contribution of the components to the stationary", + "portion of the variance in the original series,", + "after the removal of the long term trend (in %)", + sep = "\n" + ) + cat("\n") + cat( + paste0( + " ", + capture.output( + printCoefmat(variance_decomposition * 100, digits = digits, ...) + ) + ), + sep = "\n" + ) + cat("\n") + + cat("Residual seasonality tests") + cat("\n") + cat( + paste0( + " ", + capture.output( + printCoefmat(residual_tests[, "P.value", drop = FALSE], + digits = digits, + na.print = "NA", ... + ) + ) + ), + sep = "\n" + ) + cat("\n") + + return(invisible(x)) } -print_final <- function(x, ...){ - print(rjd3toolkit::sa_decomposition(x), ...) - return(invisible(x)) + +#' @export +print.JD3_X13_RSLTS <- function(x, digits = max(3L, getOption("digits") - 3L), summary_info = getOption("summary_info"), + thresholds_pval = getOption("thresholds_pval"), + ...) { + cat("Model: X-13\n") + print(x$preprocessing, digits = digits, summary_info = FALSE, ...) + cat("\n") + cat(sprintf("Seasonal filter: S3X%s; ", x$decomposition$final_seasonal)) + cat(sprintf("Trend filter: H-%s terms\n", x$decomposition$final_henderson)) + cat( + sprintf("M-Statistics: q %s (%.3f); q-m2 %s (%.3f)\n", + ifelse(x$mstats$q <= 1, "Good", "Bad"), + x$mstats$q, + ifelse(x$mstats$qm2 <= 1, "Good", "Bad"), + x$mstats$qm2 + ) + ) + cat( + sprintf("QS test on SA: %s (%.3f); ", + base::cut(x$diagnostics$seas.qstest.sa$pvalue, breaks = c(0, thresholds_pval), + labels = names(thresholds_pval)), + x$diagnostics$seas.qstest.sa$pvalue + ) + ) + cat( + sprintf("F-test on SA: %s (%.3f)\n", + base::cut(x$diagnostics$seas.ftest.sa$pvalue, breaks = c(0, thresholds_pval), + labels = names(thresholds_pval)), + x$diagnostics$seas.ftest.sa$pvalue + ) + ) + if (summary_info) { + cat("\nFor a more detailed output, use the 'summary()' function.\n") + } + return(invisible(x)) } #' @export -print.JD3_REGARIMA_SPEC <- function(x, ...) { +summary.JD3_X13_RSLTS <- function(object, ...) { + x <- list( + preprocessing = summary(object$preprocessing), + decomposition = object[c("mstats", "decomposition")], + diagnostics = rjd3toolkit::diagnostics(object), + final = rjd3toolkit::sa_decomposition(object) + ) + class(x) <- "summary.JD3_X13_RSLTS" + return(x) +} - cat("Specification", "\n", sep = "") +#' @export +summary.JD3_X13_OUTPUT <- function(object, ...) { + summary(object$result, ...) +} +#' @export +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 = "") + print_x11_decomp(x$decomposition, digits = digits, ...) + cat("\n", "Diagnostics", "\n", sep = "") + print_diagnostics(x$diagnostics, digits = digits, ...) + cat("\n", "Final", "\n", sep = "") + print(x$final, digits = digits, ...) + return(invisible(x)) +} - cat("\n", "Series", "\n", sep = "") +#' @export +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)) +} - cat("Serie span: ") - print(x$basic$span) +#' @export +print.JD3X11 <- function(x, ...) { + table <- do.call(cbind, x[grepl(pattern = "^d(\\d+)$", x = names(x))]) - cat("Preliminary Check: ", ifelse(x$basic$preliminaryCheck, "Yes", "No"), "\n", sep = "") + cat("Last values\n") + print(utils::tail(stats::.preformat.ts(table))) + return(invisible(x)) +} - cat("\n", "Estimate", "\n", sep = "") - cat("Model span: ") - print(x$estimate$span) - cat("\n") - cat("Tolerance: ", x$estimate$tol, "\n", sep = "") +#' @export +plot.JD3_X13_RSLTS <- function(x, first_date = NULL, last_date = NULL, + type_chart = c("sa-trend", "seas-irr"), + caption = c( + "sa-trend" = "Y, Sa, trend", + "seas-irr" = "Sea., irr." + )[type_chart], + colors = c( + y = "#F0B400", t = "#1E6C0B", sa = "#155692", + s = "#1E6C0B", i = "#155692" + ), + ...) { + plot(rjd3toolkit::sa_decomposition(x), + first_date = first_date, last_date = last_date, + type_chart = type_chart, + caption = caption, + colors = colors, + ... + ) +} +#' @export +plot.JD3_X13_OUTPUT <- function(x, first_date = NULL, last_date = NULL, + type_chart = c("sa-trend", "seas-irr"), + caption = c( + "sa-trend" = "Y, Sa, trend", + "seas-irr" = "Sea., irr." + )[type_chart], + colors = c( + y = "#F0B400", t = "#1E6C0B", sa = "#155692", + s = "#1E6C0B", i = "#155692" + ), + ...) { + plot(x$result, + first_date = first_date, last_date = last_date, + type_chart = type_chart, + caption = caption, + colors = colors, + ... + ) +} +#' @importFrom rjd3toolkit diagnostics +#' @export +diagnostics.JD3_X13_RSLTS <- function(x, ...) { + if (is.null(x)) { + return(NULL) + } + variance_decomposition <- x$diagnostics$vardecomposition + variance_decomposition <- matrix(unlist(variance_decomposition), + ncol = 1, + dimnames = list(names(variance_decomposition), "Component") + ) + residual_tests <- x$diagnostics[grep("test", names(x$diagnostics))] + residual_tests <- data.frame( + Statistic = sapply(residual_tests, function(test) test[["value"]]), + P.value = sapply(residual_tests, function(test) test[["pvalue"]]), + Description = sapply(residual_tests, function(test) attr(test, "distribution")) + ) + list( + preprocessing = rjd3toolkit::diagnostics(x$preprocessing), + variance_decomposition = variance_decomposition, + residual_tests = residual_tests + ) +} - cat("\n", "Transformation", "\n", sep = "") +#' @export +diagnostics.JD3_X13_OUTPUT <- function(x, ...) { + return(rjd3toolkit::diagnostics(x$result, ...)) +} - cat("Function: ", x$transform$fn, "\n", sep = "") - cat("AIC difference: ", x$transform$aicdiff, "\n", sep = "") - cat("Adjust: ", x$transform$adjust, "\n", sep = "") +#' @export +print.JD3_REGARIMA_SPEC <- function(x, ...) { + cat("Specification", "\n", sep = "") - cat("\n", "Regression", "\n", sep = "") - if (!is.null(x$regression$td$users) && length(x$regression$td$users) > 0) { - cat("Calendar regressor: user-defined calendar", "\n", sep = "") - cat("Test: ", x$regression$td$test, "\n", sep = "") - } else if (x$regression$td$w > 0) { - cat("No calendar regressor", "\n", sep = "") - } else if (x$regression$td$td == "TD_NONE") { - cat("No calendar regressor", "\n", sep = "") - } else { - if (x$regression$td$td == "TD7") { - cat("Calendar regressor: TradingDays\n", sep = "") - } else if (x$regression$td$td == "TD2") { - cat("Calendar regressor: WorkingDays\n", sep = "") - } else if (x$regression$td$td %in% c("TD3", "TD3C", "TD4")) { - cat("Calendar regressor: ", x$regression$td$td, "\n", sep = "") - } else { - message("Trading days regressor unknown.") - } - cat("with Leap Year: ", - ifelse(x$regression$td$lp == "LEAPYEAR", "Yes", "No"), "\n", sep = "") - cat("AutoAdjust: ", x$regression$td$autoadjust, "\n", sep = "") - cat("Test: ", x$regression$td$test, "\n", sep = "") - } - - cat("\n") - - cat("Easter: ") - if (x$regression$easter$type == "UNUSED") { - cat("No\n") - } else { - cat(x$regression$easter$type, "\n") - cat("Duration:", x$regression$easter$duration, ifelse(x$regression$easter$duration == 8, "(Auto)", ""), "\n") - cat("Test:", x$regression$easter$test, ifelse(x$regression$easter$test == "ADD", "(Auto)", ""), "\n") - - if (!is.null(x$regression$easter$coef)) { - cat("Coef:\n") - cat("\t- Type:", x$regression$easter$coefficient$type, - ifelse(x$regression$easter$coefficient$type == "FIXED", "(Auto)", ""), "\n") - cat("\t- Value:", x$regression$easter$coefficient$value, "\n") - } - } + cat("\n", "Series", "\n", sep = "") - cat("\n") + cat("Serie span: ") + print(x$basic$span) - cat("Pre-specified outliers: ", length(x$regression$outliers), "\n", sep = "") - if (!is.null(x$regression$outliers) && length(x$regression$outliers) > 0) { - for (out in x$regression$outliers) { - cat("\t- ", out$name, - ifelse(is.null(out$coef), "", paste0(", coefficient: ", out$coef$value, " (", out$coef$type, ")")), - "\n", sep = "") - } - } - cat("Ramps: ") - if (!is.null(x$regression$ramps) && length(x$regression$ramps) > 0) { - cat("\n") - for (ramp in x$regression$ramps) { - cat("\t- start: ", ramp$start, ", end : ", ramp$end, - ifelse(is.null(ramp$coef), "", paste0(", coefficient: ", ramp$coef, " (", ramp$coef$type, ")")), sep = "") - cat("\n") - } - } else { - cat("No\n") - } - - if (!is.null(x$regression$users) && length(x$regression$users) > 0) { - cat("User-defined variables:\n") - for (uv in x$regression$users) { - cat("\t-", uv$name, - ifelse(is.null(uv$coef), "", paste0(", coefficient: ", uv$coef)), - ", component: ", uv$regeffect, "\n", sep = "") - } - } + cat("Preliminary Check: ", ifelse(x$basic$preliminaryCheck, "Yes", "No"), "\n", sep = "") - cat("\n", "Outliers", "\n", sep = "") - if (is.null(x$outlier$outliers) || length(x$outlier$outliers) == 0) { - cat("Is enabled: No\n") - } else { - cat("Detection span: ") - print(x$outlier$span) + cat("\n", "Estimate", "\n", sep = "") - cat("Outliers type: \n") - for (out in x$outlier$outliers) { - cat("\t- ", out$type, ", critical value : ", out$va, ifelse(out$va == 0, " (Auto)", ""), "\n", sep = "") - } + cat("Model span: ") + print(x$estimate$span) + cat("\n") + cat("Tolerance: ", x$estimate$tol, "\n", sep = "") - cat("TC rate: ", x$outlier$monthlytcrate, ifelse(x$outlier$monthlytcrate == 0.7, " (Auto)", ""), "\n", sep = "") - cat("Method: ", x$outlier$method, ifelse(x$outlier$method == "ADDONE", " (Auto)", ""), "\n", sep = "") - } + cat("\n", "Transformation", "\n", sep = "") - cat("\n", "ARIMA", "\n", sep = "") + cat("Function: ", x$transform$fn, "\n", sep = "") + cat("AIC difference: ", x$transform$aicdiff, "\n", sep = "") + cat("Adjust: ", x$transform$adjust, "\n", sep = "") - print(x$arima) - return(invisible(x)) -} + cat("\n", "Regression", "\n", sep = "") -#' @export -print.JD3_X11_SPEC <- function(x, ...) { + if (!is.null(x$regression$td$users) && length(x$regression$td$users) > 0) { + cat("Calendar regressor: user-defined calendar", "\n", sep = "") + cat("Test: ", x$regression$td$test, "\n", sep = "") + } else if (x$regression$td$w > 0) { + cat("No calendar regressor", "\n", sep = "") + } else if (x$regression$td$td == "TD_NONE") { + cat("No calendar regressor", "\n", sep = "") + } else { + if (x$regression$td$td == "TD7") { + cat("Calendar regressor: TradingDays\n", sep = "") + } else if (x$regression$td$td == "TD2") { + cat("Calendar regressor: WorkingDays\n", sep = "") + } else if (x$regression$td$td %in% c("TD3", "TD3C", "TD4")) { + cat("Calendar regressor: ", x$regression$td$td, "\n", sep = "") + } else { + message("Trading days regressor unknown.") + } + cat("with Leap Year: ", + ifelse(x$regression$td$lp == "LEAPYEAR", "Yes", "No"), "\n", + sep = "" + ) + cat("AutoAdjust: ", x$regression$td$autoadjust, "\n", sep = "") + cat("Test: ", x$regression$td$test, "\n", sep = "") + } - cat("Specification X11", "\n", sep = "") + cat("\n") + cat("Easter: ") + if (x$regression$easter$type == "UNUSED") { + cat("No\n") + } else { + cat(x$regression$easter$type, "\n") + cat("Duration:", x$regression$easter$duration, ifelse(x$regression$easter$duration == 8, "(Auto)", ""), "\n") + cat("Test:", x$regression$easter$test, ifelse(x$regression$easter$test == "ADD", "(Auto)", ""), "\n") + + if (!is.null(x$regression$easter$coef)) { + cat("Coef:\n") + cat( + "\t- Type:", x$regression$easter$coefficient$type, + ifelse(x$regression$easter$coefficient$type == "FIXED", "(Auto)", ""), "\n" + ) + cat("\t- Value:", x$regression$easter$coefficient$value, "\n") + } + } - cat("Seasonal component: ", ifelse(x$seasonal, "Yes", "No"), "\n", sep = "") - cat("Length of the Henderson filter: ", x$henderson, "\n", sep = "") - cat("Seasonal filter: ", x$sfilters, "\n", sep = "") - cat("Boundaries used for extreme values correction :", - "\n\t lower_sigma: ", x$lsig, - "\n\t upper_sigma: ", x$usig) - cat("\n") - cat("Nb of forecasts: ", x$nfcasts, "\n", sep = "") - cat("Nb of backcasts: ", x$nbcasts, "\n", sep = "") - cat("Calendar sigma: ", x$sigma, "\n", sep = "") + cat("\n") - return(invisible(x)) -} + cat("Pre-specified outliers: ", length(x$regression$outliers), "\n", sep = "") + if (!is.null(x$regression$outliers) && length(x$regression$outliers) > 0) { + for (out in x$regression$outliers) { + cat("\t- ", out$name, + ifelse(is.null(out$coef), "", paste0(", coefficient: ", out$coef$value, " (", out$coef$type, ")")), + "\n", + sep = "" + ) + } + } + cat("Ramps: ") + if (!is.null(x$regression$ramps) && length(x$regression$ramps) > 0) { + cat("\n") + for (ramp in x$regression$ramps) { + cat("\t- start: ", ramp$start, ", end : ", ramp$end, + ifelse(is.null(ramp$coef), "", paste0(", coefficient: ", ramp$coef, " (", ramp$coef$type, ")")), + sep = "" + ) + cat("\n") + } + } else { + cat("No\n") + } -#' @export -print.JD3_X13_SPEC <- function(x, ...) { + if (!is.null(x$regression$users) && length(x$regression$users) > 0) { + cat("User-defined variables:\n") + for (uv in x$regression$users) { + cat("\t-", uv$name, + ifelse(is.null(uv$coef), "", paste0(", coefficient: ", uv$coef)), + ", component: ", uv$regeffect, "\n", + sep = "" + ) + } + } - print(x$regarima) + cat("\n", "Outliers", "\n", sep = "") - cat("\n") + if (is.null(x$outlier$outliers) || length(x$outlier$outliers) == 0) { + cat("Is enabled: No\n") + } else { + cat("Detection span: ") + print(x$outlier$span) - print(x$x11) + cat("Outliers type: \n") + for (out in x$outlier$outliers) { + cat("\t- ", out$type, ", critical value : ", out$va, ifelse(out$va == 0, " (Auto)", ""), "\n", sep = "") + } - cat("\n", "Benchmarking", "\n", sep = "") + cat("TC rate: ", x$outlier$monthlytcrate, ifelse(x$outlier$monthlytcrate == 0.7, " (Auto)", ""), "\n", sep = "") + cat("Method: ", x$outlier$method, ifelse(x$outlier$method == "ADDONE", " (Auto)", ""), "\n", sep = "") + } - if (!x$benchmarking$enabled) { - 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 = "") - } - return(invisible(x)) -} + cat("\n", "ARIMA", "\n", sep = "") -#' @export -print.JD3_X13_RSLTS <- function(x, digits = max(3L, getOption("digits") - 3L), - ...){ - - cat("RegARIMA","\n",sep="") - print(x$preprocessing, digits = digits, ...) - cat("\n", "Decomposition","\n",sep="") - print_x11_decomp(x, digits = digits, ...) - cat("\n", "Diagnostics","\n",sep="") - print_diagnostics(x, digits = digits, ...) - cat("\n", "Final","\n",sep="") - print_final(x, digits = digits, ...) - return(invisible(x)) -} + print(x$arima) -#' @export -print.JD3_X13_OUTPUT<- function(x, digits = max(3L, getOption("digits") - 3L), - ...){ - print(x$result, digits = digits, ...) - return(invisible(x)) + return(invisible(x)) } #' @export -print.JD3X11 <- function(x, ...) { - table <- do.call(cbind, x[grepl(pattern = "^d(\\d+)$", x = names(x))]) - - cat("Last values\n") - print(utils::tail(stats::.preformat.ts(table))) +print.JD3_X11_SPEC <- function(x, ...) { + cat("Specification X11", "\n", sep = "") - return(invisible(x)) -} + cat("Seasonal component: ", ifelse(x$seasonal, "Yes", "No"), "\n", sep = "") + cat("Length of the Henderson filter: ", x$henderson, "\n", sep = "") + cat("Seasonal filter: ", x$sfilters, "\n", sep = "") + cat( + "Boundaries used for extreme values correction :", + "\n\t lower_sigma: ", x$lsig, + "\n\t upper_sigma: ", x$usig + ) + cat("\n") + cat("Nb of forecasts: ", x$nfcasts, "\n", sep = "") + cat("Nb of backcasts: ", x$nbcasts, "\n", sep = "") + cat("Calendar sigma: ", x$sigma, "\n", sep = "") -#' @export -plot.JD3_X13_RSLTS <- function(x, first_date = NULL, last_date = NULL, - type_chart = c("sa-trend", "seas-irr"), - caption = c("sa-trend" = "Y, Sa, trend", - "seas-irr" = "Sea., irr.")[type_chart], - colors = c(y = "#F0B400", t = "#1E6C0B", sa = "#155692", - s = "#1E6C0B", i = "#155692"), - ...){ - plot(rjd3toolkit::sa_decomposition(x), - first_date = first_date, last_date = last_date, - type_chart = type_chart, - caption = caption, - colors = colors, - ...) -} -#' @export -plot.JD3_X13_OUTPUT <- function(x, first_date = NULL, last_date = NULL, - type_chart = c("sa-trend", "seas-irr"), - caption = c("sa-trend" = "Y, Sa, trend", - "seas-irr" = "Sea., irr.")[type_chart], - colors = c(y = "#F0B400", t = "#1E6C0B", sa = "#155692", - s = "#1E6C0B", i = "#155692"), - ...){ - plot(x$result, - first_date = first_date, last_date = last_date, - type_chart = type_chart, - caption = caption, - colors = colors, - ...) + return(invisible(x)) } -#' @importFrom rjd3toolkit diagnostics #' @export -diagnostics.JD3_X13_RSLTS<-function(x, ...){ - if (is.null(x)) return(NULL) - variance_decomposition <- x$diagnostics$vardecomposition - variance_decomposition <- matrix(unlist(variance_decomposition), - ncol = 1, - dimnames = list(names(variance_decomposition), "Component")) - residual_tests <- x$diagnostics[grep("test", names(x$diagnostics))] - residual_tests <- data.frame(Statistic = sapply(residual_tests, function(test) test[["value"]]), - P.value = sapply(residual_tests, function(test) test[["pvalue"]]), - Description = sapply(residual_tests, function(test) attr(test, "distribution"))) - list(preprocessing = rjd3toolkit::diagnostics(x$preprocessing), - variance_decomposition = variance_decomposition, - residual_tests = residual_tests) -} +print.JD3_X13_SPEC <- function(x, ...) { + print(x$regarima) -#' @export -diagnostics.JD3_X13_OUTPUT<-function(x, ...){ - return(rjd3toolkit::diagnostics(x$result, ...)) + cat("\n") + + print(x$x11) + + cat("\n", "Benchmarking", "\n", sep = "") + + if (x$benchmarking$enabled) { + cat("Enabled: Yes\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 = "") + } else { + cat("Is enabled: No\n") + } + + return(invisible(x)) } diff --git a/R/regarima_generic.R b/R/regarima_generic.R index 535868c..22e72de 100644 --- a/R/regarima_generic.R +++ b/R/regarima_generic.R @@ -1,66 +1,69 @@ #' @importFrom stats coef df.residual logLik residuals vcov nobs #' @export -coef.JD3_REGARIMA_OUTPUT <- function(object, component = c("regression", "arima", "both"), ...){ - coef(object$result, component = component, ...) +coef.JD3_REGARIMA_OUTPUT <- function(object, component = c("regression", "arima", "both"), ...) { + coef(object$result, component = component, ...) } #' @export logLik.JD3_REGARIMA_OUTPUT <- function(object, ...) { - logLik(object$result, ...) + logLik(object$result, ...) } #' @export -vcov.JD3_REGARIMA_OUTPUT <- function(object, ...){ - vcov(object$result, ...) +vcov.JD3_REGARIMA_OUTPUT <- function(object, ...) { + vcov(object$result, ...) } #' @export -df.residual.JD3_REGARIMA_OUTPUT <- function(object, ...){ - df.residual(object$result, ...) +df.residual.JD3_REGARIMA_OUTPUT <- function(object, ...) { + df.residual(object$result, ...) } #' @export -nobs.JD3_REGARIMA_OUTPUT <- function(object, ...){ - nobs(object$result, ...) +nobs.JD3_REGARIMA_OUTPUT <- function(object, ...) { + nobs(object$result, ...) } #' @export -residuals.JD3_REGARIMA_OUTPUT <- function(object, ...){ - residuals(object$result, ...) +residuals.JD3_REGARIMA_OUTPUT <- function(object, ...) { + residuals(object$result, ...) } #' @export -summary.JD3_REGARIMA_OUTPUT <- function(object, ...){ - summary(object$result, ...) +summary.JD3_REGARIMA_OUTPUT <- function(object, ...) { + x <- summary(object$result, ...) + x$method <- "RegARIMA" + x } #' @export -print.JD3_REGARIMA_OUTPUT <- function(x, ...){ - print(x$result, ...) +print.JD3_REGARIMA_OUTPUT <- function(x, summary_info = getOption("summary_info"), ...) { + cat("Method: RegARIMA\n") + print(x$result, summary_info = summary_info, ...) } #' @export -diagnostics.JD3_REGARIMA_OUTPUT <- function(x, ...){ - diagnostics(x$result, ...) +diagnostics.JD3_REGARIMA_OUTPUT <- function(x, ...) { + diagnostics(x$result, ...) } #' @export -coef.JD3_X13_OUTPUT <- function(object, component = c("regression", "arima", "both"), ...){ - coef(object$result$preprocessing, component = component, ...) +coef.JD3_X13_OUTPUT <- function(object, component = c("regression", "arima", "both"), ...) { + coef(object$result$preprocessing, component = component, ...) } #' @export logLik.JD3_X13_OUTPUT <- function(object, ...) { - logLik(object$result$preprocessing, ...) + logLik(object$result$preprocessing, ...) } #' @export -vcov.JD3_X13_OUTPUT <- function(object, ...){ - vcov(object$result$preprocessing, ...) +vcov.JD3_X13_OUTPUT <- function(object, ...) { + vcov(object$result$preprocessing, ...) } #' @export -df.residual.JD3_X13_OUTPUT <- function(object, ...){ - df.residual(object$result$preprocessing, ...) +df.residual.JD3_X13_OUTPUT <- function(object, ...) { + df.residual(object$result$preprocessing, ...) } #' @export -nobs.JD3_X13_OUTPUT <- function(object, ...){ - nobs(object$result$preprocessing, ...) +nobs.JD3_X13_OUTPUT <- function(object, ...) { + nobs(object$result$preprocessing, ...) } #' @export -residuals.JD3_X13_OUTPUT <- function(object, ...){ - residuals(object$result$preprocessing, ...) +residuals.JD3_X13_OUTPUT <- function(object, ...) { + residuals(object$result$preprocessing, ...) } #' @export -residuals.JD3_X13_OUTPUT <- function(object, ...){ - residuals(object$result$preprocessing, ...) +residuals.JD3_X13_OUTPUT <- function(object, ...) { + residuals(object$result$preprocessing, ...) } diff --git a/R/regarima_outliers.R b/R/regarima_outliers.R index 6a566ee..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,35 +22,51 @@ 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){ - 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) - } +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)) { + 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), - ao, ls, tc, so, cv, clean) - model<-list( - y=rjd3toolkit::.proc_ts(jregarima, "y"), - variables=rjd3toolkit::.proc_vector(jregarima, "variables"), - X=rjd3toolkit::.proc_matrix(jregarima, "regressors"), - b=rjd3toolkit::.proc_vector(jregarima, "b"), - bcov=rjd3toolkit::.proc_matrix(jregarima, "bvar"), - linearized=rjd3toolkit::.proc_vector(jregarima, "linearized") - ) + 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), + ao, ls, tc, so, cv, clean + ) + model <- list( + y = rjd3toolkit::.proc_ts(jregarima, "y"), + variables = rjd3toolkit::.proc_vector(jregarima, "variables"), + X = rjd3toolkit::.proc_matrix(jregarima, "regressors"), + b = rjd3toolkit::.proc_vector(jregarima, "b"), + bcov = rjd3toolkit::.proc_matrix(jregarima, "bvar"), + linearized = rjd3toolkit::.proc_vector(jregarima, "linearized") + ) - ll0<-rjd3toolkit::.proc_likelihood(jregarima, "initiallikelihood.") - ll1<-rjd3toolkit::.proc_likelihood(jregarima, "finallikelihood.") + ll0 <- rjd3toolkit::.proc_likelihood(jregarima, "initiallikelihood.") + ll1 <- rjd3toolkit::.proc_likelihood(jregarima, "finallikelihood.") - return(structure(list( - model=model, - likelihood=list(initial=ll0, final=ll1)), - class="JD3_REGARIMA_OUTLIERS")) + return(structure( + list( + model = model, + likelihood = list(initial = ll0, final = ll1) + ), + class = "JD3_REGARIMA_OUTLIERS" + )) } diff --git a/R/regarima_spec.R b/R/regarima_spec.R index 17b6a2e..76aa33e 100644 --- a/R/regarima_spec.R +++ b/R/regarima_spec.R @@ -1,111 +1,137 @@ #' @importFrom rjd3toolkit add_outlier #' @export add_outlier.JD3_X13_SPEC <- function(x, - ...){ - x$regarima <- add_outlier(x$regarima, - ...) - x + ...) { + x$regarima <- add_outlier( + x$regarima, + ... + ) + x } #' @importFrom rjd3toolkit remove_outlier #' @export remove_outlier.JD3_X13_SPEC <- function(x, - ...){ - x$regarima <- remove_outlier(x$regarima, - ...) - x + ...) { + x$regarima <- remove_outlier( + x$regarima, + ... + ) + x } #' @importFrom rjd3toolkit add_ramp #' @export add_ramp.JD3_X13_SPEC <- function(x, - ...){ - x$regarima <- add_ramp(x$regarima, - ...) - x + ...) { + x$regarima <- add_ramp( + x$regarima, + ... + ) + x } #' @importFrom rjd3toolkit remove_ramp #' @export remove_ramp.JD3_X13_SPEC <- function(x, - ...){ - x$regarima <- remove_ramp(x$regarima, - ...) - x + ...) { + x$regarima <- remove_ramp( + x$regarima, + ... + ) + x } #' @importFrom rjd3toolkit set_arima #' @export set_arima.JD3_X13_SPEC <- function(x, - ...){ - x$regarima <- set_arima(x$regarima, - ...) - x + ...) { + x$regarima <- set_arima( + x$regarima, + ... + ) + x } #' @importFrom rjd3toolkit set_automodel #' @export set_automodel.JD3_X13_SPEC <- function(x, - ...){ - x$regarima <- set_automodel(x$regarima, - ...) - x + ...) { + x$regarima <- set_automodel( + x$regarima, + ... + ) + x } #' @importFrom rjd3toolkit set_easter #' @export set_easter.JD3_X13_SPEC <- function(x, - ...){ - x$regarima <- set_easter(x$regarima, - ...) - x + ...) { + x$regarima <- set_easter( + x$regarima, + ... + ) + x } #' @importFrom rjd3toolkit set_estimate #' @export set_estimate.JD3_X13_SPEC <- function(x, - ...){ - x$regarima <- set_estimate(x$regarima, - ...) - x + ...) { + x$regarima <- set_estimate( + x$regarima, + ... + ) + x } #' @importFrom rjd3toolkit set_basic #' @export set_basic.JD3_X13_SPEC <- function(x, - ...){ - x$regarima <- set_basic(x$regarima, - ...) - x + ...) { + x$regarima <- set_basic( + x$regarima, + ... + ) + x } #' @importFrom rjd3toolkit set_outlier #' @export set_outlier.JD3_X13_SPEC <- function(x, - ...){ - x$regarima <- set_outlier(x$regarima, - ...) - x + ...) { + x$regarima <- set_outlier( + x$regarima, + ... + ) + x } #' @importFrom rjd3toolkit set_tradingdays #' @export set_tradingdays.JD3_X13_SPEC <- function(x, - ...){ - x$regarima <- set_tradingdays(x$regarima, - ...) - x + ...) { + x$regarima <- set_tradingdays( + x$regarima, + ... + ) + x } #' @importFrom rjd3toolkit set_transform #' @export set_transform.JD3_X13_SPEC <- function(x, - ...){ - x$regarima <- set_transform(x$regarima, - ...) - x + ...) { + x$regarima <- set_transform( + x$regarima, + ... + ) + x } #' @importFrom rjd3toolkit add_usrdefvar #' @export add_usrdefvar.JD3_X13_SPEC <- function(x, - ...){ - x$regarima <- add_usrdefvar(x$regarima, - ...) - x + ...) { + x$regarima <- add_usrdefvar( + x$regarima, + ... + ) + x } #' @importFrom rjd3toolkit set_benchmarking #' @export set_benchmarking.JD3_X13_SPEC <- function(x, ...) { - x$benchmarking <- set_benchmarking(x$benchmarking, ...) + x$benchmarking <- set_benchmarking(x$benchmarking, ...) - x + x } diff --git a/R/revisions.R b/R/revisions.R index bd7a881..3d36058 100644 --- a/R/revisions.R +++ b/R/revisions.R @@ -1,10 +1,12 @@ #' @include utils.R x13_spec.R x13_rslts.R NULL -.jrevisions<-function(jts, jspec, jcontext){ - jrslt<-.jcall("jdplus/x13/base/r/X13RevisionHistory", - "Ljdplus/toolkit/base/r/timeseries/Revisions;", "revisions", jts, jspec, jcontext) - return(jrslt) +.jrevisions <- function(jts, jspec, jcontext) { + jrslt <- .jcall( + "jdplus/x13/base/r/X13RevisionHistory", + "Ljdplus/toolkit/base/r/timeseries/Revisions;", "revisions", jts, jspec, jcontext + ) + return(jrslt) } @@ -38,55 +40,60 @@ NULL #' 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) #' @export -x13_revisions<-function(ts, spec, data_ids=NULL, ts_ids=NULL, cmp_ids=NULL, context=NULL){ - jts<-rjd3toolkit::.r2jd_tsdata(ts) - jspec<-.r2jd_spec_x13(spec) - if (is.null(context)){ - jcontext <- .jnull("jdplus/toolkit/base/api/timeseries/regression/ModellingContext") - } else { - jcontext <- rjd3toolkit::.r2jd_modellingcontext(context) - } - ldata<-NULL - jr<-.jrevisions(jts, jspec, jcontext) - if (! is.null(data_ids)){ - ldata<-lapply(data_ids, function(data_id){ - w<-.jcall(jr, "Ljdplus/toolkit/base/api/timeseries/TsData;", "history", data_id$id, data_id$start) - return(rjd3toolkit::.jd2r_tsdata(w)) - }) - names(ldata) <- sapply(data_ids, `[[`,"id") - } - 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) - return(rjd3toolkit::.jd2r_tsdata(w)) - }) - names(lts) <- sapply(ts_ids, `[[`,"id") - } - 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) - return(rjd3toolkit::.jd2r_mts(w)) - }) - names(lcmp) <- sapply(cmp_ids, `[[`,"id") - } +x13_revisions <- function(ts, spec, data_ids = NULL, ts_ids = NULL, cmp_ids = NULL, context = NULL) { + jts <- rjd3toolkit::.r2jd_tsdata(ts) + jspec <- .r2jd_spec_x13(spec) + if (is.null(context)) { + jcontext <- .jnull("jdplus/toolkit/base/api/timeseries/regression/ModellingContext") + } else { + jcontext <- rjd3toolkit::.r2jd_modellingcontext(context) + } + ldata <- NULL + jr <- .jrevisions(jts, jspec, jcontext) + if (!is.null(data_ids)) { + ldata <- lapply(data_ids, function(data_id) { + w <- .jcall(jr, "Ljdplus/toolkit/base/api/timeseries/TsData;", "history", data_id$id, data_id$start) + return(rjd3toolkit::.jd2r_tsdata(w)) + }) + names(ldata) <- sapply(data_ids, `[[`, "id") + } + 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) + return(rjd3toolkit::.jd2r_tsdata(w)) + }) + names(lts) <- sapply(ts_ids, `[[`, "id") + } + 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) + return(rjd3toolkit::.jd2r_mts(w)) + }) + names(lcmp) <- sapply(cmp_ids, `[[`, "id") + } - return(list(data=ldata, series=lts, components=lcmp)) + return(list(data = ldata, series = lts, components = lcmp)) } diff --git a/R/set_x11_spec.R b/R/set_x11_spec.R index da04b91..ac9d0ab 100644 --- a/R/set_x11_spec.R +++ b/R/set_x11_spec.R @@ -1,54 +1,76 @@ - #' 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()]. #' @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" +#' ) #' @rdname x11_spec #' @export set_x11 <- function(x, @@ -63,92 +85,103 @@ set_x11 <- function(x, calendar.sigma = c(NA, "None", "Signif", "All", "Select"), sigma.vector = NA, exclude.forecast = NA, - bias = c(NA, "LEGACY")){ - UseMethod("set_x11", x) + 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) - } +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 (!is.na(seasonal.comp) && is.logical(seasonal.comp)) { + x$seasonal <- seasonal.comp + } - if (!any(is.na(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 (!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(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 (!any(is.na(sigma.vector))) { - if (!all(sigma.vector %in% c(1, 2))) { - warning("sigma.vector must be equal to 1 or 2") - } else { - x$sigma <- "SELECT" - x$vsigmas <- as.integer(sigma.vector) + 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") + } + } + if (!is.na(bias)) { + x$bias <- bias } - } - if (!is.na(bias)) { - x$bias <- bias - } - x + x } #' @export set_x11.JD3_X13_SPEC <- function(x, ...) { - x$x11 <- set_x11(x$x11, ...) - x + x$x11 <- set_x11(x$x11, ...) + x } diff --git a/R/udvar.R b/R/udvar.R index f59b725..f00ecc3 100644 --- a/R/udvar.R +++ b/R/udvar.R @@ -1,201 +1,194 @@ -.add_ud_var <- function(x, jx, userdefined = NULL, out_class = NULL, result = FALSE){ - if (is.null(userdefined)) { - x$user_defined <- rjd3toolkit::user_defined(x, NULL) - } else { - if (result) { - res <- jx +.add_ud_var <- function(x, jx, userdefined = NULL, out_class = NULL, result = FALSE) { + if (is.null(userdefined)) { + x$user_defined <- rjd3toolkit::user_defined(x, NULL) } else { - if (is.null(out_class)) { - res <- jx$getResult() - } else { - res <- .jcall(jx, out_class, "getResult") - } + if (result) { + res <- jx + } else { + if (is.null(out_class)) { + res <- jx$getResult() + } else { + res <- .jcall(jx, out_class, "getResult") + } + } + res <- rjd3toolkit::.jd3_object(res, result = TRUE) + x$user_defined <- rjd3toolkit::user_defined(res, userdefined = userdefined) } - res <- rjd3toolkit::.jd3_object(res, result = TRUE) - x$user_defined <- rjd3toolkit::user_defined(res, userdefined = userdefined) - } - x + x } #' 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 +#' @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", - "arima.theta(*)", "benchmarking.original", "benchmarking.result", - "benchmarking.target", "cal", "cal_b", "cal_b(?)", "cal_f", "cal_f(?)", - "decomposition.b1", "decomposition.b10", "decomposition.b11", - "decomposition.b13", "decomposition.b17", "decomposition.b2", - "decomposition.b20", "decomposition.b3", "decomposition.b4", - "decomposition.b5", "decomposition.b6", "decomposition.b7", "decomposition.b8", - "decomposition.b9", "decomposition.c1", "decomposition.c10", - "decomposition.c11", "decomposition.c13", "decomposition.c17", - "decomposition.c2", "decomposition.c20", "decomposition.c4", - "decomposition.c5", "decomposition.c6", "decomposition.c7", "decomposition.c9", - "decomposition.d1", "decomposition.d10", "decomposition.d11", - "decomposition.d12", "decomposition.d13", "decomposition.d2", - "decomposition.d4", "decomposition.d5", "decomposition.d6", "decomposition.d7", - "decomposition.d8", "decomposition.d9", "decomposition.d9-global-msr", - "decomposition.d9-msr", "decomposition.d9-msr-table", "decomposition.i_cmp", - "decomposition.s_cmp", "decomposition.s_cmp_b", "decomposition.s_cmp_f", - "decomposition.sa_cmp", "decomposition.sa_cmp_b", "decomposition.sa_cmp_f", - "decomposition.seasonal-filters", "decomposition.si_cmp", "decomposition.t_cmp", - "decomposition.t_cmp_b", "decomposition.t_cmp_f", "decomposition.trend-filter", - "decomposition.x11-all", "decomposition.y_cmp", "decomposition.y_cmp_b", - "decomposition.y_cmp_f", "det", "det_b(?)", "det_f(?)", "det_i", - "det_i_b(?)", "det_i_f(?)", "det_s", "det_s_b(?)", "det_s_f(?)", - "det_t", "det_t_b(?)", "det_t_f(?)", "diagnostics.fcast-insample-mean", - "diagnostics.fcast-outsample-mean", "diagnostics.fcast-outsample-variance", - "diagnostics.seas-i-combined", "diagnostics.seas-i-combined3", - "diagnostics.seas-i-evolutive", "diagnostics.seas-i-f", "diagnostics.seas-i-friedman", - "diagnostics.seas-i-kw", "diagnostics.seas-i-periodogram", "diagnostics.seas-i-qs", - "diagnostics.seas-i-spectralpeaks", "diagnostics.seas-i-stable", - "diagnostics.seas-lin-combined", "diagnostics.seas-lin-evolutive", - "diagnostics.seas-lin-f", "diagnostics.seas-lin-friedman", "diagnostics.seas-lin-kw", - "diagnostics.seas-lin-periodogram", "diagnostics.seas-lin-qs", - "diagnostics.seas-lin-spectralpeaks", "diagnostics.seas-lin-stable", - "diagnostics.seas-res-combined", "diagnostics.seas-res-combined3", - "diagnostics.seas-res-evolutive", "diagnostics.seas-res-f", "diagnostics.seas-res-friedman", - "diagnostics.seas-res-kw", "diagnostics.seas-res-periodogram", - "diagnostics.seas-res-qs", "diagnostics.seas-res-spectralpeaks", - "diagnostics.seas-res-stable", "diagnostics.seas-sa-ac1", "diagnostics.seas-sa-combined", - "diagnostics.seas-sa-combined3", "diagnostics.seas-sa-evolutive", - "diagnostics.seas-sa-f", "diagnostics.seas-sa-friedman", "diagnostics.seas-sa-kw", - "diagnostics.seas-sa-periodogram", "diagnostics.seas-sa-qs", - "diagnostics.seas-sa-spectralpeaks", "diagnostics.seas-sa-stable", - "diagnostics.seas-si-combined", "diagnostics.seas-si-combined3", - "diagnostics.seas-si-evolutive", "diagnostics.seas-si-stable", - "diagnostics.td-i-all", "diagnostics.td-i-last", "diagnostics.td-res-all", - "diagnostics.td-res-last", "diagnostics.td-sa-all", "diagnostics.td-sa-last", - "ee", "ee_b(?)", "ee_f(?)", "finals.d11", "finals.d11a", "finals.d11b", - "finals.d12", "finals.d12a", "finals.d12b", "finals.d13", "finals.d16", - "finals.d16a", "finals.d16b", "finals.d18", "finals.d18a", "finals.d18b", - "finals.e1", "finals.e11", "finals.e2", "finals.e3", "i", "l", - "likelihood.adjustedll", "likelihood.aic", "likelihood.aicc", - "likelihood.bic", "likelihood.bic2", "likelihood.bicc", "likelihood.df", - "likelihood.hannanquinn", "likelihood.ll", "likelihood.neffectiveobs", - "likelihood.nobs", "likelihood.nparams", "likelihood.ssqerr", - "log", "m-statistics.m1", "m-statistics.m10", "m-statistics.m11", - "m-statistics.m2", "m-statistics.m3", "m-statistics.m4", "m-statistics.m5", - "m-statistics.m6", "m-statistics.m7", "m-statistics.m8", "m-statistics.m9", - "m-statistics.q", "m-statistics.q-m2", "mhe", "mhe_b(?)", "mhe_f(?)", - "omhe", "omhe_b(?)", "omhe_f(?)", "out", "out_b(?)", "out_f(?)", - "out_i", "out_i_b(?)", "out_i_f(?)", "out_s", "out_s_b(?)", "out_s_f(?)", - "out_t", "out_t_b(?)", "out_t_f(?)", "period", "preadjustment.a1", - "preadjustment.a1a", "preadjustment.a1b", "preadjustment.a6", - "preadjustment.a7", "preadjustment.a8", "preadjustment.a8i", - "preadjustment.a8s", "preadjustment.a8t", "preadjustment.a9", - "preadjustment.a9sa", "preadjustment.a9ser", "preadjustment.a9u", - "reg_i", "reg_i_b(?)", "reg_i_f(?)", "reg_s", "reg_s_b(?)", "reg_s_f(?)", - "reg_sa", "reg_sa_b(?)", "reg_sa_f(?)", "reg_t", "reg_t_b(?)", - "reg_t_f(?)", "reg_u", "reg_u_b(?)", "reg_u_f(?)", "reg_y", "reg_y_b(?)", - "reg_y_f(?)", "regression.description", "regression.details.coefficients", - "regression.details.covar", "regression.details.covar-ml", "regression.easter", - "regression.espan.end", "regression.espan.missing", "regression.espan.n", - "regression.espan.start", "regression.leaster", "regression.lp", - "regression.mean", "regression.missing(*)", "regression.ml.parameters", - "regression.ml.pcorr", "regression.ml.pcovar", "regression.ml.pcovar-ml", - "regression.ml.pscore", "regression.mu", "regression.nao", "regression.nlp", - "regression.nls", "regression.nmh", "regression.nout", "regression.nso", - "regression.ntc", "regression.ntd", "regression.nusers", "regression.out(*)", - "regression.outlier(*)", "regression.td(*)", "regression.type", - "regression.user(*)", "residuals.bp", "residuals.bp2", "residuals.doornikhansen", - "residuals.kurtosis", "residuals.lb", "residuals.lb2", "residuals.lruns", - "residuals.ludruns", "residuals.mean", "residuals.nruns", "residuals.nudruns", - "residuals.res", "residuals.seasbp", "residuals.seaslb", "residuals.ser", - "residuals.skewness", "residuals.tsres", "residuals.type", "s", - "s_b", "s_f", "sa", "sa_b", "sa_f", "span.end", "span.missing", - "span.n", "span.start", "t", "t_b", "t_f", "tde", "tde_b(?)", - "tde_f(?)", "variancedecomposition.cycle", "variancedecomposition.irregular", - "variancedecomposition.others", "variancedecomposition.seasonality", - "variancedecomposition.tdh", "variancedecomposition.total", "y", - "y_b", "y_b(?)", "y_eb(?)", "y_ef(?)", "y_f", "y_f(?)", "yc", - "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", - "arima.theta(*)", "cal", "cal_b(?)", "cal_f(?)", "det", "det_b(?)", - "det_f(?)", "det_i", "det_i_b(?)", "det_i_f(?)", "det_s", "det_s_b(?)", - "det_s_f(?)", "det_t", "det_t_b(?)", "det_t_f(?)", "ee", "ee_b(?)", - "ee_f(?)", "l", "likelihood.adjustedll", "likelihood.aic", "likelihood.aicc", - "likelihood.bic", "likelihood.bic2", "likelihood.bicc", "likelihood.df", - "likelihood.hannanquinn", "likelihood.ll", "likelihood.neffectiveobs", - "likelihood.nobs", "likelihood.nparams", "likelihood.ssqerr", - "log", "mhe", "mhe_b(?)", "mhe_f(?)", "omhe", "omhe_b(?)", "omhe_f(?)", - "out", "out_b(?)", "out_f(?)", "out_i", "out_i_b(?)", "out_i_f(?)", - "out_s", "out_s_b(?)", "out_s_f(?)", "out_t", "out_t_b(?)", "out_t_f(?)", - "period", "reg_i", "reg_i_b(?)", "reg_i_f(?)", "reg_s", "reg_s_b(?)", - "reg_s_f(?)", "reg_sa", "reg_sa_b(?)", "reg_sa_f(?)", "reg_t", - "reg_t_b(?)", "reg_t_f(?)", "reg_u", "reg_u_b(?)", "reg_u_f(?)", - "reg_y", "reg_y_b(?)", "reg_y_f(?)", "regression.description", - "regression.details.coefficients", "regression.details.covar", - "regression.details.covar-ml", "regression.easter", "regression.espan.end", - "regression.espan.missing", "regression.espan.n", "regression.espan.start", - "regression.leaster", "regression.lp", "regression.mean", "regression.missing(*)", - "regression.ml.parameters", "regression.ml.pcorr", "regression.ml.pcovar", - "regression.ml.pcovar-ml", "regression.ml.pscore", "regression.mu", - "regression.nao", "regression.nlp", "regression.nls", "regression.nmh", - "regression.nout", "regression.nso", "regression.ntc", "regression.ntd", - "regression.nusers", "regression.out(*)", "regression.outlier(*)", - "regression.td(*)", "regression.type", "regression.user(*)", - "residuals.bp", "residuals.bp2", "residuals.doornikhansen", "residuals.kurtosis", - "residuals.lb", "residuals.lb2", "residuals.lruns", "residuals.ludruns", - "residuals.mean", "residuals.nruns", "residuals.nudruns", "residuals.res", - "residuals.seasbp", "residuals.seaslb", "residuals.ser", "residuals.skewness", - "residuals.tsres", "residuals.type", "span.end", "span.missing", - "span.n", "span.start", "tde", "tde_b(?)", "tde_f(?)", "y", "y_b(?)", - "y_eb(?)", "y_ef(?)", "y_f(?)", "yc", "ycal", "ycal_f(?)") +#' +userdefined_variables_x13 <- function(x = c("X-13", "RegArima", "X-11")) { + x <- match.arg(gsub("-", "", tolower(x)), + choices = c("x13", "regarima", "x11") + ) + sa_x13 <- c( + "adjust", "arima.bd", "arima.bp", "arima.bphi(*)", "arima.bq", + "arima.btheta(*)", "arima.d", "arima.p", "arima.phi(*)", "arima.q", + "arima.theta(*)", "benchmarking.original", "benchmarking.result", + "benchmarking.target", "cal", "cal_b", "cal_b(?)", "cal_f", "cal_f(?)", + "decomposition.b1", "decomposition.b10", "decomposition.b11", + "decomposition.b13", "decomposition.b17", "decomposition.b2", + "decomposition.b20", "decomposition.b3", "decomposition.b4", + "decomposition.b5", "decomposition.b6", "decomposition.b7", "decomposition.b8", + "decomposition.b9", "decomposition.c1", "decomposition.c10", + "decomposition.c11", "decomposition.c13", "decomposition.c17", + "decomposition.c2", "decomposition.c20", "decomposition.c4", + "decomposition.c5", "decomposition.c6", "decomposition.c7", "decomposition.c9", + "decomposition.d1", "decomposition.d10", "decomposition.d11", + "decomposition.d12", "decomposition.d13", "decomposition.d2", + "decomposition.d4", "decomposition.d5", "decomposition.d6", "decomposition.d7", + "decomposition.d8", "decomposition.d9", "decomposition.d9-global-msr", + "decomposition.d9-msr", "decomposition.d9-msr-table", "decomposition.i_cmp", + "decomposition.s_cmp", "decomposition.s_cmp_b", "decomposition.s_cmp_f", + "decomposition.sa_cmp", "decomposition.sa_cmp_b", "decomposition.sa_cmp_f", + "decomposition.seasonal-filters", "decomposition.si_cmp", "decomposition.t_cmp", + "decomposition.t_cmp_b", "decomposition.t_cmp_f", "decomposition.trend-filter", + "decomposition.x11-all", "decomposition.y_cmp", "decomposition.y_cmp_b", + "decomposition.y_cmp_f", "det", "det_b(?)", "det_f(?)", "det_i", + "det_i_b(?)", "det_i_f(?)", "det_s", "det_s_b(?)", "det_s_f(?)", + "det_t", "det_t_b(?)", "det_t_f(?)", "diagnostics.fcast-insample-mean", + "diagnostics.fcast-outsample-mean", "diagnostics.fcast-outsample-variance", + "diagnostics.seas-i-combined", "diagnostics.seas-i-combined3", + "diagnostics.seas-i-evolutive", "diagnostics.seas-i-f", "diagnostics.seas-i-friedman", + "diagnostics.seas-i-kw", "diagnostics.seas-i-periodogram", "diagnostics.seas-i-qs", + "diagnostics.seas-i-spectralpeaks", "diagnostics.seas-i-stable", + "diagnostics.seas-lin-combined", "diagnostics.seas-lin-evolutive", + "diagnostics.seas-lin-f", "diagnostics.seas-lin-friedman", "diagnostics.seas-lin-kw", + "diagnostics.seas-lin-periodogram", "diagnostics.seas-lin-qs", + "diagnostics.seas-lin-spectralpeaks", "diagnostics.seas-lin-stable", + "diagnostics.seas-res-combined", "diagnostics.seas-res-combined3", + "diagnostics.seas-res-evolutive", "diagnostics.seas-res-f", "diagnostics.seas-res-friedman", + "diagnostics.seas-res-kw", "diagnostics.seas-res-periodogram", + "diagnostics.seas-res-qs", "diagnostics.seas-res-spectralpeaks", + "diagnostics.seas-res-stable", "diagnostics.seas-sa-ac1", "diagnostics.seas-sa-combined", + "diagnostics.seas-sa-combined3", "diagnostics.seas-sa-evolutive", + "diagnostics.seas-sa-f", "diagnostics.seas-sa-friedman", "diagnostics.seas-sa-kw", + "diagnostics.seas-sa-periodogram", "diagnostics.seas-sa-qs", + "diagnostics.seas-sa-spectralpeaks", "diagnostics.seas-sa-stable", + "diagnostics.seas-si-combined", "diagnostics.seas-si-combined3", + "diagnostics.seas-si-evolutive", "diagnostics.seas-si-stable", + "diagnostics.td-i-all", "diagnostics.td-i-last", "diagnostics.td-res-all", + "diagnostics.td-res-last", "diagnostics.td-sa-all", "diagnostics.td-sa-last", + "ee", "ee_b(?)", "ee_f(?)", "finals.d11", "finals.d11a", "finals.d11b", + "finals.d12", "finals.d12a", "finals.d12b", "finals.d13", "finals.d16", + "finals.d16a", "finals.d16b", "finals.d18", "finals.d18a", "finals.d18b", + "finals.e1", "finals.e11", "finals.e2", "finals.e3", "i", "l", + "likelihood.adjustedll", "likelihood.aic", "likelihood.aicc", + "likelihood.bic", "likelihood.bic2", "likelihood.bicc", "likelihood.df", + "likelihood.hannanquinn", "likelihood.ll", "likelihood.neffectiveobs", + "likelihood.nobs", "likelihood.nparams", "likelihood.ssqerr", + "log", "m-statistics.m1", "m-statistics.m10", "m-statistics.m11", + "m-statistics.m2", "m-statistics.m3", "m-statistics.m4", "m-statistics.m5", + "m-statistics.m6", "m-statistics.m7", "m-statistics.m8", "m-statistics.m9", + "m-statistics.q", "m-statistics.q-m2", "mhe", "mhe_b(?)", "mhe_f(?)", + "omhe", "omhe_b(?)", "omhe_f(?)", "out", "out_b(?)", "out_f(?)", + "out_i", "out_i_b(?)", "out_i_f(?)", "out_s", "out_s_b(?)", "out_s_f(?)", + "out_t", "out_t_b(?)", "out_t_f(?)", "period", "preadjustment.a1", + "preadjustment.a1a", "preadjustment.a1b", "preadjustment.a6", + "preadjustment.a7", "preadjustment.a8", "preadjustment.a8i", + "preadjustment.a8s", "preadjustment.a8t", "preadjustment.a9", + "preadjustment.a9sa", "preadjustment.a9ser", "preadjustment.a9u", + "reg_i", "reg_i_b(?)", "reg_i_f(?)", "reg_s", "reg_s_b(?)", "reg_s_f(?)", + "reg_sa", "reg_sa_b(?)", "reg_sa_f(?)", "reg_t", "reg_t_b(?)", + "reg_t_f(?)", "reg_u", "reg_u_b(?)", "reg_u_f(?)", "reg_y", "reg_y_b(?)", + "reg_y_f(?)", "regression.description", "regression.details.coefficients", + "regression.details.covar", "regression.details.covar-ml", "regression.easter", + "regression.espan.end", "regression.espan.missing", "regression.espan.n", + "regression.espan.start", "regression.leaster", "regression.lp", + "regression.mean", "regression.missing(*)", "regression.ml.parameters", + "regression.ml.pcorr", "regression.ml.pcovar", "regression.ml.pcovar-ml", + "regression.ml.pscore", "regression.mu", "regression.nao", "regression.nlp", + "regression.nls", "regression.nmh", "regression.nout", "regression.nso", + "regression.ntc", "regression.ntd", "regression.nusers", "regression.out(*)", + "regression.outlier(*)", "regression.td(*)", "regression.type", + "regression.user(*)", "residuals.bp", "residuals.bp2", "residuals.doornikhansen", + "residuals.kurtosis", "residuals.lb", "residuals.lb2", "residuals.lruns", + "residuals.ludruns", "residuals.mean", "residuals.nruns", "residuals.nudruns", + "residuals.res", "residuals.seasbp", "residuals.seaslb", "residuals.ser", + "residuals.skewness", "residuals.tsres", "residuals.type", "s", + "s_b", "s_f", "sa", "sa_b", "sa_f", "span.end", "span.missing", + "span.n", "span.start", "t", "t_b", "t_f", "tde", "tde_b(?)", + "tde_f(?)", "variancedecomposition.cycle", "variancedecomposition.irregular", + "variancedecomposition.others", "variancedecomposition.seasonality", + "variancedecomposition.tdh", "variancedecomposition.total", "y", + "y_b", "y_b(?)", "y_eb(?)", "y_ef(?)", "y_f", "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_regarima <- c( + "adjust", "arima.bd", "arima.bp", "arima.bphi(*)", "arima.bq", + "arima.btheta(*)", "arima.d", "arima.p", "arima.phi(*)", "arima.q", + "arima.theta(*)", "cal", "cal_b(?)", "cal_f(?)", "det", "det_b(?)", + "det_f(?)", "det_i", "det_i_b(?)", "det_i_f(?)", "det_s", "det_s_b(?)", + "det_s_f(?)", "det_t", "det_t_b(?)", "det_t_f(?)", "ee", "ee_b(?)", + "ee_f(?)", "l", "likelihood.adjustedll", "likelihood.aic", "likelihood.aicc", + "likelihood.bic", "likelihood.bic2", "likelihood.bicc", "likelihood.df", + "likelihood.hannanquinn", "likelihood.ll", "likelihood.neffectiveobs", + "likelihood.nobs", "likelihood.nparams", "likelihood.ssqerr", + "log", "mhe", "mhe_b(?)", "mhe_f(?)", "omhe", "omhe_b(?)", "omhe_f(?)", + "out", "out_b(?)", "out_f(?)", "out_i", "out_i_b(?)", "out_i_f(?)", + "out_s", "out_s_b(?)", "out_s_f(?)", "out_t", "out_t_b(?)", "out_t_f(?)", + "period", "reg_i", "reg_i_b(?)", "reg_i_f(?)", "reg_s", "reg_s_b(?)", + "reg_s_f(?)", "reg_sa", "reg_sa_b(?)", "reg_sa_f(?)", "reg_t", + "reg_t_b(?)", "reg_t_f(?)", "reg_u", "reg_u_b(?)", "reg_u_f(?)", + "reg_y", "reg_y_b(?)", "reg_y_f(?)", "regression.description", + "regression.details.coefficients", "regression.details.covar", + "regression.details.covar-ml", "regression.easter", "regression.espan.end", + "regression.espan.missing", "regression.espan.n", "regression.espan.start", + "regression.leaster", "regression.lp", "regression.mean", "regression.missing(*)", + "regression.ml.parameters", "regression.ml.pcorr", "regression.ml.pcovar", + "regression.ml.pcovar-ml", "regression.ml.pscore", "regression.mu", + "regression.nao", "regression.nlp", "regression.nls", "regression.nmh", + "regression.nout", "regression.nso", "regression.ntc", "regression.ntd", + "regression.nusers", "regression.out(*)", "regression.outlier(*)", + "regression.td(*)", "regression.type", "regression.user(*)", + "residuals.bp", "residuals.bp2", "residuals.doornikhansen", "residuals.kurtosis", + "residuals.lb", "residuals.lb2", "residuals.lruns", "residuals.ludruns", + "residuals.mean", "residuals.nruns", "residuals.nudruns", "residuals.res", + "residuals.seasbp", "residuals.seaslb", "residuals.ser", "residuals.skewness", + "residuals.tsres", "residuals.type", "span.end", "span.missing", + "span.n", "span.start", "tde", "tde_b(?)", "tde_f(?)", "y", "y_b(?)", + "y_eb(?)", "y_ef(?)", "y_f(?)", "yc", "ycal", "ycal_f(?)" + ) - sa_x11 <- c("b1", "b10", "b11", "b13", "b17", "b2", "b20", "b3", "b4", - "b5", "b6", "b7", "b8", "b9", "c1", "c10", "c11", "c13", "c17", - "c2", "c20", "c4", "c5", "c6", "c7", "c9", "d1", "d10", "d11", - "d12", "d13", "d2", "d4", "d5", "d6", "d7", "d8", "d9", "d9-global-msr", - "d9-msr", "d9-msr-table", "seasonal-filters", "trend-filter", - "x11-all") - switch(x, - x13 = sa_x13, - regarima = sa_regarima, - x11 = sa_x11 - ) + sa_x11 <- c( + "b1", "b10", "b11", "b13", "b17", "b2", "b20", "b3", "b4", + "b5", "b6", "b7", "b8", "b9", "c1", "c10", "c11", "c13", "c17", + "c2", "c20", "c4", "c5", "c6", "c7", "c9", "d1", "d10", "d11", + "d12", "d13", "d2", "d4", "d5", "d6", "d7", "d8", "d9", "d9-global-msr", + "d9-msr", "d9-msr-table", "seasonal-filters", "trend-filter", + "x11-all" + ) + switch(x, + x13 = sa_x13, + regarima = sa_regarima, + x11 = sa_x11 + ) } diff --git a/R/utils.R b/R/utils.R index f02d31d..4ff569e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -14,11 +14,11 @@ NULL #> NULL -identical_na <- function(x){ - identical(x, NA) || - identical(x, NA_character_) || - identical(x, NA_complex_) || - identical(x, NA_integer_) || - identical(x, NA_real_) || - identical(x, NaN) +identical_na <- function(x) { + identical(x, NA) || + identical(x, NA_character_) || + identical(x, NA_complex_) || + identical(x, NA_integer_) || + identical(x, NA_real_) || + identical(x, NaN) } diff --git a/R/x13.R b/R/x13.R index d72a57b..9fa15c0 100644 --- a/R/x13.R +++ b/R/x13.R @@ -4,92 +4,113 @@ 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 -#' 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) #' @export -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) - } else { - jspec<-.r2jd_spec_regarima(spec) - if (is.null(context)){ - jcontext <- .jnull("jdplus/toolkit/base/api/timeseries/regression/ModellingContext") +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) } else { - jcontext <- rjd3toolkit::.r2jd_modellingcontext(context) + jspec <- .r2jd_spec_regarima(spec) + if (is.null(context)) { + jcontext <- .jnull("jdplus/toolkit/base/api/timeseries/regression/ModellingContext") + } else { + jcontext <- rjd3toolkit::.r2jd_modellingcontext(context) + } + jrslt <- .jcall("jdplus/x13/base/r/RegArima", + "Ljdplus/x13/base/core/x13/regarima/RegArimaOutput;", + "fullProcess", jts, jspec, jcontext) + } + if (is.jnull(jrslt)) { + return(NULL) + } else { + res <- .regarima_output(jrslt) + return(.add_ud_var(res, jrslt, userdefined = userdefined)) } - jrslt<-.jcall("jdplus/x13/base/r/RegArima", "Ljdplus/x13/base/core/x13/regarima/RegArimaOutput;", "fullProcess", jts, jspec, jcontext) - } - if (is.jnull(jrslt)){ - return(NULL) - } else { - res <- .regarima_output(jrslt) - return(.add_ud_var(res, jrslt, userdefined = userdefined)) - } } #' @export #' @rdname regarima -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) - } else { - jspec<-.r2jd_spec_regarima(spec) - if (is.null(context)){ - jcontext <- .jnull("jdplus/toolkit/base/api/timeseries/regression/ModellingContext") +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) } else { - jcontext <- rjd3toolkit::.r2jd_modellingcontext(context) + jspec <- .r2jd_spec_regarima(spec) + if (is.null(context)) { + jcontext <- .jnull("jdplus/toolkit/base/api/timeseries/regression/ModellingContext") + } else { + jcontext <- rjd3toolkit::.r2jd_modellingcontext(context) + } + jrslt <- .jcall("jdplus/x13/base/r/RegArima", + "Ljdplus/toolkit/base/core/regsarima/regular/RegSarimaModel;", + "process", jts, jspec, jcontext) + } + if (is.jnull(jrslt)) { + return(NULL) + } else { + res <- .regarima_rslts(jrslt) + return(.add_ud_var(res, jrslt, userdefined = userdefined, result = TRUE)) } - jrslt<-.jcall("jdplus/x13/base/r/RegArima", "Ljdplus/toolkit/base/core/regsarima/regular/RegSarimaModel;", "process", jts, jspec, jcontext) - } - if (is.jnull(jrslt)){ - return(NULL) - } else { - res <- .regarima_rslts(jrslt) - return(.add_ud_var(res, jrslt, userdefined = userdefined, result = TRUE)) - } } -.regarima_output<-function(jq){ - if (is.jnull(jq)) - return(NULL) - q<-.jcall("jdplus/x13/base/r/RegArima", "[B", "toBuffer", jq) - p<-RProtoBuf::read(x13.RegArimaOutput, q) - return(structure(list( - result=rjd3toolkit::.p2r_regarima_rslts(p$result), - estimation_spec=.p2r_spec_regarima(p$estimation_spec), - result_spec=.p2r_spec_regarima(p$result_spec) - ), - class="JD3_REGARIMA_OUTPUT") - ) +.regarima_output <- function(jq) { + if (is.jnull(jq)) { + return(NULL) + } + q <- .jcall("jdplus/x13/base/r/RegArima", "[B", "toBuffer", jq) + p <- RProtoBuf::read(x13.RegArimaOutput, q) + return(structure( + list( + result = rjd3toolkit::.p2r_regarima_rslts(p$result), + estimation_spec = .p2r_spec_regarima(p$estimation_spec), + result_spec = .p2r_spec_regarima(p$result_spec) + ), + class = "JD3_REGARIMA_OUTPUT" + )) } #' Seasonal Adjustment with X13-ARIMA @@ -99,127 +120,150 @@ regarima_fast<-function(ts, spec= c("rg4", "rg0", "rg1", "rg2c", "rg3","rg5c"), #' #' #' @examples -#' 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" +#' 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" +#' ) +#' 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) #' -#' @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){ - 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) - } else { - jspec<-.r2jd_spec_x13(spec) - if (is.null(context)){ - jcontext <- .jnull("jdplus/toolkit/base/api/timeseries/regression/ModellingContext") +#' +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) + } else { + jspec <- .r2jd_spec_x13(spec) + if (is.null(context)) { + jcontext <- .jnull("jdplus/toolkit/base/api/timeseries/regression/ModellingContext") + } else { + jcontext <- rjd3toolkit::.r2jd_modellingcontext(context) + } + jrslt <- .jcall("jdplus/x13/base/r/X13", + "Ljdplus/x13/base/core/x13/X13Output;", + "fullProcess", jts, jspec, jcontext) + } + if (is.jnull(jrslt)) { + return(NULL) } else { - jcontext <- rjd3toolkit::.r2jd_modellingcontext(context) + res <- .x13_output(jrslt) + return(.add_ud_var(res, jrslt, userdefined = userdefined, out_class = "Ljdplus/x13/base/core/x13/X13Results;")) } - jrslt<-.jcall("jdplus/x13/base/r/X13", "Ljdplus/x13/base/core/x13/X13Output;", "fullProcess", jts, jspec, jcontext) - } - if (is.jnull(jrslt)){ - return(NULL) - } else { - res <- .x13_output(jrslt) - return(.add_ud_var(res, jrslt, userdefined = userdefined, out_class = "Ljdplus/x13/base/core/x13/X13Results;")) - } } #' @export #' @rdname x13 -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) - 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/X13Results;", "process", jts, spec) - } else { - jspec<-.r2jd_spec_x13(spec) - if (is.null(context)){ - jcontext <- .jnull("jdplus/toolkit/base/api/timeseries/regression/ModellingContext") +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) + 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/X13Results;", "process", jts, spec) + } else { + jspec <- .r2jd_spec_x13(spec) + if (is.null(context)) { + jcontext <- .jnull("jdplus/toolkit/base/api/timeseries/regression/ModellingContext") + } else { + jcontext <- rjd3toolkit::.r2jd_modellingcontext(context) + } + jrslt <- .jcall("jdplus/x13/base/r/X13", + "Ljdplus/x13/base/core/x13/X13Results;", + "process", jts, jspec, jcontext) + } + if (is.jnull(jrslt)) { + return(NULL) } else { - jcontext <- rjd3toolkit::.r2jd_modellingcontext(context) + res <- .x13_rslts(jrslt) + return(.add_ud_var(res, jrslt, userdefined = userdefined, result = TRUE)) } - jrslt<-.jcall("jdplus/x13/base/r/X13", "Ljdplus/x13/base/core/x13/X13Results;", "process", jts, jspec, jcontext) - } - if (is.jnull(jrslt)){ - return(NULL) - } else { - res <- .x13_rslts(jrslt) - return(.add_ud_var(res, jrslt, userdefined = userdefined, result = TRUE)) - } } #' @export #' @rdname x13 -.jx13<-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) - } else { - jspec<-.r2jd_spec_x13(spec) - if (is.null(context)){ - jcontext <- .jnull("jdplus/toolkit/base/api/timeseries/regression/ModellingContext") +.jx13 <- 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) } else { - jcontext <- rjd3toolkit::.r2jd_modellingcontext(context) + jspec <- .r2jd_spec_x13(spec) + if (is.null(context)) { + jcontext <- .jnull("jdplus/toolkit/base/api/timeseries/regression/ModellingContext") + } else { + jcontext <- rjd3toolkit::.r2jd_modellingcontext(context) + } + jrslt <- .jcall("jdplus/x13/base/r/X13", + "Ljdplus/x13/base/core/x13/X13Output;", + "fullProcess", jts, jspec, jcontext) + } + if (is.jnull(jrslt)) { + return(NULL) + } else { + jrslt <- .jcall(jrslt, "Ljdplus/x13/base/core/x13/X13Results;", "getResult") + res <- rjd3toolkit::.jd3_object(jrslt, result = TRUE) + return(res) } - jrslt<-.jcall("jdplus/x13/base/r/X13", "Ljdplus/x13/base/core/x13/X13Output;", "fullProcess", jts, jspec, jcontext) - } - if (is.jnull(jrslt)){ - return(NULL) - } else { - jrslt <- .jcall(jrslt, "Ljdplus/x13/base/core/x13/X13Results;", "getResult") - res <- rjd3toolkit::.jd3_object(jrslt, result = TRUE) - return(res) - } } -.x13_output<-function(jq){ - if (is.jnull(jq)) - return(NULL) - q<-.jcall("jdplus/x13/base/r/X13", "[B", "toBuffer", jq) - p<-RProtoBuf::read(x13.X13Output, q) - return(structure(list( - result=.p2r_x13_rslts(p$result), - estimation_spec=.p2r_spec_x13(p$estimation_spec), - result_spec=.p2r_spec_x13(p$result_spec) - ), - class="JD3_X13_OUTPUT") - ) - +.x13_output <- function(jq) { + if (is.jnull(jq)) { + return(NULL) + } + q <- .jcall("jdplus/x13/base/r/X13", "[B", "toBuffer", jq) + p <- RProtoBuf::read(x13.X13Output, q) + return(structure( + list( + result = .p2r_x13_rslts(p$result), + estimation_spec = .p2r_spec_x13(p$estimation_spec), + result_spec = .p2r_spec_x13(p$result_spec) + ), + class = "JD3_X13_OUTPUT" + )) } #' X-11 Decomposition Algorithm @@ -234,59 +278,81 @@ x13_fast<-function(ts, spec=c("rsa4", "rsa0", "rsa1", "rsa2c", "rsa3", "rsa5c"), #' x11_spec <- set_x11(x11_spec, henderson.filter = 13) #' x11(y, x11_spec) #' @export -x11 <- function(ts, spec = x11_spec(), userdefined = NULL){ - jts<-rjd3toolkit::.r2jd_tsdata(ts) - jspec<-.r2jd_spec_x11(spec) - jrslt<-.jcall("jdplus/x13/base/r/X11", "Ljdplus/x13/base/core/x11/X11Results;", "process", jts, jspec) - if (is.jnull(jrslt)){ - return(NULL) - } else { - res <- .x11_rslts(jrslt) - return(.add_ud_var(res, jrslt, userdefined = userdefined, result = TRUE)) - } +x11 <- function(ts, spec = x11_spec(), userdefined = NULL) { + jts <- rjd3toolkit::.r2jd_tsdata(ts) + jspec <- .r2jd_spec_x11(spec) + jrslt <- .jcall("jdplus/x13/base/r/X11", "Ljdplus/x13/base/core/x11/X11Results;", "process", jts, jspec) + if (is.jnull(jrslt)) { + return(NULL) + } else { + res <- .x11_rslts(jrslt) + return(.add_ud_var(res, jrslt, userdefined = userdefined, result = TRUE)) + } } #' 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"`. #' @@ -295,114 +361,137 @@ x11 <- function(ts, spec = x11_spec(), userdefined = NULL){ #' \url{https://jdemetra-new-documentation.netlify.app/t-rev-policies-production} #' #' @examples -#'y<- rjd3toolkit::ABS$X0.2.08.10.M -#'# raw series for first estimation -#'y_raw <-window(y,end = c(2016,12)) -#'# raw series for second (refreshed) estimation -#'y_new <-window(y,end = c(2017,6)) -#'# specification for first estimation -#'spec_x13_1<-x13_spec("rsa5c") -#'# first estimation -#'sa_x13<- x13(y_raw, spec_x13_1) +#' y <- rjd3toolkit::ABS$X0.2.08.10.M +#' # raw series for first estimation +#' y_raw <- window(y, end = c(2016, 12)) +#' # raw series for second (refreshed) estimation +#' y_new <- window(y, end = c(2017, 6)) +#' # specification for first estimation +#' spec_x13_1 <- x13_spec("rsa5c") +#' # first estimation +#' 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) #' #' @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){ - 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") - - } else { - if (!inherits(refspec, "JD3_REGARIMA_SPEC")) - stop("Invalid specification type") - jrefspec<-.r2jd_spec_regarima(refspec) - } - if (policy == 'Current'){ - if (end[2] == period) end<-c(end[1]+1, 1) else end<-c(end[1], end[2]+1) - jdom<-rjd3toolkit::.jdomain(period, start, end) - } - else if (policy == 'Outliers') - jdom<-rjd3toolkit::.jdomain(period, NULL, start) - 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) - return(.jd2r_spec_regarima(jnspec)) +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") + } else { + if (!inherits(refspec, "JD3_REGARIMA_SPEC")) { + stop("Invalid specification type") + } + jrefspec <- .r2jd_spec_regarima(refspec) + } + if (policy == "Current") { + if (end[2] == period) end <- c(end[1] + 1, 1) else end <- c(end[1], end[2] + 1) + jdom <- rjd3toolkit::.jdomain(period, start, end) + } else if (policy == "Outliers") { + jdom <- rjd3toolkit::.jdomain(period, NULL, start) + } 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) + 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){ - policy <- match.arg(policy) - if (!inherits(spec, "JD3_X13_SPEC")) - stop("Invalid specification type") - jspec<-.r2jd_spec_x13(spec) - if (is.null(refspec)){ - jrefspec<-.jcall("jdplus/x13/base/api/x13/X13Spec", "Ljdplus/x13/base/api/x13/X13Spec;", "fromString", "rsa4") - - } else { - if (!inherits(refspec, "JD3_X13_SPEC")) - stop("Invalid specification type") - jrefspec<-.r2jd_spec_x13(refspec) - } - if (policy == 'Current'){ - if (end[2] == period) end<-c(end[1]+1, 1) else end<-c(end[1], end[2]+1) - jdom<-rjd3toolkit::.jdomain(period, start, end) - } - else if (policy %in% c('Outliers', "Outliers_StochasticComponent")) - jdom<-rjd3toolkit::.jdomain(period, NULL, start) - else - jdom<-rjd3toolkit::.jdomain(0, NULL, NULL) - jnspec<-.jcall( - obj = "jdplus/x13/base/r/X13", - returnSig = "Ljdplus/x13/base/api/x13/X13Spec;", - method = "refreshSpec", - jspec, jrefspec, jdom, policy) - return(.jd2r_spec_x13(jnspec)) +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") + } + jspec <- .r2jd_spec_x13(spec) + if (is.null(refspec)) { + jrefspec <- .jcall("jdplus/x13/base/api/x13/X13Spec", "Ljdplus/x13/base/api/x13/X13Spec;", "fromString", "rsa4") + } else { + if (!inherits(refspec, "JD3_X13_SPEC")) { + stop("Invalid specification type") + } + jrefspec <- .r2jd_spec_x13(refspec) + } + if (policy == "Current") { + if (end[2] == period) end <- c(end[1] + 1, 1) else end <- c(end[1], end[2] + 1) + jdom <- rjd3toolkit::.jdomain(period, start, end) + } else if (policy %in% c("Outliers", "Outliers_StochasticComponent")) { + jdom <- rjd3toolkit::.jdomain(period, NULL, start) + } else { + jdom <- rjd3toolkit::.jdomain(0, NULL, NULL) + } + jnspec <- .jcall( + obj = "jdplus/x13/base/r/X13", + returnSig = "Ljdplus/x13/base/api/x13/X13Spec;", + method = "refreshSpec", + jspec, jrefspec, jdom, policy + ) + return(.jd2r_spec_x13(jnspec)) } #' X-13 Dictionary #' #' @return A vector containing the names of all the available output objects (series, diagnostics, parameters). #' @export -x13_dictionary<-function(){ - return(.jcall("jdplus/x13/base/r/X13","[S", "dictionary")) +x13_dictionary <- function() { + return(.jcall("jdplus/x13/base/r/X13", "[S", "dictionary")) } #' Title @@ -411,10 +500,10 @@ x13_dictionary<-function(){ #' @export #' #' @examples -x13_full_dictionary<-function(){ - q<-.jcall("jdplus/x13/base/r/X13","[S", "fullDictionary") - q<-`dim<-`(q, c(6, length(q)/6)) - q<-t(q) - q<-`colnames<-`(q, c("name", "description", "detail", "output", "type", "fullname")) - return(q) +x13_full_dictionary <- function() { + q <- .jcall("jdplus/x13/base/r/X13", "[S", "fullDictionary") + q <- `dim<-`(q, c(6, length(q) / 6)) + q <- t(q) + q <- `colnames<-`(q, c("name", "description", "detail", "output", "type", "fullname")) + return(q) } diff --git a/R/x13_rslts.R b/R/x13_rslts.R index 7387d65..eebda70 100644 --- a/R/x13_rslts.R +++ b/R/x13_rslts.R @@ -2,96 +2,99 @@ #' @importFrom rjd3toolkit sa_decomposition NULL -.regarima_rslts <- function(jrslts){ - if (is.jnull(jrslts)) - return(NULL) - q<-.jcall("jdplus/x13/base/r/RegArima", "[B", "toBuffer", jrslts) - rq<-RProtoBuf::read(regarima.RegArimaModel, q) - return(rjd3toolkit::.p2r_regarima_rslts(rq)) +.regarima_rslts <- function(jrslts) { + if (is.jnull(jrslts)) { + return(NULL) + } + q <- .jcall("jdplus/x13/base/r/RegArima", "[B", "toBuffer", jrslts) + rq <- RProtoBuf::read(regarima.RegArimaModel, q) + return(rjd3toolkit::.p2r_regarima_rslts(rq)) } #' @export #' @rdname jd3_utilities -.x13_rslts<-function(jrslts){ - if (is.jnull(jrslts)) - return(NULL) - q<-.jcall("jdplus/x13/base/r/X13", "[B", "toBuffer", jrslts) - rq<-RProtoBuf::read(x13.X13Results, q) - return(.p2r_x13_rslts(rq)) +.x13_rslts <- function(jrslts) { + if (is.jnull(jrslts)) { + return(NULL) + } + q <- .jcall("jdplus/x13/base/r/X13", "[B", "toBuffer", jrslts) + rq <- RProtoBuf::read(x13.X13Results, q) + return(.p2r_x13_rslts(rq)) } -.x11_rslts<-function(jrslts){ - if (is.jnull(jrslts)) - return(NULL) - q<-.jcall("jdplus/x13/base/r/X11", "[B", "toBuffer", jrslts) - rq<-RProtoBuf::read(x13.X11Results, q) - return(.p2r_x11_rslts(rq)) +.x11_rslts <- function(jrslts) { + if (is.jnull(jrslts)) { + return(NULL) + } + q <- .jcall("jdplus/x13/base/r/X11", "[B", "toBuffer", jrslts) + rq <- RProtoBuf::read(x13.X11Results, q) + return(.p2r_x11_rslts(rq)) } -.p2r_x13_rslts<-function(p){ - - return(structure( - list( - preprocessing=rjd3toolkit::.p2r_regarima_rslts(p$preprocessing), - preadjust=.p2r_x13_preadjust(p$preadjustment), - decomposition=.p2r_x11_rslts(p$decomposition), - final=.p2r_x13_final(p$final), - mstats=p$diagnostics_x13$mstatistics$as.list(), - diagnostics=rjd3toolkit::.p2r_sa_diagnostics(p$diagnostics_sa) - ) - , - class= "JD3_X13_RSLTS")) +.p2r_x13_rslts <- function(p) { + return(structure( + list( + preprocessing = rjd3toolkit::.p2r_regarima_rslts(p$preprocessing), + preadjust = .p2r_x13_preadjust(p$preadjustment), + decomposition = .p2r_x11_rslts(p$decomposition), + final = .p2r_x13_final(p$final), + mstats = p$diagnostics_x13$mstatistics$as.list(), + diagnostics = rjd3toolkit::.p2r_sa_diagnostics(p$diagnostics_sa) + ), + class = "JD3_X13_RSLTS" + )) } -.p2r_x11_rslts<-function(p){ - return(structure( - list( - d1=rjd3toolkit::.p2r_tsdata(p$d1), - d2=rjd3toolkit::.p2r_tsdata(p$d2), - d4=rjd3toolkit::.p2r_tsdata(p$d4), - d5=rjd3toolkit::.p2r_tsdata(p$d5), - d6=rjd3toolkit::.p2r_tsdata(p$d6), - d7=rjd3toolkit::.p2r_tsdata(p$d7), - d8=rjd3toolkit::.p2r_tsdata(p$d8), - d9=rjd3toolkit::.p2r_tsdata(p$d9), - d10=rjd3toolkit::.p2r_tsdata(p$d10), - d11=rjd3toolkit::.p2r_tsdata(p$d11), - d12=rjd3toolkit::.p2r_tsdata(p$d12), - d13=rjd3toolkit::.p2r_tsdata(p$d13), - final_seasonal=p$final_seasonal_filters, - final_henderson=p$final_henderson_filter - ), - class= "JD3X11")) +.p2r_x11_rslts <- function(p) { + return(structure( + list( + d1 = rjd3toolkit::.p2r_tsdata(p$d1), + d2 = rjd3toolkit::.p2r_tsdata(p$d2), + d4 = rjd3toolkit::.p2r_tsdata(p$d4), + d5 = rjd3toolkit::.p2r_tsdata(p$d5), + d6 = rjd3toolkit::.p2r_tsdata(p$d6), + d7 = rjd3toolkit::.p2r_tsdata(p$d7), + d8 = rjd3toolkit::.p2r_tsdata(p$d8), + d9 = rjd3toolkit::.p2r_tsdata(p$d9), + d10 = rjd3toolkit::.p2r_tsdata(p$d10), + d11 = rjd3toolkit::.p2r_tsdata(p$d11), + d12 = rjd3toolkit::.p2r_tsdata(p$d12), + d13 = rjd3toolkit::.p2r_tsdata(p$d13), + final_seasonal = p$final_seasonal_filters, + final_henderson = p$final_henderson_filter + ), + class = "JD3X11" + )) } -.p2r_x13_final<-function(p){ - return(list( - d11final=rjd3toolkit::.p2r_tsdata(p$d11final), - d12final=rjd3toolkit::.p2r_tsdata(p$d12final), - d13final=rjd3toolkit::.p2r_tsdata(p$d13final), - d16=rjd3toolkit::.p2r_tsdata(p$d16), - d18=rjd3toolkit::.p2r_tsdata(p$d18), - d11a=rjd3toolkit::.p2r_tsdata(p$d11a), - d12a=rjd3toolkit::.p2r_tsdata(p$d12a), - d16a=rjd3toolkit::.p2r_tsdata(p$d16a), - d18a=rjd3toolkit::.p2r_tsdata(p$d18a), - e1=rjd3toolkit::.p2r_tsdata(p$e1), - e2=rjd3toolkit::.p2r_tsdata(p$e2), - e3=rjd3toolkit::.p2r_tsdata(p$e3), - e11=rjd3toolkit::.p2r_tsdata(p$e11) +.p2r_x13_final <- function(p) { + return(list( + d11final = rjd3toolkit::.p2r_tsdata(p$d11final), + d12final = rjd3toolkit::.p2r_tsdata(p$d12final), + d13final = rjd3toolkit::.p2r_tsdata(p$d13final), + d16 = rjd3toolkit::.p2r_tsdata(p$d16), + d18 = rjd3toolkit::.p2r_tsdata(p$d18), + d11a = rjd3toolkit::.p2r_tsdata(p$d11a), + d12a = rjd3toolkit::.p2r_tsdata(p$d12a), + d16a = rjd3toolkit::.p2r_tsdata(p$d16a), + d18a = rjd3toolkit::.p2r_tsdata(p$d18a), + e1 = rjd3toolkit::.p2r_tsdata(p$e1), + e2 = rjd3toolkit::.p2r_tsdata(p$e2), + e3 = rjd3toolkit::.p2r_tsdata(p$e3), + e11 = rjd3toolkit::.p2r_tsdata(p$e11) )) } -.p2r_x13_preadjust<-function(p){ - return(list( - a1=rjd3toolkit::.p2r_tsdata(p$a1), - a1a=rjd3toolkit::.p2r_tsdata(p$a1a), - a1b=rjd3toolkit::.p2r_tsdata(p$a1b), - a6=rjd3toolkit::.p2r_tsdata(p$a6), - a7=rjd3toolkit::.p2r_tsdata(p$a7), - a8=rjd3toolkit::.p2r_tsdata(p$a8), - a9=rjd3toolkit::.p2r_tsdata(p$a9) +.p2r_x13_preadjust <- function(p) { + return(list( + a1 = rjd3toolkit::.p2r_tsdata(p$a1), + a1a = rjd3toolkit::.p2r_tsdata(p$a1a), + a1b = rjd3toolkit::.p2r_tsdata(p$a1b), + a6 = rjd3toolkit::.p2r_tsdata(p$a6), + a7 = rjd3toolkit::.p2r_tsdata(p$a7), + a8 = rjd3toolkit::.p2r_tsdata(p$a8), + a9 = rjd3toolkit::.p2r_tsdata(p$a9) )) } @@ -100,19 +103,21 @@ NULL #' @export #' @importFrom rjd3toolkit sa_decomposition -sa_decomposition.JD3_X13_RSLTS<-function(x, ...){ - if (is.null(x)) return(NULL) - return(rjd3toolkit::sadecomposition(x$preadjust$a1, #y - x$final$d11final, #sa - x$final$d12final, #t - x$final$d16, #s - x$final$d13final, #i - x$preprocessing$description$log - )) - +sa_decomposition.JD3_X13_RSLTS <- function(x, ...) { + if (is.null(x)) { + return(NULL) + } + return(rjd3toolkit::sadecomposition( + x$preadjust$a1, # y + x$final$d11final, # sa + x$final$d12final, # t + x$final$d16, # s + x$final$d13final, # i + x$preprocessing$description$log + )) } #' @export -sa_decomposition.JD3_X13_OUTPUT<-function(x, ...){ - return(rjd3toolkit::sa_decomposition(x$result, ...)) +sa_decomposition.JD3_X13_OUTPUT <- function(x, ...) { + return(rjd3toolkit::sa_decomposition(x$result, ...)) } diff --git a/R/x13_spec.R b/R/x13_spec.R index 1c69933..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,307 +44,329 @@ 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 #' @rdname x13_spec #' @export -regarima_spec<-function(name=c("rg4","rg0", "rg1", "rg2c", "rg3", "rg5c")){ +regarima_spec <- function(name = c("rg4", "rg0", "rg1", "rg2c", "rg3", "rg5c")) { name <- gsub("sa", "g", tolower(name), fixed = TRUE) name <- match.arg(name[1], - choices = c("rg0", "rg1", "rg2c", "rg3","rg4", "rg5c") + 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))) } #' @rdname x13_spec #' @export -x13_spec<-function(name = c("rsa4","rsa0", "rsa1", "rsa2c", "rsa3", "rsa5c")){ +x13_spec <- function(name = c("rsa4", "rsa0", "rsa1", "rsa2c", "rsa3", "rsa5c")) { name <- gsub("g", "sa", tolower(name), fixed = TRUE) name <- match.arg(name[1], - choices = c("rsa0", "rsa1", "rsa2c", "rsa3","rsa4", "rsa5c") + 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))) } #' @rdname x13_spec #' @export -x11_spec<-function(){ +x11_spec <- function() { return(.jd2r_spec_x11(.jfield("jdplus/x13/base/api/x11/X11Spec", "Ljdplus/x13/base/api/x11/X11Spec;", "DEFAULT"))) } #' @export #' @rdname jd3_utilities -.jd2r_spec_x11<-function(jspec){ - b<-.jcall("jdplus/x13/base/r/X11", "[B", "toBuffer", jspec) - p<-RProtoBuf::read(x13.X11Spec, b) +.jd2r_spec_x11 <- function(jspec) { + b <- .jcall("jdplus/x13/base/r/X11", "[B", "toBuffer", jspec) + p <- RProtoBuf::read(x13.X11Spec, b) return(.p2r_spec_x11(p)) } #' @export #' @rdname jd3_utilities -.r2jd_spec_x11<-function(spec){ - p<-.r2p_spec_x11(spec) - b<-RProtoBuf::serialize(p, NULL) - nspec<-.jcall("jdplus/x13/base/r/X11", "Ljdplus/x13/base/api/x11/X11Spec;", "of", b) +.r2jd_spec_x11 <- function(spec) { + p <- .r2p_spec_x11(spec) + b <- RProtoBuf::serialize(p, NULL) + nspec <- .jcall("jdplus/x13/base/r/X11", "Ljdplus/x13/base/api/x11/X11Spec;", "of", b) return(nspec) } #' @export #' @rdname jd3_utilities -.r2jd_spec_regarima<-function(spec){ - p<-.r2p_spec_regarima(spec) - b<-RProtoBuf::serialize(p, NULL) - nspec<-.jcall("jdplus/x13/base/r/RegArima", "Ljdplus/x13/base/api/regarima/RegArimaSpec;", "specOf", b) +.r2jd_spec_regarima <- function(spec) { + p <- .r2p_spec_regarima(spec) + b <- RProtoBuf::serialize(p, NULL) + nspec <- .jcall("jdplus/x13/base/r/RegArima", "Ljdplus/x13/base/api/regarima/RegArimaSpec;", "specOf", b) return(nspec) } #' @export #' @rdname jd3_utilities -.jd2r_spec_regarima<-function(jspec){ - b<-.jcall("jdplus/x13/base/r/RegArima", "[B", "toBuffer", jspec) - p<-RProtoBuf::read(x13.RegArimaSpec, b) +.jd2r_spec_regarima <- function(jspec) { + b <- .jcall("jdplus/x13/base/r/RegArima", "[B", "toBuffer", jspec) + p <- RProtoBuf::read(x13.RegArimaSpec, b) return(.p2r_spec_regarima(p)) } #' @export #' @rdname jd3_utilities -.r2jd_spec_x13<-function(spec){ - p<-.r2p_spec_x13(spec) - b<-RProtoBuf::serialize(p, NULL) - nspec<-.jcall("jdplus/x13/base/r/X13", "Ljdplus/x13/base/api/x13/X13Spec;", "specOf", b) +.r2jd_spec_x13 <- function(spec) { + p <- .r2p_spec_x13(spec) + b <- RProtoBuf::serialize(p, NULL) + nspec <- .jcall("jdplus/x13/base/r/X13", "Ljdplus/x13/base/api/x13/X13Spec;", "specOf", b) return(nspec) } #' @export #' @rdname jd3_utilities -.jd2r_spec_x13<-function(jspec){ - b<-.jcall("jdplus/x13/base/r/X13", "[B", "toBuffer", jspec) - p<-RProtoBuf::read(x13.Spec, b) +.jd2r_spec_x13 <- function(jspec) { + b <- .jcall("jdplus/x13/base/r/X13", "[B", "toBuffer", jspec) + p <- RProtoBuf::read(x13.Spec, b) return(.p2r_spec_x13(p)) } ## P <-> R -.p2r_spec_regarima<-function(pspec){ - basic<-list( - span=rjd3toolkit::.p2r_span(pspec$basic$span), +.p2r_spec_regarima <- function(pspec) { + basic <- list( + span = rjd3toolkit::.p2r_span(pspec$basic$span), preprocessing = pspec$basic$preprocessing, - preliminaryCheck = pspec$basic$preliminary_check) + preliminaryCheck = pspec$basic$preliminary_check + ) transform <- list( - fn=rjd3toolkit::.enum_extract(modelling.Transformation, pspec$transform$transformation), - adjust=rjd3toolkit::.enum_extract(modelling.LengthOfPeriod, pspec$transform$adjust), - aicdiff=pspec$transform$aicdiff, - outliers=pspec$transform$outliers_correction + fn = rjd3toolkit::.enum_extract(modelling.Transformation, pspec$transform$transformation), + adjust = rjd3toolkit::.enum_extract(modelling.LengthOfPeriod, pspec$transform$adjust), + aicdiff = pspec$transform$aicdiff, + outliers = pspec$transform$outliers_correction ) automodel <- list( - enabled=pspec$automodel$enabled, - ljungbox=pspec$automodel$ljungbox, - tsig=pspec$automodel$tsig, - predcv=pspec$automodel$predcv, - ubfinal=pspec$automodel$ubfinal, - ub1=pspec$automodel$ub1, - ub2=pspec$automodel$ub2, - cancel=pspec$automodel$cancel, - fct=pspec$automodel$fct, - acceptdef=pspec$automodel$acceptdef, - mixed=pspec$automodel$mixed, - balanced=pspec$automodel$balanced + enabled = pspec$automodel$enabled, + ljungbox = pspec$automodel$ljungbox, + tsig = pspec$automodel$tsig, + predcv = pspec$automodel$predcv, + ubfinal = pspec$automodel$ubfinal, + ub1 = pspec$automodel$ub1, + ub2 = pspec$automodel$ub2, + cancel = pspec$automodel$cancel, + fct = pspec$automodel$fct, + acceptdef = pspec$automodel$acceptdef, + mixed = pspec$automodel$mixed, + balanced = pspec$automodel$balanced ) - arima<-rjd3toolkit::.p2r_spec_sarima(pspec$arima) - - outlier<-list( - outliers=lapply(pspec$outlier$outliers, function(z){list(type=z$code, va=z$va)} ), - span=rjd3toolkit::.p2r_span(pspec$outlier$span), - defva=pspec$outlier$defva, - method=rjd3toolkit::.enum_extract(x13.OutlierMethod, pspec$outlier$method), - monthlytcrate=pspec$outlier$monthly_tc_rate, - maxiter=pspec$outlier$maxiter, - lsrun=pspec$outlier$lsrun + arima <- rjd3toolkit::.p2r_spec_sarima(pspec$arima) + + outlier <- list( + outliers = lapply(pspec$outlier$outliers, function(z) { + list(type = z$code, va = z$va) + }), + span = rjd3toolkit::.p2r_span(pspec$outlier$span), + defva = pspec$outlier$defva, + method = rjd3toolkit::.enum_extract(x13.OutlierMethod, pspec$outlier$method), + monthlytcrate = pspec$outlier$monthly_tc_rate, + maxiter = pspec$outlier$maxiter, + lsrun = pspec$outlier$lsrun ) - td<-list( - td=rjd3toolkit::.enum_sextract(modelling.TradingDays, pspec$regression$td$td), - lp=rjd3toolkit::.enum_extract(modelling.LengthOfPeriod, pspec$regression$td$lp), - holidays=pspec$regression$td$holidays, - users=unlist(pspec$regression$td$users), - w=pspec$regression$td$w, - test=rjd3toolkit::.enum_extract(x13.RegressionTest, pspec$regression$td$test), - auto=rjd3toolkit::.enum_extract(x13.AutomaticTradingDays, pspec$regression$td$auto), - autoadjust=pspec$regression$td$auto_adjust, - tdcoefficients=rjd3toolkit::.p2r_parameters(pspec$regression$td$tdcoefficients), - lpcoefficient=rjd3toolkit::.p2r_parameter(pspec$regression$td$lpcoefficient), - ptest1=pspec$regression$td$ptest1, - ptest2=pspec$regression$td$ptest2 + td <- list( + td = rjd3toolkit::.enum_sextract(modelling.TradingDays, pspec$regression$td$td), + lp = rjd3toolkit::.enum_extract(modelling.LengthOfPeriod, pspec$regression$td$lp), + holidays = pspec$regression$td$holidays, + users = unlist(pspec$regression$td$users), + w = pspec$regression$td$w, + test = rjd3toolkit::.enum_extract(x13.RegressionTest, pspec$regression$td$test), + auto = rjd3toolkit::.enum_extract(x13.AutomaticTradingDays, pspec$regression$td$auto), + autoadjust = pspec$regression$td$auto_adjust, + tdcoefficients = rjd3toolkit::.p2r_parameters(pspec$regression$td$tdcoefficients), + lpcoefficient = rjd3toolkit::.p2r_parameter(pspec$regression$td$lpcoefficient), + ptest1 = pspec$regression$td$ptest1, + ptest2 = pspec$regression$td$ptest2 ) - easter<-list( - type=rjd3toolkit::.enum_extract(x13.EasterType, pspec$regression$easter$type), - duration=pspec$regression$easter$duration, - test=rjd3toolkit::.enum_extract(x13.RegressionTest, pspec$regression$easter$test), - coefficient=rjd3toolkit::.p2r_parameter(pspec$regression$easter$coefficient) + easter <- list( + type = rjd3toolkit::.enum_extract(x13.EasterType, pspec$regression$easter$type), + duration = pspec$regression$easter$duration, + test = rjd3toolkit::.enum_extract(x13.RegressionTest, pspec$regression$easter$test), + coefficient = rjd3toolkit::.p2r_parameter(pspec$regression$easter$coefficient) ) # TODO: complete regression - regression<-list( - mean=rjd3toolkit::.p2r_parameter(pspec$regression$mean), - check_mean=pspec$regression$check_mean, - td=td, - easter=easter, - outliers=rjd3toolkit::.p2r_outliers(pspec$regression$outliers), - users=rjd3toolkit::.p2r_uservars(pspec$regression$users), - interventions=rjd3toolkit::.p2r_ivs(pspec$regression$interventions), - ramps=rjd3toolkit::.p2r_ramps(pspec$regression$ramps) + regression <- list( + mean = rjd3toolkit::.p2r_parameter(pspec$regression$mean), + check_mean = pspec$regression$check_mean, + td = td, + easter = easter, + outliers = rjd3toolkit::.p2r_outliers(pspec$regression$outliers), + users = rjd3toolkit::.p2r_uservars(pspec$regression$users), + interventions = rjd3toolkit::.p2r_ivs(pspec$regression$interventions), + ramps = rjd3toolkit::.p2r_ramps(pspec$regression$ramps) ) - estimate<-list( - span=rjd3toolkit::.p2r_span(pspec$estimate$span), - tol=pspec$estimate$tol + estimate <- list( + span = rjd3toolkit::.p2r_span(pspec$estimate$span), + tol = pspec$estimate$tol ) return(structure( list( - basic=basic, - transform=transform, - outlier=outlier, - arima=arima, - automodel=automodel, - regression=regression, - estimate=estimate + basic = basic, + transform = transform, + outlier = outlier, + arima = arima, + automodel = automodel, + regression = regression, + estimate = estimate ), - class="JD3_REGARIMA_SPEC")) + class = "JD3_REGARIMA_SPEC" + )) } -.r2p_spec_regarima<-function(r){ - p<-x13.RegArimaSpec$new() +.r2p_spec_regarima <- function(r) { + p <- x13.RegArimaSpec$new() # BIAS - p$basic$preliminary_check<-r$basic$preliminaryCheck - p$basic$preprocessing<-r$basic$preprocessing - p$basic$span<-rjd3toolkit::.r2p_span(r$basic$span) + p$basic$preliminary_check <- r$basic$preliminaryCheck + p$basic$preprocessing <- r$basic$preprocessing + p$basic$span <- rjd3toolkit::.r2p_span(r$basic$span) # TRANSFORM - p$transform$transformation<-rjd3toolkit::.enum_of(modelling.Transformation, r$transform$fn, "FN") - p$transform$adjust<-rjd3toolkit::.enum_of(modelling.LengthOfPeriod, r$transform$adjust, "LP") - p$transform$aicdiff<-r$transform$aicdiff - p$transform$outliers_correction<-r$transform$outliers + p$transform$transformation <- rjd3toolkit::.enum_of(modelling.Transformation, r$transform$fn, "FN") + p$transform$adjust <- rjd3toolkit::.enum_of(modelling.LengthOfPeriod, r$transform$adjust, "LP") + p$transform$aicdiff <- r$transform$aicdiff + p$transform$outliers_correction <- r$transform$outliers # OUTLIER - p$outlier$outliers<-lapply(r$outlier$outliers, function(z) - {t<-x13.RegArimaSpec$OutlierSpec$Type$new();t$code<-z$type; t$va<-z$va; return(t)}) - p$outlier$span<-rjd3toolkit::.r2p_span(r$outlier$span) - p$outlier$defva<-r$outlier$defva - p$outlier$method<-rjd3toolkit::.enum_of(x13.OutlierMethod, r$outlier$method, "OUTLIER") - p$outlier$monthly_tc_rate<-r$outlier$monthlytcrate - p$outlier$maxiter<-r$outlier$maxiter - p$outlier$lsrun<-r$outlier$lsrun - - #AMI - - p$automodel$enabled<-r$automodel$enabled - p$automodel$ljungbox<-r$automodel$ljungbox - p$automodel$tsig<-r$automodel$tsig - p$automodel$predcv<-r$automodel$predcv - p$automodel$ubfinal<-r$automodel$ubfinal - p$automodel$ub1<-r$automodel$ub1 - p$automodel$ub2<-r$automodel$ub2 - p$automodel$cancel<-r$automodel$cancel - p$automodel$fct<-r$automodel$fct - p$automodel$acceptdef<-r$automodel$acceptdef - p$automodel$mixed<-r$automodel$mixed - p$automodel$balanced<-r$automodel$balanced - - #ARIMA - p$arima<-rjd3toolkit::.r2p_spec_sarima(r$arima) - - #REGRESSION - - p$regression$mean<-rjd3toolkit::.r2p_parameter(r$regression$mean) - p$regression$check_mean<-r$regression$check_mean - p$regression$outliers<-rjd3toolkit::.r2p_outliers(r$regression$outliers) - p$regression$users<-rjd3toolkit::.r2p_uservars(r$regression$users) - p$regression$interventions<-rjd3toolkit::.r2p_ivs(r$regression$interventions) - p$regression$ramps<-rjd3toolkit::.r2p_ramps(r$regression$ramps) - - #TD - p$regression$td$td<-rjd3toolkit::.enum_sof(modelling.TradingDays, r$regression$td$td) - p$regression$td$lp<-rjd3toolkit::.enum_of(modelling.LengthOfPeriod, r$regression$td$lp, "LP") - p$regression$td$holidays<-r$regression$td$holidays - p$regression$td$users<-r$regression$td$users - p$regression$td$w<-r$regression$td$w - p$regression$td$test <-rjd3toolkit::.enum_of(x13.RegressionTest, r$regression$td$test, "TEST") - p$regression$td$auto <-rjd3toolkit::.enum_of(x13.AutomaticTradingDays, r$regression$td$auto, "TD") - p$regression$td$auto_adjust <-r$regression$td$autoadjust - p$regression$td$tdcoefficients<-rjd3toolkit::.r2p_parameters(r$regression$td$tdcoefficients) - p$regression$td$lpcoefficient<-rjd3toolkit::.r2p_parameter(r$regression$td$lpcoefficient) - p$regression$td$ptest1<-r$regression$td$ptest1 - p$regression$td$ptest2<-r$regression$td$ptest2 - - #EASTER - p$regression$easter$type<-rjd3toolkit::.enum_of(x13.EasterType, r$regression$easter$type, "EASTER") - p$regression$easter$duration<-r$regression$easter$duration - p$regression$easter$test<-rjd3toolkit::.enum_of(x13.RegressionTest, r$regression$easter$test, "TEST") - p$regression$easter$coefficient<-rjd3toolkit::.r2p_parameter(r$regression$easter$coefficient) - - #ESTIMATE - p$estimate$span<-rjd3toolkit::.r2p_span(r$estimate$span) - p$estimate$tol<-r$estimate$tol + p$outlier$outliers <- lapply(X = r$outlier$outliers, FUN = function(z) { + t <- x13.RegArimaSpec$OutlierSpec$Type$new() + t$code <- z$type + t$va <- z$va + return(t) + }) + p$outlier$span <- rjd3toolkit::.r2p_span(r$outlier$span) + p$outlier$defva <- r$outlier$defva + p$outlier$method <- rjd3toolkit::.enum_of(x13.OutlierMethod, r$outlier$method, "OUTLIER") + p$outlier$monthly_tc_rate <- r$outlier$monthlytcrate + p$outlier$maxiter <- r$outlier$maxiter + p$outlier$lsrun <- r$outlier$lsrun + + # AMI + + p$automodel$enabled <- r$automodel$enabled + p$automodel$ljungbox <- r$automodel$ljungbox + p$automodel$tsig <- r$automodel$tsig + p$automodel$predcv <- r$automodel$predcv + p$automodel$ubfinal <- r$automodel$ubfinal + p$automodel$ub1 <- r$automodel$ub1 + p$automodel$ub2 <- r$automodel$ub2 + p$automodel$cancel <- r$automodel$cancel + p$automodel$fct <- r$automodel$fct + p$automodel$acceptdef <- r$automodel$acceptdef + p$automodel$mixed <- r$automodel$mixed + p$automodel$balanced <- r$automodel$balanced + + # ARIMA + p$arima <- rjd3toolkit::.r2p_spec_sarima(r$arima) + + # REGRESSION + + p$regression$mean <- rjd3toolkit::.r2p_parameter(r$regression$mean) + p$regression$check_mean <- r$regression$check_mean + p$regression$outliers <- rjd3toolkit::.r2p_outliers(r$regression$outliers) + p$regression$users <- rjd3toolkit::.r2p_uservars(r$regression$users) + p$regression$interventions <- rjd3toolkit::.r2p_ivs(r$regression$interventions) + p$regression$ramps <- rjd3toolkit::.r2p_ramps(r$regression$ramps) + + # TD + p$regression$td$td <- rjd3toolkit::.enum_sof(modelling.TradingDays, r$regression$td$td) + p$regression$td$lp <- rjd3toolkit::.enum_of(modelling.LengthOfPeriod, r$regression$td$lp, "LP") + p$regression$td$holidays <- r$regression$td$holidays + p$regression$td$users <- r$regression$td$users + p$regression$td$w <- r$regression$td$w + p$regression$td$test <- rjd3toolkit::.enum_of(x13.RegressionTest, r$regression$td$test, "TEST") + p$regression$td$auto <- rjd3toolkit::.enum_of(x13.AutomaticTradingDays, r$regression$td$auto, "TD") + p$regression$td$auto_adjust <- r$regression$td$autoadjust + p$regression$td$tdcoefficients <- rjd3toolkit::.r2p_parameters(r$regression$td$tdcoefficients) + p$regression$td$lpcoefficient <- rjd3toolkit::.r2p_parameter(r$regression$td$lpcoefficient) + p$regression$td$ptest1 <- r$regression$td$ptest1 + p$regression$td$ptest2 <- r$regression$td$ptest2 + + # EASTER + p$regression$easter$type <- rjd3toolkit::.enum_of(x13.EasterType, r$regression$easter$type, "EASTER") + p$regression$easter$duration <- r$regression$easter$duration + p$regression$easter$test <- rjd3toolkit::.enum_of(x13.RegressionTest, r$regression$easter$test, "TEST") + p$regression$easter$coefficient <- rjd3toolkit::.r2p_parameter(r$regression$easter$coefficient) + + # ESTIMATE + p$estimate$span <- rjd3toolkit::.r2p_span(r$estimate$span) + p$estimate$tol <- r$estimate$tol return(p) } -.p2r_spec_x11<-function(p){ - +.p2r_spec_x11 <- function(p) { return(structure(list( - mode=rjd3toolkit::.enum_extract(sa.DecompositionMode, p$mode), - seasonal=p$seasonal, - henderson=p$henderson, - sfilters=sapply(p$sfilters, function(z){rjd3toolkit::.enum_extract(x13.SeasonalFilter, z)}), - lsig=p$lsig, - usig=p$usig, - nfcasts=p$nfcasts, - nbcasts=p$nbcasts, - sigma=rjd3toolkit::.enum_extract(x13.CalendarSigma, p$sigma), - vsigmas=p$vsigmas, - excludefcasts=p$exclude_fcasts, - bias=rjd3toolkit::.enum_extract(x13.BiasCorrection, p$bias) - ), class="JD3_X11_SPEC")) + mode = rjd3toolkit::.enum_extract(sa.DecompositionMode, p$mode), + seasonal = p$seasonal, + henderson = p$henderson, + sfilters = sapply(p$sfilters, function(z) { + rjd3toolkit::.enum_extract(x13.SeasonalFilter, z) + }), + lsig = p$lsig, + usig = p$usig, + nfcasts = p$nfcasts, + nbcasts = p$nbcasts, + sigma = rjd3toolkit::.enum_extract(x13.CalendarSigma, p$sigma), + vsigmas = p$vsigmas, + excludefcasts = p$exclude_fcasts, + bias = rjd3toolkit::.enum_extract(x13.BiasCorrection, p$bias) + ), class = "JD3_X11_SPEC")) } -.r2p_spec_x11<-function(r){ - p<-x13.X11Spec$new() - p$mode<- rjd3toolkit::.enum_of(x13.DecompositionMode, r$mode, "MODE") - p$seasonal<-r$seasonal - p$henderson<-r$henderson - p$sfilters<-sapply(r$sfilters, function(z){rjd3toolkit::.enum_of(x13.SeasonalFilter, z, "SEASONAL")} ) - p$lsig<-r$lsig - p$usig<-r$usig - p$nfcasts<-r$nfcasts - p$nbcasts<-r$nbcasts - p$sigma<-rjd3toolkit::.enum_of(x13.CalendarSigma, r$sigma, "SIGMA") - p$vsigmas<-r$vsigmas - p$exclude_fcasts<-r$excludefcasts - p$bias<-rjd3toolkit::.enum_of(x13.BiasCorrection, r$bias, "BIAS") +.r2p_spec_x11 <- function(r) { + p <- x13.X11Spec$new() + p$mode <- rjd3toolkit::.enum_of(x13.DecompositionMode, r$mode, "MODE") + p$seasonal <- r$seasonal + p$henderson <- r$henderson + p$sfilters <- sapply(r$sfilters, function(z) { + rjd3toolkit::.enum_of(x13.SeasonalFilter, z, "SEASONAL") + }) + p$lsig <- r$lsig + p$usig <- r$usig + p$nfcasts <- r$nfcasts + p$nbcasts <- r$nbcasts + p$sigma <- rjd3toolkit::.enum_of(x13.CalendarSigma, r$sigma, "SIGMA") + p$vsigmas <- r$vsigmas + p$exclude_fcasts <- r$excludefcasts + p$bias <- rjd3toolkit::.enum_of(x13.BiasCorrection, r$bias, "BIAS") return(p) } -.p2r_spec_x13<-function(pspec){ +.p2r_spec_x13 <- function(pspec) { return(structure(list( - regarima=.p2r_spec_regarima(pspec$regarima), - x11=.p2r_spec_x11(pspec$x11), - benchmarking=rjd3toolkit::.p2r_spec_benchmarking(pspec$benchmarking) - ), class="JD3_X13_SPEC")) + regarima = .p2r_spec_regarima(pspec$regarima), + x11 = .p2r_spec_x11(pspec$x11), + benchmarking = rjd3toolkit::.p2r_spec_benchmarking(pspec$benchmarking) + ), class = "JD3_X13_SPEC")) } -.r2p_spec_x13<-function(r){ - p<-x13.Spec$new() - p$regarima<-.r2p_spec_regarima(r$regarima) - p$x11<-.r2p_spec_x11(r$x11) - p$benchmarking<-rjd3toolkit::.r2p_spec_benchmarking(r$benchmarking) +.r2p_spec_x13 <- function(r) { + p <- x13.Spec$new() + p$regarima <- .r2p_spec_regarima(r$regarima) + p$x11 <- .r2p_spec_x11(r$x11) + p$benchmarking <- rjd3toolkit::.r2p_spec_benchmarking(r$benchmarking) return(p) } diff --git a/R/zzz.R b/R/zzz.R index 98b6f17..e3ba998 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -4,16 +4,20 @@ .onLoad <- function(libname, pkgname) { + if (!requireNamespace("rjd3toolkit", quietly = TRUE)) stop("Loading rjd3 libraries failed") - if (!requireNamespace("rjd3toolkit", quietly = TRUE)) stop("Loading rjd3 libraries failed") + result <- .jpackage(pkgname, lib.loc = libname) + if (!result) stop("Loading java packages failed") - result <- .jpackage(pkgname, lib.loc=libname) - if (!result) stop("Loading java packages failed") - - proto.dir <- system.file("proto", package = pkgname) - readProtoFiles2(protoPath = proto.dir) - - # reload extractors - rjd3toolkit::reload_dictionaries() + proto.dir <- system.file("proto", package = pkgname) + readProtoFiles2(protoPath = proto.dir) + # reload extractors + rjd3toolkit::reload_dictionaries() + if (is.null(getOption("summary_info"))) { + options(summary_info = TRUE) + } + if (is.null(getOption("thresholds_pval"))) { + options(thresholds_pval = c(Severe = 0.001, Bad = 0.01, Uncertain = 0.05, Good = Inf)) + } } diff --git a/README.Rmd b/README.Rmd index 62bb80b..8d42349 100644 --- a/README.Rmd +++ b/README.Rmd @@ -77,7 +77,7 @@ remotes::install_github("rjdverse/rjd3x13") library("rjd3x13") y <- rjd3toolkit::ABS$X0.2.09.10.M -x13_model <- x13(y) +x13_model <- x13(y) summary(x13_model$result$preprocessing) # Summary of regarima model plot(x13_model) # Plot of the final decomposition diff --git a/README.md b/README.md index a44ec50..048cc3c 100644 --- a/README.md +++ b/README.md @@ -75,10 +75,10 @@ remotes::install_github("rjdverse/rjd3x13") library("rjd3x13") y <- rjd3toolkit::ABS$X0.2.09.10.M -x13_model <- x13(y) +x13_model <- x13(y) summary(x13_model$result$preprocessing) # Summary of regarima model #> Log-transformation: yes -#> SARIMA model: (2,1,1) (0,1,1) +#> SARIMA model: (2,1,1) (0,1,1) #> #> Coefficients #> Estimate Std. Error T-stat Pr(>|t|) @@ -92,15 +92,15 @@ summary(x13_model$result$preprocessing) # Summary of regarima model #> Regression model: #> Estimate Std. Error T-stat Pr(>|t|) #> td 0.0023233 0.0006844 3.395 0.000755 *** -#> easter 0.0520113 0.0084894 6.127 2.13e-09 *** -#> TC (2000-06-01) 0.1590340 0.0288578 5.511 6.37e-08 *** -#> AO (2000-07-01) -0.2900774 0.0400551 -7.242 2.25e-12 *** +#> easter 0.0520113 0.0084894 6.127 2.14e-09 *** +#> TC (2000-06-01) 0.1590340 0.0288578 5.511 6.38e-08 *** +#> AO (2000-07-01) -0.2900774 0.0400551 -7.242 2.26e-12 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -#> Number of observations: 425 , Number of effective observations: 412 , Number of parameters: 9 -#> Loglikelihood: 746.7517, Adjusted loglikelihood: -2120.875 -#> Standard error of the regression (ML estimate): 0.03927991 -#> AIC: 4259.75 , AICc: 4260.198 , BIC: 4295.939 +#> Number of observations: 425, Number of effective observations: 412, Number of parameters: 9 +#> Loglikelihood: 746.7517, Adjusted loglikelihood: -2120.875 +#> Standard error of the regression (ML estimate): 0.03927991 +#> AIC: 4259.75, AICc: 4260.198, BIC: 4295.939 plot(x13_model) # Plot of the final decomposition ``` diff --git a/inst/java/jdplus-x13-base-api-3.2.4.jar b/inst/java/jdplus-x13-base-api-3.3.0.jar similarity index 89% rename from inst/java/jdplus-x13-base-api-3.2.4.jar rename to inst/java/jdplus-x13-base-api-3.3.0.jar index b931f85..2a8bfd7 100644 Binary files a/inst/java/jdplus-x13-base-api-3.2.4.jar and b/inst/java/jdplus-x13-base-api-3.3.0.jar differ diff --git a/inst/java/jdplus-x13-base-core-3.2.4.jar b/inst/java/jdplus-x13-base-core-3.3.0.jar similarity index 89% rename from inst/java/jdplus-x13-base-core-3.2.4.jar rename to inst/java/jdplus-x13-base-core-3.3.0.jar index 54e174d..ff443d2 100644 Binary files a/inst/java/jdplus-x13-base-core-3.2.4.jar and b/inst/java/jdplus-x13-base-core-3.3.0.jar differ diff --git a/inst/java/jdplus-x13-base-protobuf-3.2.4.jar b/inst/java/jdplus-x13-base-protobuf-3.3.0.jar similarity index 94% rename from inst/java/jdplus-x13-base-protobuf-3.2.4.jar rename to inst/java/jdplus-x13-base-protobuf-3.3.0.jar index 82f00a9..f6b5d37 100644 Binary files a/inst/java/jdplus-x13-base-protobuf-3.2.4.jar and b/inst/java/jdplus-x13-base-protobuf-3.3.0.jar differ diff --git a/inst/java/jdplus-x13-base-r-3.2.4.jar b/inst/java/jdplus-x13-base-r-3.3.0.jar similarity index 85% rename from inst/java/jdplus-x13-base-r-3.2.4.jar rename to inst/java/jdplus-x13-base-r-3.3.0.jar index 06fcd4f..0e7876e 100644 Binary files a/inst/java/jdplus-x13-base-r-3.2.4.jar and b/inst/java/jdplus-x13-base-r-3.3.0.jar differ diff --git a/man/figures/logo.png b/man/figures/logo.png index e7a2dc0..d5a7f8f 100644 Binary files a/man/figures/logo.png and b/man/figures/logo.png differ diff --git a/man/figures/logo.svg b/man/figures/logo.svg index c189ad4..c4863ec 100644 --- a/man/figures/logo.svg +++ b/man/figures/logo.svg @@ -3,14 +3,10 @@ @@ -20,303 +16,320 @@ - - - - - - + + + + + + + + + + + + + + + + + + - @@ -324,10 +337,130 @@ - rjd3x13 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - github.com/rjdverse/rjd3x13 + + + + + + + + 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()}}. } diff --git a/pkgdown/favicon/apple-touch-icon-120x120.png b/pkgdown/favicon/apple-touch-icon-120x120.png index 6f663f3..e11a9e7 100644 Binary files a/pkgdown/favicon/apple-touch-icon-120x120.png and b/pkgdown/favicon/apple-touch-icon-120x120.png differ diff --git a/pkgdown/favicon/apple-touch-icon-152x152.png b/pkgdown/favicon/apple-touch-icon-152x152.png index 0ea1ee2..0e946fe 100644 Binary files a/pkgdown/favicon/apple-touch-icon-152x152.png and b/pkgdown/favicon/apple-touch-icon-152x152.png differ diff --git a/pkgdown/favicon/apple-touch-icon-180x180.png b/pkgdown/favicon/apple-touch-icon-180x180.png index 8541f24..9bf2140 100644 Binary files a/pkgdown/favicon/apple-touch-icon-180x180.png and b/pkgdown/favicon/apple-touch-icon-180x180.png differ diff --git a/pkgdown/favicon/apple-touch-icon-60x60.png b/pkgdown/favicon/apple-touch-icon-60x60.png index 9ff3afd..41054ed 100644 Binary files a/pkgdown/favicon/apple-touch-icon-60x60.png and b/pkgdown/favicon/apple-touch-icon-60x60.png differ diff --git a/pkgdown/favicon/apple-touch-icon-76x76.png b/pkgdown/favicon/apple-touch-icon-76x76.png index da65825..5f3b83b 100644 Binary files a/pkgdown/favicon/apple-touch-icon-76x76.png and b/pkgdown/favicon/apple-touch-icon-76x76.png differ diff --git a/pkgdown/favicon/apple-touch-icon.png b/pkgdown/favicon/apple-touch-icon.png index f7b44df..76e909b 100644 Binary files a/pkgdown/favicon/apple-touch-icon.png and b/pkgdown/favicon/apple-touch-icon.png differ diff --git a/pkgdown/favicon/favicon-16x16.png b/pkgdown/favicon/favicon-16x16.png index 7611f84..0a63482 100644 Binary files a/pkgdown/favicon/favicon-16x16.png and b/pkgdown/favicon/favicon-16x16.png differ diff --git a/pkgdown/favicon/favicon-32x32.png b/pkgdown/favicon/favicon-32x32.png index b08fde5..b7cbcb8 100644 Binary files a/pkgdown/favicon/favicon-32x32.png and b/pkgdown/favicon/favicon-32x32.png differ diff --git a/pkgdown/favicon/favicon.ico b/pkgdown/favicon/favicon.ico index 3a97136..27530d7 100644 Binary files a/pkgdown/favicon/favicon.ico and b/pkgdown/favicon/favicon.ico differ diff --git a/pom.xml b/pom.xml index 48ffa77..e55f5e9 100644 --- a/pom.xml +++ b/pom.xml @@ -11,7 +11,7 @@ Usage: mvn -Pcopy-jars - 3.2.4 + 3.3.0