Skip to content

Commit

Permalink
Merge pull request #153 from rjdverse/develop
Browse files Browse the repository at this point in the history
v0.2.7
  • Loading branch information
AQLT authored Oct 9, 2024
2 parents 2c5ed1f + ad984ae commit f598940
Show file tree
Hide file tree
Showing 28 changed files with 989 additions and 593 deletions.
5 changes: 3 additions & 2 deletions .github/workflows/R-CMD-check.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@ jobs:
- {os: windows-latest, r: 'release', java: 12, os-name: windows}
- {os: windows-latest, r: 'devel', java: 12, os-name: windows}
#- {os: windows-latest, r: 'oldrel', java: 12, os-name: windows}
- {os: macOS-latest, r: 'release', java: 12, os-name: macos}
- {os: macOS-latest, r: 'release', java: 13, os-name: macos}
- {os: macOS-latest, r: 'devel', java: 17, os-name: macos}
#- {os: macOS-latest, r: 'oldrel', java: 12, os-name: macos}
- {os: windows-latest, r: 'devel', java: 17, os-name: windows}
Expand All @@ -34,8 +34,9 @@ jobs:
steps:
- uses: actions/checkout@v2

- uses: actions/setup-java@v1
- uses: actions/setup-java@v4
with:
distribution: 'zulu'
java-version: ${{ matrix.config.java }}

