Skip to content

Commit

Permalink
Merge branch 'develop' into develop
Browse files Browse the repository at this point in the history
  • Loading branch information
AQLT authored Oct 16, 2024
2 parents 404bfed + eacbcce commit ab8eb43
Show file tree
Hide file tree
Showing 19 changed files with 482 additions and 102 deletions.
26 changes: 13 additions & 13 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -4,15 +4,15 @@ Title: Trend-Cycle Extraction with Linear Filters based on JDemetra+ v3.x
Version: 2.1.1.9000
Authors@R: c(
person("Jean", "Palate", role = c("aut"),
email = "[email protected]"),
person("Alain", "Quartier-la-Tente", role = c("aut", "cre"),
email = "[email protected]",
comment = c(ORCID = "0000-0001-7890-3857")),
person("Tanguy", "Barthelemy", role = c("ctb", "art"),
email ="[email protected]"),
email = "[email protected]"),
person("Alain", "Quartier-la-Tente", role = c("aut","cre"),
email = "[email protected]",
comment = c(ORCID = "0000-0001-7890-3857")),
person("Tanguy", "Barthelemy", role = c("ctb"),
email ="[email protected]"),
person("Anna", "Smyk", role = c("ctb"),
email ="[email protected]")
)
email ="[email protected]")
)
Description: This package provides functions to build and apply symmetric
and asymmetric moving averages (= linear filters) for trend-cycle extraction.
In particular, it implements several modern approaches for real-time estimates
Expand All @@ -29,17 +29,17 @@ Imports:
MASS,
graphics,
stats,
rjd3toolkit (>= 3.2.2)
Remotes:
github::rjdverse/rjd3toolkit
rjd3toolkit (> 3.2.4)
Remotes:
github::rjdverse/rjd3toolkit
SystemRequirements: Java (>= 17)
License: EUPL
License: file LICENSE
LazyData: TRUE
URL: https://github.com/rjdverse/rjd3filters, https://rjdverse.github.io/rjd3filters/
Suggests:
knitr,
rmarkdown
VignetteBuilder: knitr
RoxygenNote: 7.3.1
RoxygenNote: 7.3.2
Roxygen: list(markdown = TRUE)
Encoding: UTF-8
2 changes: 2 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -62,11 +62,13 @@ export(loocve)
export(lower_bound)
export(lp_filter)
export(mirror)
export(mmsre_filter)
export(moving_average)
export(mse)
export(plot_coef)
export(plot_gain)
export(plot_phase)
export(polynomial_matrix)
export(rkhs_filter)
export(rkhs_kernel)
export(rkhs_optimal_bw)
Expand Down
11 changes: 10 additions & 1 deletion NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -7,8 +7,17 @@ to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).

## [Unreleased]

## [2.1.1] - 2024-07-12
## Added

* New function `polynomial_matrix()` to create a matrix of polynomial terms.

* New function `mmsre_filter()` to compute the general Proietti and Luati (2008) filter with extension for non symmetric filters and with Timeliness criterion.

### Changed

* `filter()` correction when the length of the series equals the length of the filter.

## [2.1.1] - 2024-12-07

### Changed

