From fce38d928c812af1256559dd27aa12cce8ecdfc9 Mon Sep 17 00:00:00 2001 From: Lemasson Corentin Date: Tue, 16 Jul 2024 14:42:20 +0200 Subject: [PATCH 1/2] add output residuals --- R/tempdisagg.R | 62 +++++++++++++++++++++++++++++++++------- man/denton_modelbased.Rd | 4 +-- 2 files changed, 54 insertions(+), 12 deletions(-) diff --git a/R/tempdisagg.R b/R/tempdisagg.R index 2ff8ff7..6f50191 100644 --- a/R/tempdisagg.R +++ b/R/tempdisagg.R @@ -60,11 +60,11 @@ temporaldisaggregation<-function(series, constant = TRUE, trend = FALSE, indic } } else if (is.ts(indicators)){ jlist[[1]]<-rjd3toolkit::.r2jd_tsdata(indicators) - } else { + } else{ stop("Invalid indicators") } jindicators<-.jarray(jlist, contents.class = "jdplus/toolkit/base/api/timeseries/TsData") - } else { + } else{ jindicators<-.jnull("[Ljdplus/toolkit/base/api/timeseries/TsData;") } jrslt<-.jcall("jdplus/benchmarking/base/r/TemporalDisaggregation", "Ljdplus/benchmarking/base/core/univariate/TemporalDisaggregationResults;", @@ -92,8 +92,8 @@ temporaldisaggregation<-function(series, constant = TRUE, trend = FALSE, indic regeffect=rjd3toolkit::.proc_ts(jrslt, "regeffect"), smoothingpart=rjd3toolkit::.proc_numeric(jrslt, "smoothingpart"), parameter=rjd3toolkit::.proc_numeric(jrslt, "parameter"), - eparameter=rjd3toolkit::.proc_numeric(jrslt, "eparameter") - # res= TODO + eparameter=rjd3toolkit::.proc_numeric(jrslt, "eparameter"), + residuals= .proc_residuals(jrslt) # temporary solution (see function below) ) likelihood<-rjd3toolkit::.proc_likelihood(jrslt, "likelihood.") @@ -180,7 +180,7 @@ temporaldisaggregationI<-function(series, indicator, print.JD3TempDisagg<-function(x, ...){ if (is.null(x$regression$model)){ cat("Invalid estimation") - } else { + } else{ cat("Model:", x$regression$type, "\n") print(x$regression$model) @@ -205,7 +205,7 @@ print.JD3TempDisagg<-function(x, ...){ print.JD3TempDisaggI<-function(x, ...){ if (is.null(x$estimation$parameter)){ cat("Invalid estimation") - } else { + } else{ model<-data.frame(coef = c(round(x$regression$a, 4), round(x$regression$b, 4))) row.names(model)<-c("a", "b") print(model) @@ -254,7 +254,7 @@ summary_disagg<-function(object){ if (is.null(object)){ cat("Invalid estimation") - } else { + } else{ cat("\n") cat("Likelihood statistics", "\n") cat("\n") @@ -298,7 +298,7 @@ summary.JD3TempDisaggI<-function(object, ...){ if (is.null(object)){ cat("Invalid estimation") - } else { + } else{ cat("\n") cat("Likelihood statistics", "\n") cat("\n") @@ -336,7 +336,7 @@ plot.JD3TempDisagg<-function(x, ...){ if (is.null(x)){ cat("Invalid estimation") - } else { + } else{ td_series <- x$estimation$disagg reg_effect <- x$estimation$regeffect smoothing_effect <- td_series - reg_effect @@ -364,9 +364,51 @@ plot.JD3TempDisaggI<-function(x, ...){ if (is.null(x)){ cat("Invalid estimation") - } else { + } else{ td_series <- x$estimation$disagg ts.plot(td_series, gpars=list(xlab="", ylab="disaggragated series", xaxt="n")) axis(side=1, at=start(td_series)[1]:end(td_series)[1]) } } + +# TEMPORARY SOLUTION +# For the next release, we should use proto and move the functions to rjd3toolkit +.proc_residuals <- function (jrslt){ + + z<-rjd3toolkit::.jd3_object(jrslt, "TD", TRUE) + + full_residuals <- get_result_item(z,"residuals.fullresiduals") + + extr_normality <- list(get_result_item(z,"residuals.mean"), + get_result_item(z,"residuals.skewness"), + get_result_item(z,"residuals.kurtosis"), + get_result_item(z,"residuals.doornikhansen")) + extr_independence <- get_result_item(z,"residuals.ljungbox") + extr_randomness <- list(get_result_item(z,"residuals.nruns"), + get_result_item(z,"residuals.lruns"), + get_result_item(z,"residuals.nudruns"), + get_result_item(z,"residuals.ludruns")) + linearity_test <- tryCatch(rjd3toolkit::ljungbox(full_residuals^2, k = 8, lag = 1, mean = TRUE), error=function(err) NaN) + + + normality <- matrix(unlist(extr_normality), nrow = 4, ncol = 2, byrow = TRUE, + dimnames = list(c("mean", "skewness", "kurtosis", "test(doornikhansen)"), c("value", "p-value"))) + independence <- matrix(unlist(extr_independence), nrow = 1, ncol = 2, byrow = TRUE, + dimnames = list(c("ljung_box"), c("value", "p-value"))) + randomness <- matrix(unlist(extr_randomness), nrow = 4, ncol = 2, byrow = TRUE, + dimnames = list(c("Runs around the mean: number", "Runs around the mean: length", "Up and Down runs: number", "Up and Down runs: length"), c("value", "p-value"))) + linearity <- matrix(unlist(linearity_test), nrow = 1, ncol = 2, byrow = TRUE, + dimnames = list(c("ljung_box on squared residuals"), c("value", "p-value"))) + + return(list(full_residuals=full_residuals, + tests=list(normality=round(normality,4), + independence=round(independence,4), + randomness=round(randomness,4), + linearity=round(linearity,4)))) + +} + +get_result_item <- function(jd3_obj, item){ + return(tryCatch(rjd3toolkit::result(jd3_obj, item), + error=function(err) NaN)) +} diff --git a/man/denton_modelbased.Rd b/man/denton_modelbased.Rd index f3f9221..61ee845 100644 --- a/man/denton_modelbased.Rd +++ b/man/denton_modelbased.Rd @@ -29,8 +29,8 @@ denton_modelbased( first in the format YYYY-MM-DD and enclosed in quotation marks. This must be followed by an equal sign and the intensity of the outlier, defined as the relative value of the 'innovation variances' (1= normal situation)} -\item{fixedBIratios}{a list of structured definition of the periods where the BI ratios must be fixed. The period must be -submitted first in the format YYYY-MM-DD and enclosed in quotation marks. This must be followed by an +\item{fixedBIratios}{a list of structured definition of the periods where the BI ratios must be fixed. The period must be +submitted first in the format YYYY-MM-DD and enclosed in quotation marks. This must be followed by an equal sign and the value of the BI ratio.} } \value{ From a537839da0ec8c7296c5d1c7aaeade0a0f329e28 Mon Sep 17 00:00:00 2001 From: Lemasson Corentin Date: Tue, 16 Jul 2024 14:44:10 +0200 Subject: [PATCH 2/2] update NEWS.md --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index 471b390..96ee9aa 100644 --- a/NEWS.md +++ b/NEWS.md @@ -7,6 +7,8 @@ to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). ## [Unreleased] +* Add output on residuals in temporaldisaggregation() function + ## [2.0.1] - 2024-07-12