Merge pull request #29 from rjdemetra/develop

v3.2.2

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rjd3toolkit
 Type: Package
 Title: Toolkit Functions Around 'JDemetra+ 3.0'
-Version: 3.2.1
+Version: 3.2.2
 Authors@R: c(
   person("Jean", "Palate", role = c("aut", "cre"),
                 email = "jean.palate@nbb.be"),

NAMESPACE

@@ -64,7 +64,10 @@ export(.enum_extract)
 export(.enum_of)
 export(.enum_sextract)
 export(.enum_sof)
+export(.jd2p_calendars)
 export(.jd2p_context)
+export(.jd2p_variables)
+export(.jd2r_calendars)
 export(.jd2r_lts)
 export(.jd2r_matrix)
 export(.jd2r_modellingcontext)
@@ -73,14 +76,22 @@ export(.jd2r_ts)
 export(.jd2r_tscollection)
 export(.jd2r_tsdata)
 export(.jd2r_ucarima)
+export(.jd2r_variables)
 export(.jd3_object)
 export(.jdomain)
 export(.p2jd_calendar)
+export(.p2jd_calendars)
 export(.p2jd_context)
+export(.p2jd_variables)
 export(.p2r_arima)
+export(.p2r_calendars)
 export(.p2r_context)
 export(.p2r_datasupplier)
 export(.p2r_datasuppliers)
+export(.p2r_date)
+export(.p2r_iv)
+export(.p2r_ivs)
+export(.p2r_likelihood)
 export(.p2r_matrix)
 export(.p2r_metadata)
 export(.p2r_moniker)
@@ -94,6 +105,7 @@ export(.p2r_ramps)
 export(.p2r_regarima_rslts)
 export(.p2r_sa_decomposition)
 export(.p2r_sa_diagnostics)
+export(.p2r_sequences)
 export(.p2r_span)
 export(.p2r_spec_benchmarking)
 export(.p2r_spec_sarima)
@@ -119,6 +131,7 @@ export(.proc_str)
 export(.proc_test)
 export(.proc_ts)
 export(.proc_vector)
+export(.r2jd_calendars)
 export(.r2jd_make_ts)
 export(.r2jd_make_tscollection)
 export(.r2jd_matrix)
@@ -129,17 +142,23 @@ export(.r2jd_ts)
 export(.r2jd_tscollection)
 export(.r2jd_tsdata)
 export(.r2jd_tsdomain)
+export(.r2jd_variables)
 export(.r2p_calendar)
+export(.r2p_calendars)
 export(.r2p_context)
 export(.r2p_datasupplier)
 export(.r2p_datasuppliers)
+export(.r2p_date)
+export(.r2p_iv)
+export(.r2p_ivs)
 export(.r2p_lparameters)
 export(.r2p_metadata)
 export(.r2p_moniker)
 export(.r2p_outliers)
 export(.r2p_parameter)
 export(.r2p_parameters)
 export(.r2p_ramps)
+export(.r2p_sequences)
 export(.r2p_span)
 export(.r2p_spec_benchmarking)
 export(.r2p_spec_sarima)
@@ -170,6 +189,7 @@ export(cdf_inverse_gaussian)
 export(cdf_t)
 export(chained_calendar)
 export(clean_extremities)
+export(compare_annual_totals)
 export(data_to_ts)
 export(daysOf)
 export(density_chi2)
@@ -193,6 +213,7 @@ export(intervention_variable)
 export(jarquebera)
 export(julianeaster_variable)
 export(kurtosis)
+export(likelihood)
 export(ljungbox)
 export(long_term_mean)
 export(lp_variable)
@@ -258,6 +279,7 @@ export(to_tscollection)
 export(trigonometric_variables)
 export(ts_adjust)
 export(ts_interpolate)
+export(tsdata_of)
 export(tsmoniker)
 export(ucarima_canonical)
 export(ucarima_estimate)

R/arima.R

@@ -150,7 +150,7 @@ arima_model<-function(name="arima", ar=1, delta=1, ma=1, variance=1){
                  .jarray(as.numeric(model$ar)),
                  .jarray(as.numeric(model$delta)),
                  .jarray(as.numeric(model$ma)),
-                 as.numeric(model$var), F))
+                 as.numeric(model$var), FALSE))
 }
 
 #' Sum ARIMA Models