Expand Down
1 change: 0 additions & 1 deletion R/2_finite_filters.R
Original file line number Diff line number Diff line change
Expand Up @@ -46,7 +46,6 @@ finite_filters.moving_average <- function(sfilter,
rfilters <- rev(lapply(lfilters, rev.moving_average))
} else if (is.null(lfilters) && is.null(rfilters)) {
rfilters <- lfilters <- list()

}
res <- new("finite_filters",
sfilter = sfilter, lfilters = lfilters,
Expand Down
40 changes: 25 additions & 15 deletions R/RKHS.R
Original file line number Diff line number Diff line change
Expand Up @@ -89,13 +89,16 @@ rkhs_optimization_fun <- function(horizon = 6, leads = 0, degree = 2,
smoothness = "Smoothness",
undefined = "Undefined")
density <- match.arg(density)
optimalFunCriteria <- J("jdplus/filters/base/r/RKHSFilters")$optimalCriteria(
as.integer(horizon), as.integer(leads), as.integer(degree), kernel,
asymmetricCriterion, density=="rw", passband
)$applyAsDouble

jfun <-
.jcall(
"jdplus/filters/base/r/RKHSFilters",
"Ljava/util/function/DoubleUnaryOperator;",
"optimalCriteria",
as.integer(horizon), as.integer(leads), as.integer(degree), kernel,
asymmetricCriterion, density=="rw", passband
)
Vectorize(function(x){
optimalFunCriteria(x)
.jcall(jfun, "D", "applyAsDouble", x)
})
}
#' Optimal Bandwith of Reproducing Kernel Hilbert Space (RKHS) Filters
Expand Down Expand Up @@ -124,10 +127,14 @@ rkhs_optimal_bw <- function(horizon = 6, degree = 2,
smoothness = "Smoothness",
undefined = "Undefined")
density <- match.arg(density)
optimalBw <- J("jdplus/filters/base/r/RKHSFilters")$optimalBandwidth(
as.integer(horizon), as.integer(degree), kernel,
asymmetricCriterion, density=="rw", passband, optimal.minBandwidth, optimal.maxBandwidth
)
optimalBw <-
.jcall(
"jdplus/filters/base/r/RKHSFilters",
"[D",
"optimalBandwidth",
as.integer(horizon), as.integer(degree), kernel,
asymmetricCriterion, density=="rw", passband, optimal.minBandwidth, optimal.maxBandwidth
)
names(optimalBw) <- sprintf("q=%i", 0:(horizon-1))
optimalBw
}
Expand All @@ -148,11 +155,14 @@ rkhs_kernel <- function(kernel = c("Biweight", "Henderson", "Epanechnikov", "Tri
"epanechnikov" = "Epanechnikov",
"henderson" = "Henderson"
)
kernel_fun <- J("jdplus/filters/base/r/RKHSFilters")$kernel(
kernel, as.integer(degree), as.integer(horizon)
)$applyAsDouble

jfun <-
.jcall(
"jdplus/filters/base/r/RKHSFilters",
"Ljava/util/function/DoubleUnaryOperator;",
"kernel",
kernel, as.integer(degree), as.integer(horizon)
)
Vectorize(function(x){
kernel_fun(x)
.jcall(jfun, "D", "applyAsDouble", x)
})
}
7 changes: 5 additions & 2 deletions R/dfa.R
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,7 @@
#' dfa_filter(horizon = 6, degree = 2)
dfa_filter <- function(horizon = 6, degree = 0,
density = c("uniform", "rw"),
targetfilter = lp_filter(horizon = horizon)[,1],
targetfilter = lp_filter(horizon = horizon)@sfilter,
passband = 2*pi/12,
accuracy.weight = 1/3,
smoothness.weight = 1/3,
Expand All @@ -37,7 +37,10 @@ dfa_filter <- function(horizon = 6, degree = 0,
targetfilter <- coef(targetfilter)
}
}
dfa_filter <- J("jdplus/filters/base/r/DFAFilters")$filters(
dfa_filter <- .jcall(
"jdplus/filters/base/r/DFAFilters",
"Ljdplus/toolkit/base/core/math/linearfilters/ISymmetricFiltering;",
"filters",
targetfilter,
as.integer(horizon), as.integer(degree), density=="rw",
passband,
Expand Down
24 changes: 17 additions & 7 deletions R/filter.R
Original file line number Diff line number Diff line change
Expand Up @@ -75,15 +75,25 @@ filter_ma <- function(x, coefs){
lb <- lower_bound(coefs)
ub <- upper_bound(coefs)

if (length(x) <= length(coefs))
if (length(x) < length(coefs))
return(x * NA)

DataBlock <- J("jdplus.toolkit.base.core.data.DataBlock")
jx <- DataBlock$of(as.numeric(x))
out <- DataBlock$of(as.numeric(rep(NA, length(x) - length(coefs)+1)))
.ma2jd(coefs)$apply(jx,
out)
result <- out$toArray()
jx <- .jcall(
"jdplus/toolkit/base/core/data/DataBlock",
"Ljdplus/toolkit/base/core/data/DataBlock;",
"of",
as.numeric(x)
)
out <- .jcall(
"jdplus/toolkit/base/core/data/DataBlock",
"Ljdplus/toolkit/base/core/data/DataBlock;",
"of",
.jarray(as.numeric(rep(NA, length(x) - length(coefs)+1)))
)
jfilter <- .ma2jd(coefs)
.jcall(jfilter, "V", "apply",
jx, out)
result <- .jcall(out, "[D", "toArray")
result <- c(rep(NA, abs(min(lb, 0))),
result,
rep(NA, abs(max(ub, 0))))
Expand Down
21 changes: 14 additions & 7 deletions R/get_properties_function.R
Original file line number Diff line number Diff line change
Expand Up @@ -21,22 +21,29 @@ get_properties_function <- function(x,
}

get_gain_function <- function(x){
jgain <- x$gainFunction()$applyAsDouble
jgain <- .jcall(x, "Ljava/util/function/DoubleUnaryOperator;",
"gainFunction")
Vectorize(function(x){
jgain(x)
.jcall(jgain, "D", "applyAsDouble", x)
})
}
get_phase_function <- function(x){
jphase <- x$phaseFunction()$applyAsDouble
jphase <- .jcall(x, "Ljava/util/function/DoubleUnaryOperator;",
"phaseFunction")
Vectorize(function(x){
jphase(x)
.jcall(jphase, "D", "applyAsDouble", x)
})
}
get_frequency_response_function <- function(x){
jfrf <- x$frequencyResponseFunction()$apply
jfrf <- .jcall(x,
"Ljava/lang/Object;",
"frequencyResponseFunction")

Vectorize(function(x){
res <- jfrf(x)
complex(real = res$getRe(), imaginary = res$getIm())
res <- .jcall(jfrf, "Ljava/lang/Object;", "apply", x)

complex(real = .jcall(res, "D", "getRe"),
imaginary = .jcall(res, "D", "getIm"))
})
}

Expand Down
32 changes: 21 additions & 11 deletions R/kernels.R
Original file line number Diff line number Diff line change
Expand Up @@ -16,11 +16,28 @@ get_kernel <- function(kernel = c("Henderson","Uniform", "Triangular",
"Trapezoidal", "Gaussian"),
horizon,
sd_gauss = 0.25){
jkernel <- .r2jd_kernel(kernel, horizon, sd_gauss)
coef <- sapply(as.integer(seq.int(from = 0, to = horizon, by = 1)),
function(x) .jcall(jkernel, "D", "applyAsDouble", x))
m <- horizon
result <- list(coef = coef, m = m)
attr(result, "name") <- kernel
attr(result, "class") <- "tskernel"
result
}
.r2jd_kernel <- function(
kernel = c("Henderson","Uniform", "Triangular",
"Epanechnikov","Parabolic","BiWeight", "TriWeight","Tricube",
"Trapezoidal", "Gaussian"),
horizon, sd_gauss = 0.25){

if (is.null(kernel) || kernel[1]=="")
return(.jnull("java/util/function/IntToDoubleFunction"))

kernel <- match.arg(tolower(kernel)[1],
choices = c("henderson", "uniform", "triangular", "epanechnikov", "parabolic",
"biweight", "triweight", "tricube", "trapezoidal", "gaussian"
))
choices = c("henderson", "uniform", "triangular", "epanechnikov", "parabolic",
"biweight", "triweight", "tricube", "trapezoidal", "gaussian"
))
if (kernel == "parabolic")
kernel <- "epanechnikov"
h <- as.integer(horizon)
Expand All @@ -33,12 +50,5 @@ get_kernel <- function(kernel = c("Henderson","Uniform", "Triangular",
"Ljava/util/function/IntToDoubleFunction;",
tolower(kernel), h)
}

coef <- sapply(as.integer(seq.int(from = 0, to = horizon, by = 1)),
jkernel$applyAsDouble)
m <- horizon
result <- list(coef = coef, m = m)
attr(result, "name") <- kernel
attr(result, "class") <- "tskernel"
result
jkernel
}
4 changes: 2 additions & 2 deletions R/lp_filters.R
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@ NULL
#' @param horizon horizon (bandwidth) of the symmetric filter.
#' @param degree degree of polynomial.
#' @param kernel kernel uses.
#' @param endpoints methode for endpoints.
#' @param endpoints method for endpoints.
#' @param tweight timeliness weight.
#' @param passband passband threshold.
#' @param ic ic ratio.
Expand Down Expand Up @@ -67,7 +67,7 @@ localpolynomials<-function(x,
#' * "CN": Cut and Normalized Filter
#'
#' @return a [finite_filters()] object.
#' @seealso [localpolynomials()].
#' @seealso [mmsre_filter()] [localpolynomials()].
#' @examples
#' henderson_f <- lp_filter(horizon = 6, kernel = "Henderson")
#' plot_coef(henderson_f)
Expand Down
Loading

0 comments on commit ab8eb43

Please sign in to comment.