├── .github ├── .gitignore └── workflows │ ├── pkgdown.yaml │ └── R-CMD-check.yaml ├── vignettes ├── .gitignore └── ggdemetra.Rmd ├── data ├── ipi_c_eu.rda └── ipi_c_eu_df.rda ├── man ├── figures │ ├── logo.png │ ├── ggdemetra.png │ ├── README-sa-1.png │ ├── README-sa-out-1.png │ ├── README-autoplot-1.png │ ├── README-ggsiratio-1.png │ ├── README-sa-arima-1.png │ ├── README-sa-diag-1.png │ └── README-sa-init-1.png ├── ts2df.Rd ├── init_ggplot.Rd ├── components.Rd ├── autoplot.SA.Rd ├── siratio.Rd ├── ipi_c_eu.Rd ├── geom_arima.Rd ├── geom_sa.Rd ├── geom_diagnostics.Rd └── geom_outlier.Rd ├── .gitignore ├── .Rbuildignore ├── ggdemetra.Rproj ├── R ├── ts2df.R ├── init_ggplot.R ├── autoplot.R ├── ipi_c_eu.R ├── extract_cmp.R ├── seasonal_adjustment.R ├── geom_arima.R ├── geom_sa.R ├── siratio.R ├── geom_diagnostics.R └── geom_outliers.R ├── _pkgdown.yml ├── DESCRIPTION ├── NEWS.md ├── NAMESPACE ├── README.Rmd └── README.md /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /data/ipi_c_eu.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AQLT/ggdemetra/HEAD/data/ipi_c_eu.rda -------------------------------------------------------------------------------- /data/ipi_c_eu_df.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AQLT/ggdemetra/HEAD/data/ipi_c_eu_df.rda -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AQLT/ggdemetra/HEAD/man/figures/logo.png -------------------------------------------------------------------------------- /man/figures/ggdemetra.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AQLT/ggdemetra/HEAD/man/figures/ggdemetra.png -------------------------------------------------------------------------------- /man/figures/README-sa-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AQLT/ggdemetra/HEAD/man/figures/README-sa-1.png -------------------------------------------------------------------------------- /man/figures/README-sa-out-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AQLT/ggdemetra/HEAD/man/figures/README-sa-out-1.png -------------------------------------------------------------------------------- /man/figures/README-autoplot-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AQLT/ggdemetra/HEAD/man/figures/README-autoplot-1.png -------------------------------------------------------------------------------- /man/figures/README-ggsiratio-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AQLT/ggdemetra/HEAD/man/figures/README-ggsiratio-1.png -------------------------------------------------------------------------------- /man/figures/README-sa-arima-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AQLT/ggdemetra/HEAD/man/figures/README-sa-arima-1.png -------------------------------------------------------------------------------- /man/figures/README-sa-diag-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AQLT/ggdemetra/HEAD/man/figures/README-sa-diag-1.png -------------------------------------------------------------------------------- /man/figures/README-sa-init-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AQLT/ggdemetra/HEAD/man/figures/README-sa-init-1.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | Meta 2 | doc 3 | inst/doc 4 | .Rproj.user 5 | .Rhistory 6 | .RData 7 | .Ruserdata 8 | .DS_Store 9 | TODO.R 10 | docs 11 | pkgdown 12 | cran-comments.md -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^Meta$ 2 | ^docs$ 3 | ^_pkgdown\.yml$ 4 | ^.*\.Rproj$ 5 | ^\.Rproj\.user$ 6 | ^README\.Rmd$ 7 | ^README-.*\.png$ 8 | .travis.yml 9 | ^pkgdown$ 10 | ^doc$ 11 | cran-comments.md 12 | TODO.R 13 | Exemples.R 14 | ^\.github$ 15 | ^reconf.sh$ -------------------------------------------------------------------------------- /ggdemetra.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 4 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | BuildType: Package 16 | PackageUseDevtools: Yes 17 | PackageInstallArgs: --no-multiarch --with-keep.source 18 | PackageCheckArgs: --no-multiarch --as-cran --run-donttest 19 | PackageRoxygenize: rd,collate,namespace 20 | -------------------------------------------------------------------------------- /man/ts2df.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts2df.R 3 | \name{ts2df} 4 | \alias{ts2df} 5 | \title{Convert 'ts' object to 'data.frame'} 6 | \usage{ 7 | ts2df(x) 8 | } 9 | \arguments{ 10 | \item{x}{a \code{ts} or \code{mts} object.} 11 | } 12 | \value{ 13 | a \code{data.frame} object. 14 | } 15 | \description{ 16 | Function to a \code{ts} or \code{mts} object to a \code{data.frame} that can be directly used in the plot functions. 17 | } 18 | \examples{ 19 | # To get the ipi_c_eu_df object: 20 | ts2df(ipi_c_eu) 21 | } 22 | -------------------------------------------------------------------------------- /man/init_ggplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/init_ggplot.R 3 | \name{init_ggplot} 4 | \alias{init_ggplot} 5 | \title{Initialise 'ggplot2' with 'SA' model} 6 | \usage{ 7 | init_ggplot(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{A \code{"SA"} or \code{"jsA"} model created with 'RJDemetra'.} 11 | 12 | \item{...}{Other parameters passes to \code{\link[ggplot2:ggplot]{ggplot2::ggplot()}}} 13 | } 14 | \description{ 15 | Initialise 'ggplot2' with 'SA' model 16 | } 17 | \examples{ 18 | mod <- RJDemetra::x13(ipi_c_eu[, "FR"]) 19 | init_ggplot(mod) + 20 | geom_line(color = "#F0B400") + 21 | geom_sa(component = "sa", color = "#155692") 22 | } 23 | -------------------------------------------------------------------------------- /man/components.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/extract_cmp.R 3 | \name{components} 4 | \alias{components} 5 | \alias{seasonal} 6 | \alias{trendcycle} 7 | \alias{irregular} 8 | \alias{seasonaladj} 9 | \alias{calendaradj} 10 | \alias{calendar} 11 | \alias{raw} 12 | \title{Extract Component from 'RJDemetra' model} 13 | \usage{ 14 | seasonal(x, forecast = FALSE) 15 | 16 | trendcycle(x, forecast = FALSE) 17 | 18 | irregular(x, forecast = FALSE) 19 | 20 | seasonaladj(x, forecast = FALSE) 21 | 22 | calendaradj(x, forecast = FALSE) 23 | 24 | calendar(x, forecast = FALSE) 25 | 26 | raw(x, forecast = FALSE) 27 | } 28 | \arguments{ 29 | \item{x}{a \code{"SA"} or \code{"jSA"} model.} 30 | 31 | \item{forecast}{boolean indicating if the forecast series should be returned.} 32 | } 33 | \description{ 34 | Extract Component from 'RJDemetra' model 35 | } 36 | -------------------------------------------------------------------------------- /man/autoplot.SA.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/autoplot.R 3 | \name{autoplot.SA} 4 | \alias{autoplot.SA} 5 | \title{Plot 'RJDemetra' model} 6 | \usage{ 7 | \method{autoplot}{SA}( 8 | object, 9 | components = c("y", "sa", trend = "t", seasonal = "s", irregular = "i"), 10 | forecast = FALSE, 11 | ... 12 | ) 13 | } 14 | \arguments{ 15 | \item{object}{a \code{"SA"} or \code{"jSA"} model.} 16 | 17 | \item{components}{components to print, can be \code{"y"} (input time series), 18 | \code{"sa"} (seasonal adjusted), \code{"t"} (trend-cycle), 19 | \code{"y_cal"} (calendar adjusted), \code{"s"} (seasonal), \code{"i"} (irregular), 20 | \code{"cal"} (calendar). The vector can be named to change the label} 21 | 22 | \item{forecast}{boolean indicating if the forecast series should be printed.} 23 | 24 | \item{...}{unused arguments.} 25 | } 26 | \description{ 27 | Plot 'RJDemetra' model 28 | } 29 | \examples{ 30 | x = RJDemetra::jx13(ipi_c_eu[,"FR"]) 31 | ggplot2::autoplot(x) 32 | } 33 | -------------------------------------------------------------------------------- /R/ts2df.R: -------------------------------------------------------------------------------- 1 | #' Convert 'ts' object to 'data.frame' 2 | #' 3 | #' Function to a \code{ts} or \code{mts} object to a \code{data.frame} that can be directly used in the plot functions. 4 | #' 5 | #' @param x a \code{ts} or \code{mts} object. 6 | #' 7 | #' @return a \code{data.frame} object. 8 | #' @examples 9 | #' # To get the ipi_c_eu_df object: 10 | #' ts2df(ipi_c_eu) 11 | #' @name ts2df 12 | #' @rdname ts2df 13 | #' @export 14 | ts2df <- function(x){ 15 | UseMethod("ts2df", x) 16 | } 17 | #' @export 18 | ts2df.ts <- function(x){ 19 | date <- as.numeric(time(x)) 20 | name <- deparse(substitute(x)) 21 | result <- data.frame(date = date, 22 | as.numeric(x)) 23 | colnames(result) <- c("date", name) 24 | result 25 | } 26 | #' @export 27 | ts2df.mts <- function(x){ 28 | date <- as.numeric(time(x)) 29 | data <- as.matrix(x) 30 | rownames(data) <- NULL 31 | result <- data.frame(date = date, 32 | data) 33 | colnames(result) <- c("date", colnames(x)) 34 | result 35 | } 36 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://aqlt.github.io/ggdemetra/ 2 | template: 3 | bootstrap: 5 4 | navbar: 5 | structure: 6 | left: 7 | - home 8 | - intro 9 | - reference 10 | - articles 11 | - tutorials 12 | - news 13 | - rjdemetra 14 | right: 15 | - jdemetra 16 | - github 17 | components: 18 | home: 19 | icon: fa-home fa-lg 20 | href: index.html 21 | reference: 22 | text: Reference 23 | href: reference/index.html 24 | intro: 25 | text: Get started 26 | href: articles/ggdemetra.html 27 | news: 28 | text: News 29 | href: news/index.html 30 | rjdemetra: 31 | text: RJDemetra 32 | href: https://github.com/rjdverse/rjdemetra 33 | jdemetra: 34 | text: JDemetra+ 35 | menu: 36 | - text: Download JDemetra+ 37 | href: https://github.com/jdemetra/jdemetra-app/releases 38 | - text: JDemetra+ documentation 39 | href: https://jdemetra-new-documentation.netlify.app/ 40 | github: 41 | icon: fa-github fa-lg 42 | href: https://github.com/AQLT/ggdemetra 43 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: ggdemetra 2 | Type: Package 3 | Title: 'ggplot2' Extension for Seasonal and Trading Day Adjustment with 'RJDemetra' 4 | Version: 0.3.0 5 | Authors@R: c(person("Alain", "Quartier-la-Tente", role = c("aut", "cre"), 6 | email = "alain.quartier@yahoo.fr", 7 | comment = c(ORCID = "0000-0001-7890-3857"))) 8 | Description: Provides 'ggplot2' functions to return the results of seasonal and trading day adjustment 9 | made by 'RJDemetra'. 'RJDemetra' is an 'R' interface around 'JDemetra+' (), 10 | the seasonal adjustment software officially recommended to the members of the European Statistical System and 11 | the European System of Central Banks. 12 | Depends: 13 | R (>= 3.1.2), 14 | ggplot2 (>= 2.0.0), 15 | RJDemetra (>= 0.1.2), 16 | Imports: 17 | ggrepel, 18 | gridExtra 19 | Suggests: 20 | knitr, 21 | rmarkdown 22 | SystemRequirements: Java (>= 8) 23 | License: EUPL 24 | URL: https://aqlt.github.io/ggdemetra/, https://github.com/AQLT/ggdemetra 25 | BugReports: https://github.com/AQLT/ggdemetra/issues 26 | Encoding: UTF-8 27 | LazyData: true 28 | RoxygenNote: 7.3.2 29 | Roxygen: list(markdown = TRUE) 30 | VignetteBuilder: knitr 31 | -------------------------------------------------------------------------------- /R/init_ggplot.R: -------------------------------------------------------------------------------- 1 | #' Initialise 'ggplot2' with 'SA' model 2 | #' 3 | #' @param x A `"SA"` or `"jsA"` model created with 'RJDemetra'. 4 | #' @param ... Other parameters passes to [ggplot2::ggplot()] 5 | #' @examples 6 | #' mod <- RJDemetra::x13(ipi_c_eu[, "FR"]) 7 | #' init_ggplot(mod) + 8 | #' geom_line(color = "#F0B400") + 9 | #' geom_sa(component = "sa", color = "#155692") 10 | #' @export 11 | init_ggplot <- function(x, ...) { 12 | UseMethod("init_ggplot", x) 13 | } 14 | #' @export 15 | init_ggplot.SA <- function(x, ...) { 16 | y <- raw(x) 17 | d_y <- ts2dataframe(y) 18 | if (inherits(x, "X13")) { 19 | spec = RJDemetra::x13_spec(x) 20 | method = "x13" 21 | } else { 22 | spec = RJDemetra::tramoseats_spec(x) 23 | method = "tramoseats" 24 | } 25 | seasonal_adjustment(data = d_y, 26 | method = method, 27 | spec = spec, 28 | frequency = frequency(y), 29 | message = FALSE, 30 | new_data = TRUE) 31 | ggplot2::ggplot( 32 | data = d_y, 33 | ggplot2::aes(x = x, y = y), 34 | ...) 35 | } 36 | #' @export 37 | init_ggplot.jSA <- function(x, ...) { 38 | init_ggplot(RJDemetra::jSA2R(x), ...) 39 | } 40 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [develop] 6 | release: 7 | types: [published] 8 | workflow_dispatch: 9 | 10 | name: pkgdown 11 | 12 | jobs: 13 | pkgdown: 14 | runs-on: ubuntu-latest 15 | # Only restrict concurrency for non-PR jobs 16 | concurrency: 17 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 18 | env: 19 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 20 | permissions: 21 | contents: write 22 | steps: 23 | - uses: actions/checkout@v3 24 | 25 | - uses: r-lib/actions/setup-pandoc@v2 26 | 27 | - uses: r-lib/actions/setup-r@v2 28 | with: 29 | use-public-rspm: true 30 | 31 | - uses: r-lib/actions/setup-r-dependencies@v2 32 | with: 33 | extra-packages: any::pkgdown, local::. 34 | needs: website 35 | 36 | - name: Build site 37 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 38 | shell: Rscript {0} 39 | 40 | - name: Deploy to GitHub pages 🚀 41 | if: github.event_name != 'pull_request' 42 | uses: JamesIves/github-pages-deploy-action@v4.4.1 43 | with: 44 | clean: false 45 | branch: gh-pages 46 | folder: docs 47 | single-commit: true 48 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # ggdemetra 0.2.9 2 | 3 | * `aes_()` removed (deprecated function) (issue #8). 4 | 5 | # ggdemetra 0.2.8 6 | 7 | * correction in `siratio()` for TRAMO-SEATS models when no seasonal component is exported. 8 | 9 | # ggdemetra 0.2.7 10 | 11 | * deprecated function `y_forecast()` removed. 12 | 13 | * `calendar()`, `calendaradj()` and `autoplot()` correction with TRAMO-SEATS models. 14 | 15 | # ggdemetra 0.2.6 16 | 17 | * `siratio()` correction with TRAMO-SEATS `"jSA"` models. 18 | 19 | * `y_forecast()` replaced by `raw()`. 20 | 21 | * new `init_ggplot()` function. 22 | 23 | # ggdemetra 0.2.5 24 | 25 | * new functions: `siratio()`, `siratioplot()` and `ggsiratioplot()` to plot SI ratios. 26 | 27 | * SystemRequirements update for CRAN policies. 28 | 29 | # ggdemetra 0.2.3 30 | 31 | * new functions: `autoplot.SA()` and `autoplot.jSA()` to plot 'RJDemetra' models and `y_forecast()`, ` trendcycle()`, ` seasonaladj()`, ` calendaradj()`, ` seasonal()`, ` irregular()`, ` calendar()` to extract different components of the models. 32 | 33 | * `ggdemetra` now depends on `RJDemetra`. 34 | 35 | # ggdemetra 0.2.2 36 | 37 | * `ts2df` function added to convert `ts` object to `data.frame`. 38 | 39 | * data updated. 40 | 41 | * `geom_outlier` bug correction (`first_date` and `last_date` not correctly working when `coefficients=TRUE`). 42 | 43 | # ggdemetra 0.2.1 44 | 45 | * `geom_arima` bug correction (a new model was computed). 46 | 47 | # ggdemetra 0.2.0 48 | 49 | * If no new data or seasonal adjustment specification is specified (method or specification), these parameters is inherited from the previous defined (the seasonal adjustment is then only done once). 50 | 51 | 52 | -------------------------------------------------------------------------------- /man/siratio.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/siratio.R 3 | \name{siratio} 4 | \alias{siratio} 5 | \alias{siratioplot} 6 | \alias{ggsiratioplot} 7 | \title{SI-ratio} 8 | \usage{ 9 | siratio(x, ...) 10 | 11 | siratioplot( 12 | x, 13 | labels = NULL, 14 | add = FALSE, 15 | box = TRUE, 16 | col.s = "darkblue", 17 | col.i = "gray", 18 | col.mean = "red", 19 | cex.i = 0.1, 20 | lwd.s = par("lwd"), 21 | lwd.mean = lwd.s, 22 | main = "SI ratio", 23 | xlab = NULL, 24 | ylab = NULL, 25 | xlim = NULL, 26 | ylim = NULL, 27 | start = NULL, 28 | end = NULL, 29 | ... 30 | ) 31 | 32 | ggsiratioplot( 33 | x, 34 | labels = NULL, 35 | col.s = "darkblue", 36 | col.i = "gray", 37 | col.mean = "red", 38 | cex.i = 0.5, 39 | lwd.s = 1, 40 | lwd.mean = lwd.s, 41 | main = "SI ratio", 42 | xlab = NULL, 43 | ylab = NULL, 44 | start = NULL, 45 | end = NULL, 46 | ... 47 | ) 48 | } 49 | \arguments{ 50 | \item{x}{input model or data.} 51 | 52 | \item{...}{unused parameters.} 53 | 54 | \item{labels}{labels.} 55 | 56 | \item{add}{boolean indicating whether a new plot should be drawn.} 57 | 58 | \item{box}{boolean indicating a box around the current plot should be drawn.} 59 | 60 | \item{col.s, col.i, col.mean}{colors of the different components.} 61 | 62 | \item{cex.i, lwd.s, lwd.mean}{graphical parameters.} 63 | 64 | \item{main, xlab, ylab}{title, X and Y axis label.} 65 | 66 | \item{xlim, ylim}{X and Y axis limits.} 67 | 68 | \item{start, end}{first and last dates plotted.} 69 | } 70 | \description{ 71 | SI-ratio 72 | } 73 | \examples{ 74 | x <- RJDemetra::x13(ipi_c_eu[,"FR"]) 75 | siratioplot(x) 76 | ggsiratioplot(x) 77 | } 78 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(autoplot,SA) 4 | S3method(autoplot,jSA) 5 | S3method(calendar,SA) 6 | S3method(calendar,jSA) 7 | S3method(calendaradj,SA) 8 | S3method(calendaradj,jSA) 9 | S3method(ggsiratioplot,SA) 10 | S3method(ggsiratioplot,default) 11 | S3method(ggsiratioplot,jSA) 12 | S3method(init_ggplot,SA) 13 | S3method(init_ggplot,jSA) 14 | S3method(irregular,SA) 15 | S3method(irregular,jSA) 16 | S3method(raw,SA) 17 | S3method(raw,jSA) 18 | S3method(seasonal,SA) 19 | S3method(seasonal,jSA) 20 | S3method(seasonaladj,SA) 21 | S3method(seasonaladj,jSA) 22 | S3method(siratio,TRAMO_SEATS) 23 | S3method(siratio,X13) 24 | S3method(siratio,jSA) 25 | S3method(siratioplot,SA) 26 | S3method(siratioplot,default) 27 | S3method(siratioplot,jSA) 28 | S3method(trendcycle,SA) 29 | S3method(trendcycle,jSA) 30 | S3method(ts2df,mts) 31 | S3method(ts2df,ts) 32 | export(calendar) 33 | export(calendaradj) 34 | export(geom_arima) 35 | export(geom_diagnostics) 36 | export(geom_outlier) 37 | export(geom_sa) 38 | export(ggsiratioplot) 39 | export(init_ggplot) 40 | export(irregular) 41 | export(raw) 42 | export(seasonal) 43 | export(seasonaladj) 44 | export(siratio) 45 | export(siratioplot) 46 | export(stat_sa) 47 | export(trendcycle) 48 | export(ts2df) 49 | import(RJDemetra) 50 | importFrom(ggplot2,GeomLabel) 51 | importFrom(ggplot2,GeomLine) 52 | importFrom(ggplot2,GeomText) 53 | importFrom(ggplot2,autoplot) 54 | importFrom(ggrepel,GeomLabelRepel) 55 | importFrom(ggrepel,GeomTextRepel) 56 | importFrom(graphics,axis) 57 | importFrom(graphics,lines) 58 | importFrom(graphics,par) 59 | importFrom(graphics,plot.new) 60 | importFrom(graphics,plot.window) 61 | importFrom(graphics,points) 62 | importFrom(graphics,segments) 63 | importFrom(graphics,title) 64 | importFrom(gridExtra,tableGrob) 65 | importFrom(gridExtra,ttheme_default) 66 | importFrom(stats,cycle) 67 | importFrom(stats,end) 68 | importFrom(stats,frequency) 69 | importFrom(stats,is.mts) 70 | importFrom(stats,is.ts) 71 | importFrom(stats,start) 72 | importFrom(stats,time) 73 | importFrom(stats,ts) 74 | importFrom(stats,ts.union) 75 | -------------------------------------------------------------------------------- /man/ipi_c_eu.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ipi_c_eu.R 3 | \docType{data} 4 | \name{ipi_c_eu} 5 | \alias{ipi_c_eu} 6 | \alias{ipi_c_eu_df} 7 | \title{Industrial Production Indices in manufacturing in the European Union} 8 | \format{ 9 | A monthly \code{ts} object from january 1990 to december 2017 with 34 variables for \code{ipi_c_eu} and a \code{data.frame} for \code{ipi_c_eu_df}. 10 | 11 | An object of class \code{data.frame} with 360 rows and 35 columns. 12 | } 13 | \source{ 14 | Eurostat, 'sts_inpr_m' database. 15 | } 16 | \usage{ 17 | ipi_c_eu 18 | 19 | ipi_c_eu_df 20 | } 21 | \description{ 22 | A dataset containing on monthly industrial production indices in manufacturing in the European Union (from sts_inpr_m dataset of Eurostat). Data are based 100 in 2015 and are unadjusted, i.e. neither seasonally adjusted nor calendar adjusted. 23 | } 24 | \details{ 25 | The dataset contains 34 time series corresponding to the following geographical area 26 | \tabular{cl}{ 27 | BE \tab Belgium \cr 28 | BG \tab Bulgaria \cr 29 | CZ \tab Czechia \cr 30 | DK \tab Denmark \cr 31 | DE \tab Germany (until 1990 former territory of the FRG)\cr 32 | EE \tab Estonia \cr 33 | IE \tab Ireland \cr 34 | EL \tab Greece \cr 35 | ES \tab Spain \cr 36 | FR \tab France \cr 37 | HR \tab Croatia \cr 38 | IT \tab Italy \cr 39 | CY \tab Cyprus \cr 40 | LV \tab Latvia \cr 41 | LT \tab Lithuania \cr 42 | LU \tab Luxembourg \cr 43 | HU \tab Hungary \cr 44 | MT \tab Malta \cr 45 | NL \tab Netherlands \cr 46 | AT \tab Austria \cr 47 | PL \tab Poland \cr 48 | PT \tab Portugal \cr 49 | RO \tab Romania \cr 50 | SI \tab Slovenia \cr 51 | SK \tab Slovakia \cr 52 | FI \tab Finland \cr 53 | SE \tab Sweden \cr 54 | UK \tab United Kingdom \cr 55 | NO \tab Norway \cr 56 | CH \tab Switzerland \cr 57 | ME \tab Montenegro \cr 58 | MK \tab Former Yugoslav Republic of Macedonia, the \cr 59 | RS \tab Serbia \cr 60 | TR \tab Turkey \cr 61 | BA \tab Bosnia and Herzegovina 62 | } 63 | } 64 | \keyword{datasets} 65 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: [master, develop] 4 | pull_request: 5 | branches: [master, develop] 6 | release: 7 | types: [published] 8 | workflow_dispatch: 9 | 10 | name: R-CMD-check 11 | 12 | jobs: 13 | R-CMD-check: 14 | runs-on: ${{ matrix.config.os }} 15 | 16 | name: ${{ matrix.config.os-name }}, R ${{ matrix.config.r }}, Java ${{ matrix.config.java }} 17 | 18 | strategy: 19 | fail-fast: false 20 | matrix: 21 | config: 22 | - {os: windows-latest, r: 'release', java: 12, os-name: windows} 23 | - {os: windows-latest, r: 'devel', java: 12, os-name: windows} 24 | - {os: windows-latest, r: 'oldrel', java: 12, os-name: windows} 25 | - {os: macOS-latest, r: 'release', java: 12, os-name: macos} 26 | - {os: macOS-latest, r: 'devel', java: 12, os-name: macos} 27 | - {os: macOS-latest, r: 'oldrel', java: 12, os-name: macos} 28 | #- {os: ubuntu-20.04, r: 'release', java: 12,os-name: ubuntu} 29 | #- {os: ubuntu-20.04, r: 'devel', java: 12,os-name: ubuntu} 30 | #- {os: ubuntu-20.04, r: 'release', java: 16,os-name: ubuntu} 31 | 32 | steps: 33 | - uses: actions/checkout@v2 34 | 35 | - uses: actions/setup-java@v1 36 | with: 37 | java-version: ${{ matrix.config.java }} 38 | 39 | - uses: r-lib/actions/setup-r@v2 40 | with: 41 | r-version: ${{ matrix.config.r }} 42 | 43 | - name: Info 44 | run: "bash -c 'java -version && which java && echo $PATH && echo $JAVA_HOME'" 45 | 46 | - name: Setup R Java support 47 | if: runner.os != 'Windows' 48 | run: "echo export PATH=$PATH > reconf.sh; echo export JAVA_HOME=$JAVA_HOME >> reconf.sh; echo R CMD javareconf >> reconf.sh; sudo bash reconf.sh" 49 | 50 | - name: print effective R version 51 | run: version 52 | shell: Rscript {0} 53 | 54 | - uses: r-lib/actions/setup-pandoc@v2 55 | 56 | - name: Query dependencies 57 | run: | 58 | install.packages('remotes') 59 | saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) 60 | writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") 61 | shell: Rscript {0} 62 | 63 | - name: Restore R package cache 64 | uses: actions/cache@v3 65 | with: 66 | path: ${{ env.R_LIBS_USER }} 67 | key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} 68 | restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- 69 | 70 | - name: Install system dependencies 71 | if: runner.os == 'Linux' 72 | run: | 73 | while read -r cmd 74 | do 75 | eval sudo $cmd 76 | done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))') 77 | 78 | - name: Install dependencies 79 | run: | 80 | remotes::install_deps(dependencies = TRUE) 81 | remotes::install_cran("rcmdcheck") 82 | shell: Rscript {0} 83 | 84 | - name: Check 85 | env: 86 | _R_CHECK_CRAN_INCOMING_REMOTE_: false 87 | run: | 88 | options(crayon.enabled = TRUE) 89 | rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran", "--no-multiarch"), error_on = "warning", check_dir = "check") 90 | shell: Rscript {0} 91 | 92 | - name: Upload check results 93 | if: failure() 94 | uses: actions/upload-artifact@main 95 | with: 96 | name: ${{ runner.os }}-r${{ matrix.config.r }}-results 97 | path: check 98 | -------------------------------------------------------------------------------- /man/geom_arima.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom_arima.R 3 | \name{geom_arima} 4 | \alias{geom_arima} 5 | \title{ARIMA model} 6 | \usage{ 7 | geom_arima( 8 | mapping = NULL, 9 | data = NULL, 10 | stat = "arima", 11 | geom = c("text", "label"), 12 | position = "identity", 13 | ..., 14 | method = c("x13", "tramoseats"), 15 | spec = NULL, 16 | frequency = NULL, 17 | message = TRUE, 18 | x_arima = NULL, 19 | y_arima = NULL, 20 | show.legend = NA, 21 | inherit.aes = TRUE 22 | ) 23 | } 24 | \arguments{ 25 | \item{mapping}{Set of aesthetic mappings created by \link[ggplot2:aes]{aes()}. If specified and \code{inherit.aes = TRUE} (the 26 | default), it is combined with the default mapping at the top level of the 27 | plot. You must supply \code{mapping} if there is no plot mapping.} 28 | 29 | \item{data}{A \code{data.frame} that contains the data used for the seasonal adjustment.} 30 | 31 | \item{stat}{The statistical transformation to use on the data for this 32 | layer, as a string.} 33 | 34 | \item{geom}{character. The geometric to use to display the data: 35 | \code{GeomText} (\code{geom = "text"}, the default, see \link[ggplot2:geom_text]{geom_text()}) or 36 | \code{GeomLabel} (\code{geom = "label"}, see \link[ggplot2:geom_text]{geom_label()}).} 37 | 38 | \item{position}{Position adjustment, either as a string, or the result of 39 | a call to a position adjustment function.} 40 | 41 | \item{...}{Other arguments passed on to \link[ggplot2:layer]{layer()}. These are 42 | often aesthetics, used to set an aesthetic to a fixed value, like 43 | \code{colour = "red"} or \code{size = 3}.} 44 | 45 | \item{method}{the method used for the seasonal adjustment. \code{"x13"} (by default) for the X-13ARIMA method and \code{"tramoseats"} for TRAMO-SEATS.} 46 | 47 | \item{spec}{the specification used for the seasonal adjustment. 48 | See \link[RJDemetra:x13]{x13()} or \link[RJDemetra:tramoseats]{tramoseats()}.} 49 | 50 | \item{frequency}{the frequency of the time series. By default (\code{frequency = NULL}), 51 | the frequency is computed automatically.} 52 | 53 | \item{message}{a \code{boolean} indicating if a message is printed with the frequency used.} 54 | 55 | \item{x_arima, y_arima}{position of the text of the ARIMA model. By default, the first position of the \code{data} is used.} 56 | 57 | \item{show.legend}{logical. Should this layer be included in the legends? 58 | \code{NA}, the default, includes if any aesthetics are mapped. 59 | \code{FALSE} never includes, and \code{TRUE} always includes. 60 | It can also be a named logical vector to finely select the aesthetics to 61 | display.} 62 | 63 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 64 | rather than combining with them.} 65 | } 66 | \description{ 67 | Function to add directly to the plot the ARIMA model used in the pre-adjustment process of the seasonal adjustment. 68 | } 69 | \details{ 70 | With the parameter \code{geom = "text"}, the ARIMA model used in the pre-adjustment process of the seasonal adjustment are directly added to the plot. With \code{geom = "label"} a rectangle is drawn behind the ARIMA model, making it easier to read. 71 | } 72 | \examples{ 73 | p_sa_ipi_fr <- ggplot(data = ipi_c_eu_df, mapping = aes(x = date, y = FR)) + 74 | geom_line(color = "#F0B400") + 75 | labs(title = "Seasonal adjustment of the French industrial production index", 76 | x = "time", y = NULL) + 77 | geom_sa(color = "#155692", message = FALSE) 78 | 79 | # To add the ARIMA model 80 | p_sa_ipi_fr + 81 | geom_arima(geom = "label", 82 | x_arima = - Inf, y_arima = -Inf, 83 | vjust = -1, hjust = -0.1, 84 | message = FALSE) 85 | } 86 | -------------------------------------------------------------------------------- /R/autoplot.R: -------------------------------------------------------------------------------- 1 | #' Plot 'RJDemetra' model 2 | #' 3 | #' @param object a \code{"SA"} or \code{"jSA"} model. 4 | #' @param components components to print, can be \code{"y"} (input time series), 5 | #' \code{"sa"} (seasonal adjusted), \code{"t"} (trend-cycle), 6 | #' \code{"y_cal"} (calendar adjusted), \code{"s"} (seasonal), \code{"i"} (irregular), 7 | #' \code{"cal"} (calendar). The vector can be named to change the label 8 | #' @param forecast boolean indicating if the forecast series should be printed. 9 | #' @param ... unused arguments. 10 | #' @examples 11 | #' x = RJDemetra::jx13(ipi_c_eu[,"FR"]) 12 | #' ggplot2::autoplot(x) 13 | #' @importFrom ggplot2 autoplot 14 | #' @importFrom stats ts.union 15 | #' @method autoplot SA 16 | #' @export 17 | autoplot.SA <- function(object, 18 | components = c("y", "sa", "trend" = "t", "seasonal" = "s", "irregular" = "i"), 19 | forecast = FALSE, ...){ 20 | autoplot_rjd(object = object, 21 | components = components, 22 | forecast = forecast, 23 | ...) 24 | } 25 | #' @method autoplot jSA 26 | #' @export 27 | autoplot.jSA <- function(object, 28 | components = c("y", "sa", "trend" = "t", "seasonal" = "s", "irregular" = "i"), 29 | forecast = FALSE, ...){ 30 | autoplot_rjd(object = object, 31 | components = components, 32 | forecast = forecast, 33 | ...) 34 | } 35 | 36 | 37 | extract_component <- function(component, object, forcecast) { 38 | switch(component, 39 | "y" = raw(object, forcecast), 40 | "t" = trendcycle(object, forcecast), 41 | "sa" = seasonaladj(object, forcecast), 42 | "y_cal" = calendaradj(object, forcecast), 43 | "s" = seasonal(object, forcecast), 44 | "i" = irregular(object, forcecast), 45 | "cal" = calendar(object, forcecast) 46 | ) 47 | } 48 | 49 | autoplot_rjd <- function(object, 50 | components = c("y", "sa", "trend" = "t", "seasonal" = "s", "irregular" = "i"), 51 | forecast = FALSE, ...) { 52 | components_ <- match.arg(tolower(components), 53 | choices = c("y", "t", "sa", "y_cal", "s", "i", "cal"), 54 | several.ok = TRUE) 55 | names(components_) <- names(components) 56 | if (is.null(names(components_))) { 57 | names(components_) <- components_ 58 | } 59 | names(components_)[names(components_) == ""] <- components_[names(components_) == ""] 60 | 61 | data <- ts.union(sapply(components_, extract_component, object, FALSE)) 62 | colnames(data) <- names(components_) 63 | 64 | data_plot <- data.frame(date = rep(time(data), ncol(data)), 65 | y = c(data), 66 | label = factor(rep(colnames(data), 67 | each = nrow(data)), 68 | levels = colnames(data))) 69 | p <- ggplot2::ggplot(ggplot2::aes(x = date, y = y), 70 | data = data_plot) + 71 | ggplot2::geom_line() 72 | 73 | if (forecast) { 74 | data_f <- ts.union(sapply(components_, extract_component, object, forecast)) 75 | colnames(data_f) <- names(components_) 76 | data_f_plot <- data.frame(date = rep(time(data_f), ncol(data_f)), 77 | y = c(data_f), 78 | label = factor(rep(colnames(data_f), 79 | each = nrow(data_f)), 80 | levels = colnames(data_f))) 81 | p <- p + ggplot2::geom_line(data = data_f_plot,linetype = 2) 82 | } 83 | 84 | p + ggplot2::facet_grid("label ~ .", scales = "free_y", switch = "y") + 85 | ggplot2::ylab(NULL) 86 | } 87 | utils::globalVariables(c("y")) 88 | -------------------------------------------------------------------------------- /man/geom_sa.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom_sa.R 3 | \name{geom_sa} 4 | \alias{geom_sa} 5 | \alias{stat_sa} 6 | \title{Seasonal adjustment time series} 7 | \usage{ 8 | geom_sa( 9 | mapping = NULL, 10 | data = NULL, 11 | stat = "sa", 12 | position = "identity", 13 | ..., 14 | method = c("x13", "tramoseats"), 15 | spec = NULL, 16 | frequency = NULL, 17 | message = TRUE, 18 | component = "sa", 19 | show.legend = NA, 20 | inherit.aes = TRUE 21 | ) 22 | 23 | stat_sa( 24 | mapping = NULL, 25 | data = NULL, 26 | geom = "line", 27 | position = "identity", 28 | ..., 29 | method = c("x13", "tramoseats"), 30 | spec = NULL, 31 | frequency = NULL, 32 | message = TRUE, 33 | component = "sa", 34 | show.legend = NA, 35 | inherit.aes = TRUE 36 | ) 37 | } 38 | \arguments{ 39 | \item{mapping}{Set of aesthetic mappings created by \link[ggplot2:aes]{aes()}. If specified and \code{inherit.aes = TRUE} (the 40 | default), it is combined with the default mapping at the top level of the 41 | plot. You must supply \code{mapping} if there is no plot mapping.} 42 | 43 | \item{data}{A \code{data.frame} that contains the data used for the seasonal adjustment.} 44 | 45 | \item{stat}{The statistical transformation to use on the data for this 46 | layer, as a string.} 47 | 48 | \item{position}{Position adjustment, either as a string, or the result of 49 | a call to a position adjustment function.} 50 | 51 | \item{...}{Other arguments passed on to \link[ggplot2:layer]{layer()}. These are 52 | often aesthetics, used to set an aesthetic to a fixed value, like 53 | \code{colour = "red"} or \code{size = 3}.} 54 | 55 | \item{method}{the method used for the seasonal adjustment. \code{"x13"} (by default) for the X-13ARIMA method and \code{"tramoseats"} for TRAMO-SEATS.} 56 | 57 | \item{spec}{the specification used for the seasonal adjustment. 58 | See \link[RJDemetra:x13]{x13()} or \link[RJDemetra:tramoseats]{tramoseats()}.} 59 | 60 | \item{frequency}{the frequency of the time series. By default (\code{frequency = NULL}), 61 | the frequency is computed automatically.} 62 | 63 | \item{message}{a \code{boolean} indicating if a message is printed with the frequency used.} 64 | 65 | \item{component}{a \code{character} equals to the component to plot. The result must be a time series. 66 | See \link[RJDemetra:user_defined_variables]{user_defined_variables()} for the available 67 | parameters. By default (\code{component = 'sa'}) the seasonal adjusted component is plotted.} 68 | 69 | \item{show.legend}{logical. Should this layer be included in the legends? 70 | \code{NA}, the default, includes if any aesthetics are mapped. 71 | \code{FALSE} never includes, and \code{TRUE} always includes. 72 | It can also be a named logical vector to finely select the aesthetics to 73 | display.} 74 | 75 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 76 | rather than combining with them.} 77 | 78 | \item{geom}{The geometric object to use to display the data} 79 | } 80 | \description{ 81 | Performs a seasonal adjustment and plots a time series. 82 | \code{geom_sa()} and \code{stat_sa()} are aliases: they both use the same arguments. 83 | Use \code{stat_sa()} if you want to display the results with a non-standard geom. 84 | } 85 | \examples{ 86 | p_ipi_fr <- ggplot(data = ipi_c_eu_df, mapping = aes(x = date, y = FR)) + 87 | geom_line(color = "#F0B400") + 88 | labs(title = "Seasonal adjustment of the French industrial production index", 89 | x = "time", y = NULL) 90 | 91 | # To add the seasonal adjusted series: 92 | p_ipi_fr + 93 | geom_sa(color = "#155692") 94 | 95 | # To add the forecasts of the input data and the seasonal adjusted series: 96 | p_sa <- p_ipi_fr + 97 | geom_sa(component = "y_f", linetype = 2, message = FALSE, color = "#F0B400") + 98 | geom_sa(component = "sa", color = "#155692", message = FALSE) + 99 | geom_sa(component = "sa_f", color = "#155692", linetype = 2, message = FALSE) 100 | p_sa 101 | } 102 | -------------------------------------------------------------------------------- /R/ipi_c_eu.R: -------------------------------------------------------------------------------- 1 | #' Industrial Production Indices in manufacturing in the European Union 2 | #' 3 | #' A dataset containing on monthly industrial production indices in manufacturing in the European Union (from sts_inpr_m dataset of Eurostat). Data are based 100 in 2015 and are unadjusted, i.e. neither seasonally adjusted nor calendar adjusted. 4 | #' 5 | #' The dataset contains 34 time series corresponding to the following geographical area 6 | #' \tabular{cl}{ 7 | #' BE \tab Belgium \cr 8 | #' BG \tab Bulgaria \cr 9 | #' CZ \tab Czechia \cr 10 | #' DK \tab Denmark \cr 11 | #' DE \tab Germany (until 1990 former territory of the FRG)\cr 12 | #' EE \tab Estonia \cr 13 | #' IE \tab Ireland \cr 14 | #' EL \tab Greece \cr 15 | #' ES \tab Spain \cr 16 | #' FR \tab France \cr 17 | #' HR \tab Croatia \cr 18 | #' IT \tab Italy \cr 19 | #' CY \tab Cyprus \cr 20 | #' LV \tab Latvia \cr 21 | #' LT \tab Lithuania \cr 22 | #' LU \tab Luxembourg \cr 23 | #' HU \tab Hungary \cr 24 | #' MT \tab Malta \cr 25 | #' NL \tab Netherlands \cr 26 | #' AT \tab Austria \cr 27 | #' PL \tab Poland \cr 28 | #' PT \tab Portugal \cr 29 | #' RO \tab Romania \cr 30 | #' SI \tab Slovenia \cr 31 | #' SK \tab Slovakia \cr 32 | #' FI \tab Finland \cr 33 | #' SE \tab Sweden \cr 34 | #' UK \tab United Kingdom \cr 35 | #' NO \tab Norway \cr 36 | #' CH \tab Switzerland \cr 37 | #' ME \tab Montenegro \cr 38 | #' MK \tab Former Yugoslav Republic of Macedonia, the \cr 39 | #' RS \tab Serbia \cr 40 | #' TR \tab Turkey \cr 41 | #' BA \tab Bosnia and Herzegovina 42 | #' } 43 | #' @docType data 44 | #' @format A monthly \code{ts} object from january 1990 to december 2017 with 34 variables for \code{ipi_c_eu} and a \code{data.frame} for \code{ipi_c_eu_df}. 45 | #' @source Eurostat, 'sts_inpr_m' database. 46 | "ipi_c_eu" 47 | #' @rdname ipi_c_eu 48 | "ipi_c_eu_df" 49 | 50 | # # To update data: 51 | # ipi_c_eu <- eurostat::get_eurostat("sts_inpr_m",select_time = "M", 52 | # filters = list(nace_r2="C", 53 | # unit = "I15", s_adj = "NSA", 54 | # sinceTimePeriod = "1990M01")) 55 | # ipi_c_eu <- reshape2::dcast(ipi_c_eu, time ~ geo, value.var = "values") 56 | # ipi_c_eu <- ts(ipi_c_eu[, c("BE", "BG", "CZ", "DK", "DE", 57 | # "EE", "EL", "ES", "FR", "HR", "IT", "CY", "LV", "LT", "LU", 58 | # "HU", "MT", "NL", "AT", "PL", "PT", "RO", "SI", "SK", "FI", "SE", 59 | # "UK", "NO", "CH", "ME", "MK", "RS", "TR", "BA")], 60 | # start = c(1990, 1), frequency = 12) 61 | # # # Last date is removed due to NA: 62 | # # ipi_c_eu <- window(ipi_c_eu, end = tail(time(ipi_c_eu),1) - 1/12) 63 | # ipi_c_eu_df <- ts2df(ipi_c_eu) 64 | # save(ipi_c_eu,file = "data/ipi_c_eu.rda", version = 2) 65 | # save(ipi_c_eu_df,file = "data/ipi_c_eu_df.rda", version = 2) 66 | 67 | -------------------------------------------------------------------------------- /R/extract_cmp.R: -------------------------------------------------------------------------------- 1 | #' Extract Component from 'RJDemetra' model 2 | #' 3 | #' @param x a \code{"SA"} or \code{"jSA"} model. 4 | #' @param forecast boolean indicating if the forecast series should be returned. 5 | #' @name components 6 | #' @rdname components 7 | #' @export 8 | seasonal <- function(x, forecast = FALSE) { 9 | UseMethod("seasonal", x) 10 | } 11 | #' @export 12 | seasonal.SA <- function(x, forecast = FALSE){ 13 | if (forecast) { 14 | x$final$forecasts[,"s_f"] 15 | } else { 16 | x$final$series[,"s"] 17 | } 18 | } 19 | #' @export 20 | seasonal.jSA <- function(x, forecast = FALSE){ 21 | if (forecast) { 22 | get_indicators(x, "s_f")[[1]] 23 | } else { 24 | get_indicators(x, "s")[[1]] 25 | } 26 | } 27 | #' @rdname components 28 | #' @export 29 | trendcycle <- function(x, forecast = FALSE) { 30 | UseMethod("trendcycle", x) 31 | } 32 | #' @export 33 | trendcycle.SA <- function(x, forecast = FALSE){ 34 | if (forecast) { 35 | x$final$forecasts[,"t_f"] 36 | } else { 37 | x$final$series[,"t"] 38 | } 39 | } 40 | #' @export 41 | trendcycle.jSA <- function(x, forecast = FALSE){ 42 | if (forecast) { 43 | get_indicators(x, "t_f")[[1]] 44 | } else { 45 | get_indicators(x, "t")[[1]] 46 | } 47 | } 48 | #' @rdname components 49 | #' @export 50 | irregular <- function(x, forecast = FALSE) { 51 | UseMethod("irregular", x) 52 | } 53 | #' @export 54 | irregular.SA <- function(x, forecast = FALSE){ 55 | if (forecast) { 56 | x$final$forecasts[,"i_f"] 57 | } else { 58 | x$final$series[,"i"] 59 | } 60 | } 61 | #' @export 62 | irregular.jSA <- function(x, forecast = FALSE){ 63 | if (forecast) { 64 | get_indicators(x, "i_f")[[1]] 65 | } else { 66 | get_indicators(x, "i")[[1]] 67 | } 68 | } 69 | #' @rdname components 70 | #' @export 71 | seasonaladj <- function(x, forecast = FALSE) { 72 | UseMethod("seasonaladj", x) 73 | } 74 | #' @export 75 | seasonaladj.SA <- function(x, forecast = FALSE){ 76 | if (forecast) { 77 | x$final$forecasts[,"sa_f"] 78 | } else { 79 | x$final$series[,"sa"] 80 | } 81 | } 82 | #' @export 83 | seasonaladj.jSA <- function(x, forecast = FALSE){ 84 | if (forecast) { 85 | get_indicators(x, "sa_f")[[1]] 86 | } else { 87 | get_indicators(x, "sa")[[1]] 88 | } 89 | } 90 | #' @rdname components 91 | #' @export 92 | calendaradj <- function(x, forecast = FALSE) { 93 | UseMethod("calendaradj", x) 94 | } 95 | #' @export 96 | calendaradj.SA <- function(x, forecast = FALSE){ 97 | y <- get_ts(x) 98 | if (inherits(x, "X13")) { 99 | jmod <- jx13(y, x13_spec(x)) 100 | } else { 101 | jmod <- jtramoseats(y, tramoseats_spec(x)) 102 | } 103 | calendaradj(jmod, forecast = forecast) 104 | } 105 | #' @export 106 | calendaradj.jSA <- function(x, forecast = FALSE){ 107 | if (forecast) { 108 | get_indicators(x, "preprocessing.model.ycal_f")[[1]] 109 | } else { 110 | get_indicators(x, "preprocessing.model.ycal")[[1]] 111 | } 112 | } 113 | 114 | #' @rdname components 115 | #' @export 116 | calendar <- function(x, forecast = FALSE) { 117 | UseMethod("calendar", x) 118 | } 119 | #' @export 120 | calendar.SA <- function(x, forecast = FALSE){ 121 | y <- get_ts(x) 122 | if (inherits(x, "X13")) { 123 | jmod <- jx13(y, x13_spec(x)) 124 | } else { 125 | jmod <- jtramoseats(y, tramoseats_spec(x)) 126 | } 127 | calendar(jmod, forecast = forecast) 128 | } 129 | #' @export 130 | calendar.jSA <- function(x, forecast = FALSE){ 131 | if (forecast) { 132 | get_indicators(x, "preprocessing.model.cal_f")[[1]] 133 | } else { 134 | get_indicators(x, "preprocessing.model.cal")[[1]] 135 | } 136 | } 137 | 138 | #' @rdname components 139 | #' @export 140 | raw <- function(x, forecast = FALSE) { 141 | UseMethod("raw", x) 142 | } 143 | #' @export 144 | raw.SA <- function(x, forecast = FALSE){ 145 | if (forecast) { 146 | x$final$forecasts[,"y_f"] 147 | } else { 148 | x$final$series[,"y"] 149 | } 150 | } 151 | #' @export 152 | raw.jSA <- function(x, forecast = FALSE){ 153 | if (forecast) { 154 | get_indicators(x, "y_f")[[1]] 155 | } else { 156 | get_indicators(x, "y")[[1]] 157 | } 158 | } 159 | -------------------------------------------------------------------------------- /man/geom_diagnostics.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom_diagnostics.R 3 | \name{geom_diagnostics} 4 | \alias{geom_diagnostics} 5 | \title{Table of diagnostics} 6 | \usage{ 7 | geom_diagnostics( 8 | mapping = NULL, 9 | data = NULL, 10 | position = "identity", 11 | ..., 12 | method = c("x13", "tramoseats"), 13 | spec = NULL, 14 | frequency = NULL, 15 | message = TRUE, 16 | diagnostics = NULL, 17 | digits = 2, 18 | xmin = -Inf, 19 | xmax = Inf, 20 | ymin = -Inf, 21 | ymax = Inf, 22 | table_theme = ttheme_default(), 23 | inherit.aes = TRUE 24 | ) 25 | } 26 | \arguments{ 27 | \item{mapping}{Set of aesthetic mappings created by \link[ggplot2:aes]{aes()}. If specified and \code{inherit.aes = TRUE} (the 28 | default), it is combined with the default mapping at the top level of the 29 | plot. You must supply \code{mapping} if there is no plot mapping.} 30 | 31 | \item{data}{A \code{data.frame} that contains the data used for the seasonal adjustment.} 32 | 33 | \item{position}{Position adjustment, either as a string, or the result of 34 | a call to a position adjustment function.} 35 | 36 | \item{...}{Other arguments passed on to \link[ggplot2:layer]{layer()}. These are 37 | often aesthetics, used to set an aesthetic to a fixed value, like 38 | \code{colour = "red"} or \code{size = 3}.} 39 | 40 | \item{method}{the method used for the seasonal adjustment. \code{"x13"} (by default) for the X-13ARIMA method and \code{"tramoseats"} for TRAMO-SEATS.} 41 | 42 | \item{spec}{the specification used for the seasonal adjustment. 43 | See \link[RJDemetra:x13]{x13()} or \link[RJDemetra:tramoseats]{tramoseats()}.} 44 | 45 | \item{frequency}{the frequency of the time series. By default (\code{frequency = NULL}), 46 | the frequency is computed automatically.} 47 | 48 | \item{message}{a \code{boolean} indicating if a message is printed with the frequency used.} 49 | 50 | \item{diagnostics}{vector of character containing the name of the diagnostics to plot. 51 | See \link[RJDemetra:user_defined_variables]{user_defined_variables()} for the available 52 | parameters.} 53 | 54 | \item{digits}{integer indicating the number of decimal places to be used for numeric diagnostics. By default \code{digits = 2}.} 55 | 56 | \item{xmin, xmax}{x location (in data coordinates) giving horizontal 57 | location of raster.} 58 | 59 | \item{ymin, ymax}{y location (in data coordinates) giving vertical 60 | location of raster.} 61 | 62 | \item{table_theme}{list of theme parameters for the table of diagnostics (see \link[gridExtra:tableGrob]{ttheme_default()}).} 63 | 64 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 65 | rather than combining with them.} 66 | } 67 | \description{ 68 | Adds a table of diagnostics to the plot 69 | } 70 | \examples{ 71 | p_sa_ipi_fr <- ggplot(data = ipi_c_eu_df, mapping = aes(x = date, y = FR)) + 72 | geom_line(color = "#F0B400") + 73 | labs(title = "Seasonal adjustment of the French industrial production index", 74 | x = "time", y = NULL) + 75 | geom_sa(color = "#155692", message = FALSE) 76 | 77 | # To add of diagnostics with result of the X-11 combined test and the p-values 78 | # of the residual seasonality qs and f tests: 79 | diagnostics <- c("diagnostics.combined.all.summary", "diagnostics.qs", "diagnostics.ftest") 80 | p_sa_ipi_fr + 81 | geom_diagnostics(diagnostics = diagnostics, 82 | ymin = 58, ymax = 72, xmin = 2010, 83 | table_theme = gridExtra::ttheme_default(base_size = 8), 84 | message = FALSE) 85 | 86 | # To customize the names of the diagnostics in the plot: 87 | 88 | diagnostics <- c(`Combined test` = "diagnostics.combined.all.summary", 89 | `Residual qs-test (p-value)` = "diagnostics.qs", 90 | `Residual f-test (p-value)` = "diagnostics.ftest") 91 | p_sa_ipi_fr + 92 | geom_diagnostics(diagnostics = diagnostics, 93 | ymin = 58, ymax = 72, xmin = 2010, 94 | table_theme = gridExtra::ttheme_default(base_size = 8), 95 | message = FALSE) 96 | 97 | # To add the table below the plot: 98 | 99 | p_diag <- ggplot(data = ipi_c_eu_df, mapping = aes(x = date, y = FR)) + 100 | geom_diagnostics(diagnostics = diagnostics, 101 | table_theme = gridExtra::ttheme_default(base_size = 8), 102 | message = FALSE) + 103 | theme_void() 104 | 105 | gridExtra::grid.arrange(p_sa_ipi_fr, p_diag, 106 | nrow = 2, heights = c(4, 1)) 107 | 108 | } 109 | -------------------------------------------------------------------------------- /R/seasonal_adjustment.R: -------------------------------------------------------------------------------- 1 | #' @importFrom stats ts is.mts is.ts time 2 | #' @import RJDemetra 3 | seasonal_adjustment <- function(data, 4 | method = c("x13","tramoseats"), 5 | spec = NULL, 6 | frequency = NULL, 7 | message = TRUE, 8 | new_data = TRUE){ 9 | data <- data[order(data$x), ] 10 | 11 | use_previous_model <- pre_check_param(frequency = frequency, method = method, 12 | spec = spec, new_data = new_data, 13 | data_y = data$y) 14 | if(use_previous_model){ 15 | sa <- .demetra$sa 16 | data_ts <- .demetra$data_ts 17 | }else{ 18 | data_ts <- .demetra$data_ts <- 19 | dataframe2ts(data = data, frequency = frequency, message = message) 20 | method <- match.arg(method) 21 | if (method == "x13") { 22 | if (is.null(spec)) { 23 | sa <- RJDemetra::jx13(data_ts) 24 | }else{ 25 | sa <- RJDemetra::jx13(data_ts, spec = spec) 26 | } 27 | }else{ 28 | if (is.null(spec)) { 29 | sa <- RJDemetra::jtramoseats(data_ts) 30 | }else{ 31 | sa <- RJDemetra::jtramoseats(data_ts, spec = spec) 32 | } 33 | } 34 | .demetra$sa <- sa 35 | .demetra$spec <- spec 36 | .demetra$method <- method 37 | .demetra$data_y <- data$y 38 | } 39 | 40 | 41 | # data$sa_model <- list(sa) 42 | list(data = data, sa = sa, dates = as.numeric(time(data_ts)), 43 | frequency = frequency(data_ts)) 44 | } 45 | dataframe2ts <- function(data, frequency = NULL, message = TRUE){ 46 | dates <- data$x 47 | 48 | if (inherits(dates, "Date")) { 49 | years <- as.numeric(format(dates, format = "%Y")) 50 | months <- as.numeric(format(dates, format = "%m")) 51 | if (is.null(frequency)) { 52 | frequency <- max(table(years)) 53 | if (message) 54 | message(sprintf("Frequency used: %i", frequency)) 55 | } 56 | dates <- years + (months - 1) / frequency 57 | first_date <- dates[1] 58 | }else{ 59 | # Numeric format 60 | if (is.null(frequency)) { 61 | years <- trunc(round(dates, 3)) 62 | frequency <- max(table(years)) 63 | if (message) 64 | message(sprintf("Frequency used: %i", frequency)) 65 | } 66 | first_date <- dates[1] 67 | } 68 | if (!frequency %in% c(2, 4, 6, 12)) 69 | stop("Error with the frequency: it must be equal to 12, 6, 4 or 2") 70 | 71 | .demetra$frequency <- frequency 72 | ts(data$y, start = first_date, frequency = frequency) 73 | } 74 | ts2dataframe <- function(x){ 75 | if (is.ts(x) & !is.mts(x)) { 76 | data.frame(x = as.numeric(time(x)), 77 | y = as.numeric(x)) 78 | }else{ 79 | NULL 80 | } 81 | 82 | } 83 | 84 | .demetra <- new.env(parent = emptyenv()) 85 | .demetra$frequency <- 86 | .demetra$method <- 87 | .demetra$sa <- 88 | .demetra$spec <- 89 | .demetra$data_ts <- 90 | .demetra$data_y <- 91 | NULL 92 | 93 | pre_check_param <- function(frequency = NULL, 94 | method = c("x13","tramoseats"), 95 | spec = NULL, 96 | new_data = TRUE, 97 | data_y = NULL){ 98 | use_previous_model <- FALSE 99 | if(any(new_data, 100 | is.null(.demetra$frequency), 101 | is.null(.demetra$method), 102 | is.null(.demetra$sa) 103 | )){ 104 | .demetra$frequency <- 105 | .demetra$method <- 106 | .demetra$sa <- 107 | .demetra$data_ts <- 108 | .demetra$data_y <- 109 | NULL 110 | return(use_previous_model) 111 | } 112 | 113 | # method <- match.arg(method) 114 | 115 | if((is.null(spec) || identical(spec, .demetra$spec)) & 116 | (is.null(method) || .demetra$method %in% method) & 117 | (is.null(frequency) || identical(frequency, .demetra$frequency)) & 118 | (identical(data_y, .demetra$data_y))){ 119 | use_previous_model <- TRUE 120 | }else{ 121 | .demetra$frequency <- 122 | .demetra$method <- 123 | .demetra$sa <- 124 | .demetra$spec <- 125 | .demetra$data_ts <- 126 | .demetra$data_y <- 127 | NULL 128 | } 129 | use_previous_model 130 | } 131 | -------------------------------------------------------------------------------- /R/geom_arima.R: -------------------------------------------------------------------------------- 1 | StatArima <- ggproto("StatArima", Stat, 2 | required_aes = c("x", "y"), 3 | default_aes = aes(x = x, y = y, label = stat(arima_model)), 4 | compute_group = function(data, scales, 5 | method = c("x13", "tramoseats"), 6 | spec = NULL, 7 | frequency = NULL, 8 | message = TRUE, 9 | x_arima = NULL, y_arima = NULL, 10 | new_data = TRUE) { 11 | result <- seasonal_adjustment(data = data, 12 | method = method, 13 | spec = spec, 14 | frequency = frequency, 15 | message = message, 16 | new_data = new_data) 17 | data <- result[["data"]] 18 | sa <- result[["sa"]] 19 | arima_model <- RJDemetra::get_indicators(sa, 20 | sprintf("preprocessing.arima.%s", 21 | c("p","d","q","bp","bd","bq"))) 22 | 23 | arima_model <- paste0("ARIMA(",arima_model[[1]], ",", 24 | arima_model[[2]], ",", 25 | arima_model[[3]], ")(", 26 | arima_model[[4]], ",", 27 | arima_model[[5]], ",", 28 | arima_model[[6]], ")") 29 | data <- data[1, ] 30 | if (!is.null(x_arima)) 31 | data$x <- x_arima 32 | if (!is.null(y_arima)) 33 | data$y <- y_arima 34 | data$arima_model <- arima_model 35 | data 36 | } 37 | ) 38 | #' ARIMA model 39 | #' 40 | #' Function to add directly to the plot the ARIMA model used in the pre-adjustment process of the seasonal adjustment. 41 | #' 42 | #' @inheritParams geom_sa 43 | #' @param geom character. The geometric to use to display the data: 44 | #' `GeomText` (`geom = "text"`, the default, see [geom_text()][ggplot2::geom_text]) or 45 | #' `GeomLabel` (`geom = "label"`, see [geom_label()][ggplot2::geom_label]). 46 | 47 | #' @param x_arima,y_arima position of the text of the ARIMA model. By default, the first position of the `data` is used. 48 | #' 49 | #' @details 50 | #' With the parameter `geom = "text"`, the ARIMA model used in the pre-adjustment process of the seasonal adjustment are directly added to the plot. With `geom = "label"` a rectangle is drawn behind the ARIMA model, making it easier to read. 51 | #' 52 | #' @examples 53 | #' p_sa_ipi_fr <- ggplot(data = ipi_c_eu_df, mapping = aes(x = date, y = FR)) + 54 | #' geom_line(color = "#F0B400") + 55 | #' labs(title = "Seasonal adjustment of the French industrial production index", 56 | #' x = "time", y = NULL) + 57 | #' geom_sa(color = "#155692", message = FALSE) 58 | #' 59 | #' # To add the ARIMA model 60 | #' p_sa_ipi_fr + 61 | #' geom_arima(geom = "label", 62 | #' x_arima = - Inf, y_arima = -Inf, 63 | #' vjust = -1, hjust = -0.1, 64 | #' message = FALSE) 65 | #' @importFrom ggplot2 GeomText GeomLabel 66 | #' @importFrom ggrepel GeomTextRepel GeomLabelRepel 67 | #' @export 68 | geom_arima <- function(mapping = NULL, data = NULL, stat = "arima", 69 | geom = c("text", "label"), 70 | position = "identity", ..., 71 | method = c("x13", "tramoseats"), 72 | spec = NULL, 73 | frequency = NULL, 74 | message = TRUE, 75 | x_arima = NULL, y_arima = NULL, 76 | show.legend = NA, 77 | inherit.aes = TRUE 78 | ) { 79 | geom <- match.arg(geom) 80 | if (geom == "text") { 81 | geom <- GeomText 82 | } else { 83 | geom <- GeomLabel 84 | } 85 | ggplot2::layer(data = data, mapping = mapping, stat = stat, geom = geom, 86 | position = position, show.legend = show.legend, inherit.aes = inherit.aes, 87 | params = list(method = method, spec = spec, 88 | frequency = frequency, message = message, 89 | x_arima = x_arima, y_arima = y_arima, 90 | new_data = !missing(data) || !is.null(data), 91 | ...)) 92 | } 93 | 94 | -------------------------------------------------------------------------------- /man/geom_outlier.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom_outliers.R 3 | \name{geom_outlier} 4 | \alias{geom_outlier} 5 | \title{Outliers texts} 6 | \usage{ 7 | geom_outlier( 8 | mapping = NULL, 9 | data = NULL, 10 | stat = "outlier", 11 | geom = c("text", "label", "text_repel", "label_repel"), 12 | position = "identity", 13 | ..., 14 | method = c("x13", "tramoseats"), 15 | spec = NULL, 16 | frequency = NULL, 17 | message = TRUE, 18 | first_date = NULL, 19 | last_date = NULL, 20 | coefficients = FALSE, 21 | digits = 1, 22 | show.legend = NA, 23 | inherit.aes = TRUE 24 | ) 25 | } 26 | \arguments{ 27 | \item{mapping}{Set of aesthetic mappings created by \link[ggplot2:aes]{aes()}. If specified and \code{inherit.aes = TRUE} (the 28 | default), it is combined with the default mapping at the top level of the 29 | plot. You must supply \code{mapping} if there is no plot mapping.} 30 | 31 | \item{data}{A \code{data.frame} that contains the data used for the seasonal adjustment.} 32 | 33 | \item{stat}{The statistical transformation to use on the data for this 34 | layer, as a string.} 35 | 36 | \item{geom}{character. The geometric to use to display the data: 37 | \code{GeomText} (\code{geom = "text"}, the default, see \link[ggplot2:geom_text]{geom_text()}); 38 | \code{GeomLabel} (\code{geom = "label"}, see \link[ggplot2:geom_text]{geom_label()}); 39 | \code{GeomTextRepel} (\code{geom = "text_repel"}, the default, see \link[ggrepel:geom_text_repel]{geom_text_repel()}); 40 | \code{GeomLabelRepel} (\code{geom = "label_repel"}, the default, see \link[ggrepel:geom_text_repel]{geom_label_repel()}).} 41 | 42 | \item{position}{Position adjustment, either as a string, or the result of 43 | a call to a position adjustment function.} 44 | 45 | \item{...}{Other arguments passed on to \link[ggplot2:layer]{layer()}. They may be parameters of 46 | \link[ggplot2:geom_text]{geom_text()} (if \code{geom = "text"}), 47 | \link[ggplot2:geom_text]{geom_label()} (if \code{geom = "label"}), 48 | \link[ggrepel:geom_text_repel]{geom_text_repel()} (if \code{geom = "text_repel"}) 49 | or \link[ggrepel:geom_text_repel]{geom_label_repel()} (if \code{geom = "label_repel"}).} 50 | 51 | \item{method}{the method used for the seasonal adjustment. \code{"x13"} (by default) for the X-13ARIMA method and \code{"tramoseats"} for TRAMO-SEATS.} 52 | 53 | \item{spec}{the specification used for the seasonal adjustment. 54 | See \link[RJDemetra:x13]{x13()} or \link[RJDemetra:tramoseats]{tramoseats()}.} 55 | 56 | \item{frequency}{the frequency of the time series. By default (\code{frequency = NULL}), 57 | the frequency is computed automatically.} 58 | 59 | \item{message}{a \code{boolean} indicating if a message is printed with the frequency used.} 60 | 61 | \item{first_date}{A numeric specifying the first date from which the outliers are plotted. 62 | By default (\code{first_date = NULL}) the outliers are plotted from the 63 | beginning of the time series.} 64 | 65 | \item{last_date}{A numeric specifying the first date from which the outliers are plotted. 66 | By default (\code{first_date = NULL}) the outliers are plotted until the 67 | end of the time series.} 68 | 69 | \item{coefficients}{boolean indicating if the estimates coefficients are printed. 70 | By default \code{coefficients = FALSE}.} 71 | 72 | \item{digits}{integer indicating the number of decimal places to be used for numeric diagnostics. By default \code{digits = 1}.} 73 | 74 | \item{show.legend}{logical. Should this layer be included in the legends? 75 | \code{NA}, the default, includes if any aesthetics are mapped. 76 | \code{FALSE} never includes, and \code{TRUE} always includes. 77 | It can also be a named logical vector to finely select the aesthetics to 78 | display.} 79 | 80 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 81 | rather than combining with them.} 82 | } 83 | \description{ 84 | Function to add directly to the plot the outliers used in the pre-adjustment process of the seasonal adjustment. 85 | } 86 | \details{ 87 | With the parameter \code{geom = "text"}, the outliers used in the pre-adjustment process of the seasonal adjustment are directly added to the plot. With \code{geom = "label"} a rectangle is drawn behind the names of the outliers, making them easier to read. The same with \code{geom = "text_repel"} or \code{geom = "label_repel"} but text labels are also repeled away from each other and away from the data points (see \link[ggrepel:geom_text_repel]{geom_label_repel()}). 88 | } 89 | \examples{ 90 | p_sa_ipi_fr <- ggplot(data = ipi_c_eu_df, mapping = aes(x = date, y = FR)) + 91 | geom_line(color = "#F0B400") + 92 | labs(title = "Seasonal adjustment of the French industrial production index", 93 | x = "time", y = NULL) + 94 | geom_sa(color = "#155692", message = FALSE) 95 | 96 | # To add the outliers: 97 | p_sa_ipi_fr + geom_outlier(geom = "label", 98 | message = FALSE) 99 | 100 | 101 | # To have a more readable plot with outliers names that repeled away from each other 102 | # and from the data points: 103 | p_sa_ipi_fr + 104 | geom_outlier(geom = "label_repel", 105 | message = FALSE, 106 | ylim = c(NA, 65), 107 | arrow = arrow(length = unit(0.03, "npc"), 108 | type = "closed", ends = "last")) 109 | 110 | # To only plot the outliers from a specific date (2009): 111 | p_sa_ipi_fr + 112 | geom_outlier(geom = "label_repel", 113 | message = FALSE, 114 | first_date = 2009, 115 | ylim = c(NA, 65), 116 | arrow = arrow(length = unit(0.03, "npc"), 117 | type = "closed", ends = "last")) 118 | } 119 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, echo = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-", 12 | fig.align = "center", 13 | fig.dim = c(7,4)*1.4, 14 | out.width = "100%", 15 | warning = FALSE 16 | ) 17 | ``` 18 | 19 | # ggdemetra 20 | 21 | [![R-CMD-check](https://github.com/AQLT/ggdemetra/workflows/R-CMD-check/badge.svg)](https://github.com/AQLT/ggdemetra/actions) 22 | [![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/ggdemetra)](https://cran.r-project.org/package=ggdemetra) 23 | [![CRAN last release](https://www.r-pkg.org/badges/last-release/ggdemetra)](https://cran.r-project.org/package=ggdemetra) 24 | [![CRAN monthly downloads](https://cranlogs.r-pkg.org/badges/ggdemetra?color=lightgrey)](https://cran.r-project.org/package=ggdemetra) 25 | [![CRAN downloads](https://cranlogs.r-pkg.org/badges/grand-total/ggdemetra?color=lightgrey)](https://cran.r-project.org/package=ggdemetra) 26 | 27 | ## Overview 28 | 29 | ggdemetra is an extension of [ggplot2](https://github.com/tidyverse/ggplot2) to add seasonal adjustment statistics to your plots. 30 | The seasonal adjustment process is done with [RJDemetra](https://github.com/rjdverse/rjdemetra) that is an R interface to [JDemetra+](https://github.com/jdemetra/jdemetra-app), the seasonal adjustment software [officially recommended](https://wayback.archive-it.org/12090/20240102173448/https://cros-legacy.ec.europa.eu/system/files/Jdemetra_%20release.pdf) to the members of the European Statistical System (ESS) and the European System of Central Banks. RJDemetra implements the two leading seasonal adjustment methods [TRAMO/SEATS+](https://gretl.sourceforge.net/tramo/tramo-seats.html) and [X-12ARIMA/X-13ARIMA-SEATS](https://www.census.gov/data/software/x13as.html). 31 | 32 | There are 4 main functionnalities in `ggdemetra` depending of what you want to add in the graphic: 33 | 34 | - `geom_sa()`: to add a time series compute during the seasonal adjustment (the trend, the seasonal adjusted time series, etc.). 35 | - `geom_outlier()`: to add the outliers used in the pre-adjustment process of the seasonal adjustment. 36 | - `geom_arima()`: to add the ARIMA model used in the pre-adjustment process of the seasonal adjustment. 37 | - `geom_diagnostics()`: to add a table containing some diagnostics on the seasonal adjustment process. 38 | 39 | ## Installation 40 | 41 | Since RJDemetra requires Java SE 8 or later version, the same requirements are also needed for ggdemetra. 42 | 43 | ```{r, eval = FALSE} 44 | # Install release version from CRAN 45 | install.packages("ggdemetra") 46 | 47 | # Install development version from GitHub 48 | # install.packages("devtools") 49 | devtools::install_github("AQLT/ggdemetra") 50 | ``` 51 | 52 | If you have troubles with the installation of RJDemetra, check the [installation manual](https://github.com/rjdverse/rjdemetra/wiki/Installation-manual). 53 | 54 | ## Usage 55 | 56 | By default, the seasonal adjustment is made with X-13-ARIMA with the pre-defined specification "RSA5c" (automatic log detection, automatic ARIMA and outliers detection and trading day and easter adjustment). 57 | If no new data or seasonal adjustment specification is specified (method or specification), these parameters is inherited from the previous defined: therefore you only need to specify the specification once. 58 | In the following examples, the seasonal adjustment will be perform with X-13-ARIMA with working day adjustment and no gradual easter effect adjustment (it is the specification that has the most economic sense for the industrial production index). 59 | 60 | To add the seasonal adjusted series and the forecasts of the input data and of the seasonal adjusted series: 61 | ```{r sa, warning=FALSE, message=FALSE} 62 | library(ggplot2) 63 | library(ggdemetra) 64 | spec <- RJDemetra::x13_spec("RSA3", tradingdays.option = "WorkingDays") 65 | p_ipi_fr <- ggplot(data = ipi_c_eu_df, mapping = aes(x = date, y = FR)) + 66 | geom_line(color = "#F0B400") + 67 | labs(title = "Seasonal adjustment of the French industrial production index", 68 | x = NULL, y = NULL) 69 | p_sa <- p_ipi_fr + 70 | geom_sa(component = "y_f", linetype = 2, 71 | spec = spec, frequency = 12, color = "#F0B400") + 72 | geom_sa(component = "sa", color = "#155692") + 73 | geom_sa(component = "sa_f", color = "#155692", linetype = 2) 74 | p_sa 75 | ``` 76 | 77 | To add the outliers at the bottom of the plot with an arrow to the data point and the estimated coefficients: 78 | ```{r sa-out} 79 | p_sa + 80 | geom_outlier(geom = "label_repel", 81 | coefficients = TRUE, 82 | ylim = c(NA, 65), 83 | arrow = arrow(length = unit(0.03, "npc"), 84 | type = "closed", ends = "last"), 85 | digits = 2) 86 | ``` 87 | 88 | To add the ARIMA model: 89 | 90 | ```{r sa-arima} 91 | p_sa + 92 | geom_arima(geom = "label", 93 | x_arima = -Inf, y_arima = -Inf, 94 | vjust = -1, hjust = -0.1) 95 | ``` 96 | 97 | To add a table of diagnostics below the plot: 98 | ```{r sa-diag} 99 | diagnostics <- c(`Combined test` = "diagnostics.combined.all.summary", 100 | `Residual qs-test (p-value)` = "diagnostics.qs", 101 | `Residual f-test (p-value)` = "diagnostics.ftest") 102 | p_diag <- ggplot(data = ipi_c_eu_df, mapping = aes(x = date, y = FR)) + 103 | geom_diagnostics(diagnostics = diagnostics, 104 | table_theme = gridExtra::ttheme_default(base_size = 8), 105 | spec = spec, frequency = 12) + 106 | theme_void() 107 | 108 | gridExtra::grid.arrange(p_sa, p_diag, 109 | nrow = 2, heights = c(4, 1.5)) 110 | ``` 111 | 112 | See the [vignette](https://aqlt.github.io/ggdemetra/articles/ggdemetra.html) for more details. 113 | 114 | Note that `ts` objects cannot be directly used in `ggplot2`. 115 | To convert `ts` or `mts` object to `data.frame`, you can use the `ts2df()` function. 116 | For example, the data `ipi_c_eu_df` used in this package is obtained by applying the `ts2df()`function to the `ipi_c_eu` data available in RJDemetra: 117 | ```{r, eval = FALSE} 118 | ipi_c_eu_df <- ts2df(ipi_c_eu) 119 | ``` 120 | 121 | 122 | ## Existing models 123 | 124 | ggdemetra offers several function that can be used to manipulate existing models. 125 | 126 | The different components of seasonal adjustment models can be extracted through `calendar()`, `calendaradj()`, `irregular()`, `trendcycle()`, `seasonal()`, `seasonaladj()`, `trendcycle()` and `raw()`. 127 | 128 | If you already have a seasonally adjusted model you can also used the function `init_ggplot()` : 129 | ```{r sa-init} 130 | spec <- RJDemetra::x13_spec("RSA3", tradingdays.option = "WorkingDays") 131 | mod <- RJDemetra::x13(ipi_c_eu[,"FR"], spec) 132 | init_ggplot(mod) + 133 | geom_line(color = "#F0B400") + 134 | geom_sa(component = "sa", color = "#155692") 135 | ``` 136 | 137 | There is also an `autoplot()` function: 138 | 139 | ```{r autoplot} 140 | autoplot(mod) 141 | ``` 142 | 143 | SI-ratio plots can be plotted with `siratioplot` and `ggsiratioplot`: 144 | 145 | ```{r ggsiratio} 146 | ggsiratioplot(mod) 147 | ``` 148 | -------------------------------------------------------------------------------- /R/geom_sa.R: -------------------------------------------------------------------------------- 1 | StatSa <- ggproto("StatSa", Stat, 2 | required_aes = c("x", "y"), 3 | compute_group = function(data, scales, 4 | method = c("x13", "tramoseats"), 5 | spec = NULL, 6 | frequency = NULL, 7 | message = TRUE, 8 | component = "sa", 9 | new_data = TRUE) { 10 | result <- seasonal_adjustment(data = data, 11 | method = method, 12 | spec = spec, 13 | frequency = frequency, 14 | message = message, 15 | new_data = new_data) 16 | data <- result[["data"]] 17 | sa <- result[["sa"]] 18 | component <- component[1] 19 | component_ts <- RJDemetra::get_indicators(sa, component)[[1]] 20 | if (!is.ts(component_ts)) { 21 | warning(sprintf("The component %s isn't a time series!", component)) 22 | return(NULL) 23 | } 24 | component_df <- ts2dataframe(component_ts) 25 | 26 | # if the ts is a forecast we add the last observed value: 27 | if (length(grep("^.*_f$", component)) > 0) { 28 | component_df <- rbind(tail(data[,c("x", "y")],1), component_df) 29 | } 30 | 31 | data$x <- data$y <- NULL 32 | if (nrow(component_df) <= nrow(data)) { 33 | component_df <- cbind(component_df, 34 | data[seq_len(nrow(component_df)), ]) 35 | } 36 | 37 | component_df 38 | } 39 | ) 40 | #' Seasonal adjustment time series 41 | #' 42 | #' Performs a seasonal adjustment and plots a time series. 43 | #' `geom_sa()` and `stat_sa()` are aliases: they both use the same arguments. 44 | #' Use `stat_sa()` if you want to display the results with a non-standard geom. 45 | #' 46 | #' @param mapping Set of aesthetic mappings created by [aes()][ggplot2::aes]. If specified and `inherit.aes = TRUE` (the 47 | #' default), it is combined with the default mapping at the top level of the 48 | #' plot. You must supply `mapping` if there is no plot mapping. 49 | #' @param data A \code{data.frame} that contains the data used for the seasonal adjustment. 50 | #' @param geom The geometric object to use to display the data 51 | #' @param stat The statistical transformation to use on the data for this 52 | #' layer, as a string. 53 | #' @param position Position adjustment, either as a string, or the result of 54 | #' a call to a position adjustment function. 55 | #' @param ... Other arguments passed on to [layer()][ggplot2::layer]. These are 56 | #' often aesthetics, used to set an aesthetic to a fixed value, like 57 | #' `colour = "red"` or `size = 3`. 58 | #' @param method the method used for the seasonal adjustment. `"x13"` (by default) for the X-13ARIMA method and `"tramoseats"` for TRAMO-SEATS. 59 | #' @param spec the specification used for the seasonal adjustment. 60 | #' See [x13()][RJDemetra::x13] or [tramoseats()][RJDemetra::tramoseats]. 61 | #' @param frequency the frequency of the time series. By default (`frequency = NULL`), 62 | #' the frequency is computed automatically. 63 | #' @param message a `boolean` indicating if a message is printed with the frequency used. 64 | #' @param component a `character` equals to the component to plot. The result must be a time series. 65 | #' See [user_defined_variables()][RJDemetra::user_defined_variables] for the available 66 | #' parameters. By default (`component = 'sa'`) the seasonal adjusted component is plotted. 67 | #' @param show.legend logical. Should this layer be included in the legends? 68 | #' `NA`, the default, includes if any aesthetics are mapped. 69 | #' `FALSE` never includes, and `TRUE` always includes. 70 | #' It can also be a named logical vector to finely select the aesthetics to 71 | #' display. 72 | #' @param inherit.aes If `FALSE`, overrides the default aesthetics, 73 | #' rather than combining with them. 74 | #' 75 | #' 76 | #' @examples 77 | #' p_ipi_fr <- ggplot(data = ipi_c_eu_df, mapping = aes(x = date, y = FR)) + 78 | #' geom_line(color = "#F0B400") + 79 | #' labs(title = "Seasonal adjustment of the French industrial production index", 80 | #' x = "time", y = NULL) 81 | #' 82 | #' # To add the seasonal adjusted series: 83 | #' p_ipi_fr + 84 | #' geom_sa(color = "#155692") 85 | #' 86 | #' # To add the forecasts of the input data and the seasonal adjusted series: 87 | #' p_sa <- p_ipi_fr + 88 | #' geom_sa(component = "y_f", linetype = 2, message = FALSE, color = "#F0B400") + 89 | #' geom_sa(component = "sa", color = "#155692", message = FALSE) + 90 | #' geom_sa(component = "sa_f", color = "#155692", linetype = 2, message = FALSE) 91 | #' p_sa 92 | #' @importFrom ggplot2 GeomLine 93 | #' @export 94 | geom_sa <- function(mapping = NULL, data = NULL, stat = "sa", 95 | position = "identity", ..., 96 | method = c("x13", "tramoseats"), 97 | spec = NULL, 98 | frequency = NULL, 99 | message = TRUE, 100 | component = "sa", 101 | show.legend = NA, 102 | inherit.aes = TRUE 103 | ) { 104 | ggplot2::layer(data = data, mapping = mapping, stat = stat, geom = GeomLine, 105 | position = position, show.legend = show.legend, inherit.aes = inherit.aes, 106 | params = list(method = method, spec = spec, 107 | frequency = frequency, message = message, 108 | component = component, 109 | new_data = !missing(data) || !is.null(data), 110 | ...)) 111 | } 112 | #' @rdname geom_sa 113 | #' @name geom_sa 114 | #' @export 115 | stat_sa <- function(mapping = NULL, data = NULL, geom = "line", 116 | position = "identity", ..., 117 | method = c("x13", "tramoseats"), 118 | spec = NULL, 119 | frequency = NULL, 120 | message = TRUE, 121 | component = "sa", 122 | show.legend = NA, 123 | inherit.aes = TRUE) { 124 | ggplot2::layer( 125 | stat = StatSa, data = data, mapping = mapping, geom = geom, 126 | position = position, show.legend = show.legend, inherit.aes = inherit.aes, 127 | params = list(method = method, spec = spec, 128 | frequency = frequency, message = message, 129 | component = component, 130 | new_data = !missing(data) || !is.null(data), 131 | ...) 132 | ) 133 | } 134 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # ggdemetra 5 | 6 | [![R-CMD-check](https://github.com/AQLT/ggdemetra/workflows/R-CMD-check/badge.svg)](https://github.com/AQLT/ggdemetra/actions) 7 | [![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/ggdemetra)](https://cran.r-project.org/package=ggdemetra) 8 | [![CRAN last 9 | release](https://www.r-pkg.org/badges/last-release/ggdemetra)](https://cran.r-project.org/package=ggdemetra) 10 | [![CRAN monthly 11 | downloads](https://cranlogs.r-pkg.org/badges/ggdemetra?color=lightgrey)](https://cran.r-project.org/package=ggdemetra) 12 | [![CRAN 13 | downloads](https://cranlogs.r-pkg.org/badges/grand-total/ggdemetra?color=lightgrey)](https://cran.r-project.org/package=ggdemetra) 14 | 15 | ## Overview 16 | 17 | ggdemetra is an extension of 18 | [ggplot2](https://github.com/tidyverse/ggplot2) to add seasonal 19 | adjustment statistics to your plots. The seasonal adjustment process is 20 | done with [RJDemetra](https://github.com/rjdverse/rjdemetra) that is an 21 | R interface to [JDemetra+](https://github.com/jdemetra/jdemetra-app), 22 | the seasonal adjustment software [officially 23 | recommended](https://wayback.archive-it.org/12090/20240102173448/https://cros-legacy.ec.europa.eu/system/files/Jdemetra_%20release.pdf) 24 | to the members of the European Statistical System (ESS) and the European 25 | System of Central Banks. RJDemetra implements the two leading seasonal 26 | adjustment methods 27 | [TRAMO/SEATS+](https://gretl.sourceforge.net/tramo/tramo-seats.html) and 28 | [X-12ARIMA/X-13ARIMA-SEATS](https://www.census.gov/data/software/x13as.html). 29 | 30 | There are 4 main functionnalities in `ggdemetra` depending of what you 31 | want to add in the graphic: 32 | 33 | - `geom_sa()`: to add a time series compute during the seasonal 34 | adjustment (the trend, the seasonal adjusted time series, etc.). 35 | - `geom_outlier()`: to add the outliers used in the pre-adjustment 36 | process of the seasonal adjustment. 37 | - `geom_arima()`: to add the ARIMA model used in the pre-adjustment 38 | process of the seasonal adjustment. 39 | - `geom_diagnostics()`: to add a table containing some diagnostics on 40 | the seasonal adjustment process. 41 | 42 | ## Installation 43 | 44 | Since RJDemetra requires Java SE 8 or later version, the same 45 | requirements are also needed for ggdemetra. 46 | 47 | ``` r 48 | # Install release version from CRAN 49 | install.packages("ggdemetra") 50 | 51 | # Install development version from GitHub 52 | # install.packages("devtools") 53 | devtools::install_github("AQLT/ggdemetra") 54 | ``` 55 | 56 | If you have troubles with the installation of RJDemetra, check the 57 | [installation 58 | manual](https://github.com/rjdverse/rjdemetra/wiki/Installation-manual). 59 | 60 | ## Usage 61 | 62 | By default, the seasonal adjustment is made with X-13-ARIMA with the 63 | pre-defined specification “RSA5c” (automatic log detection, automatic 64 | ARIMA and outliers detection and trading day and easter adjustment). If 65 | no new data or seasonal adjustment specification is specified (method or 66 | specification), these parameters is inherited from the previous defined: 67 | therefore you only need to specify the specification once. In the 68 | following examples, the seasonal adjustment will be perform with 69 | X-13-ARIMA with working day adjustment and no gradual easter effect 70 | adjustment (it is the specification that has the most economic sense for 71 | the industrial production index). 72 | 73 | To add the seasonal adjusted series and the forecasts of the input data 74 | and of the seasonal adjusted series: 75 | 76 | ``` r 77 | library(ggplot2) 78 | library(ggdemetra) 79 | spec <- RJDemetra::x13_spec("RSA3", tradingdays.option = "WorkingDays") 80 | p_ipi_fr <- ggplot(data = ipi_c_eu_df, mapping = aes(x = date, y = FR)) + 81 | geom_line(color = "#F0B400") + 82 | labs(title = "Seasonal adjustment of the French industrial production index", 83 | x = NULL, y = NULL) 84 | p_sa <- p_ipi_fr + 85 | geom_sa(component = "y_f", linetype = 2, 86 | spec = spec, frequency = 12, color = "#F0B400") + 87 | geom_sa(component = "sa", color = "#155692") + 88 | geom_sa(component = "sa_f", color = "#155692", linetype = 2) 89 | p_sa 90 | ``` 91 | 92 | 93 | 94 | To add the outliers at the bottom of the plot with an arrow to the data 95 | point and the estimated coefficients: 96 | 97 | ``` r 98 | p_sa + 99 | geom_outlier(geom = "label_repel", 100 | coefficients = TRUE, 101 | ylim = c(NA, 65), 102 | arrow = arrow(length = unit(0.03, "npc"), 103 | type = "closed", ends = "last"), 104 | digits = 2) 105 | ``` 106 | 107 | 108 | 109 | To add the ARIMA model: 110 | 111 | ``` r 112 | p_sa + 113 | geom_arima(geom = "label", 114 | x_arima = -Inf, y_arima = -Inf, 115 | vjust = -1, hjust = -0.1) 116 | ``` 117 | 118 | 119 | 120 | To add a table of diagnostics below the plot: 121 | 122 | ``` r 123 | diagnostics <- c(`Combined test` = "diagnostics.combined.all.summary", 124 | `Residual qs-test (p-value)` = "diagnostics.qs", 125 | `Residual f-test (p-value)` = "diagnostics.ftest") 126 | p_diag <- ggplot(data = ipi_c_eu_df, mapping = aes(x = date, y = FR)) + 127 | geom_diagnostics(diagnostics = diagnostics, 128 | table_theme = gridExtra::ttheme_default(base_size = 8), 129 | spec = spec, frequency = 12) + 130 | theme_void() 131 | 132 | gridExtra::grid.arrange(p_sa, p_diag, 133 | nrow = 2, heights = c(4, 1.5)) 134 | ``` 135 | 136 | 137 | 138 | See the 139 | [vignette](https://aqlt.github.io/ggdemetra/articles/ggdemetra.html) for 140 | more details. 141 | 142 | Note that `ts` objects cannot be directly used in `ggplot2`. To convert 143 | `ts` or `mts` object to `data.frame`, you can use the `ts2df()` 144 | function. For example, the data `ipi_c_eu_df` used in this package is 145 | obtained by applying the `ts2df()`function to the `ipi_c_eu` data 146 | available in RJDemetra: 147 | 148 | ``` r 149 | ipi_c_eu_df <- ts2df(ipi_c_eu) 150 | ``` 151 | 152 | ## Existing models 153 | 154 | ggdemetra offers several function that can be used to manipulate 155 | existing models. 156 | 157 | The different components of seasonal adjustment models can be extracted 158 | through `calendar()`, `calendaradj()`, `irregular()`, `trendcycle()`, 159 | `seasonal()`, `seasonaladj()`, `trendcycle()` and `raw()`. 160 | 161 | If you already have a seasonally adjusted model you can also used the 162 | function `init_ggplot()` : 163 | 164 | ``` r 165 | spec <- RJDemetra::x13_spec("RSA3", tradingdays.option = "WorkingDays") 166 | mod <- RJDemetra::x13(ipi_c_eu[,"FR"], spec) 167 | init_ggplot(mod) + 168 | geom_line(color = "#F0B400") + 169 | geom_sa(component = "sa", color = "#155692") 170 | ``` 171 | 172 | 173 | 174 | There is also an `autoplot()` function: 175 | 176 | ``` r 177 | autoplot(mod) 178 | ``` 179 | 180 | 181 | 182 | SI-ratio plots can be plotted with `siratioplot` and `ggsiratioplot`: 183 | 184 | ``` r 185 | ggsiratioplot(mod) 186 | ``` 187 | 188 | 189 | -------------------------------------------------------------------------------- /R/siratio.R: -------------------------------------------------------------------------------- 1 | #' SI-ratio 2 | #' @param x input model or data. 3 | #' @param labels labels. 4 | #' @param add boolean indicating whether a new plot should be drawn. 5 | #' @param box boolean indicating a box around the current plot should be drawn. 6 | #' @param col.s,col.i,col.mean colors of the different components. 7 | #' @param cex.i,lwd.s,lwd.mean graphical parameters. 8 | #' @param xlim,ylim X and Y axis limits. 9 | #' @param main,xlab,ylab title, X and Y axis label. 10 | #' @param start,end first and last dates plotted. 11 | #' @param ... unused parameters. 12 | #' 13 | #' @examples 14 | #' x <- RJDemetra::x13(ipi_c_eu[,"FR"]) 15 | #' siratioplot(x) 16 | #' ggsiratioplot(x) 17 | #' @importFrom stats cycle frequency start end 18 | #' @importFrom graphics axis lines par plot.new plot.window points segments title 19 | #' @rdname siratio 20 | #' @export 21 | siratio <- function(x, ...) { 22 | UseMethod("siratio", x) 23 | } 24 | #' @export 25 | siratio.X13 <- function(x, ...){ 26 | res <- x$decomposition$si_ratio 27 | colnames(res) <- c("si", "s") 28 | res 29 | } 30 | #' @export 31 | siratio.TRAMO_SEATS <- function(x, ...){ 32 | s <- x$decomposition$components[, "s_cmp"] 33 | i <- x$decomposition$components[, "i_cmp"] 34 | mode <- x$decomposition$mode 35 | 36 | if (all(is.na(s))) { 37 | if (mode == "Additive") { 38 | s <- 0 39 | } else { 40 | s <- 1 41 | } 42 | s <- ts(s, start = start(i), 43 | end = end(i), 44 | frequency = frequency(i)) 45 | } 46 | if (mode == "Additive") { 47 | si <- s + i 48 | } else { 49 | si <- s * i 50 | } 51 | res <- ts.union(si, s) 52 | colnames(res) <- c("si", "s") 53 | res 54 | } 55 | #' @export 56 | siratio.jSA <- function(x, ...){ 57 | res <- RJDemetra::get_indicators(x, c("decomposition.d8", "decomposition.d10")) 58 | 59 | if (is.null(res[[1]])) { 60 | # TRAMO-SEATS model 61 | res <- RJDemetra::get_indicators(x, c("decomposition.i_cmp", "decomposition.s_cmp")) 62 | mode <- RJDemetra::get_indicators(x, "mode")[[1]] 63 | if (is.null(res[[2]])) { 64 | if (mode == "Additive") { 65 | s <- 0 66 | } else { 67 | s <- 1 68 | } 69 | res[[2]] <- ts(s, start = start(res[[1]]), 70 | end = end(res[[1]]), 71 | frequency = frequency(res[[1]])) 72 | } 73 | if (mode == "Additive"){ 74 | res[[1]] <- res[[1]] + res[[2]] 75 | } else { 76 | res[[1]] <- res[[1]] * res[[2]] 77 | } 78 | } 79 | if (is.null(res[[1]])) # neither X-13 nor TRAMO-SEATS 80 | return(NULL) 81 | res <- ts.union(res[[1]], res[[2]]) 82 | colnames(res) <- c("si", "s") 83 | res 84 | } 85 | 86 | #' @rdname siratio 87 | #' @export 88 | siratioplot <- function(x, labels = NULL, 89 | add = FALSE, box = TRUE, 90 | col.s = "darkblue", col.i = "gray", col.mean = "red", 91 | cex.i = 0.1, 92 | lwd.s = par("lwd"), lwd.mean = lwd.s, 93 | main = "SI ratio", 94 | xlab = NULL, ylab = NULL, 95 | xlim = NULL, ylim = NULL, 96 | start = NULL, end = NULL, 97 | ...) { 98 | UseMethod("siratioplot", x) 99 | } 100 | #' @export 101 | siratioplot.SA <- function(x, ...){ 102 | siratioplot(siratio(x), ...) 103 | } 104 | #' @export 105 | siratioplot.jSA <- function(x, ...){ 106 | siratioplot(siratio(x), ...) 107 | } 108 | #' @export 109 | siratioplot.default <- function(x, labels = NULL, 110 | add = FALSE, box = TRUE, 111 | col.s = "darkblue", col.i = "gray", col.mean = "red", 112 | cex.i = 0.1, 113 | lwd.s = par("lwd"), lwd.mean = lwd.s, 114 | main = "SI ratio", 115 | xlab = NULL, ylab = NULL, 116 | xlim = NULL, ylim = NULL, 117 | start = NULL, end = NULL, 118 | ...) { 119 | x <- stats::window(x, start = start, end = end) 120 | data <- data_siratio(x, labels = labels) 121 | labels <- data$labels 122 | data_plot <- data$data_plot 123 | data_means <- data$data_means 124 | if (is.null(xlim)) 125 | xlim <- c(0.55, length(labels) + 0.45) 126 | if (is.null(ylim)) 127 | ylim <- range(x, na.rm = TRUE) 128 | if (!add){ 129 | plot.new( ) 130 | plot.window( 131 | xlim = xlim, 132 | ylim = ylim, 133 | xaxt = "n") 134 | axis(1, at = seq_along(labels), labels = labels) 135 | axis(2) 136 | if (box) 137 | box() 138 | title(main = main, xlab = xlab, ylab = ylab) 139 | } 140 | segments(x0 = data_means$x0, y0 = data_means$y0, 141 | x1 = data_means$x1, y1 = data_means$y1, 142 | col = col.mean, lwd = lwd.mean) 143 | for (i in labels) { 144 | sub <- data_plot$cycle == i 145 | lines(data_plot[sub, "x"], data_plot[sub, "s"], 146 | lwd = lwd.s, 147 | col = col.s, ... 148 | ) 149 | points(data_plot[sub, "x"], data_plot[sub, "si"], 150 | pch = 1, cex = cex.i, 151 | col = col.i, 152 | ... 153 | ) 154 | } 155 | } 156 | #' @rdname siratio 157 | #' @export 158 | ggsiratioplot <- function(x, labels = NULL, 159 | col.s = "darkblue", col.i = "gray", col.mean = "red", 160 | cex.i = 0.5, 161 | lwd.s = 1, lwd.mean = lwd.s, 162 | main = "SI ratio", 163 | xlab = NULL, ylab = NULL, 164 | start = NULL, end = NULL, 165 | ...) { 166 | UseMethod("ggsiratioplot", x) 167 | } 168 | #' @export 169 | ggsiratioplot.SA <- function(x, ...){ 170 | ggsiratioplot(siratio(x), ...) 171 | } 172 | #' @export 173 | ggsiratioplot.jSA <- function(x, ...){ 174 | ggsiratioplot(siratio(x), ...) 175 | } 176 | #' @export 177 | ggsiratioplot.default <- function(x, labels = NULL, 178 | col.s = "darkblue", col.i = "gray", col.mean = "red", 179 | cex.i = 0.5, 180 | lwd.s = NULL, lwd.mean = lwd.s, 181 | main = "SI ratio", 182 | xlab = NULL, ylab = NULL, 183 | start = NULL, end = NULL, 184 | ...) { 185 | x <- stats::window(x, start = start, end = end) 186 | data <- data_siratio(x, labels = labels) 187 | labels <- data$labels 188 | data_plot <- data$data_plot 189 | data_means <- data$data_means 190 | ggplot2::ggplot(data = data_plot, ggplot2::aes(x = x, group = cycle)) + 191 | ggplot2::geom_segment(ggplot2::aes(x=x0, y = y0, 192 | xend = x1, yend = y1), 193 | data=data_means, 194 | colour=col.mean, 195 | lwd = lwd.mean) + 196 | ggplot2::geom_line(ggplot2::aes(y=s), colour=col.s, lwd = lwd.s) + 197 | ggplot2::geom_point(ggplot2::aes(y=si), colour=col.i, cex = cex.i) + 198 | ggplot2::labs(title = main, 199 | x = xlab, y = ylab) + 200 | ggplot2::scale_x_continuous(breaks = seq_along(labels), 201 | labels = labels) + 202 | ggplot2::theme(panel.grid.major.x = ggplot2::element_blank()) 203 | } 204 | 205 | data_siratio <- function(x, labels = NULL) { 206 | times <- time(x) 207 | if (is.null(labels)) { 208 | if (frequency(x)==12){ 209 | labels <- month.abb 210 | } else if (frequency(x)==4){ 211 | labels <- c("Q1", "Q2", "Q3", "Q4") 212 | } else if (frequency(x)==2) { 213 | labels <- c("H1","H2") 214 | } else { 215 | labels=c("") 216 | } 217 | } 218 | means <- tapply(x[,"s"], cycle(x), mean) 219 | data_means <- data.frame(x0 = seq_along(labels) - 0.45, y0 = means, 220 | x1 = seq_along(labels) + 0.45, y1 = means, 221 | cycle = factor(labels, levels = labels, ordered = TRUE) 222 | ) 223 | scale <- 1/diff(range(times, na.rm = TRUE)) * 0.9 224 | data_plot <- data.frame(x = as.numeric((times - min(times)) * scale - 0.45 + cycle(x)), 225 | s = as.numeric(x[, "s"]), 226 | si = as.numeric(x[, "si"]), 227 | cycle = factor(labels[cycle(x)], levels = labels, ordered = TRUE) 228 | ) 229 | list(labels = labels, data_means = data_means, 230 | data_plot = data_plot) 231 | } 232 | utils::globalVariables(c("s", "si", "x0", "x1", "y0", "y1")) 233 | 234 | -------------------------------------------------------------------------------- /R/geom_diagnostics.R: -------------------------------------------------------------------------------- 1 | #' Table of diagnostics 2 | #' 3 | #' Adds a table of diagnostics to the plot 4 | #' 5 | #' @inheritParams geom_sa 6 | #' @param diagnostics vector of character containing the name of the diagnostics to plot. 7 | #' See [user_defined_variables()][RJDemetra::user_defined_variables] for the available 8 | #' parameters. 9 | #' @param digits integer indicating the number of decimal places to be used for numeric diagnostics. By default `digits = 2`. 10 | #' @param xmin,xmax x location (in data coordinates) giving horizontal 11 | #' location of raster. 12 | #' @param ymin,ymax y location (in data coordinates) giving vertical 13 | #' location of raster. 14 | #' @param table_theme list of theme parameters for the table of diagnostics (see [ttheme_default()][gridExtra::ttheme_default()]). 15 | #' 16 | #' 17 | #' @examples 18 | #' p_sa_ipi_fr <- ggplot(data = ipi_c_eu_df, mapping = aes(x = date, y = FR)) + 19 | #' geom_line(color = "#F0B400") + 20 | #' labs(title = "Seasonal adjustment of the French industrial production index", 21 | #' x = "time", y = NULL) + 22 | #' geom_sa(color = "#155692", message = FALSE) 23 | #' 24 | #' # To add of diagnostics with result of the X-11 combined test and the p-values 25 | #' # of the residual seasonality qs and f tests: 26 | #' diagnostics <- c("diagnostics.combined.all.summary", "diagnostics.qs", "diagnostics.ftest") 27 | #' p_sa_ipi_fr + 28 | #' geom_diagnostics(diagnostics = diagnostics, 29 | #' ymin = 58, ymax = 72, xmin = 2010, 30 | #' table_theme = gridExtra::ttheme_default(base_size = 8), 31 | #' message = FALSE) 32 | #' 33 | #' # To customize the names of the diagnostics in the plot: 34 | #' 35 | #' diagnostics <- c(`Combined test` = "diagnostics.combined.all.summary", 36 | #' `Residual qs-test (p-value)` = "diagnostics.qs", 37 | #' `Residual f-test (p-value)` = "diagnostics.ftest") 38 | #' p_sa_ipi_fr + 39 | #' geom_diagnostics(diagnostics = diagnostics, 40 | #' ymin = 58, ymax = 72, xmin = 2010, 41 | #' table_theme = gridExtra::ttheme_default(base_size = 8), 42 | #' message = FALSE) 43 | #' 44 | #' # To add the table below the plot: 45 | #' 46 | #' p_diag <- ggplot(data = ipi_c_eu_df, mapping = aes(x = date, y = FR)) + 47 | #' geom_diagnostics(diagnostics = diagnostics, 48 | #' table_theme = gridExtra::ttheme_default(base_size = 8), 49 | #' message = FALSE) + 50 | #' theme_void() 51 | #' 52 | #' gridExtra::grid.arrange(p_sa_ipi_fr, p_diag, 53 | #' nrow = 2, heights = c(4, 1)) 54 | #' 55 | #' @importFrom gridExtra tableGrob ttheme_default 56 | #' @export 57 | geom_diagnostics <- function(mapping = NULL, data = NULL, 58 | position = "identity", ..., 59 | method = c("x13", "tramoseats"), 60 | spec = NULL, 61 | frequency = NULL, 62 | message = TRUE, 63 | diagnostics = NULL, 64 | digits = 2, 65 | xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf, 66 | table_theme = ttheme_default(), 67 | inherit.aes = TRUE 68 | ) { 69 | ggplot2::layer(data = data, mapping = mapping, stat = StatDiagnostics, 70 | geom = GeomDiagnostics, 71 | position = position, inherit.aes = inherit.aes, 72 | params = list(method = method, spec = spec, 73 | frequency = frequency, message = message, 74 | digits = digits, diagnostics = diagnostics, 75 | xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax, 76 | table_theme = table_theme, 77 | new_data = !missing(data) || !is.null(data), 78 | ...)) 79 | } 80 | # Code largely inspired by GeomCustomAnn of ggplot2 81 | GeomDiagnostics <- ggproto("GeomDiagnostics", Geom, 82 | extra_params = "", 83 | handle_na = function(data, params) { 84 | data 85 | }, 86 | draw_panel = function(data, panel_params, coord, 87 | xmin = -Inf, xmax = Inf, 88 | ymin = -Inf, ymax = Inf, 89 | table_theme = ttheme_default()) { 90 | if (is.null(data)) 91 | NULL 92 | if (!inherits(coord, "CoordCartesian")) { 93 | stop("geom_diagnostics only works with Cartesian coordinates", 94 | call. = FALSE) 95 | } 96 | corners <- data.frame(x = c(xmin, xmax), 97 | y = c(ymin, ymax)) 98 | datatemp <- coord$transform(corners, panel_params) 99 | x_rng <- range(datatemp$x, na.rm = TRUE) 100 | y_rng <- range(datatemp$y, na.rm = TRUE) 101 | vp <- grid::viewport(x = mean(x_rng), y = mean(y_rng), 102 | width = diff(x_rng), height = diff(y_rng), 103 | just = c("center","center")) 104 | 105 | ## computation data 106 | 107 | grob <- gridExtra::tableGrob(data[, c("Diagnostic", "Value")], 108 | theme = table_theme, 109 | rows = NULL) 110 | ## 111 | grid::editGrob(grob, vp = vp) 112 | }, 113 | default_aes = aes(xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf) 114 | ) 115 | 116 | StatDiagnostics <- ggproto("StatDiagnostics", Stat, 117 | required_aes = c("x", "y"), 118 | compute_group = function(data, scales, 119 | method = c("x13", "tramoseats"), 120 | spec = NULL, 121 | frequency = NULL, 122 | message = TRUE, 123 | diagnostics = NULL, 124 | digits = 2, 125 | first_date = NULL, 126 | last_date = NULL, 127 | new_data = TRUE){ 128 | if (is.null(diagnostics)) 129 | return(NULL) 130 | result <- seasonal_adjustment(data = data, 131 | method = method, 132 | spec = spec, 133 | frequency = frequency, 134 | message = message, 135 | new_data = new_data) 136 | data <- result[["data"]] 137 | first_data <- data[1, c("x", "y")] 138 | sa <- result[["sa"]] 139 | frequency <- result[["frequency"]] 140 | 141 | diag_table <- RJDemetra::get_indicators(sa, diagnostics) 142 | diag_table <- lapply(diag_table, function(x){ 143 | if (is.null(x) || is.ts(x)) 144 | return(NULL) 145 | if (length(x) > 1) { 146 | x <- x[2] 147 | } 148 | if (is.numeric(x)) 149 | x <- round(x, digits) 150 | x 151 | }) 152 | diag_table <- do.call(c, diag_table) 153 | if (is.null(diag_table)) 154 | NULL 155 | diag_names <- diagnostics[diagnostics %in% names(diag_table)] 156 | if (!is.null(diag_names)) { 157 | names_supplied <- names(diag_names) != "" 158 | diag_names[names_supplied] <- names(diag_names)[names_supplied] 159 | } 160 | diag_table <- data.frame(Diagnostic = 161 | diag_names, 162 | Value = diag_table, 163 | x = first_data[1], y = first_data[2]) 164 | diag_table 165 | } 166 | ) 167 | -------------------------------------------------------------------------------- /R/geom_outliers.R: -------------------------------------------------------------------------------- 1 | 2 | StatOutlier <- ggproto("StatOutlier", Stat, 3 | required_aes = c("x", "y"), 4 | default_aes = aes(x = x, y = y, label = stat(outlier)), 5 | compute_group = function(data, scales, 6 | method = c("x13", "tramoseats"), 7 | spec = NULL, 8 | frequency = NULL, 9 | message = TRUE, 10 | first_date = NULL, 11 | last_date = NULL, 12 | coefficients = FALSE, 13 | digits = 1, 14 | new_data = TRUE){ 15 | result <- seasonal_adjustment(data = data, 16 | method = method, 17 | spec = spec, 18 | frequency = frequency, 19 | message = message, 20 | new_data = new_data) 21 | data <- result[["data"]] 22 | sa <- result[["sa"]] 23 | frequency <- result[["frequency"]] 24 | 25 | reg_names <- RJDemetra::get_indicators(sa, "preprocessing.model.description")[[1]] 26 | liste_outlier <- grep("(^LS )| (^AO )| (^TC )| (^SO )", 27 | reg_names) 28 | 29 | if (length(liste_outlier) == 0) 30 | return(NULL) 31 | liste_outlier_name <- reg_names[liste_outlier] 32 | 33 | # Extraction of the date 34 | date <- gsub("(^.* )|(\\()|(\\))", "", liste_outlier_name) 35 | date <- sapply(strsplit(date, "-"),function(x){ 36 | x <- as.numeric(x) 37 | x[2] + (x[1] - 1)/frequency 38 | }) 39 | 40 | out_to_keep <- 1:length(date) 41 | if (!is.null(first_date)) 42 | out_to_keep <- intersect(out_to_keep, which(date >= first_date)) 43 | if (!is.null(last_date)) 44 | out_to_keep <- intersect(out_to_keep, which(date <= last_date)) 45 | 46 | date <- date[out_to_keep] 47 | liste_outlier_name <- liste_outlier_name[out_to_keep] 48 | 49 | if (length(liste_outlier) == 0) 50 | return(NULL) 51 | 52 | label_outlier <- liste_outlier_name 53 | if (coefficients) { 54 | reg_coef <- RJDemetra::get_indicators(sa, "preprocessing.model.coefficients")[[1]][liste_outlier,1] 55 | reg_coef <- reg_coef[out_to_keep] 56 | label_outlier <- sprintf(paste0("%s: %.",digits,"f"), 57 | liste_outlier_name, 58 | reg_coef) 59 | } 60 | 61 | id_date <- match(as.character(round(date, 3)), 62 | as.character(round(result[["dates"]], 3))) 63 | data_final <- data.frame(x = data$x[id_date], 64 | y = data$y[id_date], 65 | outlier = label_outlier, 66 | stringsAsFactors = FALSE 67 | ) 68 | data_final 69 | } 70 | ) 71 | 72 | 73 | #' Outliers texts 74 | #' 75 | #' Function to add directly to the plot the outliers used in the pre-adjustment process of the seasonal adjustment. 76 | #' 77 | #' @inheritParams geom_sa 78 | #' @param geom character. The geometric to use to display the data: 79 | #' `GeomText` (`geom = "text"`, the default, see [geom_text()][ggplot2::geom_text]); 80 | #' `GeomLabel` (`geom = "label"`, see [geom_label()][ggplot2::geom_label]); 81 | #' `GeomTextRepel` (`geom = "text_repel"`, the default, see [geom_text_repel()][ggrepel::geom_text_repel]); 82 | #' `GeomLabelRepel` (`geom = "label_repel"`, the default, see [geom_label_repel()][ggrepel::geom_label_repel]). 83 | #' 84 | #' @param ... Other arguments passed on to [layer()][ggplot2::layer]. They may be parameters of 85 | #' [geom_text()][ggplot2::geom_text] (if `geom = "text"`), 86 | #' [geom_label()][ggplot2::geom_label] (if `geom = "label"`), 87 | #' [geom_text_repel()][ggrepel::geom_text_repel] (if `geom = "text_repel"`) 88 | #' or [geom_label_repel()][ggrepel::geom_label_repel] (if `geom = "label_repel"`). 89 | #' @param first_date A numeric specifying the first date from which the outliers are plotted. 90 | #' By default (`first_date = NULL`) the outliers are plotted from the 91 | #' beginning of the time series. 92 | #' @param last_date A numeric specifying the first date from which the outliers are plotted. 93 | #' By default (`first_date = NULL`) the outliers are plotted until the 94 | #' end of the time series. 95 | #' @param coefficients boolean indicating if the estimates coefficients are printed. 96 | #' By default `coefficients = FALSE`. 97 | #' @param digits integer indicating the number of decimal places to be used for numeric diagnostics. By default `digits = 1`. 98 | #' @details 99 | #' With the parameter `geom = "text"`, the outliers used in the pre-adjustment process of the seasonal adjustment are directly added to the plot. With `geom = "label"` a rectangle is drawn behind the names of the outliers, making them easier to read. The same with `geom = "text_repel"` or `geom = "label_repel"` but text labels are also repeled away from each other and away from the data points (see [geom_label_repel()][ggrepel::geom_label_repel]). 100 | #' 101 | #' @examples 102 | #' p_sa_ipi_fr <- ggplot(data = ipi_c_eu_df, mapping = aes(x = date, y = FR)) + 103 | #' geom_line(color = "#F0B400") + 104 | #' labs(title = "Seasonal adjustment of the French industrial production index", 105 | #' x = "time", y = NULL) + 106 | #' geom_sa(color = "#155692", message = FALSE) 107 | #' 108 | #' # To add the outliers: 109 | #' p_sa_ipi_fr + geom_outlier(geom = "label", 110 | #' message = FALSE) 111 | #' 112 | #' 113 | #' # To have a more readable plot with outliers names that repeled away from each other 114 | #' # and from the data points: 115 | #' p_sa_ipi_fr + 116 | #' geom_outlier(geom = "label_repel", 117 | #' message = FALSE, 118 | #' ylim = c(NA, 65), 119 | #' arrow = arrow(length = unit(0.03, "npc"), 120 | #' type = "closed", ends = "last")) 121 | #' 122 | #' # To only plot the outliers from a specific date (2009): 123 | #' p_sa_ipi_fr + 124 | #' geom_outlier(geom = "label_repel", 125 | #' message = FALSE, 126 | #' first_date = 2009, 127 | #' ylim = c(NA, 65), 128 | #' arrow = arrow(length = unit(0.03, "npc"), 129 | #' type = "closed", ends = "last")) 130 | #' @export 131 | geom_outlier <- function(mapping = NULL, data = NULL, 132 | stat = "outlier", 133 | geom = c("text", "label", 134 | "text_repel", "label_repel"), 135 | position = "identity", ..., 136 | method = c("x13", "tramoseats"), 137 | spec = NULL, 138 | frequency = NULL, 139 | message = TRUE, 140 | first_date = NULL, 141 | last_date = NULL, 142 | coefficients = FALSE, 143 | digits = 1, 144 | show.legend = NA, 145 | inherit.aes = TRUE 146 | ) { 147 | geom <- match.arg(geom) 148 | if (geom == "label_repel") { 149 | geom <- GeomLabelRepel 150 | } else if (geom == "text_repel") { 151 | geom <- GeomTextRepel 152 | } else if (geom == "label") { 153 | geom <- GeomLabel 154 | } else { 155 | geom <- GeomText 156 | } 157 | 158 | ggplot2::layer(data = data, mapping = mapping, stat = stat, geom = geom, 159 | position = position, show.legend = show.legend, inherit.aes = inherit.aes, 160 | params = list(method = method, spec = spec, 161 | frequency = frequency, message = message, 162 | first_date = first_date, last_date = last_date, 163 | coefficients = coefficients, digits = digits, 164 | new_data = !missing(data) || !is.null(data), 165 | ...)) 166 | } 167 | 168 | -------------------------------------------------------------------------------- /vignettes/ggdemetra.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "ggdemetra: extending ggplot2 to perform seasonal adjustment with RJDemetra" 3 | author: "Alain Quartier-la-Tente" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{ggdemetra} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | ```{r setup, include = FALSE} 13 | knitr::opts_chunk$set( 14 | collapse = TRUE, 15 | comment = "#>", 16 | fig.dim = c(7,4)*1.4, 17 | out.width = "100%", 18 | warning = FALSE 19 | ) 20 | ``` 21 | 22 | `ggdemetra` is an extension of `ggplot2` to add seasonal adjustment statistics to your plots. The seasonal adjustment process is done with [RJDemetra](https://github.com/rjdverse/rjdemetra) that is an R interface to [JDemetra+](https://github.com/jdemetra/jdemetra-app), the seasonal adjustment software officially recommended to the members of the European Statistical System (ESS) and the European System of Central Banks. `RJDemetra` implements the two leading seasonal adjustment methods [TRAMO/SEATS+](https://gretl.sourceforge.net/tramo/tramo-seats.html) and [X-12ARIMA/X-13ARIMA-SEATS](https://www.census.gov/data/software/x13as.html). 23 | 24 | There are 4 main functionalities in `ggdemetra` depending of what you want to add in the graphic: 25 | 26 | - `geom_sa()`: to add a time series compute during the seasonal adjustment (the trend, the seasonal adjusted time series, etc.). 27 | - `geom_outliers()`: to add the outliers used in the pre-adjustment process of the seasonal adjustment. 28 | - `geom_arima()`: to add the ARIMA model used in the pre-adjustment process of the seasonal adjustment. 29 | - `geom_diagnostics()`: to add a table containing some diagnostics on the seasonal adjustment process. 30 | 31 | Note `ts` objects cannot be directly used in `ggplot2`. 32 | To convert `ts` or `mts` object to `data.frame`, you can use the `ts2df()` function. 33 | For example, the data `ipi_c_eu_df` used in this package is obtained by applying the `ts2df()`function to the `ipi_c_eu` data available in RJDemetra: 34 | ```{r, eval = FALSE} 35 | ipi_c_eu_df <- ts2df(ipi_c_eu) 36 | ``` 37 | 38 | 39 | # Seasonal adjustment specification 40 | 41 | All the functions have some common parameters and especially those to defined the seasonal adjustment method: 42 | 43 | - `method` is the method used for the seasonal adjustment: X-13ARIMA (`method = "x13"`, the default) or TRAMO-SEATS (`method = "tramoseats"`). 44 | - `spec` is the seasonal adjustment specification. It can be the name of pre-defined specification (see `?RJDemetra::x13` or `?RJDemetra::tramoseats`) or a user-defined specification created by `RJDemetra` (by `RJDemetra::x13_spec` or `RJDemetra::tramoseats_spec`). 45 | - `frequency` is the frequency of the input time series. By default, the frequency is computed and a message is printed with the one chosen (use `message = FALSE` to suppress this message). 46 | 47 | In the following examples, the data used is the French industrial production index. 48 | By default, the seasonal adjustment will then be processed with X-13ARIMA with a pre-defined specification `"RSA5c` (automatic log detection, automatic ARIMA and outliers detection and trading day and easter adjustment). 49 | However, in the industrial production the working day effect has more economic sense than the trading day effect and a gradual effect for easter does not make economic sense for the aggregated series. 50 | The specification that should be used with X-13ARIMA is `spec = RJDemetra::x13_spec("RSA3", tradingdays.option = "WorkingDays")`. 51 | If no new data or seasonal adjustment specification is specified (method or specification), these parameters is inherited from the previous defined: therefore you only need to specify this parameter once. 52 | 53 | ```{r, warning=FALSE, message=FALSE} 54 | library(ggplot2) 55 | library(ggdemetra) 56 | p_ipi_fr <- ggplot(data = ipi_c_eu_df, mapping = aes(x = date, y = FR)) + 57 | geom_line() + 58 | labs(title = "Seasonal adjustment of the French industrial production index", 59 | x = NULL, y = NULL) 60 | p_ipi_fr 61 | ``` 62 | 63 | ```{r,include=FALSE} 64 | library(RJDemetra) 65 | sa <- jx13(ipi_c_eu[, "FR"]) 66 | ``` 67 | 68 | # Add the result of the seasonal adjusment 69 | 70 | By default `geom_sa()` adds the seasonal adjusted time series: 71 | 72 | ```{r} 73 | spec <- RJDemetra::x13_spec("RSA3", tradingdays.option = "WorkingDays") 74 | p_ipi_fr + 75 | geom_sa(color = "#155692", 76 | spec = spec) 77 | ``` 78 | 79 | To add other components of the seasonal adjustment, use the `component` parameter of `geom_sa()` (see `?RJDemetra::user_defined_variables()` for the availables parameters). 80 | For example, to add the forecasts of the input data and of the seasonal adjusted series: 81 | 82 | ```{r} 83 | p_sa <- p_ipi_fr + 84 | geom_sa(component = "y_f", linetype = 2, message = FALSE, 85 | spec = spec) + 86 | geom_sa(component = "sa", color = "#155692") + 87 | geom_sa(component = "sa_f", color = "#155692", linetype = 2) 88 | p_sa 89 | ``` 90 | 91 | # Add the outliers to the plot 92 | 93 | There are four differents geometrics to add to the plot the names of the outliers used in the pre-adjustment process: 94 | 95 | - `geom = "text"` (the default) adds directly the names of the outliers and `geom = "label"` draws a rectangle behind the names, making them easier to read. 96 | - `geom = "text_repel"` and `geom = "label_repel"` do the same but text labels repel away from each other and away from the data points (see `?ggrepel::geom_label_repel`). 97 | 98 | In our example, there are `r get_indicators(sa, "preprocessing.model.nout")[[1]]` outliers: 99 | 100 | ```{r} 101 | p_sa + geom_outlier(geom = "label") 102 | ``` 103 | 104 | They can be plotted in more readable way using the parameters of `ggrepel::geom_label_repel`: 105 | ```{r} 106 | p_sa + 107 | geom_outlier(geom = "label_repel", 108 | ylim = c(NA, 65), 109 | arrow = arrow(length = unit(0.03, "npc"), 110 | type = "closed", ends = "last")) 111 | ``` 112 | 113 | Use the parameters `first_date` and `last_date` to only have the outliers in a precise time interval. 114 | For example, to only plot the outliers from 2009 use `first_date = 2009`: 115 | ```{r} 116 | p_sa + 117 | geom_outlier(geom = "label_repel", 118 | first_date = 2009, 119 | ylim = c(NA, 65), 120 | arrow = arrow(length = unit(0.03, "npc"), 121 | type = "closed", ends = "last")) 122 | ``` 123 | 124 | # Add the ARIMA model 125 | 126 | The ARIMA model used pre-adjustment process can be added to the plot with `geom_arima()`. 127 | The parameter `geom = "label"` draws a rectangle behind the ARIMA model, making it easier to read: 128 | 129 | ```{r} 130 | p_sa + 131 | geom_arima(geom = "label", 132 | x_arima = -Inf, y_arima = -Inf, 133 | vjust = -1, hjust = -0.1) 134 | ``` 135 | 136 | # Add a table with some diagnostics 137 | 138 | A table with some diagnostics on the seasonal adjustment process can be added with `geom_diagnostics()`. 139 | The desired diagnostics have to be added to the `diagnostics` parameter (see `?RJDemetra::user_defined_variables()` for the availables diagnostics). 140 | For example, to add the result of the X-11 combined test and the p-values of the residual seasonality qs and f tests: 141 | 142 | ```{r} 143 | diagnostics <- c("diagnostics.combined.all.summary", "diagnostics.qs", "diagnostics.ftest") 144 | p_sa + 145 | geom_diagnostics(diagnostics = diagnostics, 146 | ymin = 58, ymax = 72, xmin = 2010, 147 | table_theme = gridExtra::ttheme_default(base_size = 8)) 148 | ``` 149 | 150 | To customize the names of the diagnostics in the plot, pass a named vector to the `diagnostics` parameter: 151 | 152 | ```{r} 153 | diagnostics <- c(`Combined test` = "diagnostics.combined.all.summary", 154 | `Residual qs-test (p-value)` = "diagnostics.qs", 155 | `Residual f-test (p-value)` = "diagnostics.ftest") 156 | p_sa + 157 | geom_diagnostics(diagnostics = diagnostics, 158 | ymin = 58, ymax = 72, xmin = 2010, 159 | table_theme = gridExtra::ttheme_default(base_size = 8)) 160 | ``` 161 | 162 | 163 | To add the table below the plot, you can for example use `gridExtra::grid.arrange()`: 164 | ```{r} 165 | p_diag <- ggplot(data = ipi_c_eu_df, mapping = aes(x = date, y = FR)) + 166 | geom_diagnostics(diagnostics = diagnostics, 167 | spec = spec, frequency = 12, 168 | table_theme = gridExtra::ttheme_default(base_size = 8)) + 169 | theme_void() 170 | 171 | gridExtra::grid.arrange(p_sa, p_diag, 172 | nrow = 2, heights = c(4, 1.5)) 173 | ``` 174 | 175 | # Use existing model 176 | 177 | ggdemetra offers several function that can be used to manipulate existing models. 178 | 179 | ```{r mod} 180 | mod <- RJDemetra::x13(ipi_c_eu[,"UK"], spec) 181 | ``` 182 | 183 | The previous plots can be initialized with the `init_ggplot()` function: 184 | 185 | ```{r init-ggplot} 186 | init_ggplot(mod) + 187 | geom_line(color = "#F0B400") + 188 | geom_sa(color = "#155692") + 189 | geom_arima(geom = "label", 190 | x_arima = -Inf, y_arima = -Inf, 191 | vjust = -1, hjust = -0.1) 192 | ``` 193 | 194 | The different components of seasonal adjustment models can be extracted through `calendar()`, `calendaradj()`, `irregular()`, `trendcycle()`, `seasonal()`, `seasonaladj()`, `trendcycle()` and `raw()`. 195 | 196 | ```{r sa-init} 197 | data <- ts.union(raw(mod), raw(mod, forecast = TRUE), 198 | trendcycle(mod), trendcycle(mod, forecast = TRUE), 199 | seasonaladj(mod), seasonaladj(mod, forecast = TRUE)) 200 | colnames(data) <- c("y", "y_f", 201 | "t", "t_f", 202 | "sa", "sa_f") 203 | ggplot(data = ts2df(data), mapping = aes(x = date)) + 204 | geom_line(mapping = aes(y = y), color = "#F0B400", na.rm = TRUE) + 205 | geom_line(mapping = aes(y = y_f), color = "#F0B400", na.rm = TRUE, linetype = 2) + 206 | geom_line(mapping = aes(y = t), color = "#1E6C0B", na.rm = TRUE) + 207 | geom_line(mapping = aes(y = t_f), color = "#1E6C0B", na.rm = TRUE, linetype = 2) + 208 | geom_line(mapping = aes(y = sa), color = "#155692", na.rm = TRUE) + 209 | geom_line(mapping = aes(y = sa_f), color = "#155692", na.rm = TRUE, linetype = 2) + 210 | theme_bw() 211 | ``` 212 | 213 | 214 | SI-ratio plots can be plotted with `siratioplot` and `ggsiratioplot`: 215 | 216 | ```{r ggsiratio} 217 | ggsiratioplot(mod) 218 | ``` 219 | 220 | And there is also an `autoplot()` function: 221 | 222 | ```{r autoplot} 223 | autoplot(mod) 224 | ``` 225 | --------------------------------------------------------------------------------