Skip to content

Commit

Permalink
Merge pull request #26 from TanguyBarthelemy/develop
Browse files Browse the repository at this point in the history
Update repo
  • Loading branch information
AQLT authored May 22, 2024
2 parents 849bee6 + 3680f16 commit f5dd0d5
Show file tree
Hide file tree
Showing 15 changed files with 118 additions and 57 deletions.
34 changes: 21 additions & 13 deletions .Rbuildignore
Original file line number Diff line number Diff line change
@@ -1,19 +1,27 @@
^appveyor\.yml$
^docs$
^_pkgdown\.yml$
^.*\.Rproj$
^\.Rproj\.user$
^.lintr$
^README.Rmd$

^\.git$
^\.github$

^README\.Rmd$
^README-.*\.png$
.travis.yml
^pkgdown$

^Meta$
^docs$
^doc$
^pkgdown$
^_pkgdown\.yml$

^\.lintr$

^appveyor\.yml$
.travis.yml

cran-comments.md
TODO.R

^\.DS_Store$

^revdep$
workspace
workspace.xml
R/test_X11.R
^\.github$
^LICENSE$
^reconf\.sh$
^pom\.xml$
5 changes: 1 addition & 4 deletions .github/workflows/test-coverage.yaml
Original file line number Diff line number Diff line change
@@ -1,10 +1,7 @@
# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
on:
push:
branches: [main, develop]
pull_request:
branches: [main, develop]
workflow_dispatch

name: test-coverage

Expand Down
59 changes: 54 additions & 5 deletions .gitignore
Original file line number Diff line number Diff line change
@@ -1,9 +1,58 @@
.Rproj.user
# History files
.Rhistory
.Rapp.history

# Session Data files
.RData
.RDataTmp

# User-specific files
.Ruserdata

# Example code in package build process
*-Ex.R

