multivariate aggregate, differences, ts_adjust and ts_interpolate

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,6 +53,12 @@ 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)

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
 #'

R/timeseries.R

@@ -24,6 +24,12 @@ NULL
 #' # Quarterly mean
 #' aggregate(s, nfreq = 4, conversion = "Average")
 aggregate<-function(s, nfreq=1,
+                    conversion=c("Sum", "Average", "First", "Last", "Min", "Max"),
+                    complete=TRUE) {
+  UseMethod("aggregate", s)
+}
+#' @export
+aggregate.default<-function(s, nfreq=1,
                     conversion=c("Sum", "Average", "First", "Last", "Min", "Max"),
                     complete=TRUE){
   conversion <- match.arg(conversion)
@@ -39,6 +45,26 @@ aggregate<-function(s, nfreq=1,
     return (.jd2r_ts(jd_agg))
   }
 }
+#' @export
+aggregate.matrix <- function(s, nfreq=1,
+                    conversion=c("Sum", "Average", "First", "Last", "Min", "Max"),
+                    complete=TRUE) {
+  res <- do.call(cbind, lapply(seq_len(ncol(s)), function(i){
+    aggregate(s[,i], nfreq = nfreq, conversion = conversion, complete = complete)
+  }))
+  colnames(res) <- colnames(s)
+  res
+}
+#' @export
+aggregate.data.frame <- function(s, nfreq=1,
+                             conversion=c("Sum", "Average", "First", "Last", "Min", "Max"),
+                             complete=TRUE) {
+  res <- base::list2DF(lapply(seq_len(ncol(s)), function(i){
+    aggregate(s[,i], nfreq = nfreq, conversion = conversion, complete = complete)
+  }))
+  colnames(res) <- colnames(s)
+  res
+}
 
 #' Removal of missing values at the beginning/end
 #'
@@ -77,8 +103,11 @@ clean_extremities<-function(s){
 #' @return The interpolated series
 #' @export
 #'
-#' @examples
 ts_interpolate<-function(s, method=c("airline", "average")){
+  UseMethod("ts_interpolate", s)
+}
+#' @export
+ts_interpolate.default<-function(s, method=c("airline", "average")){
   method<-match.arg(method)
   if (is.null(s)){
     return (NULL)
@@ -93,6 +122,22 @@ ts_interpolate<-function(s, method=c("airline", "average")){
   }else
     return (NULL)
 }
+#' @export
+ts_interpolate.matrix <- function(s, method=c("airline", "average")){
+  result <- s
+  for (i in seq_len(ncol(s))){
+    result[, i] <- ts_interpolate(s[,i], method = method)
+  }
+  result
+}
+#' @export
+ts_interpolate.data.frame <- function(s, method=c("airline", "average")){
+  result <- s
+  for (i in seq_len(ncol(s))){
+    result[, i] <- ts_interpolate(s[,i], method = method)
+  }
+  result
+}
 
 #' Multiplicative adjustment of a time series for leap year / length of periods
 #'
@@ -106,7 +151,15 @@ ts_interpolate<-function(s, method=c("airline", "average")){
 #' @export
 #'
 #' @examples
+#' y <- ABS$X0.2.09.10.M
+#' ts_adjust(y)
+#' # with reverse we can find the
+#' all.equal(ts_adjust(ts_adjust(y), reverse = TRUE), y)
 ts_adjust<-function(s, method=c("LeapYear", "LengthOfPeriod"), reverse = FALSE){
+  UseMethod("ts_adjust", s)
+}
+#' @export
+ts_adjust.default<-function(s, method=c("LeapYear", "LengthOfPeriod"), reverse = FALSE){
   method<-match.arg(method)
   if (is.null(s)){
     return (NULL)
@@ -120,5 +173,21 @@ ts_adjust<-function(s, method=c("LeapYear", "LengthOfPeriod"), reverse = FALSE){
     return (.jd2r_ts(jd_st))
   }
 }
+#' @export
+ts_adjust.matrix <- function(s, method=c("LeapYear", "LengthOfPeriod"), reverse = FALSE){
+  result <- s
+  for (i in seq_len(ncol(s))){
+    result[, i] <- ts_adjust(s[,i], method = method, reverse = reverse)
+  }
+  result
+}
+#' @export
+ts_adjust.data.frame <- function(s, method=c("LeapYear", "LengthOfPeriod"), reverse = FALSE){
+  result <- s
+  for (i in seq_len(ncol(s))){
+    result[, i] <- ts_adjust(s[,i], method = method, reverse = reverse)
+  }
+  result
+}