- uses: r-lib/actions/setup-r@v2
Expand Down
8 changes: 4 additions & 4 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: RJDemetra
Type: Package
Title: Interface to 'JDemetra+' Seasonal Adjustment Software
Version: 0.2.6
Version: 0.2.7
Authors@R: c(
person("Alain", "Quartier-la-Tente", role = c("aut", "cre"),
email = "[email protected]",
Expand Down Expand Up @@ -31,7 +31,7 @@ LazyData: TRUE
Suggests:
knitr,
rmarkdown
URL: https://jdemetra.github.io/rjdemetra/, https://github.com/jdemetra/rjdemetra
BugReports: https://github.com/jdemetra/rjdemetra/issues
URL: https://rjdverse.github.io/rjdemetra/, https://github.com/rjdverse/rjdemetra
BugReports: https://github.com/rjdverse/rjdemetra/issues
Encoding: UTF-8
RoxygenNote: 7.3.1
RoxygenNote: 7.3.2
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -107,6 +107,7 @@ export(regarima_tramoseats)
export(regarima_x13)
export(s_arima)
export(s_arimaCoef)
export(s_benchmarking)
export(s_easter)
export(s_estimate)
export(s_fcst)
Expand Down
12 changes: 12 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,15 @@
# RJDemetra 0.2.7

- URL to github repository updated (github.com/jdemetra replaced by github.com/rjdverse).

- results of `user_defined_variables()` updated.

- README correction.

- benchmarking option added to `x13_spec()` and `tramoseats_spec()` and in output of `x13()` and `tramoseats()`.

- .jars updated.

# RJDemetra 0.2.6

- possibility to export last msr for monthly data (issue #122).
Expand Down
204 changes: 204 additions & 0 deletions R/benchmarking_spec.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,204 @@
benchmarking_spec_def <- function(spec,
benchmarking.enabled = NA,
benchmarking.target = c(NA, "Original", "CalendarAdjusted"),
benchmarking.useforecast = NA,
benchmarking.rho = NA_real_,
benchmarking.lambda = NA_real_)

{
default_spec <- data.frame(benchmarking.enabled = FALSE, benchmarking.target = "CalendarAdjusted",
benchmarking.useforecast = FALSE, benchmarking.rho = 1, benchmarking.lambda = 1)
if(identical(spec, "X11")) {
benchmarking.mod <- rbind(
default_spec,
default_spec,
NA)
return(spec_benchmarking(benchmarking.mod))
}

benchmarking.target <- match.arg(benchmarking.target)


list.logical <- list("benchmarking.enabled", "benchmarking.useforecast")
list.numeric <- list("benchmarking.rho", "benchmarking.lambda")

var.list <- list()
for (i in 1:length(list.logical)) {
eval(parse(text = paste("if( !is.logical(",list.logical[i],")) {",
list.logical[i],
" = NA; var.list=append(var.list,'",
list.logical[i],
"')}",
sep = "")))
}
if (length(var.list) > 0) {
warning(paste("Variable(s)",
deparse(as.character(var.list)),
" should be logical. They are ignored."),
call. = FALSE)
}

var.list <- list()
for (i in 1:length(list.numeric)) {
eval(parse(text = paste("if( !is.numeric(",
list.numeric[i],
")) {",
list.numeric[i],
" = NA; var.list=append(var.list,'",
list.numeric[i],
"')}",
sep = "")))
}
if (length(var.list) > 0) {
warning(paste("Variable(s)",
deparse(as.character(var.list)),
" should be numeric. They are ignored."),
call. = FALSE)
}

benchmarking <- data.frame(
benchmarking.enabled = benchmarking.enabled, benchmarking.target = benchmarking.target,
benchmarking.useforecast = benchmarking.useforecast, benchmarking.rho = benchmarking.rho,
benchmarking.lambda = benchmarking.lambda)
benchmarking.mod <- rbind(
default_spec,
benchmarking,
NA)
return(spec_benchmarking(benchmarking.mod))
}

spec_benchmarking <- function(benchmarking){

for (i in c("benchmarking.enabled", "benchmarking.target", "benchmarking.useforecast",
"benchmarking.rho", "benchmarking.lambda")){
benchmarking[3,i] <- if (!is.na(benchmarking[2,i])) {benchmarking[2,i]} else {benchmarking[1,i]}
}
if (!benchmarking[3,"benchmarking.enabled"]) {
benchmarking[3, "benchmarking.target"] <- "CalendarAdjusted"
benchmarking[3, "benchmarking.useforecast"] <- FALSE
benchmarking[3, "benchmarking.rho"] <- 1
benchmarking[3, "benchmarking.lambda"] <- 1
}

rownames(benchmarking) <- c("Predefined","User_modif","Final")
class(benchmarking) <- c("benchmarking_spec", "data.frame")
return(benchmarking)
}

benchmarking_spec<- function(spec,
benchmarking.enabled = NA,
benchmarking.target = c(NA, "Original", "CalendarAdjusted"),
benchmarking.useforecast = NA,
benchmarking.rho = NA_real_,
benchmarking.lambda = NA_real_)

{
benchmarking.target <- match.arg(benchmarking.target)

list.logical <- list("benchmarking.enabled", "benchmarking.useforecast")
list.numeric <- list("benchmarking.rho", "benchmarking.lambda")

var.list <- list()
for (i in 1:length(list.logical)) {
eval(parse(text = paste("if( !is.logical(",list.logical[i],")) {",
list.logical[i],
" = NA; var.list=append(var.list,'",
list.logical[i],
"')}",
sep = "")))
}
if (length(var.list) > 0) {
warning(paste("Variable(s)",
deparse(as.character(var.list)),
" should be logical. They are ignored."),
call. = FALSE)
}

var.list <- list()
for (i in 1:length(list.numeric)) {
eval(parse(text = paste("if( !is.numeric(",
list.numeric[i],
")) {",
list.numeric[i],
" = NA; var.list=append(var.list,'",
list.numeric[i],
"')}",
sep = "")))
}
if (length(var.list) > 0) {
warning(paste("Variable(s)",
deparse(as.character(var.list)),
" should be numeric. They are ignored."),
call. = FALSE)
}

benchmarking <- data.frame(
benchmarking.enabled = benchmarking.enabled, benchmarking.target = benchmarking.target,
benchmarking.useforecast = benchmarking.useforecast, benchmarking.rho = benchmarking.rho,
benchmarking.lambda = benchmarking.lambda)
benchmarking.spec <- s_benchmarking(spec)
benchmarking.mod <- rbind(benchmarking.spec, benchmarking, NA)
return(spec_benchmarking(benchmarking.mod))
}


spec_benchmarking_r2jd <- function(rspec = NA, jdspec = NA){
benchmarking <- s_benchmarking(rspec)
jbench <- .jcall(jdspec,"Ljdr/spec/sa/SaBenchmarkingSpec;","getBenchmarking")

.jcall(jbench, "V", "setEnabled", benchmarking[["benchmarking.enabled"]])
if (benchmarking[["benchmarking.enabled"]]) {
.jcall(jbench, "V", "setTarget", benchmarking[["benchmarking.target"]])
.jcall(jbench, "V", "setUseForecast", benchmarking[["benchmarking.useforecast"]])
.jcall(jbench, "V", "setRho", benchmarking[["benchmarking.rho"]])
.jcall(jbench, "V", "setLambda", benchmarking[["benchmarking.lambda"]])
}

return(jbench)
}

spec_benchmarking_jd2r <- function(jrobj){
jbench <- .jcall(jrobj, "Ljdr/spec/sa/SaBenchmarkingSpec;", "getBenchmarking")
benchmarking.target <- .jcall(jbench, "Ljava/lang/String;", "getTarget")
benchmarking.enabled <- .jcall(jbench, "Z", "isEnabled")
benchmarking.useforecast <- .jcall(jbench, "Z", "isUseForecast")
benchmarking.rho <- .jcall(jbench, "D", "getRho")
benchmarking.lambda <- .jcall(jbench, "D", "getLambda")

data.frame(
benchmarking.enabled = benchmarking.enabled, benchmarking.target = benchmarking.target,
benchmarking.useforecast = benchmarking.useforecast, benchmarking.rho = benchmarking.rho,
benchmarking.lambda = benchmarking.lambda)
}

benchmarking <- function(jrobj,spec){
specification <- spec[3,]
rownames(specification) <- ""
if(specification[["benchmarking.enabled"]]) {
original <- result(jrobj, "benchmarking.original")
result <- result(jrobj, "benchmarking.result")
Differences <- original - result
bench_res <- ts.union(original, result, Differences)
} else {
bench_res <- NULL
}
z <- list(specification = specification, benchmarking = bench_res)
class(z) <- c("benchmarking")
return(z)
}

benchmarking_def <- function(jrobj,jspec){
specification <- spec_benchmarking_jd2r(jspec)
rownames(specification) <- ""
if(specification[["benchmarking.enabled"]]) {
original <- result(jrobj, "benchmarking.original")
result <- result(jrobj, "benchmarking.result")
Differences <- original - result
bench_res <- ts.union(original, result, Differences)
} else {
bench_res <- NULL
}
z <- list(specification = specification, benchmarking = bench_res)
class(z) <- c("benchmarking")
return(z)
}
10 changes: 6 additions & 4 deletions R/get_jspec.R
Original file line number Diff line number Diff line change
Expand Up @@ -15,17 +15,19 @@ get_jspec.X13 <- function(x, ...){
} else {
jrspec <- .jcall("jdr/spec/x13/X13Spec", "Ljdr/spec/x13/X13Spec;", "of", "RSA0")
}
jdictionary <- spec_regarima_X13_r2jd(spec,jrspec)
seasma <- specX11_r2jd(spec,jrspec, freq = frequency(x$final$series))
spec_regarima_X13_r2jd(spec,jrspec)
specX11_r2jd(spec,jrspec, freq = frequency(x$final$series))
spec_benchmarking_r2jd(spec, jrspec)
jspec <- .jcall(jrspec, "Lec/satoolkit/x13/X13Specification;", "getCore")
jspec
}
#' @export
get_jspec.TRAMO_SEATS <- function(x, ...){
spec <- tramoseats_spec(x, ...)
jrspec <- .jcall("jdr/spec/tramoseats/TramoSeatsSpec", "Ljdr/spec/tramoseats/TramoSeatsSpec;", "of", "RSA0")
jdictionary <- spec_TRAMO_r2jd(spec,jrspec)
spec_seats <- specSeats_r2jd(spec,jrspec)
spec_TRAMO_r2jd(spec,jrspec)
specSeats_r2jd(spec,jrspec)
spec_benchmarking_r2jd(spec, jrspec)
jspec <- .jcall(jrspec, "Lec/satoolkit/tramoseats/TramoSeatsSpecification;", "getCore")
jspec
}
Expand Down
2 changes: 1 addition & 1 deletion R/init.R
Original file line number Diff line number Diff line change
Expand Up @@ -229,7 +229,7 @@ rjdemetra_java <- new.env(parent = emptyenv())
rjdemetra_java$clobject <- NULL

check_valid_java_version <- function(){
# Check Java version >= 8 and <= 15
# Check Java version >= 8
jv <- rJava::.jcall("java/lang/System", "S", "getProperty", "java.version")
if(jv < "1.8.0")
return (FALSE)
Expand Down
1 change: 1 addition & 0 deletions R/jtramoseats.R
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@ jtramoseats.SA_spec <- function(series, spec,
jrspec <- .jcall("jdr/spec/tramoseats/TramoSeatsSpec", "Ljdr/spec/tramoseats/TramoSeatsSpec;", "of", "RSA0")
jdictionary <- spec_TRAMO_r2jd(spec,jrspec)
specSeats_r2jd(spec,jrspec)
spec_benchmarking_r2jd(rspec = spec, jdspec = jrspec)
jspec <- .jcall(jrspec, "Lec/satoolkit/tramoseats/TramoSeatsSpecification;", "getCore")
jrslt <- .jcall("ec/tstoolkit/jdr/sa/Processor", "Lec/tstoolkit/jdr/sa/TramoSeatsResults;", "tramoseats", ts_r2jd(series), jspec, jdictionary )
jrslt <- new (Class = "TramoSeats_java", internal = jrslt)
Expand Down
1 change: 1 addition & 0 deletions R/jx13.R
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,7 @@ jx13.SA_spec <- function(series, spec, userdefined = NULL){
}
jdictionary <- spec_regarima_X13_r2jd(spec, jrspec)
seasma <- specX11_r2jd(spec, jrspec, freq = frequency(series))
spec_benchmarking_r2jd(rspec = spec, jdspec = jrspec)
jspec <- .jcall(jrspec, "Lec/satoolkit/x13/X13Specification;", "getCore")
jrslt <- .jcall("ec/tstoolkit/jdr/sa/Processor", "Lec/tstoolkit/jdr/sa/X13Results;", "x13", ts_r2jd(series), jspec, jdictionary)
jrslt <- new(Class = "X13_java", internal = jrslt)
Expand Down
Loading

0 comments on commit f598940

Please sign in to comment.