Skip to content

Commit

Permalink
Merge pull request #10 from rjdemetra/develop
Browse files Browse the repository at this point in the history
v2.0.0
  • Loading branch information
palatej authored Dec 12, 2023
2 parents 564dc36 + 18d3f68 commit a55dfc0
Show file tree
Hide file tree
Showing 17 changed files with 366 additions and 56 deletions.
7 changes: 4 additions & 3 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: rjd3bench
Type: Package
Title: Interface to 'JDemetra+ 3.0' Seasonal Adjustment Software
Version: 1.0.0
Version: 2.0.0
Authors@R: c(
person("Jean", "Palate", role = c("aut", "cre"),
email = "[email protected]"))
Expand All @@ -10,8 +10,8 @@ Depends:
R (>= 3.6.0)
Imports:
rJava (>= 1.0-6),
rjd3toolkit (>= 3.0.1),
RProtoBuf (>= 0.4.17)
rjd3toolkit (>= 3.2.1),
RProtoBuf (>= 0.4.20)
SystemRequirements: Java SE 8 or higher
License: EUPL
URL: https://github.com/jdemetra/rjd3sa
Expand All @@ -21,6 +21,7 @@ RoxygenNote: 7.2.3
BugReports: https://github.com/jdemetra/rjdemetra3/issues
Encoding: UTF-8
Collate:
'adl.R'
'utils.R'
'benchmark.R'
'calendarization.R'
Expand Down
4 changes: 4 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,14 +1,18 @@
# Generated by roxygen2: do not edit by hand

S3method(plot,JD3AdlDisagg)
S3method(plot,JD3MBDenton)
S3method(plot,JD3TempDisagg)
S3method(plot,JD3TempDisaggI)
S3method(print,JD3AdlDisagg)
S3method(print,JD3MBDenton)
S3method(print,JD3TempDisagg)
S3method(print,JD3TempDisaggI)
S3method(summary,JD3AdlDisagg)
S3method(summary,JD3MBDenton)
S3method(summary,JD3TempDisagg)
S3method(summary,JD3TempDisaggI)
export(adl_disaggregation)
export(calendarization)
export(cholette)
export(cubicspline)
Expand Down
131 changes: 131 additions & 0 deletions R/adl.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,131 @@
#' Title
#'
#' @param series
#' @param constant
#' @param trend
#' @param indicators
#' @param conversion
#' @param conversion.obsposition
#' @param phi
#' @param phi.fixed
#' @param phi.truncated
#' @param xar
#'
#' @return
#' @export
#'
#' @examples
#' # qna data, fernandez with/without quarterly indicator
#' data("qna_data")
#' Y<-ts(qna_data$B1G_Y_data[,"B1G_FF"], frequency=1, start=c(2009,1))
#' x<-ts(qna_data$TURN_Q_data[,"TURN_INDEX_FF"], frequency=4, start=c(2009,1))
#' td1<-rjd3bench::adl_disaggregation(Y, indicators=x, xar="FREE")
#' td2<-rjd3bench::adl_disaggregation(Y, indicators=x, xar="SAME")
adl_disaggregation<-function(series, constant=T, trend=F, indicators=NULL,
conversion=c("Sum", "Average", "Last", "First", "UserDefined"), conversion.obsposition=1,
phi=0, phi.fixed=F, phi.truncated=0, xar=c("FREE", "SAME", "NONE")){
conversion=match.arg(conversion)
xar=match.arg(xar)
jseries<-rjd3toolkit::.r2jd_tsdata(series)
jlist<-list()
if (!is.null(indicators)){
if (is.list(indicators)){
for (i in 1:length(indicators)){
jlist[[i]]<-rjd3toolkit::.r2jd_tsdata(indicators[[i]])
}
}else if (is.ts(indicators)){
jlist[[1]]<-rjd3toolkit::.r2jd_tsdata(indicators)
}else{
stop("Invalid indicators")
}
jindicators<-.jarray(jlist, contents.class = "jdplus/toolkit/base/api/timeseries/TsData")
}else{
jindicators<-.jnull("[Ljdplus/toolkit/base/api/timeseries/TsData;")
}
jrslt<-.jcall("jdplus/benchmarking/base/r/TemporalDisaggregation", "Ljdplus/benchmarking/base/core/univariate/ADLResults;",
"processADL", jseries, constant, trend, jindicators, conversion,
phi, phi.fixed, phi.truncated, xar)

# Build the S3 result
bcov<-rjd3toolkit::.proc_matrix(jrslt, "covar")
vars<-rjd3toolkit::.proc_vector(jrslt, "regnames")
coef<-rjd3toolkit::.proc_vector(jrslt, "coeff")
se<-sqrt(diag(bcov))
t<-coef/se
m<-data.frame(coef, se, t)
m<-`row.names<-`(m, vars)

regression<-list(
type=xar,
conversion=conversion,
model=m,
cov=bcov
)
estimation<-list(
disagg=rjd3toolkit::.proc_ts(jrslt, "disagg"),
edisagg=rjd3toolkit::.proc_ts(jrslt, "edisagg"),
parameter=rjd3toolkit::.proc_numeric(jrslt, "parameter"),
eparameter=rjd3toolkit::.proc_numeric(jrslt, "eparameter")
# res= TODO
)
likelihood<-rjd3toolkit::.proc_likelihood(jrslt, "likelihood.")

return(structure(list(
regression=regression,
estimation=estimation,
likelihood=likelihood),
class="JD3AdlDisagg"))
}

