Merge pull request #2 from AQLT/develop

v0.1.4

.Rbuildignore

@@ -12,3 +12,4 @@ TODO.R
 ^revdep$
 ^pkgdown$
 ^\.github$
+^reconf.sh$

.github/workflows/R-CMD-check.yaml

@@ -3,10 +3,12 @@ on:
     branches:
       - main
       - master
+      - develop
   pull_request:
     branches:
-      - main
+      - develop
       - master
+      - develop
 
 name: R-CMD-check
 

.github/workflows/pkgdown.yaml

@@ -3,6 +3,8 @@
 on:
   push:
     branches: [master, develop]
+  pull_request:
+    branches: [master, develop]
   release:
     types: [published]
   workflow_dispatch:
@@ -44,3 +46,4 @@ jobs:
           clean: false
           branch: gh-pages
           folder: docs
+          single-commit: true

.gitignore

@@ -2,4 +2,5 @@
 .Rhistory
 .RData
 .Ruserdata
-.DS_Store
+.DS_Store
+cran-comments.md

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rjdqa
 Type: Package
 Title: Quality Assessment for Seasonal Adjustment
-Version: 0.1.3
+Version: 0.1.4
 Authors@R: c(
    person("Alain", "Quartier-la-Tente", role = c("aut", "cre"),
                  email = "[email protected]",
@@ -12,10 +12,10 @@ License: EUPL
 SystemRequirements: Java (>= 8)
 Depends:
     R (>= 3.1.1),
-    RJDemetra,
+    RJDemetra (>= 0.2.5),
 Imports:
     plotrix,
-    ggdemetra,
+    ggdemetra (>= 0.2.5),
     utils,
     graphics,
     stats

NEWS.md

@@ -1,3 +1,9 @@
+# rjdqa 0.1.4
+
+- Fix of minimum versions of dependencies.
+
+- Correction of the orders of the outliers in `simple_dashboard2()`.
+
 # rjdqa 0.1.3
 
 - deprecated function `sa_dashboard()` removed.

R/simple_dashboard.R

@@ -44,7 +44,7 @@ simple_dashboard <- function(x, digits = 2,
     # Global info on model
     arima_ord <- sprintf("ARIMA(%s)(%s)",
                          paste(unlist(RJDemetra::get_indicators(x, sprintf("preprocessing.arima.%s", c("p", "d", "q")))), collapse = ","),
-                         paste(unlist(RJDemetra::get_indicators(x, sprintf("preprocessing.arima.%s", c("bp", "bd", "bd")))), collapse = ","))
+                         paste(unlist(RJDemetra::get_indicators(x, sprintf("preprocessing.arima.%s", c("bp", "bd", "bq")))), collapse = ","))
     ntd <- RJDemetra::get_indicators(x, "preprocessing.model.ntd")[[1]] # nombre de JO
     nmh <- RJDemetra::get_indicators(x, "preprocessing.model.nmh")[[1]]
     is_easter <- (! is.null(nmh)) &&

R/simple_dashboard2.R

@@ -10,6 +10,7 @@
 #' By default only the estimate coefficients and the t-statistics are printed 
 #' (`columns_outliers = c("Estimate", "T-stat")`).
 #' @param n_last_outliers number of last outliers to be printed (by default `n_last_outliers = 4`).
+#' @param order_outliers order of the outliers in case of several outliers at the same date.
 #' 
 #' 
 #' @rdname simple_dashboard
@@ -19,7 +20,8 @@ simple_dashboard2 <- function(x, digits = 2,
                               remove_others_contrib = FALSE,
                               digits_outliers = digits,
                               columns_outliers = c("Estimate", "T-stat"),
-                              n_last_outliers = 4) {
+                              n_last_outliers = 4,
+                              order_outliers = c("AO", "LS", "TC", "SO")) {
     if (inherits(x, "TRAMO_SEATS")) {
         x <- RJDemetra::jtramoseats(RJDemetra::get_ts(x), RJDemetra::tramoseats_spec(x))
     } else if (inherits(x, "X13")) {
@@ -48,7 +50,7 @@ simple_dashboard2 <- function(x, digits = 2,
     # Global info on model
     arima_ord <- sprintf("ARIMA(%s)(%s)",
                          paste(unlist(RJDemetra::get_indicators(x, sprintf("preprocessing.arima.%s", c("p", "d", "q")))), collapse = ","),
-                         paste(unlist(RJDemetra::get_indicators(x, sprintf("preprocessing.arima.%s", c("bp", "bd", "bd")))), collapse = ","))
+                         paste(unlist(RJDemetra::get_indicators(x, sprintf("preprocessing.arima.%s", c("bp", "bd", "bq")))), collapse = ","))
     ntd <- RJDemetra::get_indicators(x, "preprocessing.model.ntd")[[1]] # nombre de JO
     nmh <- RJDemetra::get_indicators(x, "preprocessing.model.nmh")[[1]]
     is_easter <- (! is.null(nmh)) &&
@@ -68,7 +70,8 @@ simple_dashboard2 <- function(x, digits = 2,
                    ifelse(is_easter, "easter effect",
                           "no easter effect"))
     # nb outliers
-    out <- sprintf("%s detected outliers", RJDemetra::get_indicators(x, "preprocessing.model.nout")[[1]])
+    nout <- RJDemetra::get_indicators(x, "preprocessing.model.nout")[[1]]
+    out <- sprintf("%s detected outliers", nout)
     summary_text <- c(est_span, transform, tde, out, arima_ord)
 
 
@@ -153,10 +156,14 @@ simple_dashboard2 <- function(x, digits = 2,
         colnames(decomp_stats)[ncol(qstats)+1] <- "   "
     }
 
-    outliers <- do.call(rbind, RJDemetra::get_indicators(x, sprintf("preprocessing.model.out(%i)", seq_len(n_last_outliers))))
-    outliers_color <- NULL
-    if (!is.null(outliers)) {
-        outliers <- outliers[, columns_outliers, drop = FALSE]
+    outliers <- outliers_color <- NULL
+    if (nout > 0) {
+        outliers <- do.call(rbind, RJDemetra::get_indicators(x, sprintf("preprocessing.model.out(%i)", seq_len(nout))))
+        # sort outliers by dates
+        dates_out <- outliers_to_dates(rownames(outliers))
+        dates_out$type <- factor(dates_out$type, levels = order_outliers, ordered = TRUE)
+        outliers <- outliers[order(dates_out$year, dates_out$period, dates_out$type, decreasing = TRUE), , drop = FALSE]
+        outliers <- outliers[seq_len(min(n_last_outliers, nrow(outliers))), columns_outliers, drop = FALSE]
         outliers <- round(outliers, digits_outliers)
         outliers <- data.frame(rownames(outliers), 
                                outliers)
@@ -181,7 +188,14 @@ simple_dashboard2 <- function(x, digits = 2,
     class(res) <- c("simple_dashboard2")
     res
 }
-
+outliers_to_dates <- function(name_out){
+    dates_out <- gsub("\\w. \\((.*)\\)", "\\1", name_out)
+    types <- gsub(" .*", "", name_out)
+    dates <- do.call(rbind, strsplit(dates_out, "-"))
+    periods <- as.numeric(as.roman(dates[,1]))
+    years <- as.numeric(dates[,2])
+    data.frame(year = years, period = periods, type = types)
+}
 #' @rdname plot.simple_dashboard
 #' @export
 plot.simple_dashboard2 <- function(x, main = "Simple Dashboard with outliers",

README.Rmd

@@ -40,7 +40,8 @@ install.packages("rjdqa")
 
 # Install development version from GitHub
 # install.packages("devtools")
-devtools::install_github("AQLT/rjdqa")
+# devtools::install_github("AQLT/rjdqa")
+install.packages("rjdqa", repos = c('https://aqlt.r-universe.dev', 'https://cloud.r-project.org'))
 ```
 
 If you have troubles with the installation of RJDemetra or rjdqa, check the [installation manual](https://github.com/jdemetra/rjdemetra/wiki/Installation-manual).

README.md

@@ -35,7 +35,8 @@ install.packages("rjdqa")
 
 # Install development version from GitHub
 # install.packages("devtools")
-devtools::install_github("AQLT/rjdqa")
+# devtools::install_github("AQLT/rjdqa")
+install.packages("rjdqa", repos = c('https://aqlt.r-universe.dev', 'https://cloud.r-project.org'))
 ```
 
 If you have troubles with the installation of RJDemetra or rjdqa, check