Initial commit

.Rbuildignore

@@ -0,0 +1,2 @@
+^.*\.Rproj$
+^\.Rproj\.user$

.gitignore

@@ -0,0 +1,4 @@
+.Rproj.user
+.Rhistory
+.RData
+.Ruserdata

DESCRIPTION

@@ -0,0 +1,26 @@
+Package: rjd3stl
+Type: Package
+Title: Interface to 'JDemetra+ 3.0' Seasonal Adjustment Software
+Version: 1.0.0
+Authors@R: c(
+  person("Jean", "Palate", role = c("aut", "cre"),
+                email = "[email protected]"))
+Description: Interface around 'JDemetra+ 3.x' sa-toolkit (<https://github.com/jdemetra/jdemetra-core>), STACE project 
+Depends:
+  R (>= 3.6.0)
+Imports:
+  rJava (>= 1.0-6),
+  rjd3toolkit (>= 3.0.0)
+SystemRequirements: Java JRE 17 or higher
+License: EUPL
+URL: https://github.com/jdemetra/rjd3stl
+LazyData: TRUE
+Suggests:
+    knitr,
+    rmarkdown
+RoxygenNote: 7.2.3
+BugReports: https://github.com/jdemetra/rjdemetra3/issues
+Encoding: UTF-8
+Collate: 
+    'jd3_stl.R'
+    'zzz.R'

NAMESPACE

@@ -0,0 +1,8 @@
+# Generated by roxygen2: do not edit by hand
+
+export(istl)
+export(loess)
+export(mstl)
+export(stl)
+import(rJava)
+import(rjd3toolkit)

R/jd3_stl.R

@@ -0,0 +1,173 @@
+
+#' Title
+#'
+#' Perform an STL like (based on Loess) decomposition on any periodicity
+#'
+#' @param y input time series.
+#' @param period period, any positive real number.
+#' @param multiplicative Boolean indicating if the decomposition mode is multiplicative (TRUE).
+#' @param swindow length of seasonal filter.
+#' @param twindow length of trend filter.
+#' @param ninnerloop Number of inner loops
+#' @param nouterloop Number of outer loops (computation of robust weights) 
+#' @param nojump 
+#' @param weight.threshold Weights threshold (in [0, 0.3])
+#' @param weight.function weights function
+#'
+#' @return
+#' @export
+#'
+#' @examples 
+#' q<-rjd3stl::stl(rjd3toolkit::ABS$X0.2.09.10.M, 12)
+#' decomp<-q$decomposition
+stl<-function(y, period, multiplicative=TRUE, swindow=7, twindow=0, ninnerloop=1, nouterloop=15, nojump=FALSE, weight.threshold=0.001, 
+    weight.function=c('BIWEIGHT', 'UNIFORM', 'TRIANGULAR', 'EPANECHNIKOV', 'TRICUBE', 'TRIWEIGHT')){
+  weight.function=match.arg(weight.function)
+
+  jrslt<-.jcall("jdplus/stl/base/r/StlDecomposition", "Ljdplus/toolkit/base/api/math/matrices/Matrix;", "stl", as.numeric(y), as.integer(period), as.logical(multiplicative), as.integer(swindow), as.integer(twindow), 
+                as.integer(ninnerloop), as.integer(nouterloop), as.logical(nojump), as.numeric(weight.threshold), as.character(weight.function))
+  m<-rjd3toolkit::.jd2r_matrix(jrslt)
+  colnames(m)<-c('y', 'sa', 't', 's', 'i', 'fit', 'weights')
+  parameters<-list(
+    multiplicative=multiplicative, 
+    swindow=swindow, 
+    twindow=twindow, 
+    ninnerloop=ninnerloop,
+    nouterloop=nouterloop,
+    weight.threshold=weight.threshold,
+    weight.function=weight.function
+  )
+
+  return(structure(list(
+    decomposition=m,
+    parameters=parameters),
+    class="JD3_STL"))
+}
+
+#' Title
+#'
+#' @param y 
+#' @param periods 
+#' @param multiplicative 
+#' @param swindows 
+#' @param twindow 
+#' @param ninnerloop 
+#' @param nouterloop 
+#' @param nojump 
+#' @param weight.threshold 
+#' @param weight.function 
+#'
+#' @return
+#' @export
+#'
+#' @examples
+#' q<-rjd3stl::mstl(rjd3toolkit::ABS$X0.2.09.10.M, c(12, 25))
+#' decomp<-q$decomposition
+mstl<-function(y, periods, multiplicative=TRUE, swindows=NULL, twindow=0, ninnerloop=1, nouterloop=15, nojump=FALSE, weight.threshold=0.001, 
+              weight.function=c('BIWEIGHT', 'UNIFORM', 'TRIANGULAR', 'EPANECHNIKOV', 'TRICUBE', 'TRIWEIGHT')){
+  weight.function=match.arg(weight.function)
+
+  if (is.null(swindows))
+    swin<-.jnull("[I")
+  else
+    swin<-.jarray(as.integer(swindows))
+
+  jrslt<-.jcall("jdplus/stl/base/r/StlDecomposition", "Ljdplus/toolkit/base/api/math/matrices/Matrix;", "mstl", as.numeric(y), .jarray(as.integer(periods)), as.logical(multiplicative), swin, as.integer(twindow), 
+                as.integer(ninnerloop), as.integer(nouterloop), as.logical(nojump), as.numeric(weight.threshold), as.character(weight.function))
+  m<-rjd3toolkit::.jd2r_matrix(jrslt)
+
+  snames<-paste('s', as.integer(periods), sep='')
+  colnames(m)<-c('y', 'sa', 't', snames, 'i', 'fit', 'weights')
+  parameters<-list(
+    multiplicative=multiplicative, 
+    swindow=swindows, 
+    twindow=twindow, 
+    ninnerloop=ninnerloop,
+    nouterloop=nouterloop,
+    weight.threshold=weight.threshold,
+    weight.function=weight.function
+  )
+
+  return(structure(list(
+    decomposition=m,
+    parameters=parameters),
+    class="JD3_STL"))
+}
+
+#' Title
+#'
+#' @param y 
+#' @param periods 
+#' @param multiplicative 
+#' @param swindows 
+#' @param twindows 
+#' @param ninnerloop 
+#' @param nouterloop 
+#' @param nojump 
+#' @param weight.threshold 
+#' @param weight.function 
+#'
+#' @return
+#' @export
+#'
+#' @examples
+#' q<-rjd3stl::istl(rjd3toolkit::ABS$X0.2.09.10.M, c(12, 25))
+#' decomp<-q$decomposition
+istl<-function(y, periods, multiplicative=TRUE, swindows=NULL, twindows=NULL, ninnerloop=1, nouterloop=15, nojump=FALSE, weight.threshold=0.001, 
+              weight.function=c('BIWEIGHT', 'UNIFORM', 'TRIANGULAR', 'EPANECHNIKOV', 'TRICUBE', 'TRIWEIGHT')){
+  weight.function=match.arg(weight.function)
+  if (is.null(swindows))
+    swin<-.jnull("[I")
+  else
+    swin<-.jarray(as.integer(swindows))
+  if (is.null(twindows))
+    twin<-.jnull("[I")
+  else
+    twin<-.jarray(as.integer(twindows))
+
+  jrslt<-.jcall("jdplus/stl/base/r/StlDecomposition", "Ljdplus/toolkit/base/api/math/matrices/Matrix;", "istl", as.numeric(y), .jarray(as.integer(periods)), as.logical(multiplicative), swin, twin, 
+                as.integer(ninnerloop), as.integer(nouterloop), as.logical(nojump), as.numeric(weight.threshold), as.character(weight.function))
+  m<-rjd3toolkit::.jd2r_matrix(jrslt)
+  snames<-paste('s', as.integer(periods), sep='')
+  colnames(m)<-c('y', 'sa', 't', snames, 'i', 'fit', 'weights')
+  parameters<-list(
+    multiplicative=multiplicative, 
+    swindows=swindows, 
+    twindows=twindows, 
+    ninnerloop=ninnerloop,
+    nouterloop=nouterloop,
+    weight.threshold=weight.threshold,
+    weight.function=weight.function
+  )
+
+  return(structure(list(
+    decomposition=m,
+    parameters=parameters),
+    class="JD3_STL"))
+}
+
+
+
+#' Fit a Loess regression.
+#'
+#' @param y input time series.
+#' @param window 
+#' @param degree 
+#' @param jump 
+#'
+#' @return
+#' @export
+#'
+#' @examples
+#' q<-rjd3stl::stl(rjd3toolkit::ABS$X0.2.09.10.M, 12)
+#' decomp<-q$decomposition
+#' t<-decomp[,'t']
+#' matplot(cbind(t,loess(t, 121)), type='l')
+loess<-function(y, window, degree=1, jump=0){
+  if (degree != 0 && degree != 1)
+    stop("Unsupported degree")
+  if (jump <0)
+    stop("jump should be positive")
+  return (.jcall("jdplus/stl/base/r/StlDecomposition", "[D", "loess", as.numeric(y), as.integer(window), as.integer(degree), as.integer(jump)))
+}
+

R/zzz.R

@@ -0,0 +1,15 @@
+#' @import rJava
+#' @import rjd3toolkit
+
+.onLoad <- function(libname, pkgname) {
+  if (! requireNamespace("rjd3toolkit", quietly=T)) stop("Loading rjd3 libraries failed")
+
+  result <- rJava::.jpackage(pkgname, lib.loc=libname)
+  if (!result) stop("Loading java packages failed")
+
+  #proto.dir <- system.file("proto", package = pkgname)
+  #RProtoBuf::readProtoFiles2(protoPath = proto.dir)
+
+  # reload extractors
+  #.jcall("demetra/information/InformationExtractors", "V", "reloadExtractors")
+}

README.md

@@ -0,0 +1,2 @@
+# rjd3stl
+STL in R