#' Print function for object of class JD3AdlDisagg
#'
#' @param x an object of class JD3AdlDisagg
#'
#' @return
#' @export
#'
#' @examples
#' Y<-rjd3toolkit::aggregate(rjd3toolkit::retail$RetailSalesTotal, 1)
#' x<-rjd3toolkit::retail$FoodAndBeverageStores
#' td<-rjd3bench::adl_disaggregation(Y, indicator=x, xar="FREE")
#' print(td)
#'
print.JD3AdlDisagg<-function(x, ...){
if (is.null(x$regression$model)){
cat("Invalid estimation")
}else{
cat("Model:", x$regression$type, "\n")
print(x$regression$model)

cat("\n")
cat("Use summary() for more details. \nUse plot() to see the decomposition of the disaggregated series.")
}
}

#' Plot function for object of class JD3AdlDisagg
#'
#' @param x an object of class JD3AdlDisagg
#' @param \dots further arguments to pass to ts.plot.
#'
#' @export
#'
#' @examples
#' Y<-rjd3toolkit::aggregate(rjd3toolkit::retail$RetailSalesTotal, 1)
#' x<-rjd3toolkit::retail$FoodAndBeverageStores
#' td<-rjd3bench::adl_disaggregation(Y, indicator=x, xar="FREE")
#' plot(td)
#'
plot.JD3AdlDisagg<-function(x, ...){
if (is.null(x)){
cat("Invalid estimation")

}else{
td_series <- x$estimation$disagg

ts.plot(td_series, gpars=list(col=c("orange"), xlab = "", xaxt="n", las=2, ...))
axis(side=1, at=start(td_series)[1]:end(td_series)[1])
legend("topleft",c("disaggragated series"),lty = c(1,1,1), col=c("orange"), bty="n", cex=0.8)
}
}


28 changes: 14 additions & 14 deletions R/benchmark.R
Original file line number Diff line number Diff line change
Expand Up @@ -40,16 +40,16 @@ denton<-function(s=NULL, t, d=1, mul=TRUE, nfreq=4, modified=TRUE,

conversion=match.arg(conversion)

jd_t<-rjd3toolkit::.r2jd_ts(t)
jd_t<-rjd3toolkit::.r2jd_tsdata(t)

if (!is.null(s)){
jd_s<-rjd3toolkit::.r2jd_ts(s)
jd_s<-rjd3toolkit::.r2jd_tsdata(s)
} else{
jd_s<-as.integer(nfreq)
}
jd_rslt<-.jcall("jdplus/benchmarking/base/r/Benchmarking", "Ljdplus/toolkit/base/api/timeseries/TsData;", "denton"
,jd_s, jd_t, as.integer(d), mul, modified, conversion, as.integer(obsposition))
rjd3toolkit::.jd2r_ts(jd_rslt)
rjd3toolkit::.jd2r_tsdata(jd_rslt)
}


Expand Down Expand Up @@ -81,11 +81,11 @@ grp<-function(s, t,

conversion=match.arg(conversion)

jd_s<-rjd3toolkit::.r2jd_ts(s)
jd_t<-rjd3toolkit::.r2jd_ts(t)
jd_s<-rjd3toolkit::.r2jd_tsdata(s)
jd_t<-rjd3toolkit::.r2jd_tsdata(t)
jd_rslt<-.jcall("jdplus/benchmarking/base/r/Benchmarking", "Ljdplus/toolkit/base/api/timeseries/TsData;", "grp"
,jd_s, jd_t, conversion, as.integer(obsposition), eps, as.integer(iter), as.logical(denton))
rjd3toolkit::.jd2r_ts(jd_rslt)
rjd3toolkit::.jd2r_tsdata(jd_rslt)
}

#' Benchmarking by means of cubic splines
Expand Down Expand Up @@ -129,16 +129,16 @@ cubicspline<-function(s=NULL, t, nfreq=4,

conversion=match.arg(conversion)

jd_t<-rjd3toolkit::.r2jd_ts(t)
jd_t<-rjd3toolkit::.r2jd_tsdata(t)

if (!is.null(s)){
jd_s<-rjd3toolkit::.r2jd_ts(s)
jd_s<-rjd3toolkit::.r2jd_tsdata(s)
} else{
jd_s<-as.integer(nfreq)
}
jd_rslt<-.jcall("jdplus/benchmarking/base/r/Benchmarking", "Ljdplus/toolkit/base/api/timeseries/TsData;", "cubicSpline"
,jd_s, jd_t, conversion, as.integer(obsposition))
rjd3toolkit::.jd2r_ts(jd_rslt)
rjd3toolkit::.jd2r_tsdata(jd_rslt)
}


