Merge pull request #13 from rjdemetra/develop

v3.1.0

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rjd3toolkit
 Type: Package
 Title: Toolkit Functions Around 'JDemetra+ 3.0'
-Version: 3.0.0
+Version: 3.1.0
 Authors@R: c(
   person("Jean", "Palate", role = c("aut", "cre"),
                 email = "[email protected]"),
@@ -15,20 +15,20 @@ Description: Interface around 'JDemetra+ 3.x' (<https://github.com/jdemetra/jdem
 Depends:
   R (>= 3.6.0)
 Imports:
-	RProtoBuf (>= 0.4.17),
+	RProtoBuf (>= 0.4.20),
   rJava (>= 1.0-6),
   checkmate,
   methods
 SystemRequirements: Java (>= 17)
 License: EUPL
-URL: https://github.com/palatej/rjd3toolkit
+URL: https://github.com/rjdemetra/rjd3toolkit
 LazyData: TRUE
 Suggests:
     knitr,
     rmarkdown
 RoxygenNote: 7.2.3
 Roxygen: list(markdown = TRUE)
-BugReports: https://github.com/palatej/rjd3toolkit/issues
+BugReports: https://github.com/rjdemetra/rjd3toolkit/issues
 Encoding: UTF-8
 Collate: 
     'utils.R'

NAMESPACE

@@ -3,10 +3,16 @@
 S3method(add_outlier,default)
 S3method(add_ramp,default)
 S3method(add_usrdefvar,default)
+S3method(aggregate,data.frame)
+S3method(aggregate,default)
+S3method(aggregate,matrix)
 S3method(coef,JD3_REGARIMA_RSLTS)
 S3method(df.residual,JD3_REGARIMA_RSLTS)
 S3method(diagnostics,JD3)
 S3method(diagnostics,JD3_REGARIMA_RSLTS)
+S3method(differences,data.frame)
+S3method(differences,default)
+S3method(differences,matrix)
 S3method(logLik,JD3_REGARIMA_RSLTS)
 S3method(nobs,JD3_REGARIMA_RSLTS)
 S3method(plot,JD3_SADECOMPOSITION)
@@ -47,15 +53,25 @@ S3method(summary,JD3_LIKELIHOOD)
 S3method(summary,JD3_REGARIMA_RSLTS)
 S3method(summary,JD3_SARIMA_ESTIMATE)
 S3method(summary,JD3_SARIMA_ESTIMATION)
+S3method(ts_adjust,data.frame)
+S3method(ts_adjust,default)
+S3method(ts_adjust,matrix)
+S3method(ts_interpolate,data.frame)
+S3method(ts_interpolate,default)
+S3method(ts_interpolate,matrix)
 S3method(vcov,JD3_REGARIMA_RSLTS)
 export(.enum_extract)
 export(.enum_of)
 export(.enum_sextract)
 export(.enum_sof)
 export(.jd2p_context)
+export(.jd2r_lts)
 export(.jd2r_matrix)
 export(.jd2r_modellingcontext)
+export(.jd2r_mts)
 export(.jd2r_ts)
+export(.jd2r_tscollection)
+export(.jd2r_tsdata)
 export(.jd2r_ucarima)
 export(.jd3_object)
 export(.jdomain)
@@ -66,6 +82,7 @@ export(.p2r_context)
 export(.p2r_datasupplier)
 export(.p2r_datasuppliers)
 export(.p2r_matrix)
+export(.p2r_metadata)
 export(.p2r_moniker)
 export(.p2r_outliers)
 export(.p2r_parameter)
@@ -82,6 +99,8 @@ export(.p2r_spec_benchmarking)
 export(.p2r_spec_sarima)
 export(.p2r_test)
 export(.p2r_ts)
+export(.p2r_tscollection)
+export(.p2r_tsdata)
 export(.p2r_ucarima)
 export(.p2r_uservars)
 export(.p2r_variables)
@@ -100,16 +119,22 @@ export(.proc_str)
 export(.proc_test)
 export(.proc_ts)
 export(.proc_vector)
+export(.r2jd_make_ts)
+export(.r2jd_make_tscollection)
 export(.r2jd_matrix)
 export(.r2jd_modellingcontext)
 export(.r2jd_sarima)
+export(.r2jd_tmp_ts)
 export(.r2jd_ts)
+export(.r2jd_tscollection)
+export(.r2jd_tsdata)
 export(.r2jd_tsdomain)
 export(.r2p_calendar)
 export(.r2p_context)
 export(.r2p_datasupplier)
 export(.r2p_datasuppliers)
 export(.r2p_lparameters)
+export(.r2p_metadata)
 export(.r2p_moniker)
 export(.r2p_outliers)
 export(.r2p_parameter)
@@ -119,6 +144,8 @@ export(.r2p_span)
 export(.r2p_spec_benchmarking)
 export(.r2p_spec_sarima)
 export(.r2p_ts)
+export(.r2p_tscollection)
+export(.r2p_tsdata)
 export(.r2p_uservars)
 export(DATE_MAX)
 export(DATE_MIN)
@@ -142,6 +169,8 @@ export(cdf_inverse_gaussian)
 export(cdf_t)
 export(chained_calendar)
 export(clean_extremities)
+export(data_to_ts)
+export(daysOf)
 export(density_chi2)
 export(density_gamma)
 export(density_inverse_gamma)
@@ -162,10 +191,12 @@ export(holidays)
 export(intervention_variable)
 export(jarquebera)
 export(julianeaster_variable)
+export(kurtosis)
 export(ljungbox)
 export(long_term_mean)
 export(lp_variable)
 export(ls_variable)
+export(mad)
 export(modelling_context)
 export(national_calendar)
 export(periodic.contrasts)
@@ -184,10 +215,12 @@ export(remove_outlier)
 export(remove_ramp)
 export(result)
 export(sa.decomposition)
-export(sa.preprocessing)
+export(sa_decomposition)
+export(sa_preprocessing)
 export(sadecomposition)
 export(sarima_decompose)
 export(sarima_estimate)
+export(sarima_hannan_rissanen)
 export(sarima_model)
 export(sarima_properties)
 export(sarima_random)
@@ -208,6 +241,7 @@ export(set_outlier)
 export(set_tradingdays)
 export(set_transform)
 export(single_day)
+export(skewness)
 export(so_variable)
 export(special_day)
 export(statisticaltest)
@@ -218,6 +252,8 @@ export(td_ch)
 export(td_f)
 export(testofruns)
 export(testofupdownruns)
+export(to_ts)
+export(to_tscollection)
 export(trigonometric_variables)
 export(ts_adjust)
 export(ts_interpolate)

R/arima.R

@@ -47,14 +47,15 @@ sarima_properties<-function(model, nspectrum=601, nacf=36){
 #'  Unused if `tdegree` is larger than 0.
 #' @param tdegree degrees of freedom of the T distribution of the innovations.
 #' `tdegree = 0` if normal distribution is used.
+#' @param seed seed of the random numbers generator. Negative values mean random seeds
 #'
 #' @examples
 #' # Airline model
 #' s_model <- sarima_model(period = 12, d =1, bd = 1, theta = 0.2, btheta = 0.2)
-#' x <- sarima_random(s_model, length = 64)
-#' plot(x, type = "line")
+#' x <- sarima_random(s_model, length = 64, seed = 0)
+#' plot(x, type = "l")
 #' @export
-sarima_random<-function(model, length, stde=1, tdegree=0){
+sarima_random<-function(model, length, stde=1, tdegree=0, seed=-1){
   if (!inherits(model, "JD3_SARIMA"))
     stop("Invalid model")
   return (.jcall("jdplus/toolkit/base/r/arima/SarimaModels", "[D", "random",
@@ -67,10 +68,11 @@ sarima_random<-function(model, length, stde=1, tdegree=0){
          as.integer(model$bd),
          .jarray(as.numeric(model$btheta)),
          stde,
-         as.integer(tdegree)))
+         as.integer(tdegree),
+         as.integer(seed)))
 }
 
-#' Decompose SARIMA Model
+#' Decompose SARIMA Model into three components trend, seasonal, irregular
 #'
 #' @param model SARIMA model to decompose.
 #' @param rmod trend threshold.
@@ -323,7 +325,24 @@ sarima_estimate<-function(x, order=c(0,0,0), seasonal = list(order=c(0,0,0), per
   bytes<-.jcall("jdplus/toolkit/base/r/arima/SarimaModels", "[B", "toBuffer", jestim)
   p<-RProtoBuf::read(regarima.RegArimaModel$Estimation, bytes)
   res <- .p2r_regarima_estimation(p)
-  names(res$b) <- colnames(xreg)
+
+  if (length(res$b) > 0) {
+
+    names_xreg <- colnames(xreg)
+    if (is.null (names_xreg) & !is.null (xreg)){
+      if (is.matrix(xreg)) {
+        # unnamed matrix regressors
+        names_xreg <- sprintf("xreg_%i", seq_len(ncol(xreg)))
+      } else {
+        # vector external regressor
+        names_xreg <- "xreg_1"
+      }
+    }
+    if (mean) {
+      names_xreg <- c("intercept", names_xreg)
+    }
+    names(res$b) <- names_xreg
+  }
   names(res$parameters$val) <- c(sprintf("phi(%i)", seq_len(order[1])),
                                  sprintf("bphi(%i)", seq_len(seasonal$order[1])),
                                  sprintf("theta(%i)", seq_len(order[3])),
@@ -332,3 +351,32 @@ sarima_estimate<-function(x, order=c(0,0,0), seasonal = list(order=c(0,0,0), per
   class(res) <- c("JD3_SARIMA_ESTIMATE", "JD3_REGARIMA_RSLTS")
   return (res)
 }
+
+#' Title
+#'
+#' @param x a univariate time series.
+#' @param order vector specifying of the non-seasonal part of the ARIMA model: the AR order, the degree of differencing, and the MA order.
+#' @param seasonal specification of the seasonal part of the ARIMA model and the seasonal frequency (by default equals to `frequency(x)`).
+#' Either  a list with components `order` and `period` or a numeric vector specifying the seasonal order (the default period is then used).
+#' @param initialization Algorithm used in the computation of the long order auto-regressive model (used to estimate the innovations)
+#' @param biasCorrection Bias correction
+#' @param finalCorrection Final correction as implemented in Tramo
+#'
+#' @return
+#' @export
+#'
+#' @examples
+#' y <- ABS$X0.2.09.10.M
+#' sarima_hannan_rissanen(y, order = c(0,1,1), seasonal = c(0,1,1))
+sarima_hannan_rissanen<-function(x, order=c(0,0,0), seasonal = list(order=c(0,0,0), period=NA), initialization=c("Ols", "Levinson", "Burg"), biasCorrection=TRUE, finalCorrection=TRUE){
+  if (!is.list(seasonal) && is.numeric(seasonal) && length(seasonal) == 3) {
+    initialization=match.arg(initialization)
+    seasonal <- list(order = seasonal,
+                     period = NA)
+  }
+  if (is.na(seasonal$period))
+    seasonal$period <- frequency(x)
+  jmodel<-.jcall("jdplus/toolkit/base/r/arima/SarimaModels", "Ljdplus/toolkit/base/core/sarima/SarimaModel;", "hannanRissanen",
+                 as.numeric(x), as.integer(order), as.integer(seasonal$period), as.integer(seasonal$order), as.character(initialization), as.logical(biasCorrection), as.logical(finalCorrection))
+  return (.jd2r_sarima(jmodel))
+}

R/decomposition.R

@@ -4,7 +4,7 @@
 NULL
 
 
-#' @rdname sa.decomposition
+#' @rdname sa_decomposition
 #' @export
 sadecomposition<-function(y, sa, t, s, i, mul){
   if (! is.logical(mul))stop("Invalid SA decomposition")
@@ -33,7 +33,7 @@ sadecomposition<-function(y, sa, t, s, i, mul){
   return (structure(list(series=y, sa=sa, trend=t, seas=s, irr=i, multiplicative=mul), class=c("JD3_SADECOMPOSITION", "JD3")))
 }
 
-#' @rdname sa.decomposition
+#' @rdname sa_decomposition
 #' @export
 print.JD3_SADECOMPOSITION<-function(x, n_last_obs = frequency(x$series), ...){
   cat("Last values\n")
@@ -43,7 +43,7 @@ print.JD3_SADECOMPOSITION<-function(x, n_last_obs = frequency(x$series), ...){
     )
   )
 }
-#' @rdname sa.decomposition
+#' @rdname sa_decomposition
 #' @export
 plot.JD3_SADECOMPOSITION <- function(x, first_date = NULL, last_date = NULL,
                        type_chart = c("sa-trend", "seas-irr"),
@@ -74,7 +74,7 @@ plot.JD3_SADECOMPOSITION <- function(x, first_date = NULL, last_date = NULL,
     # par(mar = c(5, 4, 4, 2) + 0.1)
     ts.plot(data_plot[, series_graph],
             col = colors[series_graph],
-            main = caption, lty = lty,
+            main = caption[1], lty = lty,
             ...)
     legend("bottomleft", legend = c("Series", "Trend","Seasonally adjusted"),
            col = colors[series_graph], lty = 1,
@@ -90,7 +90,7 @@ plot.JD3_SADECOMPOSITION <- function(x, first_date = NULL, last_date = NULL,
     # col <- colors[gsub("_.*$", "", series_graph)]
     ts.plot(data_plot[, series_graph],
             col = colors[series_graph],
-            main = caption, lty = lty,
+            main = caption[1], lty = lty,
             ...)
     legend("bottomleft", legend = c("Seas (component)",
                                     "Irregular"),

R/differencing.R

@@ -9,7 +9,7 @@ NULL
     del<-`rownames<-`(del, c("lag", "order"))
     return (list(ddata=p$stationary_series,
                  mean=p$mean_correction,
-            differences=del))
+                 differences=del))
   }
 }
 
@@ -34,11 +34,12 @@ NULL
 #' @export
 #'
 #' @examples
+#' do_stationary(log(ABS$X0.2.09.10.M),12)
 do_stationary<-function(data, period){
   if (is.ts(data) & missing(period))
     period <- frequency(data)
   jst<-.jcall("jdplus/toolkit/base/r/modelling/Differencing", "Ljdplus/toolkit/base/core/modelling/StationaryTransformation;", "doStationary",
-         as.numeric(data), as.integer(period))
+              as.numeric(data), as.integer(period))
   q<-.jcall("jdplus/toolkit/base/r/modelling/Differencing", "[B", "toBuffer", jst)
   p<-RProtoBuf::read(modelling.StationaryTransformation, q)
   res <- .p2r_differencing(p)
@@ -67,7 +68,7 @@ do_stationary<-function(data, period){
 #' @export
 #'
 #' @examples
-#' z <- differencing_fast(log(ABS$X0.2.09.10.M),12)
+#' differencing_fast(log(ABS$X0.2.09.10.M),12)
 #'
 differencing_fast<-function(data, period, mad=TRUE, centile=90, k=1.2){
   if (is.ts(data) & missing(period))
@@ -95,12 +96,32 @@ differencing_fast<-function(data, period, mad=TRUE, centile=90, k=1.2){
 #' differences(retail$BookStores, c(1,1,12), FALSE)
 #'
 differences<-function(data, lags=1, mean=TRUE){
+  UseMethod("differences", data)
+}
+#' @export
+differences.default<-function(data, lags=1, mean=TRUE){
   res <- .jcall("jdplus/toolkit/base/r/modelling/Differencing", "[D", "differences",
                 as.numeric(data), .jarray(as.integer(lags)), mean)
   if (is.ts(data))
     res <- ts(res, end = end(data), frequency = frequency(data))
   return (res)
 }
+#' @export
+differences.matrix<-function(data, lags=1, mean=TRUE){
+  result <- data[-(1:sum(lags)),]
+  for (i in seq_len(ncol(data))){
+    result[, i] <- differences(data[,i], lags = lags, mean = mean)
+  }
+  result
+}
+#' @export
+differences.data.frame<-function(data, lags=1, mean=TRUE){
+  result <- data[-(1:sum(lags)),]
+  for (i in seq_len(ncol(data))){
+    result[, i] <- differences(data[,i], lags = lags, mean = mean)
+  }
+  result
+}
 
 #' Range-Mean Regression
 #'