Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Documentation #58

Merged
merged 3 commits into from
Aug 1, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
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
Loading