diff --git a/.lintr b/.lintr index 0a53596..d640649 100644 --- a/.lintr +++ b/.lintr @@ -1,5 +1,7 @@ linters: linters_with_defaults( indentation_linter = lintr::indentation_linter(indent = 4L), + # line_length_linter = lintr::line_length_linter(80L), + line_length_linter = lintr::line_length_linter(500L), indentation_linter = NULL, assignment_linter = NULL, trailing_blank_lines_linter = NULL, @@ -21,7 +23,6 @@ linters: linters_with_defaults( cyclocomp_linter = NULL, object_usage_linter = NULL, object_name_linter = NULL, - line_length_linter = NULL, commented_code_linter = NULL ) encoding: "UTF-8" diff --git a/R/deprecated.R b/R/deprecated.R index aa95ea6..8410a1c 100644 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -4,31 +4,31 @@ #' @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 0897f6e..70d1d3e 100644 --- a/R/print.R +++ b/R/print.R @@ -1,171 +1,200 @@ -#'@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)) +#' @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), - ...){ - 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)) + ...) { + 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)) } #' @export print.JD3_X13_RSLTS <- function(x, digits = max(3L, getOption("digits") - 3L), summary_info = getOption("summary_info"), - ...){ - - 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("\n") - cat(sprintf("Trend filter: %s terms Henderson moving average\n", x$decomposition$final_henderson)) - if (summary_info) - cat("\nFor a more detailed output, use the 'summary()' function.\n") - return(invisible(x)) + ...) { + 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("\n") + cat(sprintf("Trend filter: %s terms Henderson moving average\n", x$decomposition$final_henderson)) + if (summary_info) { + cat("\nFor a more detailed output, use the 'summary()' function.\n") + } + return(invisible(x)) } #' @export -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) - ) +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) } #' @export -summary.JD3_X13_OUTPUT <- function(object, ...){ +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"), ...){ +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="") + cat("\n", "Decomposition", "\n", sep = "") print_x11_decomp(x$decomposition, digits = digits, ...) - cat("\n", "Diagnostics","\n",sep="") + cat("\n", "Diagnostics", "\n", sep = "") print_diagnostics(x$diagnostics, digits = digits, ...) - cat("\n", "Final","\n",sep="") + cat("\n", "Final", "\n", sep = "") print(x$final, digits = digits, ...) return(invisible(x)) } #' @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)) +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)) } #' @export print.JD3X11 <- function(x, ...) { - table <- do.call(cbind, x[grepl(pattern = "^d(\\d+)$", x = names(x))]) + table <- do.call(cbind, x[grepl(pattern = "^d(\\d+)$", x = names(x))]) - cat("Last values\n") - print(utils::tail(stats::.preformat.ts(table))) + cat("Last values\n") + print(utils::tail(stats::.preformat.ts(table))) - return(invisible(x)) + return(invisible(x)) } #' @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, - ...) + 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, - ...) + 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) +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 + ) } #' @export -diagnostics.JD3_X13_OUTPUT<-function(x, ...){ - return(rjd3toolkit::diagnostics(x$result, ...)) +diagnostics.JD3_X13_OUTPUT <- function(x, ...) { + return(rjd3toolkit::diagnostics(x$result, ...)) } #' @export print.JD3_REGARIMA_SPEC <- function(x, ...) { - cat("Specification", "\n", sep = "") @@ -212,7 +241,9 @@ print.JD3_REGARIMA_SPEC <- function(x, ...) { message("Trading days regressor unknown.") } cat("with Leap Year: ", - ifelse(x$regression$td$lp == "LEAPYEAR", "Yes", "No"), "\n", sep = "") + 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 = "") } @@ -229,8 +260,10 @@ print.JD3_REGARIMA_SPEC <- function(x, ...) { 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- Type:", x$regression$easter$coefficient$type, + ifelse(x$regression$easter$coefficient$type == "FIXED", "(Auto)", ""), "\n" + ) cat("\t- Value:", x$regression$easter$coefficient$value, "\n") } } @@ -242,7 +275,9 @@ print.JD3_REGARIMA_SPEC <- function(x, ...) { 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 = "") + "\n", + sep = "" + ) } } cat("Ramps: ") @@ -250,7 +285,9 @@ print.JD3_REGARIMA_SPEC <- function(x, ...) { 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 = "") + ifelse(is.null(ramp$coef), "", paste0(", coefficient: ", ramp$coef, " (", ramp$coef$type, ")")), + sep = "" + ) cat("\n") } } else { @@ -262,7 +299,9 @@ print.JD3_REGARIMA_SPEC <- function(x, ...) { for (uv in x$regression$users) { cat("\t-", uv$name, ifelse(is.null(uv$coef), "", paste0(", coefficient: ", uv$coef)), - ", component: ", uv$regeffect, "\n", sep = "") + ", component: ", uv$regeffect, "\n", + sep = "" + ) } } @@ -293,16 +332,17 @@ print.JD3_REGARIMA_SPEC <- function(x, ...) { #' @export print.JD3_X11_SPEC <- function(x, ...) { - cat("Specification X11", "\n", sep = "") 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 :", + cat( + "Boundaries used for extreme values correction :", "\n\t lower_sigma: ", x$lsig, - "\n\t upper_sigma: ", x$usig) + "\n\t upper_sigma: ", x$usig + ) cat("\n") cat("Nb of forecasts: ", x$nfcasts, "\n", sep = "") cat("Nb of backcasts: ", x$nbcasts, "\n", sep = "") @@ -313,7 +353,6 @@ print.JD3_X11_SPEC <- function(x, ...) { #' @export print.JD3_X13_SPEC <- function(x, ...) { - print(x$regarima) cat("\n") diff --git a/R/regarima_generic.R b/R/regarima_generic.R index e222eca..22e72de 100644 --- a/R/regarima_generic.R +++ b/R/regarima_generic.R @@ -1,69 +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, ...){ - x <- summary(object$result, ...) - x$method <- "RegARIMA" - x +summary.JD3_REGARIMA_OUTPUT <- function(object, ...) { + x <- summary(object$result, ...) + x$method <- "RegARIMA" + x } #' @export -print.JD3_REGARIMA_OUTPUT <- function(x, summary_info = getOption("summary_info"), ...){ - cat("Method: RegARIMA\n") - print(x$result, summary_info = summary_info, ...) +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..62fe660 100644 --- a/R/regarima_outliers.R +++ b/R/regarima_outliers.R @@ -20,35 +20,40 @@ 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)) { + sy <- start(y) + td <- rjd3toolkit::td(s = y, groups = X.td) + X <- cbind(X, td) + } - jregarima<-.jcall("jdplus/x13/base/r/RegArimaOutliersDetection", "Ljdplus/x13/base/r/RegArimaOutliersDetection$Results;", "process", - rjd3toolkit::.r2jd_tsdata(y), as.integer(order), as.integer(seasonal), mean, rjd3toolkit::.r2jd_matrix(X), - 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..d70ea5f 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,58 @@ 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..8b83c8e 100644 --- a/R/set_x11_spec.R +++ b/R/set_x11_spec.R @@ -1,4 +1,3 @@ - #' 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()' @@ -37,18 +36,19 @@ #' @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,8 +63,8 @@ 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, @@ -80,75 +80,85 @@ set_x11.JD3_X11_SPEC <- function(x, 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 + ) + } - 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))) { + warning("sigma.vector must be equal to 1 or 2") + } else { + x$sigma <- "SELECT" + x$vsigmas <- as.integer(sigma.vector) + } + } + 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..5f50d9d 100644 --- a/R/udvar.R +++ b/R/udvar.R @@ -1,20 +1,20 @@ -.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 @@ -26,9 +26,9 @@ #' 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") @@ -37,165 +37,172 @@ #' 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")) +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() + # 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(?)") + 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() + # 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(?)") + 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(?)" + ) - # 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() + # jts<-rjd3toolkit::.r2jd_tsdata(rjd3toolkit::ABS$X0.2.09.10.M) + # jrslt<- rJava::.jcall("jdplus/x13/base/r/X11", "Ljdplus/x13/base/core/x11/X11Results;", "process", jts, + # rjd3x13::.r2jd_spec_x11(rjd3x13::spec_x11())) + # rjd3toolkit::dictionary(rjd3toolkit::.jd3_object(jrslt, result = TRUE)) |> + # sort() |> + # dput() - sa_x11 <- c("b1", "b10", "b11", "b13", "b17", "b2", "b20", "b3", "b4", - "b5", "b6", "b7", "b8", "b9", "c1", "c10", "c11", "c13", "c17", - "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..4796150 100644 --- a/R/x13.R +++ b/R/x13.R @@ -11,85 +11,88 @@ NULL #' @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 { + 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 { - jcontext <- rjd3toolkit::.r2jd_modellingcontext(context) + 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 { + 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 { - jcontext <- rjd3toolkit::.r2jd_modellingcontext(context) + 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,25 +102,27 @@ 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") +#' 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) #' #' @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. @@ -126,100 +131,101 @@ regarima_fast<-function(ts, spec= c("rg4", "rg0", "rg1", "rg2c", "rg3","rg5c"), #' 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 { + 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) + 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,16 +240,16 @@ 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 @@ -295,114 +301,122 @@ 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 +425,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..01fe88e 100644 --- a/R/x13_spec.R +++ b/R/x13_spec.R @@ -45,10 +45,10 @@ NULL #' @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))) } @@ -56,10 +56,10 @@ regarima_spec<-function(name=c("rg4","rg0", "rg1", "rg2c", "rg3", "rg5c")){ #' @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))) } @@ -67,279 +67,290 @@ x13_spec<-function(name = c("rsa4","rsa0", "rsa1", "rsa2c", "rsa3", "rsa5c")){ #' @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 3fedb63..5302c15 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -4,17 +4,17 @@ .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) - 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) + # reload extractors + rjd3toolkit::reload_dictionaries() + if (is.null(getOption("summary_info"))) { + options(summary_info = TRUE) + } } 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/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/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