Skip to content

Commit

Permalink
Merge pull request #58 from palatej/develop
Browse files Browse the repository at this point in the history
Documentation
  • Loading branch information
palatej authored Aug 1, 2024
2 parents 37ca33a + 42420ad commit 4955a22
Show file tree
Hide file tree
Showing 16 changed files with 194 additions and 100 deletions.
1 change: 1 addition & 0 deletions .Rbuildignore
Original file line number Diff line number Diff line change
Expand Up @@ -25,3 +25,4 @@ cran-comments.md
^revdep$
^reconf\.sh$
^pom\.xml$

2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ Imports:
checkmate,
methods
SystemRequirements: Java (>= 17)
License: EUPL
License: file LICENSE
URL: https://github.com/rjdverse/rjd3toolkit, https://rjdverse.github.io/rjd3toolkit/
LazyData: TRUE
Suggests:
Expand Down
89 changes: 58 additions & 31 deletions R/arima.R
Original file line number Diff line number Diff line change
Expand Up @@ -185,21 +185,22 @@ arima_lsum<-function(components){
return(.jd2r_arima(jsum))
}

#' Remove an arima model from an existing one
#' Remove an arima model from an existing one. More exactly, m_diff = m_left - m_right iff m_left = m_right + m_diff.
#'
#' @param left Left operand
#' @param right Right operand
#' @param simplify Simplify the results
#' @param left Left operand (JD3_ARIMA object)
#' @param right Right operand (JD3_ARIMA object)
#' @param simplify Simplify the results if possible (common roots in the auto-regressive and in the moving average polynomials, including unit roots)
#'
#' @return a `"JD3_ARIMA"` model.
#' @export
#'
#' @details
#'
#' @examples
#' mod1 = arima_model(delta = c(1,-2,1))
#' mod2 = arima_model(variance=.01)
#' diff<- arima_difference(mod1, mod2)
#' diff <- arima_difference(mod1, mod2)
#' sum <- arima_sum(diff, mod2)
#' # sum should be equal to mod1
#'
arima_difference<-function(left, right, simplify=TRUE){
jleft<-.r2jd_arima(left)
Expand All @@ -209,33 +210,39 @@ arima_difference<-function(left, right, simplify=TRUE){
}


#' ARIMA Properties
#' Properties of an ARIMA model; the (pseudo-)spectrum and the auto-covariances of the model are returned
#'
#' @param model a `"JD3_ARIMA"` model (created with [arima_model()]).
#' @param nspectrum number of points in \[0, pi\] to calculate the spectrum.
#' @param nacf maximum lag at which to calculate the acf.
#' @param nspectrum number of points to calculate the spectrum; th points are uniformly distributed in \[0, pi\]
#' @param nac maximum lag at which to calculate the auto-covariances; if the model is non-stationary, the auto-covariances are computed on its stationary transformation.
#' @returns A list with tha auto-covariances and with the (pseudo-)spectrum
#'
#' @examples
#' mod1 = arima_model(ar = c(0.1, 0.2), delta = 0, ma = 0)
#' mod1 <- arima_model(ar = c(0.1, 0.2), delta = c(1,-1), ma = 0)
#' arima_properties(mod1)
#' @export
arima_properties<-function(model, nspectrum=601, nacf=36){
arima_properties<-function(model, nspectrum=601, nac=36){
jmodel<-.r2jd_arima(model)
spectrum<-.jcall("jdplus/toolkit/base/r/arima/ArimaModels", "[D", "spectrum", jmodel, as.integer(nspectrum))
acf<-.jcall("jdplus/toolkit/base/r/arima/ArimaModels", "[D", "acf", jmodel, as.integer(nacf))
acf<-.jcall("jdplus/toolkit/base/r/arima/ArimaModels", "[D", "acf", jmodel, as.integer(nac))
return(list(acf=acf, spectrum=spectrum))
}

#' Title
#' Creates an UCARIMA model, which is composed of ARIMA models with independent innovations.
#'
#' @param model
#' @param components
#' @param complements Complements of (some) components
#' @param model The reduced model. Usually not provided.
#' @param components The ARIMA models representing the components
#' @param complements Complements of (some) components. Usually not provided
#' @param checkmodel When the model is provided and *checkmodel* is TRUE, we check that it indeed corresponds to the reduced form of the components; similar controls are applied on complements. Currently not implemented
#'
#' @return
#' @return A list with the reduced model, the components and their complements
#' @export
#'
#' @examples
#' mod1 <- arima_model("trend", delta = c(1,-2,1))
#' mod2 <- arima_model("noise", var = 1600)
#' hp<-ucarima_model(components=list(mod1, mod2))
#' print(hp$model)
ucarima_model<-function(model=NULL, components, complements=NULL, checkmodel=FALSE){
if (is.null(model))
model<-arima_lsum(components)
Expand Down Expand Up @@ -265,16 +272,22 @@ ucarima_model<-function(model=NULL, components, complements=NULL, checkmodel=FAL

#' Wiener Kolmogorov Estimators
#'
#' @param ucm UCARIMA model returned by [ucarima_model()].
#' @param cmp
#' @param signal
#' @param nspectrum
#' @param nwk
#' @param ucm An UCARIMA model returned by [ucarima_model()].
#' @param cmp Index of the component for which we want to compute the filter
#' @param signal TRUE for the signal (component), FALSE for the noise (complement)
#' @param nspectrum Number of points used to compute the (pseudo-) spectrum of the estimator
#' @param nwk Number of weights of the wiener-kolmogorov filter returned in the result
#'
#' @return
#' @return A list with the (pseudo-)spectrum, the weights of the filter and the squared-gain function (with the same number of points as the spectrum)
#' @export
#'
#' @examples
#' mod1 <- arima_model("trend", delta = c(1,-2,1))
#' mod2 <- arima_model("noise", var = 1600)
#' hp<-ucarima_model(components=list(mod1, mod2))
#' wk1<-ucarima_wk(hp, 1, nwk=50)
#' wk2<-ucarima_wk(hp, 2)
#' plot(wk1$filter, type='h')
ucarima_wk<-function(ucm, cmp, signal=TRUE, nspectrum=601, nwk=300){
jucm<-.r2jd_ucarima(ucm)
jwks<-.jcall("jdplus/toolkit/base/r/arima/UcarimaModels", "Ljdplus/toolkit/base/core/ucarima/WienerKolmogorovEstimators;", "wienerKolmogorovEstimators", jucm)
Expand All @@ -287,15 +300,21 @@ ucarima_wk<-function(ucm, cmp, signal=TRUE, nspectrum=601, nwk=300){
return(structure(list(spectrum=spectrum, filter=wk, gain2=gain*gain), class="JD3_UCARIMA_WK"))
}

#' Title
#' Makes a UCARIMA model canonical; more specifically, put all the noise of the components in one dedicated component
#'
#' @inheritParams ucarima_wk
#' @param adjust
#' @param ucm An UCARIMA model returned by [ucarima_model()].
#' @param cmp Index of the component that will contain the noises; 0 if a new component with all the noises will be added to the model
#' @param adjust If TRUE, some noise could be added to the model to ensure that all the components has positive (pseudo-)spectrum
#'
#' @return
#' @return A new UCARIMA model
#' @export
#'
#' @examples
#' mod1 <- arima_model("trend", delta = c(1,-2,1))
#' mod2 <- arima_model("noise", var = 1600)
#' hp <- ucarima_model(components=list(mod1, mod2))
#' hpc <- ucarima_canonical(hp, cmp=2)

ucarima_canonical<-function(ucm, cmp=0, adjust=TRUE){
jucm<-.r2jd_ucarima(ucm)
jnucm<-.jcall("jdplus/toolkit/base/r/arima/UcarimaModels", "Ljdplus/toolkit/base/core/ucarima/UcarimaModel;", "doCanonical",
Expand All @@ -306,13 +325,21 @@ ucarima_canonical<-function(ucm, cmp=0, adjust=TRUE){
#' Estimate UCARIMA Model
#'
#' @inheritParams ucarima_wk
#' @param x univariate time series
#' @param stdev
#' @param x Univariate time series
#' @param stdev TRUE if standard deviation of the components are computed
#'
#' @return matrix containing the different components.
#' @return A matrix containing the different components and their standard deviations if stdev is TRUE.
#' @export
#'
#' @examples
#' mod1 <- arima_model("trend", delta = c(1,-2,1))
#' mod2 <- arima_model("noise", var = 16)
#' hp <- ucarima_model(components=list(mod1, mod2))
#' s <- log(aggregate(retail$AutomobileDealers))
#' all <- ucarima_estimate(s, hp, stdev=TRUE)
#' plot(s, type = 'l')
#' t <- ts(all[,1], frequency = frequency(s), start = start(s))
#' lines(t, col='blue')
ucarima_estimate<-function(x, ucm, stdev=TRUE){
jucm<-.r2jd_ucarima(ucm)
jcmps<-.jcall("jdplus/toolkit/base/r/arima/UcarimaModels", "Ljdplus/toolkit/base/api/math/matrices/Matrix;", "estimate",
Expand Down Expand Up @@ -353,7 +380,7 @@ sarima_estimate<-function(x, order=c(0,0,0), seasonal = list(order=c(0,0,0), per
if (length(res$b) > 0) {

names_xreg <- colnames(xreg)
if (is.null (names_xreg) && !is.null (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)))
Expand Down
6 changes: 3 additions & 3 deletions R/calendars.R
Original file line number Diff line number Diff line change
Expand Up @@ -691,7 +691,7 @@ weighted_calendar<-function(calendars, weights){
#' \url{https://jdemetra-new-documentation.netlify.app/}
#' @export
national_calendar <- function(days, mean_correction=TRUE){
if (! is.list(days)) stop ('Days should be a list of holidays')
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')))
}

Expand Down Expand Up @@ -825,7 +825,7 @@ print.JD3_CALENDAR <- function(x, ...) {
}

#' @export
print.JD3_CHAINEDCALENDAR <- function (x, ...)
print.JD3_CHAINEDCALENDAR <- function(x, ...)
{
cat("First calendar before ", x$break_date, "\n", sep = "")
print(x$calendar1)
Expand All @@ -839,7 +839,7 @@ print.JD3_CHAINEDCALENDAR <- function (x, ...)
}

#' @export
print.JD3_WEIGHTEDCALENDAR <- function (x, ...)
print.JD3_WEIGHTEDCALENDAR <- function(x, ...)
{
for (index_cal in seq_along(x$weights)) {
cat("Calendar n", index_cal, "\n", sep = "")
Expand Down
30 changes: 15 additions & 15 deletions R/jd3rslts.R
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@
if (!is.jnull(s))
.jcall(s, "D", "doubleValue")
else
return (NaN)
return(NaN)
}
#' @export
#' @rdname jd3_utilities
Expand Down Expand Up @@ -38,11 +38,11 @@
.proc_ts<-function(rslt, name){
s<-.jcall(rslt, "Ljava/lang/Object;", "getData", name)
if (is.jnull(s))
return (NULL)
return(NULL)
if (.jinstanceof(s, "jdplus/toolkit/base/api/timeseries/TsData"))
return(.jd2r_tsdata(.jcast(s,"jdplus/toolkit/base/api/timeseries/TsData")))
else
return (NULL)
return(NULL)
}
#' @export
#' @rdname jd3_utilities
Expand Down Expand Up @@ -80,7 +80,7 @@
if (is.jnull(s))
return(NULL)
val<-.jcall(s, "D", "getValue")
return (val)
return(val)
}
#' @export
#' @rdname jd3_utilities
Expand All @@ -102,38 +102,38 @@
s<-.jcall(rslt, "Ljava/lang/Object;", "getData", name)
if (is.jnull(s))
return(NULL)
return (.jd2r_matrix(s))
return(.jd2r_matrix(s))
}
#' @export
#' @rdname jd3_utilities
.proc_data<-function(rslt, name){
s<-.jcall(rslt, "Ljava/lang/Object;", "getData", name)
if (is.jnull(s))
return (NULL)
return(NULL)
if (.jinstanceof(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"))
return(.jcall(s, "D", "doubleValue"))
else if (.jinstanceof(s, "jdplus/toolkit/base/api/math/matrices/Matrix"))
return(.jd2r_matrix(.jcast(s,"jdplus/toolkit/base/api/math/matrices/Matrix")))
else if (.jinstanceof(s, "jdplus/toolkit/base/api/data/Parameter")){
val<-.jcall(s, "D", "getValue")
return (c(val))
return(c(val))
} else if (.jinstanceof(s, "[Ljdplus/toolkit/base/api/data/Parameter;")){
p<-.jcastToArray(s)
len<-length(p)
all<-array(0, dim=c(len))
for (i in 1:len){
all[i]<-.jcall(p[[i]], "D", "getValue")
}
return (all)
return(all)
} else if (.jcall(.jcall(s, "Ljava/lang/Class;", "getClass"), "Z", "isArray"))
return (.jevalArray(s, silent=TRUE))
return(.jevalArray(s, silent=TRUE))
else if (.jinstanceof(s, "jdplus/toolkit/base/api/stats/StatisticalTest")) {
return (.jd2r_test(s))
return(.jd2r_test(s))
}
else
return (.jcall(s, "S", "toString"))
return(.jcall(s, "S", "toString"))
}

#' @export
Expand All @@ -151,7 +151,7 @@
keys[i] <- .jcall(.jcall(jiter, "Ljava/lang/Object;", "next"), "Ljava/lang/String;", "toString")
}
}
return (keys)
return(keys)
}

#' @export
Expand All @@ -167,13 +167,13 @@
keys[i] <- .jcall(.jcall(jiter, "Ljava/lang/Object;", "next"), "Ljava/lang/String;", "toString")
}
}
return (keys)
return(keys)
}

#' @export
#' @rdname jd3_utilities
.proc_likelihood<-function(jrslt, prefix){
return (list(
return(list(
ll=.proc_numeric(jrslt, paste(prefix,"ll", sep="")),
ssq=.proc_numeric(jrslt, paste(prefix,"ssqerr", sep="")),
nobs=.proc_int(jrslt, paste(prefix,"nobs", sep="")),
Expand Down
2 changes: 1 addition & 1 deletion R/modellingcontext.R
Original file line number Diff line number Diff line change
Expand Up @@ -312,7 +312,7 @@ modelling_context<-function(calendars=NULL, variables=NULL){
variables[[i]] <- all_var
}
}
if (any (ts_var)) {
if (any(ts_var)) {
# case of a simple ts dictionary
# Use 'r' as the name of the dictionary
variables <- c(variables[!ts_var], list(r = variables[ts_var]))
Expand Down
Loading

0 comments on commit 4955a22

Please sign in to comment.