Merge branch 'develop' of https://github.com/AQLT/rjd3toolkit into de…

…velop

.gitignore

@@ -3,3 +3,5 @@
 .Rhistory
 .RData
 .Ruserdata
+
+TO_DO

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rjd3toolkit
 Type: Package
 Title: Toolkit Functions Around 'JDemetra+ 3.0'
-Version: 3.0.1
+Version: 3.1.1
 Authors@R: c(
   person("Jean", "Palate", role = c("aut", "cre"),
                 email = "jean.palate@nbb.be"),
@@ -15,7 +15,7 @@ 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

NAMESPACE

@@ -65,10 +65,13 @@ 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)
@@ -79,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)
@@ -95,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)
@@ -113,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)
@@ -132,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)
@@ -155,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)
@@ -204,6 +220,7 @@ export(sa_preprocessing)
 export(sadecomposition)
 export(sarima_decompose)
 export(sarima_estimate)
+export(sarima_hannan_rissanen)
 export(sarima_model)
 export(sarima_properties)
 export(sarima_random)
@@ -235,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,7 +68,8 @@ 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 into three components trend, seasonal, irregular
@@ -349,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/jd2r.R

@@ -16,7 +16,7 @@ NULL
 
 #' @export
 #' @rdname jd3_utilities
-.r2jd_ts<-function(s){
+.r2jd_tsdata<-function(s){
   if (is.null(s)){
     return (NULL)
   }
@@ -35,8 +35,8 @@ NULL
 
 #' @export
 #' @rdname jd3_utilities
-.jd2r_ts<-function(s){
-  if (is.null(s)){
+.jd2r_tsdata<-function(s){
+  if (is.jnull(s)){
     return (NULL)
   }
   jx<-.jcall(s, "Ljdplus/toolkit/base/api/data/DoubleSeq;", "getValues")
@@ -50,16 +50,34 @@ NULL
 #' @export
 #' @rdname jd3_utilities
 .jd2r_mts<-function(s){
-  if (is.null(s)){
+  if (is.jnull(s)){
     return (NULL)
   }
   jx<-.jcall(s, "Ljdplus/toolkit/base/api/math/matrices/Matrix;", "toMatrix")
   x<-.jd2r_matrix(jx)
-  if (is.null(x)) return (NULL)
+  if (is.jnull(x)) return (NULL)
   pstart<-.jcall("jdplus/toolkit/base/r/timeseries/TsUtility", "[I", "startPeriod", s)
   ts(x,start=pstart[2:3], frequency=pstart[1])
 }
 
+.extract_jts<-function(collection, index){
+  js<- .jcall(collection, "Ljdplus/toolkit/base/api/timeseries/Ts;", "get", as.integer(index-1) )
+  return (js)
+}
+
+#' @export
+#' @rdname jd3_utilities
+.jd2r_lts<-function(s){
+  if (is.jnull(s)){
+    return (NULL)
+  }
+  size<-.jcall(s, "I", "length")
+  if (size == 0)
+    return (NULL)
+  all <- lapply(1:size, function(idx){ return (.jd2r_ts(.extract_jts(s, idx)))} )
+  return (all)
+}
+
 #' @export
 #' @rdname jd3_utilities
 .jd2r_matrix<-function(s){

R/jd3rslts.R

@@ -40,7 +40,7 @@
   if (is.jnull(s))
     return (NULL)
   if (.jinstanceof(s, "jdplus/toolkit/base/api/timeseries/TsData"))
-    return(.jd2r_ts(.jcast(s,"jdplus/toolkit/base/api/timeseries/TsData")))
+    return(.jd2r_tsdata(.jcast(s,"jdplus/toolkit/base/api/timeseries/TsData")))
   else
     return (NULL)
 }
@@ -111,7 +111,7 @@
   if (is.jnull(s))
     return (NULL)
   if (.jinstanceof(s, "jdplus/toolkit/base/api/timeseries/TsData"))
-    return(.jd2r_ts(.jcast(s,"jdplus/toolkit/base/api/timeseries/TsData")))
+    return(.jd2r_tsdata(.jcast(s,"jdplus/toolkit/base/api/timeseries/TsData")))
   else if (.jinstanceof(s, "java/lang/Number"))
     return (.jcall(s, "D", "doubleValue"))
   else if (.jinstanceof(s, "jdplus/toolkit/base/api/math/matrices/Matrix"))