# Output files from R CMD build
/*.tar.gz

# Output files from R CMD check
/*.Rcheck/

# RStudio files
.Rproj.user/

# produced vignettes
vignettes/*.html
vignettes/*.pdf
Meta/
inst/doc/
doc/

# OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3
.httr-oauth

# knitr and R markdown default cache directories
*_cache/
/cache/

# Temporary files created by R markdown
*.utf8.md
*.knit.md

# R Environment Variables
.Renviron

# pkgdown site
docs/

# translation temp files
po/*~

# RStudio Connect folder
rsconnect/

# Hidden file from mac-os
.DS_Store
workspace
workspace.xml
inst/doc
docs

# produced README.html
README.html
6 changes: 3 additions & 3 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,6 @@ to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
* New Jars


[Unreleased]: https://github.com/rjdemetra/rjd3filters/compare/v2.0.0...HEAD
[2.0.0]: https://github.com/rjdemetra/rjd3filters/releases/tag/v1.0.0...v2.0.0
[1.0.0]: https://github.com/rjdemetra/rjd3filters/releases/tag/v1.0.0
[Unreleased]: https://github.com/rjdverse/rjd3filters/compare/v2.0.0...HEAD
[2.0.0]: https://github.com/rjdverse/rjd3filters/releases/tag/v1.0.0...v2.0.0
[1.0.0]: https://github.com/rjdverse/rjd3filters/releases/tag/v1.0.0
2 changes: 1 addition & 1 deletion R/2_finite_filters.R
Original file line number Diff line number Diff line change
Expand Up @@ -106,7 +106,7 @@ is.finite_filters <- function(x){
rfilters <- rev(rfilters)
}
} else {
if(first_to_last) {
if (first_to_last) {
lfilters <- rev(lfilters)
rfilters <- rev(rfilters)
}
Expand Down
2 changes: 1 addition & 1 deletion R/filter.R
Original file line number Diff line number Diff line change
Expand Up @@ -122,7 +122,7 @@ ff_ma <- function(x, coefs, remove_missing = TRUE) {
result <- c(rep(NA, data_clean$leading), result,
rep(NA, data_clean$trailing))
}
if(is.ts(x))
if (is.ts(x))
result <- ts(result,start = start(x), frequency = frequency(x))
result
}
Expand Down
2 changes: 1 addition & 1 deletion R/fst_filters.R
Original file line number Diff line number Diff line change
Expand Up @@ -176,7 +176,7 @@ mse.default<-function(aweights, sweights, density=c("uniform", "rw"), passband =
} else {
sweights <- coef(sweights)
}
} else if(length(sweights)>length(aweights)){
} else if (length(sweights)>length(aweights)){
# we asume sweights were specify from [-n to n] instead of [0,n]
n <- (length(sweights)-1)/2
sweights <- sweights[-seq_len(n)]
Expand Down
2 changes: 1 addition & 1 deletion R/get_properties_function.R
Original file line number Diff line number Diff line change
Expand Up @@ -131,7 +131,7 @@ diagnostic_matrix <- function(x, lags, passband = pi/6,
results <- c(sum(x)-1, sum(coef(x) * seq(lower_bound(x), upper_bound(x), by = 1)),
sum(coef(x) * seq(lower_bound(x), upper_bound(x), by = 1)^2),
fst(x, lags, passband = passband))
if(!missing(sweights)){
if (!missing(sweights)){
results <- c(results,
mse(x,
sweights,
Expand Down
4 changes: 2 additions & 2 deletions R/kernels.R
Original file line number Diff line number Diff line change
Expand Up @@ -21,10 +21,10 @@ get_kernel <- function(kernel = c("Henderson","Uniform", "Triangular",
choices = c("henderson", "uniform", "triangular", "epanechnikov", "parabolic",
"biweight", "triweight", "tricube", "trapezoidal", "gaussian"
))
if(kernel == "parabolic")
if (kernel == "parabolic")
kernel <- "epanechnikov"
h <- as.integer(horizon)
if(kernel == "gaussian"){
if (kernel == "gaussian"){
jkernel <- .jcall("jdplus/toolkit/base/core/data/analysis/DiscreteKernel",
"Ljava/util/function/IntToDoubleFunction;",
tolower(kernel), h, sd_gauss)
Expand Down
4 changes: 2 additions & 2 deletions R/lp_filters.R
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,7 @@ localpolynomials<-function(x,
endpoints = c("LC", "QL", "CQ", "CC", "DAF"),
ic = 4.5,
tweight = 0, passband = pi/12){
if(2*horizon < degree)
if (2*horizon < degree)
stop("You need more observation (2 * horizon + 1) than variables (degree + 1) to estimate the filter.")

d <- 2 / (sqrt(pi) * ic)
Expand Down Expand Up @@ -78,7 +78,7 @@ lp_filter <- function(horizon = 6, degree = 3,
endpoints = c("LC", "QL", "CQ", "CC", "DAF", "CN"),
ic = 4.5,
tweight = 0, passband = pi/12){
if(2*horizon < degree)
if (2*horizon < degree)
stop("You need more observation (2 * horizon + 1) than variables (degree + 1) to estimate the filter.")

d <- 2 / (sqrt(pi) * ic)
Expand Down
30 changes: 15 additions & 15 deletions R/plots.R
Original file line number Diff line number Diff line change
Expand Up @@ -31,13 +31,13 @@ plot_coef <- function(x, nxlab = 7, add = FALSE, ...){
plot_coef.default <- function(x, nxlab = 7, add = FALSE,
zero_as_na = TRUE, q = 0, legend = FALSE,
legend.pos = "topright", ...){
if(zero_as_na)
if (zero_as_na)
x <- apply(x,2, trailingzero_as_na)
col_to_plot <- sprintf("q=%i",q)
col_to_plot <- col_to_plot[col_to_plot %in% colnames(x)]
horizon <- (nrow(x)-1)/2
if (length(col_to_plot) == 0) {
if(!add){
if (!add){
plot(1, type="n",xaxt = "n", xlab = "",
ylab = "coefficient", xlim=c(-horizon, horizon), ylim=c(0, 1),
...)
Expand All @@ -48,10 +48,10 @@ plot_coef.default <- function(x, nxlab = 7, add = FALSE,
matplot(seq(-horizon, horizon, by = 1),x[,col_to_plot],
xaxt = "n", xlab = "", type = "o", pch = 20,
ylab = "coefficient", add = add, ...)
if(legend)
if (legend)
legend(legend.pos,col_to_plot,
col = seq_along(col_to_plot), lty=seq_along(col_to_plot), lwd=2)
if(!add)
if (!add)
axis(1, at=seq(-horizon, horizon, by = 1), labels = rownames(x))
}

Expand All @@ -62,7 +62,7 @@ plot_coef.moving_average <- function(x, nxlab = 7, add = FALSE, ...){
matplot(seq(lower_bound(x), upper_bound(x), by = 1), x_plot,
xaxt = "n", xlab = "", type = "o", pch = 20,
ylab = "coefficient", add = add, ...)
if(!add)
if (!add)
axis(1, at=seq(lower_bound(x), upper_bound(x), by = 1), labels = names(x_plot))
}

Expand Down Expand Up @@ -91,7 +91,7 @@ plot_gain.moving_average<- function(x, nxlab = 7, add = FALSE,
plot(g, type = "l",
xaxt = "n", xlab = "",
ylab = "gain", add = add, xlim = xlim, ...)
if(!add){
if (!add){
x_lab_at <- seq(xlim[1]/pi, xlim[2]/pi, length.out = nxlab)
axis(1, at = x_lab_at * pi, labels = xlabel(x_lab_at))
}
Expand All @@ -112,7 +112,7 @@ plot_gain.finite_filters <- function(x, nxlab = 7, add = FALSE,
all_g_f <- all_g_f[col_to_plot]
y_val <- sapply(all_g_f, function(f) f(x_values))
if (length(col_to_plot) == 0) {
if(!add){
if (!add){
plot(1, type="n",xaxt = "n", xlab = "",
ylab = "gain", xlim=xlim, ylim=c(0, 1),
...)
Expand Down Expand Up @@ -157,7 +157,7 @@ plot_phase.moving_average<- function(x, nxlab = 7, add = FALSE,
plot(p_plot, type = "l",
xaxt = "n", xlab = "",
ylab = "phase", add = add, xlim = xlim, ...)
if(!add){
if (!add){
x_lab_at <- seq(xlim[1]/pi, xlim[2]/pi, length.out = nxlab)
axis(1, at = x_lab_at * pi, labels = xlabel(x_lab_at))
}
Expand All @@ -180,11 +180,11 @@ plot_phase.finite_filters <- function(x, nxlab = 7, add = FALSE,
all_p_f <- all_p_f[col_to_plot]
y_val <- sapply(all_p_f, function(f) f(x_values))

if(normalized){
if (normalized){
y_val[-1,] <- y_val[-1,] / x_values[-1]
}
if (length(col_to_plot) == 0) {
if(!add){
if (!add){
plot(1, type="n",xaxt = "n", xlab = "",
ylab = "phase", xlim=xlim, ylim=c(0, 1),
...)
Expand Down Expand Up @@ -222,7 +222,7 @@ trailingzero_as_na <- function(x){
i <- i - 1
}
x
# if(x[length(x)]==0)
# if (x[length(x)]==0)
# x [seq(from = tail(which(!sapply(x, function(y) isTRUE(all.equal(y,0)))),1)+1,
# to = length(x),
# by = 1)] <- NA
Expand All @@ -237,7 +237,7 @@ rm_leading_zero_or_na <- function(x){
remove_i <- c(i, remove_i)
i <- i + 1
}
if(is.null(remove_i)){
if (is.null(remove_i)){
x
} else{
x[-remove_i]
Expand All @@ -252,7 +252,7 @@ rm_trailing_zero_or_na <- function(x){
remove_i <- c(i, remove_i)
i <- i - 1
}
if(is.null(remove_i)){
if (is.null(remove_i)){
x
} else{
x[-remove_i]
Expand All @@ -267,7 +267,7 @@ rm_trailing_zero <- function(x){
remove_i <- c(i, remove_i)
i <- i - 1
}
if(is.null(remove_i)){
if (is.null(remove_i)){
x
} else{
x[-remove_i]
Expand All @@ -288,7 +288,7 @@ remove_bound_NA <- function(x) {
j <- j + 1
}

if(is.null(remove_i_first) & is.null(remove_i_last)){
if (is.null(remove_i_first) & is.null(remove_i_last)){
# list(data = x, leading = 0,
# trailing = 0)
} else{
Expand Down
2 changes: 1 addition & 1 deletion R/zzz.R
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@
NULL

.onLoad <- function(libname, pkgname) {
if (! requireNamespace("rjd3toolkit", quietly = TRUE)) stop("Loading rjd3 libraries failed")
if (!requireNamespace("rjd3toolkit", quietly = TRUE)) stop("Loading rjd3 libraries failed")
# For debugts_ging: to see if Jars are effectively loaded
# options(java.parameters = "-verbose:class")

Expand Down
12 changes: 8 additions & 4 deletions README.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -10,8 +10,9 @@ knitr::opts_chunk$set(
comment = "#>",
fig.path = "man/figures/README-",
fig.align="center",
fig.width = 8
fig.width = 8L
)
options(max.print = 1000L)
```

# rjd3filters
Expand Down Expand Up @@ -127,13 +128,16 @@ legend("topleft", legend = c("y", "Musgrave", "FST", "RKHS"),
### Comparison of the filters

Different quality criteria from Grun-Rehomme *et al* (2018) and Wildi and McElroy(2019) can also be computed with the function `diagnostic_matrix()`:

```{r diagnostic-table, eval = TRUE}
q_0_coefs <- list(Musgrave = musgrave[, "q=0"],
fst_notimeliness = fst_notimeliness[, "q=0"],
rkhs_timeliness = rkhs_timeliness[, "q=0"])
sapply(q_0_coefs, diagnostic_matrix,
lags = 6, sweight = musgrave[, "q=6"])
sapply(X = q_0_coefs,
FUN = diagnostic_matrix,
lags = 6,
sweights = musgrave[, "q=6"])
```

The filters can also be compared by plotting there coefficients (`plot_coef`), gain function (`plot_gain`) and phase function (`plot_phase`):
Expand Down Expand Up @@ -244,4 +248,4 @@ pull requests should include **updated tests** and **updated documentation**. If

## Licensing

The code of this project is licensed under the [European Union Public Licence (EUPL)](https://joinup.ec.europa.eu/page/eupl-text-11-12).
The code of this project is licensed under the [European Union Public Licence (EUPL)](https://joinup.ec.europa.eu/collection/eupl/eupl-text-eupl-12).
9 changes: 6 additions & 3 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -142,8 +142,10 @@ q_0_coefs <- list(Musgrave = musgrave[, "q=0"],
fst_notimeliness = fst_notimeliness[, "q=0"],
rkhs_timeliness = rkhs_timeliness[, "q=0"])

sapply(q_0_coefs, diagnostic_matrix,
lags = 6, sweight = musgrave[, "q=6"])
sapply(X = q_0_coefs,
FUN = diagnostic_matrix,
lags = 6,
sweights = musgrave[, "q=6"])
#> Musgrave fst_notimeliness rkhs_timeliness
#> b_c 0.000000000 2.220446e-16 0.000000000
#> b_l -0.575984377 -1.554312e-15 -0.611459167
Expand Down Expand Up @@ -361,4 +363,5 @@ should be added or updated.
## Licensing

The code of this project is licensed under the [European Union Public
Licence (EUPL)](https://joinup.ec.europa.eu/page/eupl-text-11-12).
Licence
(EUPL)](https://joinup.ec.europa.eu/collection/eupl/eupl-text-eupl-12).
2 changes: 1 addition & 1 deletion _pkgdown.yml
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
url: https://rjdemetra.github.io/rjd3filters/
url: https://rjdverse.github.io/rjd3filters/
template:
bootstrap: 5

Expand Down

0 comments on commit f5dd0d5

Please sign in to comment.