@@ -236,7 +236,7 @@ arima_properties<-function(model, nspectrum=601, nacf=36){
 #' @export
 #'
 #' @examples
-ucarima_model<-function(model=NULL, components, complements=NULL, checkmodel=F){
+ucarima_model<-function(model=NULL, components, complements=NULL, checkmodel=FALSE){
   if (is.null(model))
     model<-arima_lsum(components)
   else if (! is(model, "JD3_ARIMA") && ! is(model, "JD3_SARIMA")) stop("Invalid model")

R/calendars.R

@@ -676,7 +676,7 @@ weighted_calendar<-function(calendars, weights){
 #' More information on calendar correction in JDemetra+ online documentation:
 #' \url{https://jdemetra-new-documentation.netlify.app/}
 #' @export
-national_calendar<-function(days, mean_correction=T){
+national_calendar<-function(days, mean_correction=TRUE){
   if (! is.list(days)) stop ('Days should be a list of holidays')
   return (structure(list(days=days, mean_correction=mean_correction), class=c('JD3_CALENDAR', 'JD3_CALENDARDEFINITION')))
 }
@@ -836,4 +836,3 @@ print.JD3_WEIGHTEDCALENDAR <- function (x, ...)
 
   return(invisible(x))
 }
-

R/display.R

@@ -131,7 +131,7 @@ print.summary.JD3_SARIMA_ESTIMATION<-function(x, digits = max(3L, getOption("dig
       stde<-sqrt(diag(cov))
       sel<-fr$type=='ESTIMATED'
       t<-fr$value[sel]/stde
-      pval<-2*pt(abs(t), ndf, lower.tail = F)
+      pval<-2*pt(abs(t), ndf, lower.tail = FALSE)
       fr$stde[sel]<-stde
       fr$t[sel]<-t
       fr$pvalue[sel]<-pval
@@ -163,7 +163,7 @@ print.summary.JD3_SARIMA_ESTIMATION<-function(x, digits = max(3L, getOption("dig
   if (length(estimate) > 0){
     stde <- sqrt(diag(x$parameters$cov))
     t<-estimate/stde
-    pval<-2*pt(abs(t), ndf, lower.tail = F)
+    pval<-2*pt(abs(t), ndf, lower.tail = FALSE)
     table <- data.frame(estimate, "ESTIMATED", stde, t, pval)
     colnames(table) <- c("Estimate", "Type", "Std. Error",
                          "T-stat", "Pr(>|t|)")
@@ -313,7 +313,7 @@ print.JD3_SARIMA_ESTIMATE<-function(x, digits = max(3L, getOption("digits") - 3L
     sel<-xregs$type=='ESTIMATED'
     t<-xregs$value[sel]/stde
     ndf<-q$estimation$likelihood$neffectiveobs-q$estimation$likelihood$nparams+1
-    pval<-2*pt(abs(t), ndf, lower.tail = F)
+    pval<-2*pt(abs(t), ndf, lower.tail = FALSE)
     xregs$stde[sel]<-stde
     xregs$t[sel]<-t
     xregs$pvalue[sel]<-pval
@@ -331,7 +331,7 @@ print.JD3_SARIMA_ESTIMATE<-function(x, digits = max(3L, getOption("digits") - 3L
   if (length(estimate) > 0){
     stde <- sqrt(diag(x$bvar))
     t<-estimate/stde
-    pval<-2*pt(abs(t), ndf, lower.tail = F)
+    pval<-2*pt(abs(t), ndf, lower.tail = FALSE)
     table <- data.frame(estimate, "ESTIMATED", stde, t, pval)
     colnames(table) <- c("Estimate", "Type", "Std. Error",
                          "T-stat", "Pr(>|t|)")

R/jd2r.R

@@ -146,10 +146,12 @@ NULL
 #' @rdname jd3_utilities
 .jdomain<-function(period, start, end){
   if (period == 0)return (.jnull("jdplus/toolkit/base/api/timeseries/TsDomain"))
+  if (is.null(start))
+      start<-c(1900,1)
+  if (is.null(end))
+      end<-c(2100, 1)
   n<-period*(end[1]-start[1])+end[2]-start[2]
   jdom<-.jcall("jdplus/toolkit/base/r/timeseries/TsUtility", "Ljdplus/toolkit/base/api/timeseries/TsDomain;", "of"
                , as.integer(period), as.integer(start[1]), as.integer(start[2]), as.integer(n))
   return (jdom)
 }
-
-

R/modellingcontext.R

@@ -226,6 +226,41 @@ dynamic_ts<-function(moniker, data){
   return (l)
 }
 
+#' @export
+#' @rdname jd3_utilities
+.p2jd_variables<-function(p){
+    bytes<-p$serialize(NULL)
+    jcal <- .jcall("jdplus/toolkit/base/r/util/Modelling", "Ljdplus/toolkit/base/api/timeseries/regression/TsDataSuppliers;",
+                   "variablesOf",
+                   bytes)
+    return (jcal)
+}
+
+#' @export
+#' @rdname jd3_utilities
+.jd2p_variables<-function(jd){
+    bytes<-.jcall("jdplus/toolkit/base/r/util/Modelling", "[B", "toBuffer", jd)
+    p<-RProtoBuf::read(jd3.TsDataSuppliers, bytes)
+    return (p)
+}
+
+
+
+#' @export
+#' @rdname jd3_utilities
+.jd2r_variables<-function(jcals){
+    p<-.jd2p_variables(jcals)
+    return (.p2r_datasuppliers(p))
+}
+
+#' @export
+#' @rdname jd3_utilities
+.r2jd_variables<-function(r){
+    p<-.r2p_datasuppliers(r)
+    return (.p2jd_variables(p))
+}
+
+
 #' Create context
 #' @description
 #' Function allowing to include calendars and external regressors in a format that makes them usable
@@ -270,7 +305,7 @@ modelling_context<-function(calendars=NULL, variables=NULL){
     if (any(mts_var)) {
       # case of a simple mts dictionary
       for (i in which(mts_var)) {
-        all_var <- lapply(1:ncol(variables[[i]]), function(j) {
+        all_var <- lapply(seq_len(ncol(variables[[i]])), function(j) {
           variables[[i]][, j]
         })
         names(all_var) <- colnames(variables[[i]])
@@ -384,4 +419,67 @@ modelling_context<-function(calendars=NULL, variables=NULL){
   return (.p2jd_context(p))
 }
 
+#' @export
+#' @rdname jd3_utilities
+.p2r_calendars<-function(p){
+    n<-length(p$calendars)
+    lcal <- NULL
+    if (n > 0){
+        lcal<-lapply(1:n, function(i){return(.p2r_calendardef(p$calendars[[i]]$value))})
+        ns<-sapply(1:n, function(i){return(p$calendars[[i]]$key)})
+        names(lcal)<-ns
+    }
+    return (lcal)
+}
+
+#' @export
+#' @rdname jd3_utilities
+.r2p_calendars<-function(r){
+    p<-jd3.Calendars$new()
+    ns<-names(r)
+    n<-length(ns)
+    # To take into account empty calendars
+    length_cal <- sapply(r, length)
+
+    p$calendars<-lapply((1:n)[length_cal!=0], function(i){
+            entry<-jd3.Calendars$CalendarsEntry$new()
+            entry$key<-ns[i]
+            entry$value<-.r2p_calendardef(r[[i]])
+            return(entry)
+        })
+    return (p)
+}
+
+#' @export
+#' @rdname jd3_utilities
+.p2jd_calendars<-function(p){
+    bytes<-p$serialize(NULL)
+    jcal <- .jcall("jdplus/toolkit/base/r/util/Modelling", "Ljdplus/toolkit/base/api/timeseries/calendars/CalendarManager;",
+                   "calendarsOf",
+                   bytes)
+    return (jcal)
+}
+
+#' @export
+#' @rdname jd3_utilities
+.jd2p_calendars<-function(jd){
+    bytes<-.jcall("jdplus/toolkit/base/r/util/Modelling", "[B", "toBuffer", jd)
+    p<-RProtoBuf::read(jd3.Calendars, bytes)
+    return (p)
+}
+
+
+#' @export
+#' @rdname jd3_utilities
+.jd2r_calendars<-function(jcals){
+    p<-.jd2p_calendars(jcals)
+    return (.p2r_calendars(p))
+}
+
+#' @export
+#' @rdname jd3_utilities
+.r2jd_calendars<-function(r){
+    p<-.r2p_calendars(r)
+    return (.p2jd_calendars(p))
+}
 

R/procresults.R

@@ -6,7 +6,7 @@ RSLT<-'JD3_ProcResults'
 
 #' @export
 #' @rdname jd3_utilities
-.jd3_object<-function(jobjRef, subclasses=NULL, result=F){
+.jd3_object<-function(jobjRef, subclasses=NULL, result=FALSE){
   if (result)
     classes<-c(OBJ, RSLT, subclasses)
   else
@@ -64,5 +64,3 @@ user_defined <- function(object, userdefined = NULL){
   class(result) <- c("user_defined")
   result
 }
-
-