Expand All @@ -161,11 +161,11 @@ cubicspline<-function(s=NULL, t, nfreq=4,
#'
#'
cholette<-function(s, t, rho=1, lambda=1, bias="None", conversion="Sum", obsposition=1){
jd_s<-rjd3toolkit::.r2jd_ts(s)
jd_t<-rjd3toolkit::.r2jd_ts(t)
jd_s<-rjd3toolkit::.r2jd_tsdata(s)
jd_t<-rjd3toolkit::.r2jd_tsdata(t)
jd_rslt<-.jcall("jdplus/benchmarking/base/r/Benchmarking", "Ljdplus/toolkit/base/api/timeseries/TsData;", "cholette"
,jd_s, jd_t, rho, lambda, bias, conversion, as.integer(obsposition))
rjd3toolkit::.jd2r_ts(jd_rslt)
rjd3toolkit::.jd2r_tsdata(jd_rslt)
}

#' Multi-variate Cholette
Expand All @@ -187,7 +187,7 @@ multivariatecholette<-function(xlist, tcvector=NULL, ccvector=NULL, rho=1, lambd
#create the input
jdic=.jnew("jdplus/toolkit/base/r/util/Dictionary")
for(i in seq_along(xlist)){
.jcall(jdic, "V", "add", names(xlist[i]), rjd3toolkit::.r2jd_ts(xlist[[i]]))
.jcall(jdic, "V", "add", names(xlist[i]), rjd3toolkit::.r2jd_tsdata(xlist[[i]]))
}
if (is.null(tcvector)){
ntc=0
Expand Down Expand Up @@ -219,7 +219,7 @@ multivariatecholette<-function(xlist, tcvector=NULL, ccvector=NULL, rho=1, lambd
for(i in seq_along(rnames)){
jts<-.jcall(jd_rslt, "Ljdplus/toolkit/base/api/timeseries/TsData;", "get", rnames[i])
if (! is.jnull(jts)){
rlist[[rnames[i]]]<-rjd3toolkit::.jd2r_ts(jts)
rlist[[rnames[i]]]<-rjd3toolkit::.jd2r_tsdata(jts)
}
}
return (rlist)
Expand Down
22 changes: 16 additions & 6 deletions R/mbdenton.R
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,9 @@ NULL
#' @param outliers a list of structured definition of the outlier periods and their intensity. 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 intensity of the outlier, defined as the relative value of the 'innovation variances' (1= normal situation)
#' @param 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.
#' @return an object of class 'JD3MBDenton'
#' @export
#'
Expand All @@ -34,8 +37,8 @@ NULL
#' Y<-ts(qna_data$B1G_Y_data[,"B1G_FF"], frequency=1, start=c(2009,1))
#' x<-ts(qna_data$TURN_Q_data[,"TURN_INDEX_FF"], frequency=4, start=c(2009,1))
#'
#' td1<-rjd3bench::denton_modelbased(Y,x)
#' td2<-rjd3bench::denton_modelbased(Y, x, outliers = list("2020-04-01"=100))
#' td1<-rjd3bench::denton_modelbased(Y, x)
#' td2<-rjd3bench::denton_modelbased(Y, x, outliers=list("2020-04-01"=100), fixedBIratios=list("2021-04-01"=39.0))
#'
#' bi1<-td1$estimation$biratio
#' bi2<-td2$estimation$biratio
Expand All @@ -47,22 +50,29 @@ NULL
#' }
#'
denton_modelbased<-function(series, indicator, differencing=1, conversion=c("Sum", "Average", "Last", "First", "UserDefined"), conversion.obsposition=1,
outliers=NULL){
outliers=NULL, fixedBIratios=NULL){

conversion=match.arg(conversion)

jseries=rjd3toolkit::.r2jd_ts(series)
jseries=rjd3toolkit::.r2jd_tsdata(series)
jindicator<-rjd3toolkit::.r2jd_tsdata(indicator)
if (is.null(outliers)){
odates=.jcast(.jnull(), "[Ljava/lang/String;")
ovars=.jnull("[D")
}else{
odates=.jarray(names(outliers))
ovars=.jarray(as.numeric(outliers))
}
jindicator<-rjd3toolkit::.r2jd_ts(indicator)
if (is.null(fixedBIratios)){
fdates=.jcast(.jnull(), "[Ljava/lang/String;")
fvars=.jnull("[D")
}else{
fdates=.jarray(names(fixedBIratios))
fvars=.jarray(as.numeric(fixedBIratios))
}
jrslt<-.jcall("jdplus/benchmarking/base/r/TemporalDisaggregation", "Ljdplus/benchmarking/base/core/univariate/ModelBasedDentonResults;",
"processModelBasedDenton", jseries, jindicator, as.integer(1), conversion, as.integer(conversion.obsposition), odates, ovars,
.jcast(.jnull(), "[Ljava/lang/String;"), .jnull("[D"))
fdates, fvars)
# Build the S3 result
estimation<-list(
disagg=rjd3toolkit::.proc_ts(jrslt, "disagg"),
Expand Down
Loading

0 comments on commit a55dfc0

Please sign in to comment.