#' @importFrom stats ts is.mts is.ts time
#' @import RJDemetra
seasonal_adjustment <- function(data,
method = c("x13","tramoseats"),
spec = NULL,
frequency = NULL,
message = TRUE,
new_data = TRUE){
data <- data[order(data$x), ]
use_previous_model <- pre_check_param(frequency = frequency, method = method,
spec = spec, new_data = new_data,
data_y = data$y)
if(use_previous_model){
sa <- .demetra$sa
data_ts <- .demetra$data_ts
}else{
data_ts <- .demetra$data_ts <-
dataframe2ts(data = data, frequency = frequency, message = message)
method <- match.arg(method)
if (method == "x13") {
if (is.null(spec)) {
sa <- RJDemetra::jx13(data_ts)
}else{
sa <- RJDemetra::jx13(data_ts, spec = spec)
}
}else{
if (is.null(spec)) {
sa <- RJDemetra::jtramoseats(data_ts)
}else{
sa <- RJDemetra::jtramoseats(data_ts, spec = spec)
}
}
.demetra$sa <- sa
.demetra$spec <- spec
.demetra$method <- method
.demetra$data_y <- data$y
}
# data$sa_model <- list(sa)
list(data = data, sa = sa, dates = as.numeric(time(data_ts)),
frequency = frequency(data_ts))
}
dataframe2ts <- function(data, frequency = NULL, message = TRUE){
dates <- data$x
if (inherits(dates, "Date")) {
years <- as.numeric(format(dates, format = "%Y"))
months <- as.numeric(format(dates, format = "%m"))
if (is.null(frequency)) {
frequency <- max(table(years))
if (message)
message(sprintf("Frequency used: %i", frequency))
}
dates <- years + (months - 1) / frequency
first_date <- dates[1]
}else{
# Numeric format
if (is.null(frequency)) {
years <- trunc(round(dates, 3))
frequency <- max(table(years))
if (message)
message(sprintf("Frequency used: %i", frequency))
}
first_date <- dates[1]
}
if (!frequency %in% c(2, 4, 6, 12))
stop("Error with the frequency: it must be equal to 12, 6, 4 or 2")
.demetra$frequency <- frequency
ts(data$y, start = first_date, frequency = frequency)
}
ts2dataframe <- function(x){
if (is.ts(x) & !is.mts(x)) {
data.frame(x = as.numeric(time(x)),
y = as.numeric(x))
}else{
NULL
}
}
.demetra <- new.env(parent = emptyenv())
.demetra$frequency <-
.demetra$method <-
.demetra$sa <-
.demetra$spec <-
.demetra$data_ts <-
.demetra$data_y <-
NULL
pre_check_param <- function(frequency = NULL,
method = c("x13","tramoseats"),
spec = NULL,
new_data = TRUE,
data_y = NULL){
use_previous_model <- FALSE
if(any(new_data,
is.null(.demetra$frequency),
is.null(.demetra$method),
is.null(.demetra$sa)
)){
.demetra$frequency <-
.demetra$method <-
.demetra$sa <-
.demetra$data_ts <-
.demetra$data_y <-
NULL
return(use_previous_model)
}
# method <- match.arg(method)
if((is.null(spec) || identical(spec, .demetra$spec)) &
(is.null(method) || .demetra$method %in% method) &
(is.null(frequency) || identical(frequency, .demetra$frequency)) &
(identical(data_y, .demetra$data_y))){
use_previous_model <- TRUE
}else{
.demetra$frequency <-
.demetra$method <-
.demetra$sa <-
.demetra$spec <-
.demetra$data_ts <-
.demetra$data_y <-
NULL
}
use_previous_model
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.