├── .Rbuildignore ├── .github ├── .gitignore └── workflows │ ├── R-CMD-check.yaml │ ├── pkgdown.yaml │ └── styler.yaml ├── .gitignore ├── DESCRIPTION ├── NAMESPACE ├── NEWS ├── R ├── CHGDP.R ├── KOF.R ├── add_legend.R ├── add_title.R ├── color_blind.R ├── concat_ts.R ├── create_cross_sec_overview.R ├── create_dummies.R ├── deprecated.R ├── df_to_reg_ts.R ├── draw_ts_ci.R ├── fill_year_with_nas.R ├── find_group_coords.R ├── generate_random_ts.R ├── import_helpers.R ├── low_level_bar_plots.R ├── low_level_line_plots.R ├── m_to_q.R ├── overlap_sorted_ts_lists.R ├── overlap_ts_lists_by_name.R ├── read_swissdata.R ├── read_swissdata_meta.R ├── read_ts.R ├── regularize.R ├── resolve_ts_overlap.R ├── set_month_to_NA.R ├── start_ts_after_internal_nas.R ├── strip_nas.R ├── themes.R ├── tsplot.R ├── tsqm.R ├── utils.R └── write_ts.R ├── README.Rmd ├── README.md ├── _pkgdown.yml ├── data ├── CHGDP.rda └── KOF.rda ├── inst ├── colors.yaml └── example_data │ └── ch.seco.css.csv ├── man ├── CHGDP.Rd ├── KOF.Rd ├── color_blind.Rd ├── compute_decimal_time.Rd ├── concat_ts.Rd ├── create_cross_sec_overview.Rd ├── create_dummy_ts.Rd ├── df_to_reg_ts.Rd ├── dot-read_swissdata_meta_unknown_format.Rd ├── figures │ ├── README-example-1.png │ └── README-unnamed-chunk-2-1.png ├── fill_year_with_nas.Rd ├── generate_random_ts.Rd ├── getCiLegendColors.Rd ├── get_date_vector.Rd ├── init_tsplot_theme.Rd ├── long_to_ts.Rd ├── m_to_q.Rd ├── overlap_sorted_ts_lists.Rd ├── overlap_ts_lists_by_name.Rd ├── read_swissdata.Rd ├── read_swissdata_meta.Rd ├── read_ts.Rd ├── regularize.Rd ├── resolve_ts_overlap.Rd ├── set_month_to_NA.Rd ├── start_ts_after_internal_nas.Rd ├── strip_nas.Rd ├── tsplot.Rd ├── tsqm.Rd ├── tstools-deprecated.Rd ├── wide_to_ts.Rd └── write_ts.Rd └── vignettes └── tstools.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^_pkgdown\.yml$ 2 | ^docs$ 3 | ^pkgdown$ 4 | .github 5 | README.Rmd 6 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.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: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: R-CMD-check 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ${{ matrix.config.os }} 14 | 15 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 16 | 17 | strategy: 18 | fail-fast: false 19 | matrix: 20 | config: 21 | - { os: macos-latest, r: "release" } 22 | - { os: windows-latest, r: "release" } 23 | - { os: ubuntu-latest, r: "devel", http-user-agent: "release" } 24 | - { os: ubuntu-latest, r: "release" } 25 | - { os: ubuntu-latest, r: "oldrel-1" } 26 | 27 | env: 28 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 29 | R_KEEP_PKG_SOURCE: yes 30 | 31 | steps: 32 | - uses: actions/checkout@v3 33 | 34 | - uses: r-lib/actions/setup-pandoc@v2 35 | 36 | - uses: r-lib/actions/setup-r@v2 37 | with: 38 | r-version: ${{ matrix.config.r }} 39 | http-user-agent: ${{ matrix.config.http-user-agent }} 40 | use-public-rspm: true 41 | 42 | - uses: r-lib/actions/setup-r-dependencies@v2 43 | with: 44 | extra-packages: any::rcmdcheck 45 | needs: check 46 | 47 | - uses: r-lib/actions/check-r-package@v2 48 | with: 49 | upload-snapshots: true# Workflow derived from https://github.com/r-lib/actions/tree/master/examples 50 | -------------------------------------------------------------------------------- /.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: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | release: 9 | types: [published] 10 | workflow_dispatch: 11 | 12 | name: pkgdown 13 | 14 | jobs: 15 | pkgdown: 16 | runs-on: ubuntu-latest 17 | # Only restrict concurrency for non-PR jobs 18 | concurrency: 19 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 20 | env: 21 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 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 | -------------------------------------------------------------------------------- /.github/workflows/styler.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 | paths: 6 | [ 7 | "**.[rR]", 8 | "**.[qrR]md", 9 | "**.[rR]markdown", 10 | "**.[rR]nw", 11 | "**.[rR]profile", 12 | ] 13 | 14 | name: Style 15 | 16 | jobs: 17 | style: 18 | runs-on: ubuntu-latest 19 | env: 20 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 21 | steps: 22 | - name: Checkout repo 23 | uses: actions/checkout@v3 24 | with: 25 | fetch-depth: 0 26 | 27 | - name: Setup R 28 | uses: r-lib/actions/setup-r@v2 29 | with: 30 | use-public-rspm: true 31 | 32 | - name: Install dependencies 33 | uses: r-lib/actions/setup-r-dependencies@v2 34 | with: 35 | extra-packages: any::styler, any::roxygen2 36 | needs: styler 37 | 38 | - name: Enable styler cache 39 | run: styler::cache_activate() 40 | shell: Rscript {0} 41 | 42 | - name: Determine cache location 43 | id: styler-location 44 | run: | 45 | cat( 46 | "location=", 47 | styler::cache_info(format = "tabular")$location, 48 | "\n", 49 | file = Sys.getenv("GITHUB_OUTPUT"), 50 | append = TRUE, 51 | sep = "" 52 | ) 53 | shell: Rscript {0} 54 | 55 | - name: Cache styler 56 | uses: actions/cache@v3 57 | with: 58 | path: ${{ steps.styler-location.outputs.location }} 59 | key: ${{ runner.os }}-styler-${{ github.sha }} 60 | restore-keys: | 61 | ${{ runner.os }}-styler- 62 | ${{ runner.os }}- 63 | 64 | - name: Style 65 | run: styler::style_pkg() 66 | shell: Rscript {0} 67 | 68 | - name: Commit and push changes 69 | run: | 70 | if FILES_TO_COMMIT=($(git diff-index --name-only ${{ github.sha }} \ 71 | | egrep --ignore-case '\.(R|[qR]md|Rmarkdown|Rnw|Rprofile)$')) 72 | then 73 | git config --local user.name "$GITHUB_ACTOR" 74 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 75 | git commit ${FILES_TO_COMMIT[*]} -m "Style code (GHA)" 76 | git pull --ff-only 77 | git push origin 78 | else 79 | echo "No changes to commit." 80 | fi 81 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.Rproj 2 | .Rproj.user 3 | .Rhistory 4 | inst/doc 5 | docs 6 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Type: Package 2 | Package: tstools 3 | Title: A Time Series Toolbox for Official Statistics 4 | Version: 0.4.3 5 | Authors@R: c( 6 | person("Matthias", "Bannert", , "bannert@kof.ethz.ch", role = "aut"), 7 | person("Severin", "Thoeni", , "thoenis@kof.ethz.ch", role = "aut"), 8 | person("Stéphane", "Bisinger", , "bisinger@kof.ethz.ch", role = c("aut", "cre")) 9 | ) 10 | Description: Plot official statistics' time series conveniently: automatic 11 | legends, highlight windows, stacked bar chars with positive and 12 | negative contributions, sum-as-line option, two y-axes with automatic 13 | horizontal grids that fit both axes and other popular chart types. 14 | 'tstools' comes with a plethora of defaults to let you plot without 15 | setting an abundance of parameters first, but gives you the 16 | flexibility to tweak the defaults. In addition to charts, 'tstools' 17 | provides a super fast, 'data.table' backed time series I/O that allows 18 | the user to export / import long format, wide format and transposed 19 | wide format data to various file types. 20 | License: GPL-2 21 | URL: https://github.com/KOF-ch/tstools 22 | BugReports: https://github.com/KOF-ch/tstools/issues 23 | Depends: 24 | R (>= 3.0.0), 25 | zoo (>= 1.7-12) 26 | Imports: 27 | data.table, 28 | graphics, 29 | jsonlite, 30 | stats, 31 | xts, 32 | yaml 33 | Suggests: 34 | knitr, 35 | openxlsx, 36 | reshape2, 37 | rmarkdown, 38 | testthat 39 | VignetteBuilder: 40 | knitr 41 | Encoding: UTF-8 42 | LazyData: true 43 | NeedsCompilation: no 44 | RoxygenNote: 7.2.3 45 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(fill_year_with_nas,ts) 4 | S3method(fill_year_with_nas,xts) 5 | S3method(fill_year_with_nas,zoo) 6 | S3method(tsplot,list) 7 | S3method(tsplot,mts) 8 | S3method(tsplot,ts) 9 | S3method(tsplot,xts) 10 | S3method(tsplot,zoo) 11 | export(color_blind) 12 | export(computeDecimalTime) 13 | export(compute_decimal_time) 14 | export(concatTs) 15 | export(concat_ts) 16 | export(create_cross_sec_overview) 17 | export(create_dummy_ts) 18 | export(df_to_reg_ts) 19 | export(fill_year_with_nas) 20 | export(fillupYearWitnNAs) 21 | export(generate_random_ts) 22 | export(importTimeSeries) 23 | export(initDefaultTheme) 24 | export(init_tsplot_print_theme) 25 | export(init_tsplot_theme) 26 | export(long_to_ts) 27 | export(m_to_q) 28 | export(overlapSortedLists) 29 | export(overlapTslByName) 30 | export(overlap_sorted_ts_lists) 31 | export(overlap_ts_lists_by_name) 32 | export(read_swissdata) 33 | export(read_swissdata_meta) 34 | export(read_ts) 35 | export(regularize) 36 | export(resolveOverlap) 37 | export(resolve_ts_overlap) 38 | export(set_month_to_NA) 39 | export(start_ts_after_internal_nas) 40 | export(stripLeadingNAsFromTs) 41 | export(stripTrailingNAsFromTs) 42 | export(strip_ts_of_leading_nas) 43 | export(strip_ts_of_trailing_nas) 44 | export(tsplot) 45 | export(tsqm) 46 | export(wide_to_ts) 47 | export(writeTimeSeries) 48 | export(write_ts) 49 | import(data.table) 50 | importFrom(data.table,dcast) 51 | importFrom(data.table,fread) 52 | importFrom(data.table,month) 53 | importFrom(data.table,quarter) 54 | importFrom(data.table,year) 55 | importFrom(grDevices,col2rgb) 56 | importFrom(grDevices,colors) 57 | importFrom(grDevices,dev.off) 58 | importFrom(grDevices,dev.size) 59 | importFrom(grDevices,pdf) 60 | importFrom(grDevices,rgb) 61 | importFrom(graphics,axis) 62 | importFrom(graphics,box) 63 | importFrom(graphics,legend) 64 | importFrom(graphics,lines) 65 | importFrom(graphics,mtext) 66 | importFrom(graphics,par) 67 | importFrom(graphics,plot) 68 | importFrom(graphics,polygon) 69 | importFrom(graphics,rect) 70 | importFrom(graphics,strheight) 71 | importFrom(graphics,title) 72 | importFrom(jsonlite,fromJSON) 73 | importFrom(jsonlite,toJSON) 74 | importFrom(stats,as.ts) 75 | importFrom(stats,end) 76 | importFrom(stats,frequency) 77 | importFrom(stats,is.ts) 78 | importFrom(stats,na.omit) 79 | importFrom(stats,rnorm) 80 | importFrom(stats,runif) 81 | importFrom(stats,start) 82 | importFrom(stats,time) 83 | importFrom(stats,ts) 84 | importFrom(stats,ts.union) 85 | importFrom(stats,window) 86 | importFrom(utils,unzip) 87 | importFrom(utils,zip) 88 | importFrom(xts,xts) 89 | importFrom(yaml,read_yaml) 90 | importFrom(yaml,yaml.load) 91 | importFrom(zoo,as.yearmon) 92 | importFrom(zoo,as.yearqtr) 93 | importFrom(zoo,index) 94 | importFrom(zoo,na.trim) 95 | -------------------------------------------------------------------------------- /NEWS: -------------------------------------------------------------------------------- 1 | Changes in version 0.4.2 2 | * Load XLSX files as data.table instead of data.frame 3 | Changes in version 0.4.1 4 | * Bringing tstools back to CRAN, maintenance release. 5 | Changes in version 0.3.6.1 6 | * regularize series using NAs, better plot support for NAs, smaller bugfixes 7 | Changes in version 0.3.6 8 | * major co-ordination fixes, auto legends fixes. enjoy! 9 | Changes in version 0.3.5.1 10 | * CRAN release 11 | Changes in version 0.3.4.2 12 | * Improvement of tick handling, more automatic determination 13 | Changes in version 0.3.4 14 | * introduced data.table dependency 15 | Changes in version 0.3.3 16 | * speedup writeTimeSeries by optionally using data.table's rbindlist 17 | Changes in version 0.3.2 18 | * optional data.table read csv for speedup 19 | Changes in version 0.3.1 20 | * minor add ons, problems in versions fixed 21 | Changes in version 0.3 22 | * function to create regular time series from data.frames 23 | Changes in version 0.2.7.9.1 24 | * minor change to unit test to avoid re-import warning with other packages that load openxlsx. 25 | Changes in version 0.2.7.9 26 | * added function to turn quarterly to monthly series (interpolate). 27 | Changes in version 0.2.7.8 28 | * added function to start after last internal NA. 29 | -------------------------------------------------------------------------------- /R/CHGDP.R: -------------------------------------------------------------------------------- 1 | #' CH GDP Growth Contributions 2 | #' 3 | #' A list of time series containing sector contributions to Swiss GDP over time. 4 | #' 5 | #' 6 | #' @format List list of six time series of class ts, 7 | #' containing contributions to Swiss GDP growth 8 | #' \describe{ 9 | #' \item{manufacturing}{Growth contribution of manufacturing.} 10 | #' \item{energy}{Growth contribution of energy, water sector} 11 | #' \item{construction}{Growth contribution construction sector.} 12 | #' \item{hotels}{Growth contribution of hotels.} 13 | #' \item{fin_insur}{Growth contribution of financial services and insurances.} 14 | #' \item{other}{Growth contribution of other sectors.} 15 | #' } 16 | #' @source \url{https://www.seco.admin.ch/seco/en/home/wirtschaftslage---wirtschaftspolitik/Wirtschaftslage/bip-quartalsschaetzungen-/daten.html} 17 | #' 18 | "CHGDP" 19 | -------------------------------------------------------------------------------- /R/KOF.R: -------------------------------------------------------------------------------- 1 | #' KOF Barometer - Swiss Business Cycle Indicator 2 | #' 3 | #' A list of time series containing two time series the KOF Barometer and the growth of Swiss GDP over time. KOF Barometer is a monthly business cycle indicator computed by the KOF Swiss Economic Institute. The GDP growth rate is used as a reference series to the Barometer. 4 | #' 5 | #' @format A list of two time series of class ts 6 | #' \describe{ 7 | #' \item{kofbarometer}{KOF Barometer Indicator}' 8 | #' \item{reference}{Reference series to KOF Barometer, change in Swiss GDP compared to previous month} 9 | #' \item{baro_point_fc}{Auto Arima point forecast of the KOF Barometer} 10 | #' \item{baro_lo_80}{Auto Arima 80 percent CI lower bound of the KOF Barometer forecast} 11 | #' \item{baro_hi_80}{Auto Arima 80 percent CI upper bound of the KOF Barometer forecast} 12 | #' \item{baro_lo_95}{Auto Arima 95 percent CI lower bound of the KOF Barometer forecast} 13 | #' \item{baro_hi_95}{Auto Arima 95 percent CI upper bound of the KOF Barometer forecast} 14 | #' ... 15 | #' } 16 | #' @source \url{https://kof.ethz.ch/en/forecasts-and-indicators/indicators/kof-economic-barometer.html} 17 | #' 18 | "KOF" 19 | -------------------------------------------------------------------------------- /R/add_legend.R: -------------------------------------------------------------------------------- 1 | # TODO: Order ci by value, for the pretties 2 | 3 | #' @importFrom graphics par plot legend 4 | #' @importFrom grDevices dev.size 5 | #' @importFrom stats na.omit 6 | add_legend <- function(tsln, 7 | tsrn = NULL, 8 | ci_names, 9 | left_as_bar = FALSE, 10 | left_as_band = FALSE, 11 | theme = init_tsplot_theme()) { 12 | # Grab the number of legends 13 | ll <- length(tsln) 14 | lr <- length(tsrn) 15 | lb <- length(c(tsln, tsrn)) 16 | 17 | # Calculate how far below the top edge of the plot to place the legend 18 | plt <- par("plt") 19 | 20 | # theme$legend_margin_top is specified in % of device height so we need to scale it to % of plot height here 21 | inset_y <- 1 + theme$legend_margin_top / (100 * (plt[4] - plt[3])) 22 | 23 | # Make vectors that "wrap around" 24 | theme$line_colors <- rep(theme$line_colors, ceiling(lb / length(theme$line_colors))) 25 | theme$bar_fill_colors <- rep(theme$bar_fill_color, ceiling(ll / length(theme$bar_fill_color))) 26 | theme$lty <- rep(theme$lty, ceiling(lb / length(theme$lty))) 27 | theme$lwd <- rep(theme$lwd, ceiling(lb / length(theme$lwd))) 28 | theme$point_symbol <- rep(theme$point_symbol, ceiling(lb / length(theme$point_symbol))) 29 | 30 | # Helper to insert ci legends at the correct positions 31 | splice_ci_names <- function(ts_names) { 32 | unlist(lapply(ts_names, function(x) { 33 | c(x, ci_names[[x]]) 34 | })) 35 | } 36 | 37 | # Insert ci legends (if any) 38 | legend_l <- splice_ci_names(tsln) 39 | n_tot_l <- length(legend_l) 40 | 41 | # Initialize legend pch, col, lty and lwd with the theme parameters 42 | # where there are ts and ci band params where there are those 43 | is_ci_l <- !(legend_l %in% tsln) 44 | pch_l <- `if`( 45 | left_as_bar || left_as_band, 46 | rep(15, n_tot_l), 47 | ifelse(theme$show_points, theme$point_symbol, NA) 48 | ) # TODO: in case of T, F, T, do we want 1, NA, 3 or 1, NA, 2?? 49 | pch_l[is_ci_l] <- 15 50 | col_l <- rep(NA, n_tot_l) 51 | col_l[!is_ci_l] <- theme$line_colors[1:ll] 52 | lty_l <- rep(0, n_tot_l) 53 | lty_l[!is_ci_l] <- theme$lty[1:ll] 54 | lwd_l <- rep(0, n_tot_l) 55 | lwd_l[!is_ci_l] <- theme$lwd[1:ll] 56 | 57 | # Set the legend colors of the ci bands 58 | ci_color_indices_l <- cumsum(!is_ci_l)[is_ci_l] 59 | ci_legend_colors_l <- c() 60 | left_ci_colors <- theme$ci_colors[1:ll] 61 | for (i in unique(ci_color_indices_l)) { 62 | ci_legend_colors_l <- c( 63 | ci_legend_colors_l, 64 | rev(getCiLegendColors(left_ci_colors[i], sum(ci_color_indices_l == i), theme$ci_alpha))[order(ci_names[[tsln[i]]])] 65 | ) 66 | } 67 | 68 | col_l[is_ci_l] <- ci_legend_colors_l 69 | 70 | # If left as bar, do not draw lines in the legend 71 | if (left_as_bar || left_as_band) { 72 | if (left_as_bar) { 73 | col_l[!is_ci_l] <- theme$bar_fill_color[1:ll] 74 | } else { 75 | col_l[!is_ci_l] <- theme$band_fill_color[1:ll] 76 | } 77 | lty_l[!is_ci_l] <- 0 78 | # Add sum line legend if necessary 79 | if (theme$sum_as_line && !is.null(theme$sum_legend)) { 80 | legend_l <- c(legend_l, theme$sum_legend) 81 | lty_l <- c(lty_l, theme$sum_line_lty) 82 | lwd_l <- c(lwd_l, theme$sum_line_lwd) 83 | col_l <- c(col_l, theme$sum_line_color) 84 | pch_l <- c(pch_l, NA) 85 | } 86 | } 87 | 88 | 89 | # initialize right legend params 90 | 91 | legend_r <- splice_ci_names(tsrn) 92 | n_tot_r <- length(legend_r) 93 | is_ci_r <- !(legend_r %in% tsrn) 94 | pch_r <- ifelse(theme$show_points, 95 | `if`(left_as_bar || left_as_band, theme$point_symbol[1:lr], theme$point_symbol[(ll + 1):lb]), 96 | NA 97 | ) 98 | pch_r[is_ci_r] <- 15 99 | col_r <- rep(NA, n_tot_r) 100 | col_r[!is_ci_r] <- theme$line_colors[`if`(left_as_bar || left_as_band, 1:lr, (ll + 1):lb)] 101 | 102 | ci_color_indices_r <- cumsum(!is_ci_r)[is_ci_r] 103 | ci_legend_colors_r <- c() 104 | right_ci_colors <- theme$ci_colors[`if`(left_as_bar || left_as_band, 1:lr, (ll + 1):lb)] 105 | for (i in unique(ci_color_indices_r)) { 106 | ci_legend_colors_r <- c( 107 | ci_legend_colors_r, 108 | rev(getCiLegendColors(right_ci_colors[i], sum(ci_color_indices_r == i), theme$ci_alpha))[order(ci_names[[tsrn[i]]])] 109 | ) 110 | } 111 | 112 | col_r[is_ci_r] <- ci_legend_colors_r # namedColor2Hex(theme$ci_colors[ifelse(left_as_bar || left_as_band, 1:lr, (ll+1):lb)], theme$ci_alpha)[cumsum(!is_ci_r)[is_ci_r]] 113 | lty_r <- rep(0, n_tot_r) 114 | lty_r[!is_ci_r] <- theme$lty[`if`(left_as_bar || left_as_band, 1:lr, (ll + 1):lb)] 115 | lwd_r <- rep(0, n_tot_r) 116 | lwd_r[!is_ci_r] <- theme$lwd[`if`(left_as_bar || left_as_band, 1:lr, (ll + 1):lb)] 117 | 118 | 119 | # Merge left and right legends if desired 120 | if (theme$legend_all_left) { 121 | legend_l <- c(legend_l, legend_r) 122 | col_l <- c(col_l, col_r) 123 | lty_l <- c(lty_l, lty_r) 124 | lwd_l <- c(lwd_l, lwd_r) 125 | pch_l <- c(pch_l, pch_r) 126 | } 127 | 128 | 129 | # Pop quiz: Why are the legends placed relative to the top? Because then their anchor is at the top 130 | # and they grow downwards instead of up into the plotting area. 131 | 132 | # Draw the legends 133 | legend("topleft", 134 | legend = legend_l, 135 | ncol = theme$legend_col, 136 | bty = "n", 137 | xpd = NA, 138 | cex = theme$legend_font_size, 139 | inset = c(0, inset_y), 140 | col = col_l, 141 | lty = lty_l, 142 | lwd = lwd_l, 143 | pch = pch_l, 144 | pt.cex = `if`(left_as_bar || left_as_band, theme$legend_box_size, 1), 145 | x.intersp = theme$legend_intersp_x, 146 | y.intersp = theme$legend_intersp_y, 147 | seg.len = theme$legend_seg.len 148 | ) 149 | 150 | # Repeat the above steps (minus sum line) for the right series (if any) 151 | if (!is.null(tsrn) && !theme$legend_all_left) { 152 | legend("topright", 153 | legend = legend_r, 154 | ncol = theme$legend_col, 155 | bty = "n", 156 | xpd = NA, 157 | cex = theme$legend_font_size, 158 | inset = c(0, inset_y), 159 | col = col_r, 160 | lty = lty_r, 161 | lwd = lwd_r, 162 | pch = pch_r, 163 | pt.cex = 1, 164 | x.intersp = theme$legend_intersp_x, 165 | y.intersp = theme$legend_intersp_y, 166 | seg.len = theme$legend_seg.len 167 | ) 168 | } 169 | } 170 | -------------------------------------------------------------------------------- /R/add_title.R: -------------------------------------------------------------------------------- 1 | add_title <- function(plot_title, plot_subtitle, plot_subtitle_r, theme) { 2 | dev_size <- dev.size() 3 | if (!is.null(plot_title)) { 4 | if (!any(is.na(theme$title_transform))) { 5 | plot_title <- do.call( 6 | theme$title_transform, 7 | list(plot_title) 8 | ) 9 | } 10 | 11 | # Transform title line from % of device height to "lines outside the plot" 12 | # the height of such a line is strheight("\n") - strheight("") i.e. 1 line plus interline spacing 13 | # because reasons I guess. 14 | 15 | title_line_height <- strheight("\n", 16 | units = "inches", 17 | cex = theme$title_cex.main 18 | ) - 19 | strheight("", units = "inches", cex = theme$title_cex.main) 20 | title_line <- (theme$title_margin * dev_size[2]) / (100 * title_line_height) 21 | 22 | title( 23 | main = plot_title, adj = theme$title_adj, 24 | line = title_line, 25 | outer = theme$title_outer, 26 | cex.main = theme$title_cex.main 27 | ) 28 | } 29 | 30 | # Transform subtitle line from % of device height to "lines outside the plot" 31 | sub_line_height <- strheight("\n", 32 | units = "inches", 33 | cex = theme$subtitle_cex 34 | ) - 35 | strheight("", units = "inches", cex = theme$subtitle_cex) 36 | sub_line <- (theme$subtitle_margin * dev_size[2]) / (100 * sub_line_height) 37 | 38 | # See R source src/library/graphics/src/graphics.c:3325 39 | # where they add a ("visually tuned") offset to the mtext line 40 | sub_line <- sub_line - 0.2 / par("mex") 41 | 42 | if (!is.null(plot_subtitle)) { 43 | if (!is.null(theme$subtitle_transform)) { 44 | plot_subtitle <- do.call( 45 | theme$subtitle_transform, 46 | list(plot_subtitle) 47 | ) 48 | } 49 | mtext(plot_subtitle, 50 | adj = theme$subtitle_adj, 51 | line = sub_line, 52 | outer = theme$subtitle_outer, 53 | cex = theme$subtitle_cex 54 | ) 55 | } 56 | 57 | 58 | if (!is.null(plot_subtitle_r)) { 59 | if (!is.null(theme$subtitle_transform)) { 60 | plot_subtitle_r <- do.call( 61 | theme$subtitle_transform, 62 | list(plot_subtitle_r) 63 | ) 64 | } 65 | mtext(plot_subtitle_r, 66 | adj = theme$subtitle_adj_r, 67 | line = sub_line, 68 | outer = theme$subtitle_outer, 69 | cex = theme$subtitle_cex 70 | ) 71 | } 72 | } 73 | -------------------------------------------------------------------------------- /R/color_blind.R: -------------------------------------------------------------------------------- 1 | #' Provide Colorblind Compliant Colors 2 | #' 3 | #' 8 Hex RGB color defintions suitable for charts for colorblind people. 4 | #' 5 | #' @export 6 | color_blind <- function() { 7 | c( 8 | "#000000", "#E69F00", "#56B4E9", 9 | "#009E73", "#F0E442", "#0072B2", 10 | "#D55E00", "#CC79A7" 11 | ) 12 | } 13 | -------------------------------------------------------------------------------- /R/concat_ts.R: -------------------------------------------------------------------------------- 1 | #' Concatenate to Non-Overlapping Time Series 2 | #' 3 | #' Append one time series to another. This only works for non-overlapping time series of the same frequency. 4 | #' For overlapping time series please see \code{\link{resolveOverlap}}. 5 | #' 6 | #' @param ts1 object of class ts1, typically the older of two time series. 7 | #' @param ts2 object of class ts1, typically the younger of two time series. 8 | #' @export 9 | #' @importFrom stats frequency time ts 10 | concat_ts <- function(ts1, ts2) { 11 | stopifnot(frequency(ts1) == frequency(ts2)) 12 | if (any(time(ts1) %in% time(ts2))) { 13 | stop("time series are not allowed to overlap use resolveOverlap for overlapping series!") 14 | } 15 | s <- min(time(ts1)) 16 | f <- frequency(ts1) 17 | ts(c(ts1, ts2), start = s, frequency = f) 18 | } 19 | -------------------------------------------------------------------------------- /R/create_cross_sec_overview.R: -------------------------------------------------------------------------------- 1 | #' Create an Overview data.table of (last) observations 2 | #' 3 | #' Create a data.table that shows the i-th obsersvation of 4 | #' several time series. 5 | #' 6 | #' @param list_of_rows list of time series names 7 | #' @param col_labels character list of column labels 8 | #' @param tsl list of time series object to select from 9 | #' @param selected_period numeric date as in defining ts objects. 10 | #' @import data.table 11 | #' @export 12 | #' @examples 13 | #' tsl <- generate_random_ts(10, lengths = 20) 14 | #' list_of_rows <- list( 15 | #' "group 1" = c("ts1", "ts2", "ts3", "ts4"), 16 | #' "group 2" = c("ts5", "ts6", "ts7", "ts10") 17 | #' ) 18 | #' # These are no real +,=,- values just random data. 19 | #' create_cross_sec_overview( 20 | #' list_of_rows, 21 | #' c("+", "=", "-", "random"), 22 | #' tsl, c(1988, 12) 23 | #' ) 24 | create_cross_sec_overview <- function(list_of_rows, 25 | col_labels, 26 | tsl, 27 | selected_period) { 28 | all_series <- tsl[unlist(list_of_rows)] 29 | single_obs <- lapply(all_series, window, 30 | start = selected_period, 31 | end = selected_period 32 | ) 33 | 34 | by_rows <- lapply(list_of_rows, function(x) { 35 | data.table(t(unlist((single_obs[x])))) 36 | }) 37 | 38 | out <- rbindlist(by_rows) 39 | # this could be done more efficient, 40 | # yet performance is not a factor here and this 41 | # seems straight forward 42 | out <- cbind(names(list_of_rows), out) 43 | setnames(out, names(out), c("", col_labels)) 44 | out 45 | } 46 | -------------------------------------------------------------------------------- /R/create_dummies.R: -------------------------------------------------------------------------------- 1 | #' Flexible Function to Create Time Series Dummy Variables 2 | #' 3 | #' Generate time series with a default value that is changed within a certain subperiod. 4 | #' The function allows for additional convenience when specifying single period dummies and dummies that go from a certain point in time to the end of the series. 5 | #' 6 | #' @param end_basic numeric vector of form c(yyyy,p) defining the end of the time series. 7 | #' @param dummy_start numeric vector of form c(yyyy,p) defining the beginning of the period with different value. 8 | #' @param dummy_end numeric vector of form c(yyyy,p) defining the end of the period with different value. Defaults to NULL, using the end_date of the series. 9 | #' @param sp logical should NULL value for dummy_end lead to a single period dummy (TRUE) or to alternative values until the end. 10 | #' @param start_basic numeric vector of form c(yyyy,p) defining the start of the time series. Defaults to c(1980,1) 11 | #' @param basic_value default value of the time series, defaults to 0. 12 | #' @param dummy_value the alternative value, defaults to 1. 13 | #' @param frequency integer frequency of the regular time series, defaults to 4 (quarterly). 14 | #' @author Matthias Bannert 15 | #' @export 16 | #' @importFrom stats ts 17 | create_dummy_ts <- function(end_basic, 18 | dummy_start, 19 | dummy_end = NULL, 20 | sp = T, 21 | start_basic = c(1980, 1), 22 | basic_value = 0, 23 | dummy_value = 1, 24 | frequency = 4) { 25 | basic <- ts(basic_value, start_basic, 26 | end_basic, 27 | frequency = frequency 28 | ) 29 | if (is.null(dummy_end)) { 30 | if (sp) { 31 | dummy_end <- dummy_start 32 | } else { 33 | dummy_end <- end_basic 34 | } 35 | } 36 | dummy <- ts(dummy_value, dummy_start, 37 | dummy_end, 38 | frequency = frequency 39 | ) 40 | resolve_ts_overlap(basic, dummy) 41 | } 42 | -------------------------------------------------------------------------------- /R/deprecated.R: -------------------------------------------------------------------------------- 1 | #' Deprecated function(s) in tstools 2 | #' 3 | #' These functions are provided for compatibility with older version of 4 | #' the tstools package. They may eventually be completely 5 | #' removed. 6 | #' @rdname tstools-deprecated 7 | #' @name tstools-deprecated 8 | #' @param ... Parameters to be passed to the modern version of the function 9 | #' @export computeDecimalTime concatTs fillupYearWitnNAs importTimeSeries initDefaultTheme overlapSortedLists overlapTslByName resolveOverlap stripLeadingNAsFromTs stripTrailingNAsFromTs writeTimeSeries 10 | #' @aliases computeDecimalTime concatTs fillupYearWitnNAs importTimeSeries initDefaultTheme overlapSortedLists overlapTslByName resolveOverlap stripLeadingNAsFromTs stripTrailingNAsFromTs writeTimeSeries 11 | #' @section Details: 12 | #' \tabular{rl}{ 13 | #' \code{computeDecimalTime} \tab now a synonym for \code{\link{compute_decimal_time}}\cr 14 | #' \code{concatTs} \tab now a synonym for \code{\link{concat_ts}}\cr 15 | #' \code{fillupYearWitnNAs} \tab now a synonym for \code{\link{fill_year_with_nas}}\cr 16 | #' \code{importTimeSeries} \tab now a synonym for \code{\link{read_ts}}\cr 17 | #' \code{init_tsplot_theme} \tab now a synonym for \code{\link{init_tsplot_theme}}\cr 18 | #' \code{overlapSortedLists} \tab now a synonym for \code{\link{overlap_sorted_ts_lists}}\cr 19 | #' \code{overlapTslByName} \tab now a synonym for \code{\link{overlap_ts_lists_by_name}}\cr 20 | #' \code{resolveOverlap} \tab now a synonym for \code{\link{resolve_ts_overlap}}\cr 21 | #' \code{stripLeadingNAsFromTs} \tab now a synonym for \code{\link{strip_ts_of_leading_nas}}\cr 22 | #' \code{stripTrailingNAsFromTs} \tab now a synonym for \code{\link{strip_ts_of_trailing_nas}}\cr 23 | #' \code{writeTimeSeries} \tab now a synonym for \code{\link{write_ts}}\cr 24 | #' } 25 | #' 26 | NULL 27 | computeDecimalTime <- function(...) { 28 | .Deprecated("compute_decimal_time", package = "tstools") 29 | compute_decimal_time(...) 30 | } 31 | concatTs <- function(...) { 32 | .Deprecated("concat_ts", package = "tstools") 33 | concat_ts(...) 34 | } 35 | fillupYearWitnNAs <- function(...) { 36 | .Deprecated("fill_year_with_nas", package = "tstools") 37 | fill_year_with_nas(...) 38 | } 39 | importTimeSeries <- function(...) { 40 | .Deprecated("read_ts", package = "tstools") 41 | read_ts(...) 42 | } 43 | initDefaultTheme <- function(...) { 44 | .Deprecated("init_tsplot_theme", package = "tstools") 45 | init_tsplot_theme(...) 46 | } 47 | overlapSortedLists <- function(...) { 48 | .Deprecated("overlap_sorted_ts_lists", package = "tstools") 49 | overlap_sorted_ts_lists(...) 50 | } 51 | overlapTslByName <- function(...) { 52 | .Deprecated("oberlap_ts_list_by_name", package = "tstools") 53 | overlap_ts_lists_by_name(...) 54 | } 55 | resolveOverlap <- function(...) { 56 | .Deprecated("resolve_ts_overlap", package = "tstools") 57 | resolve_ts_overlap(...) 58 | } 59 | stripLeadingNAsFromTs <- function(...) { 60 | .Deprecated("strip_ts_of_leading_nas", package = "tstools") 61 | strip_ts_of_leading_nas(...) 62 | } 63 | stripTrailingNAsFromTs <- function(...) { 64 | .Deprecated("strip_ts_of_leading_nas", package = "tstools") 65 | strip_ts_of_trailing_nas(...) 66 | } 67 | writeTimeSeries <- function(...) { 68 | .Deprecated("write_ts", package = "tstools") 69 | write_ts(...) 70 | } 71 | -------------------------------------------------------------------------------- /R/df_to_reg_ts.R: -------------------------------------------------------------------------------- 1 | #' Turn data.frame to Regular Monthly or Quarterly Time Series 2 | #' 3 | #' Turn a data.frame with date columns to a regular time series object 4 | #' if possible. Design to work with quarterly and monthly data. 5 | #' 6 | #' @param dframe data.frame input 7 | #' @param var_cols columns that contain variables as opposed to date index. 8 | #' @param year_col integer, logical or character vector indicating the year 9 | #' position within the data.frame. 10 | #' @param period_col integer, logical or character vector indicating the period 11 | #' position within the data.frame. 12 | #' @param freq integer indicating the frequency of new time series. 13 | #' @param return_ts logical should a (list of) time series be returned? Defaults to TRUE. 14 | #' FALSE returns data.frame. 15 | #' @param by character overwrite automatically detected (from freq) by parameter. 16 | #' e.g. '1 day'. Defaults to NULL. 17 | #' @examples 18 | #' start_m <- as.Date("2017-01-01") 19 | #' df_missing <- data.frame( 20 | #' date = seq(start_m, by = "2 months", length = 6), 21 | #' value = 1:6, 22 | #' another_value = letters[1:6], 23 | #' yet_another_col = letters[6:1] 24 | #' ) 25 | #' df_to_reg_ts(df_missing, c("value", "another_value")) 26 | #' df_to_reg_ts(df_missing, c("value", "another_value"), return_ts = FALSE) 27 | #' @export 28 | #' @importFrom data.table year quarter month 29 | #' @importFrom stats ts 30 | df_to_reg_ts <- function(dframe, 31 | var_cols, 32 | year_col = "year", 33 | period_col = "month", 34 | freq = 12, 35 | return_ts = T, 36 | by = NULL) { 37 | n_vars <- length(var_cols) 38 | if (!is.null(by)) by_period <- by 39 | if (freq == 12) by_period <- "1 month" 40 | if (freq == 4) by_period <- "1 quarter" 41 | 42 | if ("date" %in% names(dframe)) { 43 | d_s <- dframe[order(dframe[, "date"]), ] 44 | d_s[, year_col] <- year(d_s[, "date"]) 45 | if (freq == 12) { 46 | periods <- month(d_s[, "date"]) 47 | } else if (freq == 4) { 48 | periods <- quarter(d_s[, "date"]) 49 | } 50 | d_s[, period_col] <- periods 51 | } else { 52 | # sort the data.frame, so all periods within a year are in the right order. 53 | d_s <- dframe[order( 54 | dframe[, year_col], 55 | dframe[, period_col] 56 | ), ] 57 | # append a date column in order to compare with a full date column. 58 | d_s$date <- as.Date(paste(d_s[, year_col], d_s[, period_col], "01", sep = "-")) 59 | } 60 | 61 | # start and end end date to construct a full date vector 62 | start_period <- c(d_s[1, year_col], d_s[1, period_col]) 63 | end_period <- c(d_s[nrow(d_s), year_col], d_s[nrow(d_s), period_col]) 64 | full_dates <- seq( 65 | from = as.Date(d_s$date[1]), to = as.Date(d_s$date[nrow(d_s)]), 66 | by = by_period 67 | ) 68 | 69 | # create a full matrix of NAs to have the maximum amount of observations 70 | # observations that are not missing are replaced with the actual values 71 | # later on 72 | na_m <- matrix(rep(NA, n_vars * length(full_dates)), ncol = n_vars) 73 | # combine na matrix with date in order to use indexing 74 | na_df <- data.frame(date = full_dates, na_m) 75 | # TRUE / FALSE matrix 76 | tf_m <- matrix(rep(full_dates %in% d_s$date, n_vars), ncol = n_vars) 77 | # use matrix indexing to replace all NAs 78 | na_df[, -1][tf_m] <- as.matrix(d_s[, var_cols]) 79 | names(na_df)[-1] <- var_cols 80 | 81 | if (return_ts) { 82 | lapply(na_df[, -1], ts, start = as.numeric(start_period), end = as.numeric(end_period), frequency = freq) 83 | } else { 84 | na_df 85 | } 86 | } 87 | -------------------------------------------------------------------------------- /R/draw_ts_ci.R: -------------------------------------------------------------------------------- 1 | #' @importFrom graphics polygon 2 | draw_ts_ci <- function(ci, theme) { 3 | if (!is.null(ci)) { 4 | ci_colors <- namedColor2Hex(theme$ci_colors, theme$ci_alpha) 5 | for (ci_series_i in 1:length(ci)) { 6 | ci_series <- ci[[ci_series_i]] 7 | 8 | for (ci_level_i in 1:length(ci_series)) { 9 | ci_level <- ci_series[[ci_level_i]] 10 | xx <- as.numeric(time(ci_level$lb)) 11 | 12 | frq <- frequency(ci_level$lb) 13 | 14 | if (theme$line_to_middle) { 15 | xx <- xx + (1 / frq) / 2 16 | } 17 | 18 | yy_low <- ci_level$lb 19 | yy_high <- ci_level$ub 20 | 21 | polygon(c(xx, rev(xx)), c(yy_low, rev(yy_high)), border = NA, col = ci_colors[ci_series_i]) 22 | } 23 | } 24 | } 25 | } 26 | -------------------------------------------------------------------------------- /R/fill_year_with_nas.R: -------------------------------------------------------------------------------- 1 | #' Fill Up a Time Series with NAs 2 | #' 3 | #' When plotting a time series you might want set the range of the plot a little wider than just the start and end date of the original series. This function add fills up the current period (typically year) with NA. 4 | #' 5 | #' @param x object of class ts 6 | #' @param add_periods integer periods to add. 7 | #' @param fill_up_start logical should start year be filled up? Defaults to FALSE. 8 | #' @export 9 | #' @importFrom stats start end 10 | fill_year_with_nas <- function(x, add_periods = 1, 11 | fill_up_start = FALSE) { 12 | UseMethod("fill_year_with_nas") 13 | } 14 | 15 | #' @export 16 | fill_year_with_nas.ts <- function(x, add_periods = 1, 17 | fill_up_start = FALSE) { 18 | frq <- frequency(x) 19 | de <- frq - end(x)[2] 20 | ds <- start(x)[2] - 1 21 | new_start <- c(start(x)[1], 1) 22 | if (fill_up_start) { 23 | ts(c(rep(NA, ds), x, rep(NA, de + add_periods)), 24 | start = new_start, 25 | frequency = frq 26 | ) 27 | } else { 28 | ts(c(x, rep(NA, de + add_periods)), 29 | start = start(x), 30 | frequency = frq 31 | ) 32 | } 33 | } 34 | 35 | #' @export 36 | fill_year_with_nas.xts <- function(x, add_periods = 1, 37 | fill_up_start = FALSE) { 38 | stop("xts support for filling up NAs not supported yet.") 39 | } 40 | 41 | 42 | #' @export 43 | fill_year_with_nas.zoo <- function(x, add_periods = 1, 44 | fill_up_start = FALSE) { 45 | stop("zoo support for filling up NAs not supported yet.") 46 | } 47 | -------------------------------------------------------------------------------- /R/find_group_coords.R: -------------------------------------------------------------------------------- 1 | find_group_coords <- function(x, theme, i) { 2 | ts_time <- time(x) 3 | COLS <- ncol(x) 4 | FRQ <- frequency(x) 5 | T_SPACE <- 1 / FRQ 6 | 7 | T_MARGIN_SPACE <- theme$total_bar_margin_pct * T_SPACE 8 | MARGIN_SPACE <- T_MARGIN_SPACE / 2 9 | T_BAR_SPACE <- (1 - theme$total_bar_margin_pct) * T_SPACE 10 | BAR_SPACE <- T_BAR_SPACE / COLS 11 | # XL vector 12 | coords <- list() 13 | coords$xl <- cumsum(c(0, rep(BAR_SPACE, COLS - 1))) + 14 | MARGIN_SPACE + 15 | ts_time[i] 16 | 17 | # YB vector 18 | coords$yb <- rep(0, COLS) 19 | 20 | # XR vector 21 | coords$xr <- coords$xl + BAR_SPACE 22 | 23 | # YT vector 24 | coords$yt <- apply(x, 1, function(x) x)[, i] 25 | coords 26 | } 27 | -------------------------------------------------------------------------------- /R/generate_random_ts.R: -------------------------------------------------------------------------------- 1 | #' Generate a list of random time series 2 | #' 3 | #' Useful for development or generating easily reproducible examples 4 | #' 5 | #' @param n The number of ts objects to generate 6 | #' @param lengths The lengths of the time series 7 | #' @param starts The start points of the time series in single number notation (e.g. 1990.5) 8 | #' @param frequencies The frequencies of the time series 9 | #' @param ranges_min The minimum values of the time series (if normally_distributed == FALSE) 10 | #' @param ranges_max The maximum values of the time series (if normally_distributed == FALSE) 11 | #' @param shifts The shifts of time series values per series 12 | #' @param ts_names The names of the ts objects in the resulting list 13 | #' @param seed The random seed to be used 14 | #' @param random_NAs Whether or not to introcude NA values at random positions in the ts 15 | #' @param random_NA_proportions The fraction of values to be replaced with NAs if random_NAs is TRUE for the series 16 | #' @param normally_distributed Use normal distribution instead of uniform 17 | #' @param normal_means The means to use for normal distribution. Ignored unless normally_distributed is set to TRUE. 18 | #' @param normal_sds The sds to use for normal distribution. Ignored unless normally_distributed is set to TRUE. 19 | #' @param frequency_shifts Introduce frequency shifts (from 4 to 12) in the ts 20 | #' @param frequency_shift_after After what fraction of the ts to shift frequencies 21 | #' 22 | #' @details 23 | #' Except for n and ts_names, all parameters accept either a single value or a vector of values. If a single value is 24 | #' supplied, that value is used for all time series being generated. If a vector is supplied, its values 25 | #' will be used for the corresponding series (e.g. starts[1] is used for the first series, starts[2] for 26 | #' the second and so on). Vectors are recycled if n is larger than their length. 27 | #' 28 | #' If a ts_names vector is supplied, it must have length n and must not contain duplicates. 29 | #' 30 | #' @return A list of ts objects 31 | #' 32 | #' @importFrom stats rnorm runif 33 | #' @export 34 | #' 35 | #' @examples 36 | #' generate_random_ts() 37 | #' 38 | #' generate_random_ts(n = 3, ranges_min = c(-10, 0, 10), ranges_max = 20, starts = 2011) 39 | generate_random_ts <- function(n = 1, 40 | lengths = 36, 41 | starts = 1988, 42 | frequencies = 12, 43 | ranges_min = -1, 44 | ranges_max = 1, 45 | shifts = 0, 46 | ts_names = sprintf("ts%d", 1:n), 47 | seed = 30042018, 48 | random_NAs = FALSE, 49 | random_NA_proportions = 0.1, 50 | normally_distributed = FALSE, 51 | normal_means = 0, 52 | normal_sds = 1, 53 | frequency_shifts = FALSE, 54 | frequency_shift_after = 0.5) { 55 | if (any(frequency_shifts & frequencies != 12)) { 56 | # may also determine locaton of error for bettar feedback 57 | stop("Frequency shift only supported if frequency is 12!") 58 | } 59 | 60 | if (length(ts_names) < n) { 61 | stop("Too few ts_names supplied!") 62 | } 63 | 64 | if (any(duplicated(ts_names))) { 65 | stop("Duplicate ts_names detected!") 66 | } 67 | 68 | set.seed(seed) 69 | 70 | out <- list() 71 | 72 | recycle <- function(values, index) { 73 | index <- index - 1 74 | values[(index %% length(values)) + 1] 75 | } 76 | 77 | for (i in 1:n) { 78 | n_x <- recycle(lengths, i) 79 | 80 | if (recycle(normally_distributed, i)) { 81 | x <- rnorm(n_x, recycle(normal_means, i), recycle(normal_sds, i)) + recycle(shifts, i) 82 | } else { 83 | x <- runif(n_x, recycle(ranges_min, i), recycle(ranges_max, i)) + recycle(shifts, i) 84 | } 85 | 86 | if (recycle(random_NAs, i)) { 87 | n_na <- ceiling(recycle(random_NA_proportions, i) * n_x) 88 | pos_na <- sample(1:n_x, n_na) 89 | x[pos_na] <- NA 90 | } 91 | 92 | if (recycle(frequency_shifts, i)) { 93 | breakpoint <- ceiling(recycle(frequency_shift_after, i) * n_x) 94 | 95 | if (breakpoint > 0) { 96 | before_shift <- x[1:breakpoint] 97 | after_shift <- x[(breakpoint + 1):n_x] 98 | 99 | before_shift[!c(TRUE, FALSE, FALSE)] <- NA 100 | 101 | x <- c(before_shift, after_shift) 102 | } 103 | } 104 | 105 | s <- ts(x, start = recycle(starts, i), frequency = recycle(frequencies, i)) 106 | 107 | nm <- recycle(ts_names, i) 108 | 109 | out[[nm]] <- s 110 | } 111 | 112 | out 113 | } 114 | -------------------------------------------------------------------------------- /R/import_helpers.R: -------------------------------------------------------------------------------- 1 | # Helper to turn api-returned json (lists) into lists of ts objects 2 | 3 | #' @importFrom stats as.ts start end 4 | json_to_ts <- function(json_data) { 5 | xt <- xts(json_data$value, order.by = as.yearmon(json_data$date)) 6 | 7 | if (frequency(xt) < Inf) { 8 | as.ts(xt, start = start(xt), end = end(xt)) 9 | } else { 10 | xt 11 | } 12 | } 13 | 14 | #' Transform a long format data.frame of time series to a tslist 15 | #' 16 | #' The data.frame must have three columns "date", "value" and "series" (identifying the time series) 17 | #' @param data data.frame The data.frame to be transformed 18 | #' @param keep_last_freq_only in case there is a frequency change in a time series, 19 | #' should only the part of the series be returned that has the same frequency as 20 | #' the last observation. This is useful when data start out crappy and then stabilize 21 | # after a while. Defaults to FALSE. Hence only the last part of the series is returned. 22 | #' @param force_xts logical 23 | #' @param strip_nas logical should NAs be stripped (no leading and trailing nas) ? 24 | #' @importFrom data.table dcast 25 | #' @importFrom zoo na.trim 26 | #' @export 27 | long_to_ts <- function(data, keep_last_freq_only = FALSE, force_xts = FALSE, 28 | strip_nas = TRUE) { 29 | data_dt <- as.data.table(data) 30 | 31 | # Strip series consisting only of NAs 32 | empty_series <- data_dt[, list(is_empty = all(is.na(value))), by = series] 33 | 34 | if (empty_series[, any(is_empty)]) { 35 | warning(sprintf( 36 | "Some series contained only NAs and were stripped:\n%s", 37 | paste(empty_series[is_empty == TRUE, series], collapse = "\n") 38 | )) 39 | } 40 | 41 | data_dt <- data_dt[!(series %in% empty_series[is_empty == TRUE, series])] 42 | # this helps to read in yearly data, otherwise the fact that date is 43 | # a character would break zoo's as.yearmon below. 44 | # not an optimal solution but a good fix to read in yearly data w/o complaints. 45 | if (all(grepl("^[0-9]{4}\\s*$", data_dt$date))) { 46 | data_dt[, date := as.numeric(date)] 47 | } 48 | 49 | data_dt[, `:=`(date_zoo = as.numeric(as.yearmon(date)), frq = 12), by = series] 50 | 51 | data_dt[is.na(date_zoo), `:=`(date_zoo = as.numeric(as.yearqtr(date)), frq = 4)] 52 | 53 | dt_of_lists <- data_dt[, 54 | { 55 | if (.N == 1) { 56 | NULL 57 | } else { 58 | dT <- diff(date_zoo) 59 | if (any(abs(diff(dT)) > 1e-6) || force_xts) { 60 | if (keep_last_freq_only && !force_xts) { 61 | # find last frequency shift in order to keep only 62 | # the data which has the same frequency as the end of the series 63 | # this is useful when data start out crappy and then stabilize 64 | # after a while. 65 | l <- length(dT) 66 | use_only <- (max(which(dT != dT[l])) + 1):(l + 1) 67 | list(ts_object = list(ts(value[use_only], 68 | start = .SD[use_only[1], date_zoo], 69 | end = .SD[.N, date_zoo], deltat = dT[use_only[1]] 70 | ))) 71 | } else { 72 | if (any(dT == 0)) { 73 | # Daily series 74 | list(ts_object = list(xts(value, order.by = as.Date(date)))) 75 | } else if (frq[1] == 4) { 76 | list(ts_object = list(xts(value, order.by = as.yearqtr(date_zoo)))) 77 | } else { 78 | list(ts_object = list(xts(value, order.by = as.yearmon(date_zoo)))) 79 | } 80 | } 81 | } else { 82 | list(ts_object = list(ts(value, 83 | start = .SD[1, date_zoo], 84 | end = .SD[.N, date_zoo], deltat = dT[1] 85 | ))) 86 | } 87 | } 88 | }, 89 | by = series 90 | ] 91 | 92 | dropped <- setdiff(data_dt$series, dt_of_lists$series) 93 | if (length(dropped) > 0) { 94 | message( 95 | "dropped: \n", paste(dropped, collapse = " \n"), 96 | "\n\nFrequency cannot be detected in time series of length 1!" 97 | ) 98 | } 99 | 100 | tslist <- dt_of_lists[, ts_object] 101 | if (strip_nas) { 102 | tslist <- lapply(tslist, function(x) { 103 | strip_ts_of_leading_nas(strip_ts_of_trailing_nas(x)) 104 | }) 105 | } 106 | 107 | names(tslist) <- dt_of_lists[, series] 108 | tslist 109 | } 110 | 111 | 112 | 113 | utils::globalVariables(c("date_zoo", "series", "ts_object", "value", "frq", "is_empty")) 114 | 115 | #' Transform a wide format data.frame into a tslist 116 | #' 117 | #' The time series in the data.frame may be stored either rowwise or columnswise. 118 | #' The identifying column must be called date (for columnwise) or series (for rowwise) 119 | #' @param data data.frame The data.frame to be transformed 120 | #' @param keep_last_freq_only in case there is a frequency change in a time series, 121 | #' should only the part of the series be returned that has the same frequency as 122 | #' the last observation. This is useful when data start out crappy and then stabilize 123 | #' after a while. Defaults to FALSE. Hence only the last part of the series is returned. 124 | #' @param force_xts boolean force xts format? Defaults to FALSE. 125 | #' @importFrom xts xts 126 | #' @importFrom zoo as.yearqtr as.yearmon 127 | #' @export 128 | wide_to_ts <- function(data, keep_last_freq_only = FALSE, force_xts = FALSE) { 129 | if (!("date" %in% names(data))) { 130 | # Data was written in transposed format 131 | long_to_ts(melt(data, id.vars = "series", variable.name = "date"), 132 | keep_last_freq_only = keep_last_freq_only, 133 | force_xts = force_xts 134 | ) 135 | } else { 136 | long_to_ts(melt(data, id.vars = "date", variable.name = "series"), 137 | keep_last_freq_only = keep_last_freq_only, 138 | force_xts = force_xts 139 | ) 140 | } 141 | } 142 | -------------------------------------------------------------------------------- /R/low_level_bar_plots.R: -------------------------------------------------------------------------------- 1 | #' @importFrom graphics rect 2 | draw_ts_bars <- function(x, group_bar_chart = FALSE, theme = NULL) { 3 | n_ts <- length(x) 4 | 5 | # Matrixify tslist 6 | x <- do.call(cbind, x) 7 | 8 | # "Remove" NAs (basically rect omits them anyway. Might even be better because of the borders) 9 | x[is.na(x)] <- 0 10 | 11 | # Base rect coordinates 12 | ts_time <- time(x) 13 | frq <- frequency(x) 14 | positives <- x 15 | positives[x < 0] <- 0 16 | negatives <- x 17 | negatives[x > 0] <- 0 18 | 19 | if (!group_bar_chart || n_ts == 1) { 20 | # Bars are 1/frq wide, bar_gap is in % of alloted width, half of which needs to go to each side 21 | offset <- theme$bar_gap / (frq * 200) 22 | 23 | x_pos_left <- rep(ts_time + offset, each = n_ts) 24 | x_pos_right <- rep(ts_time + 1 / frq - offset, each = n_ts) 25 | 26 | h_pos <- rbind(rectbase = 0, apply(t(positives), 2L, cumsum)) 27 | rect(x_pos_left, 28 | h_pos[1:n_ts, ], 29 | x_pos_right, 30 | h_pos[(1:n_ts) + 1, ], 31 | border = theme$bar_border, 32 | lwd = theme$bar_border_lwd, 33 | col = theme$bar_fill_color[1:n_ts] 34 | ) 35 | 36 | h_neg <- rbind(rectbase = 0, apply(t(negatives), 2L, cumsum)) 37 | rect(rep(ts_time + offset, each = n_ts), 38 | h_neg[1:n_ts, ], 39 | rep(ts_time + 1 / frq - offset, each = n_ts), 40 | h_neg[(1:n_ts) + 1, ], 41 | border = theme$bar_border, 42 | lwd = theme$bar_border_lwd, 43 | col = theme$bar_fill_color[1:n_ts] 44 | ) 45 | } else { 46 | inter_group_offset_value <- theme$bar_group_gap / (frq * 200) 47 | 48 | x_pos_raw <- t(c(ts_time) + rep(1, length(ts_time)) %*% t(seq(0, 1 / frq, 1 / (n_ts * frq)))) 49 | 50 | inter_group_offset <- t(rep(inter_group_offset_value, length(ts_time)) %*% t(c(1, rep(0, n_ts - 1), -1))) 51 | x_pos_group <- x_pos_raw + inter_group_offset 52 | 53 | x_pos_final <- apply(x_pos_group, 2, function(x) { 54 | seq(x[1], x[n_ts + 1], length.out = n_ts + 1) 55 | }) 56 | 57 | x_left <- apply(x_pos_final, 2, function(x) { 58 | grp <- x[n_ts + 1] - x[1] 59 | mar <- grp * theme$bar_gap * theme$use_bar_gap_in_groups / 100 60 | bar <- (grp - (n_ts - 1) * mar) / n_ts 61 | seq(x[1], x[n_ts + 1] - bar, by = bar + mar) 62 | }) 63 | 64 | x_right <- apply(x_pos_final, 2, function(x) { 65 | grp <- x[n_ts + 1] - x[1] 66 | mar <- grp * theme$bar_gap * theme$use_bar_gap_in_groups / 100 67 | bar <- (grp - (n_ts - 1) * mar) / n_ts 68 | seq(x[1] + bar, x[n_ts + 1], by = bar + mar) 69 | }) 70 | 71 | rect( 72 | x_left, 73 | t(negatives), 74 | x_right, 75 | t(positives), 76 | border = theme$bar_border, 77 | lwd = theme$bar_border_lwd, 78 | col = theme$bar_fill_color[1:n_ts] 79 | ) 80 | } 81 | } 82 | -------------------------------------------------------------------------------- /R/low_level_line_plots.R: -------------------------------------------------------------------------------- 1 | #' @importFrom stats ts.union 2 | draw_ts_lines <- function(x, theme = NULL, bandplot = FALSE) { 3 | nts <- length(x) 4 | op <- rep(theme$show_points, ceiling(nts / length(theme$show_points))) 5 | ops <- rep(theme$point_symbol, ceiling(nts / length(theme$point_symbol))) 6 | 7 | # "harmonize" all ts, range wise 8 | if (bandplot) { 9 | x_mat <- do.call(ts.union, x) 10 | x_mat[is.na(x_mat)] <- 0 11 | x <- as.list(x_mat) 12 | } 13 | 14 | band_low <- rep(0, length(x[[1]])) 15 | 16 | for (i in 1:nts) { 17 | xx <- as.numeric(time(x[[i]])) 18 | yy <- x[[i]] 19 | frq <- frequency(x[[i]]) 20 | 21 | if (theme$line_to_middle) { 22 | xx <- xx + (1 / frq) / 2 23 | } 24 | 25 | if (theme$NA_continue_line[i]) { 26 | yy_na <- is.na(yy) 27 | xx <- xx[!yy_na] 28 | yy <- yy[!yy_na] 29 | } 30 | 31 | if (!bandplot) { 32 | lines(xx, yy, 33 | col = theme$line_colors[i], 34 | lwd = theme$lwd[i], 35 | lty = theme$lty[i], 36 | type = ifelse(theme$show_points[i], "o", "l"), 37 | pch = theme$point_symbol[i] 38 | ) 39 | } else { 40 | band_high <- band_low + yy 41 | polygon(c(xx, rev(xx)), c(band_low, rev(band_high)), border = NA, col = theme$band_fill_color[i]) 42 | band_low <- band_high 43 | } 44 | } 45 | } 46 | 47 | #' @importFrom graphics lines 48 | draw_sum_as_line <- function(x, theme = NULL) { 49 | xx <- as.numeric(time(x)) 50 | yy <- x 51 | frq <- frequency(x) 52 | if (theme$line_to_middle) xx <- xx + (1 / frq) / 2 53 | lines(xx, yy, 54 | col = theme$sum_line_color, 55 | lwd = theme$sum_line_lwd, 56 | lty = theme$sum_line_lty 57 | ) 58 | } 59 | -------------------------------------------------------------------------------- /R/m_to_q.R: -------------------------------------------------------------------------------- 1 | #' Turn monthly series with regular NAs to quarter 2 | #' 3 | #' Monthly series with NAs in non-quarter months are turned to quarterly series. 4 | #' Series without NAs are just returned. 5 | #' 6 | #' @param series an object of class ts with monthly frequency 7 | #' @importFrom stats start 8 | #' 9 | #' @export 10 | m_to_q <- function(series) { 11 | stopifnot(frequency(series) == 12) 12 | if (!any(is.na(series))) { 13 | return(series) 14 | } 15 | period <- start(series)[2] 16 | q_start <- c(start(series)[1], rep(1:4, each = 3)[period]) 17 | no_nas <- na.omit(as.numeric(series)) 18 | ts(no_nas, start = q_start, frequency = 4) 19 | } 20 | -------------------------------------------------------------------------------- /R/overlap_sorted_ts_lists.R: -------------------------------------------------------------------------------- 1 | #' Concat Time Series list wise 2 | #' 3 | #' Concat overlapping time series list wise. List needs 4 | #' to be of same length. Takes names of list B. 5 | #' 6 | #' @param listA list of time series 7 | #' @param listB list of time series 8 | #' @export 9 | overlap_sorted_ts_lists <- function(listA, listB) { 10 | stopifnot(length(listA) == length(listB)) 11 | concat_list <- lapply(seq_along(listA), function(x) { 12 | out <- tryCatch( 13 | { 14 | resolveOverlap(listA[[x]], listB[[x]]) 15 | }, 16 | error = function(e) { 17 | attr(listB[[x]], "concat") <- FALSE 18 | listB[[x]] 19 | } 20 | ) 21 | out 22 | }) 23 | names(concat_list) <- names(listB) 24 | concat_list 25 | } 26 | -------------------------------------------------------------------------------- /R/overlap_ts_lists_by_name.R: -------------------------------------------------------------------------------- 1 | #' Resolve Overlap Listwise, helpful with SA 2 | #' 3 | #' 4 | #' @param listA list of time series often of lower frequency 5 | #' @param listB list of time series often of higher frequency 6 | #' @param chunkA character chunk representing frequencies, defaults to _f4. 7 | #' @param chunkB character chunk representing frequences, defaults to _f12. 8 | #' @export 9 | overlap_ts_lists_by_name <- function(listA, listB, 10 | chunkA = "_f4", 11 | chunkB = "_f12") { 12 | nma <- names(listA) 13 | ccl <- lapply(nma, function(x) { 14 | nmb <- gsub(x, chunkA, chunkB) 15 | out <- tryCatch( 16 | { 17 | resolveOverlap( 18 | listA[[x]], 19 | listB[[nmb]] 20 | ) 21 | }, 22 | error = function(e) { 23 | attr(listB[[nmb]], "concat") <- FALSE 24 | listB[[nmb]] 25 | } 26 | ) 27 | out 28 | }) 29 | ccl 30 | } 31 | -------------------------------------------------------------------------------- /R/read_swissdata.R: -------------------------------------------------------------------------------- 1 | #' Read data generated by the Swissdata project 2 | #' 3 | #' Read data from swissdata compliant .csv files and 4 | #' turn them into a list of time series. 5 | #' 6 | #' @param path character full path to dataset. 7 | #' @param key_columns character vector specifying all columns that should be 8 | #' part of the key. Defaults to the dim.order specified by swissdata. 9 | #' @param filter function A function that is applied to the raw data.data table after it is read. Useful for 10 | #' filtering out undesired data. 11 | #' @param aggregates list A list of dimensions over which to aggregate data. The names of this list determing 12 | #' which function is used to calculate the aggregate (e.g. sum, mean etc.). Defaults to sum. 13 | #' @param keep_last_freq_only in case there is a frequency change in a time series, 14 | #' should only the part of the series be returned that has the same frequency as 15 | #' the last observation. This is useful when data start out crappy and then stabilize 16 | # after a while. Defaults to FALSE. Hence only the last part of the series is returned. 17 | #' @details 18 | #' The order of dimensions in key_columns determines their order in the key 19 | #' The resulting ts_key will be of the form .... 20 | #' @examples 21 | #' ds_location <- system.file("example_data/ch.seco.css.csv", package = "tstools") 22 | #' tslist <- read_swissdata(ds_location, "idx_type") 23 | #' tsplot(tslist[1]) 24 | #' @importFrom data.table fread 25 | #' @export 26 | read_swissdata <- function(path, key_columns = NULL, filter = NULL, 27 | aggregates = NULL, 28 | keep_last_freq_only = FALSE) { 29 | ..raw_names <- NULL 30 | . <- NULL 31 | dataset <- gsub("\\.csv", "", basename(path)) 32 | 33 | if (is.null(key_columns)) { 34 | set_id <- gsub(".csv$", "", basename(path)) 35 | 36 | meta <- .read_swissdata_meta_unknown_format(gsub(".csv", "", path)) 37 | 38 | if (length(meta) == 0) { 39 | # Alternatively: Take them as they come in the csv? 40 | stop("Neither JSON nor YAML metadata found and key_columns not specified. Cannot proceed!") 41 | } 42 | 43 | key_columns <- meta$dim.order 44 | } 45 | 46 | # Read all columns as character to preserve things like 47 | # 00, 012 etc. in dims 48 | raw <- fread(path, colClasses = "character") 49 | raw[, value := as.numeric(value)] 50 | 51 | # TODO!!! Document change in aggregates param 52 | if (!is.null(aggregates)) { 53 | raw_names <- names(raw) 54 | dims <- setdiff(raw_names, c("date", "value")) 55 | totals <- lapply(seq_along(aggregates), function(i) { 56 | agg <- aggregates[[i]] 57 | aggregate_fcn <- agg$fcn 58 | aggregate_fcn <- ifelse(is.null(aggregate_fcn), "sum", aggregate_fcn) 59 | aggdim <- agg$dimensions 60 | raw[, .(value = do.call(aggregate_fcn, list(value))), 61 | by = c(setdiff(dims, aggdim), "date") 62 | ][, get("aggdim") := "total"][, ..raw_names] 63 | }) 64 | totals <- rbindlist(totals) 65 | raw <- rbindlist(list(raw, totals)) 66 | } 67 | 68 | raw[, series := do.call( 69 | paste, 70 | c(dataset, .SD, sep = ".") 71 | ), 72 | .SDcols = key_columns 73 | ] 74 | if (!is.null(filter)) { 75 | raw <- filter(raw) 76 | } 77 | 78 | long_to_ts(raw[, list(series, date, value)], 79 | keep_last_freq_only = keep_last_freq_only 80 | ) 81 | } 82 | -------------------------------------------------------------------------------- /R/read_swissdata_meta.R: -------------------------------------------------------------------------------- 1 | #' Read swissdata style yaml timeseries metadata 2 | #' 3 | #' read_swissdata_meta reads the given .yaml file and converts it into a 4 | #' per-timeseries format. 5 | #' 6 | #' If as_list is set to TRUE, the function returns a nested list with one 7 | #' element per timeseries, otherwise a data.table with one row per series. 8 | #' 9 | #' @param path Path to the yaml file to be read 10 | #' @param locale Locale in which to read the data (supported are "de", "fr", "it" and "en") 11 | #' @param as_list Should the output be converted to a list? 12 | #' @importFrom yaml read_yaml yaml.load 13 | #' @export 14 | read_swissdata_meta <- function(path, locale = "de", as_list = FALSE) { 15 | # avoid them CRAN NOTEs on data.table 16 | ts_key <- NULL 17 | if (grepl("yaml$", path)) { 18 | if (file.exists(path)) { 19 | set_name <- gsub(".yaml$", "", basename(path)) 20 | meta <- read_yaml(path) 21 | } else { 22 | stop(sprintf("Could not find file %s!", path)) 23 | } 24 | } else if (grepl("json$", path)) { 25 | if (file.exists(path)) { 26 | set_name <- gsub(".json$", "", basename(path)) 27 | meta <- jsonlite::fromJSON(path) 28 | } else { 29 | stop(sprintf("Could not find file %s!", path)) 30 | } 31 | } else { 32 | set_name <- basename(path) 33 | meta <- .read_swissdata_meta_unknown_format(path) 34 | } 35 | 36 | if (length(meta) == 0) { 37 | stop("No metadata found!") 38 | } 39 | 40 | dimnames_idx <- match("dimnames", names(meta$labels)) 41 | meta_labels <- meta$labels[-dimnames_idx] 42 | meta_dimnames <- sapply(meta$labels$dimnames, `[[`, locale) 43 | 44 | # Override column names for which no name is provided 45 | # (these are likely NULL and won't show up in the output anyway) 46 | missing_dimnames <- sapply(meta_dimnames, function(x) { 47 | is.null(x) || nchar(x) == 0 || x == "---" || is.list(x) 48 | }) 49 | meta_dimnames[missing_dimnames] <- names(meta_dimnames)[missing_dimnames] 50 | n_dims <- length(meta_dimnames) 51 | 52 | # Enforce dim.order 53 | meta_dimorder <- meta$dim.order 54 | meta_labels <- meta_labels[match(names(meta_labels), meta_dimorder)] 55 | meta_dimnames <- meta_dimnames[match(meta_dimorder, names(meta_dimnames))] 56 | 57 | keychunks <- lapply(meta_labels, names) 58 | keys <- do.call(paste, c( 59 | expand.grid(keychunks, stringsAsFactors = FALSE, KEEP.OUT.ATTRS = FALSE), # To understand, run expand.grid(list(1:2, 1:5)) 60 | sep = "." 61 | )) 62 | keys <- paste(set_name, keys, sep = ".") 63 | 64 | # Now this is some serious R-Fu 65 | labels <- expand.grid(lapply(meta_labels, sapply, `[[`, locale), stringsAsFactors = FALSE, KEEP.OUT.ATTRS = FALSE) 66 | 67 | # Work some dark magic to get units into it? 68 | 69 | # Is this smert? dimnames could be any old crazy strings 70 | names(labels) <- meta_dimnames 71 | 72 | # prettify NULL columns 73 | null_cols <- sapply(labels, function(x) { 74 | sum(sapply(x, is.null)) == length(x) 75 | }) 76 | if (any(null_cols)) { 77 | null_col_names <- names(null_cols)[null_cols] 78 | labels[null_col_names] <- NA_character_ 79 | } 80 | 81 | 82 | out <- as.data.table(labels) 83 | 84 | if (!is.null(meta$source.url)) { 85 | meta$source <- paste0(meta$source.name[[locale]], " (", meta$source.url, ")") 86 | } else { 87 | meta$source <- meta$source.name[[locale]] 88 | } 89 | 90 | per_set_dims <- yaml.load( 91 | " 92 | title: 93 | de: Datensatz 94 | fr: Datensatz 95 | it: Datensatz 96 | en: Dataset 97 | source: 98 | de: Quelle 99 | fr: Source 100 | it: La sourca (not correct) 101 | en: Source 102 | details: 103 | de: Details 104 | fr: Details 105 | it: Details 106 | en: Details 107 | utc.updated: 108 | de: Aktualisierungszeitpunkt 109 | fr: Aktualisierungszeitpunkt 110 | it: Aktualisierungszeitpunkt 111 | en: Last update 112 | " 113 | ) 114 | per_set_dims <- sapply(per_set_dims, `[[`, locale) 115 | 116 | # Keep only those that appear in the data (e.g. details is optional) 117 | per_set_dims <- per_set_dims[intersect(names(per_set_dims), names(meta))] 118 | 119 | n_dims <- n_dims + length(per_set_dims) 120 | 121 | out[, (per_set_dims) := lapply(meta[names(per_set_dims)], function(x) { 122 | if (is.list(x)) x[[locale]] else x 123 | })] 124 | 125 | if (as_list) { 126 | lapply(split(out, keys), as.list) 127 | } else { 128 | n_dims <- ncol(out) 129 | out[, ts_key := keys] 130 | setcolorder(out, c(n_dims + 1, 1:(n_dims))) 131 | out 132 | } 133 | } 134 | 135 | #' Read Meta Data File w/o File Extension 136 | #' 137 | #' Read a meta file without extension -> unknown format 138 | #' Tries to determine format (yaml, json) and return the metadata 139 | #' path must point to the file without extension e.g. swissdata_wd/set_id/set_id 140 | #' @param path character file path. 141 | #' @importFrom yaml read_yaml 142 | #' @importFrom jsonlite fromJSON 143 | #' @return Meta list if file could be located, empty list otherwise 144 | .read_swissdata_meta_unknown_format <- function(path) { 145 | set_id <- basename(path) 146 | meta_formats <- c("yaml", "json") 147 | existing_meta_files <- file.exists(file.path(dirname(path), sprintf("%s.%s", set_id, meta_formats))) 148 | names(existing_meta_files) <- meta_formats 149 | 150 | if (existing_meta_files["yaml"]) { 151 | meta <- read_yaml(paste0(path, ".yaml")) 152 | } else if (existing_meta_files["json"]) { 153 | meta <- fromJSON(paste0(path, ".json")) 154 | } else { 155 | meta <- list() 156 | } 157 | 158 | meta 159 | } 160 | -------------------------------------------------------------------------------- /R/read_ts.R: -------------------------------------------------------------------------------- 1 | #' Import time series data from a file. 2 | #' 3 | #' If importing from a zip file, the archive should contain a single file with the extension .csv, .xlsx or .json. 4 | #' 5 | #' @param file Path to the file to be read 6 | #' @param format Which file format is the data stored in? If no format is supplied, read_ts will attempt to guess 7 | #' from the file extension. 8 | #' @param sep character seperator for csv files. defaults to ','. 9 | #' @param skip numeric See data.table's fread. 10 | #' @param column_names character vector denoting column names, defaults to c("date","value","series). 11 | #' @param keep_last_freq_only in case there is a frequency change in a time series, 12 | #' should only the part of the series be returned that has the same frequency as 13 | #' the last observation. This is useful when data start out crappy and then stabilize 14 | #' after a while. Defaults to FALSE. Hence only the last part of the series is returned. 15 | #' @param force_xts If set to true, the time series will be returned as xts objects regargless of 16 | #' regularity. Setting this to TRUE means keep_last_freq_only is ignored. 17 | #' @return A named list of ts objects 18 | #' 19 | #' @importFrom data.table fread 20 | #' @importFrom utils unzip 21 | #' @export 22 | read_ts <- function(file, 23 | format = c( 24 | "csv", "xlsx", 25 | "json", "zip" 26 | ), 27 | sep = ",", 28 | skip = 0, 29 | column_names = c("date", "value", "series"), 30 | keep_last_freq_only = FALSE, 31 | force_xts = FALSE) { 32 | if (length(format) == 1) { 33 | format <- match.arg(format) 34 | } else { 35 | # Try to guess format from extension 36 | format <- regmatches(file, regexec(".*?[.](.*)$", file))[[1]][2] 37 | if (!(format %in% c("csv", "xlsx", "json", "zip"))) { 38 | stop("Could not detect file format. Please supply format parameter!\nValid file formats are csv, xlsx, json and zip.") 39 | } 40 | } 41 | 42 | if (format == "zip") { 43 | contents <- unzip(file, list = TRUE) 44 | 45 | if (nrow(contents) > 1) { 46 | warning("Found more than 1 file in zip archive, proceeding with the first one...") 47 | } 48 | 49 | zipped_file <- contents$Name[1] 50 | message(sprintf("Found file %s in zip archive, proceeding...", zipped_file)) 51 | 52 | zipped_format <- regmatches(zipped_file, regexec(".*?[.](.*)$", zipped_file))[[1]][2] 53 | if (!(zipped_format %in% c("csv", "xlsx", "json"))) { 54 | stop("Zipped file is not a csv-, xlsx- or json-file!") 55 | } 56 | 57 | file <- unzip(file, zipped_file, exdir = tempdir()) 58 | format <- zipped_format 59 | } 60 | 61 | switch(format, 62 | "csv" = read_ts.csv(file, sep, skip = skip, column_names = column_names, keep_last_freq_only = keep_last_freq_only, force_xts = force_xts), 63 | "xlsx" = read_ts.xlsx(file, column_names = column_names, keep_last_freq_only = keep_last_freq_only, force_xts = force_xts), 64 | "json" = read_ts.json(file) 65 | ) 66 | } 67 | 68 | # Could export these, but no real need. 69 | read_ts.csv <- function(file, sep = ",", skip, column_names = c("date", "value", "series"), 70 | keep_last_freq_only = FALSE, 71 | force_xts = FALSE) { 72 | csv <- fread(file, sep = sep, stringsAsFactors = FALSE, colClasses = "numeric", skip = skip) 73 | 74 | if (length(csv) == 3 && length(setdiff(names(csv), column_names)) == 0) { 75 | long_to_ts(csv, keep_last_freq_only = keep_last_freq_only, force_xts = force_xts) 76 | } else { 77 | wide_to_ts(csv, keep_last_freq_only = keep_last_freq_only, force_xts = force_xts) 78 | } 79 | } 80 | 81 | 82 | read_ts.xlsx <- function(file, column_names = c("date", "value", "series"), 83 | keep_last_freq_only = FALSE, 84 | force_xts = FALSE) { 85 | xlsx_available <- requireNamespace("openxlsx") 86 | 87 | if (!xlsx_available) { 88 | return(warning("openxlsx not available. Install openxlsx or export to csv.")) 89 | } 90 | 91 | xlsx <- data.table::as.data.table(openxlsx::read.xlsx(file)) 92 | 93 | if (length(xlsx) == 3 && length(setdiff(names(xlsx), column_names)) == 0) { 94 | long_to_ts(xlsx, keep_last_freq_only = keep_last_freq_only, force_xts = force_xts) 95 | } else { 96 | wide_to_ts(xlsx, keep_last_freq_only = keep_last_freq_only, force_xts = force_xts) 97 | } 98 | } 99 | 100 | #' @importFrom jsonlite fromJSON 101 | read_ts.json <- function(file) { 102 | data <- fromJSON(readLines(file)) 103 | 104 | lapply(data, json_to_ts) 105 | } 106 | -------------------------------------------------------------------------------- /R/regularize.R: -------------------------------------------------------------------------------- 1 | #' Turn an Irregular Time Series to a Regular, ts-Based Series 2 | #' 3 | #' Adds missing values to turn an irregular time series into a regular one. This function is currently experimental. Only works or target frequencies 1,2,4,12. 4 | #' 5 | #' @param x an irregular time series object of class zoo or xts. 6 | #' @examples 7 | #' ts1 <- rnorm(5) 8 | #' dv <- c( 9 | #' seq(as.Date("2010-01-01"), length = 3, by = "3 years"), 10 | #' seq(as.Date("2018-01-01"), length = 2, by = "2 years") 11 | #' ) 12 | #' library(zoo) 13 | #' xx <- zoo(ts1, dv) 14 | #' regularize(xx) 15 | #' 16 | #' dv2 <- c(seq(as.Date("2010-01-01"), length = 20, by = "1 months")) 17 | #' dv2 <- dv2[c(1:10, 14:20)] 18 | #' xx2 <- zoo(rnorm(length(dv2)), dv2) 19 | #' regularize(xx2) 20 | #' 21 | #' @importFrom zoo as.yearmon index 22 | #' @export 23 | regularize <- function(x) { 24 | idx <- index(x) 25 | # difference in days in order to guess frequency 26 | dt <- as.numeric(diff(idx)) / 365 27 | freqs <- c(12, 4, 2, 1) 28 | frq <- freqs[which.min(abs(min(dt) - 1 / freqs))] 29 | full_r <- seq(min(idx), max(idx), by = sprintf("%d months", 12 / frq)) 30 | val <- rep(NA, length(full_r)) 31 | val[(full_r %in% idx)] <- x 32 | tx <- ts(val, start = as.yearmon(min(idx)), frequency = frq) 33 | tx 34 | } 35 | -------------------------------------------------------------------------------- /R/resolve_ts_overlap.R: -------------------------------------------------------------------------------- 1 | #' Concatenate Time Series and Resolve Overlap Automatically 2 | #' 3 | #' Append time series to each other. Resolve overlap determines 4 | #' which of two ts class time series is 5 | #' reaching further and arranges the two series into first and second 6 | #' series accordingly. Both time series are concatenated to one 7 | #' if both series had the same frequency. Typically this function is used 8 | #' concatenate two series that have a certain overlap, but one series clearly 9 | #' starts earlier while the other lasts longer. If one series starts earlier and 10 | #' stops later, all elements of the shorter series will be inserted into the 11 | #' larger series, i.e. elements of the smaller series will replace the elements 12 | #' of the longer series. Usually ts2 is kept. 13 | #' 14 | #' @param ts1 ts time series, typically the older series 15 | #' @param ts2 ts time series, typically the younger series 16 | #' @param keep_ts2 logical should ts2 be kept? Defaults to TRUE. 17 | #' @param tolerance numeric when comparing min and max values with a index vector of a time series R runs in to trouble with precision handling, thus a tolerance needs to be set. Typically this does not need to be adjusted. E.g. 2010 != 2010.000. With the help of the tolerance parameter these two are equal. 18 | #' @importFrom stats is.ts 19 | #' @export 20 | #' @examples 21 | #' ts1 <- ts(rnorm(100), start = c(1990, 1), frequency = 4) 22 | #' ts2 <- ts(1:18, start = c(2000, 1), frequency = 4) 23 | #' resolve_ts_overlap(ts1, ts2) 24 | #' 25 | #' # automatical detection of correction sequence! 26 | #' ts1 <- ts(rnorm(90), start = c(1990, 1), frequency = 4) 27 | #' ts2 <- ts(1:60, start = c(2000, 1), frequency = 4) 28 | #' resolve_ts_overlap(ts1, ts2) 29 | #' 30 | #' # both series are of the same length use sequence of arguments. 31 | #' ts1 <- ts(rnorm(100), start = c(1990, 1), frequency = 4) 32 | #' ts2 <- ts(1:48, start = c(2003, 1), frequency = 4) 33 | #' resolve_ts_overlap(ts1, ts2) 34 | #' ts1 <- ts(rnorm(101), start = c(1990, 1), frequency = 4) 35 | #' ts2 <- ts(1:61, start = c(2000, 1), frequency = 4) 36 | #' resolve_ts_overlap(ts1, ts2) 37 | #' #' clearly dominatn ts2 series 38 | #' ts1 <- ts(rnorm(50), start = c(1990, 1), frequency = 4) 39 | #' ts2 <- ts(1:100, start = c(1990, 1), frequency = 4) 40 | #' resolve_ts_overlap(ts1, ts2) 41 | resolve_ts_overlap <- function(ts1, ts2, keep_ts2 = T, tolerance = 1e-3) { 42 | # R seems to have some issues with comparing min time 43 | # because of double tolerance. got to set a tolerance here 44 | tol <- tolerance 45 | 46 | 47 | stopifnot(is.ts(ts1)) 48 | stopifnot(is.ts(ts2)) 49 | stopifnot(frequency(ts1) == frequency(ts2)) 50 | freq <- frequency(ts1) 51 | ts1s <- min(time(ts1)) 52 | ts1e <- max(time(ts1)) 53 | ts2s <- min(time(ts2)) 54 | ts2e <- max(time(ts2)) 55 | if (ts1s < ts2s & ts1e < ts2e) { 56 | # add special case of appending single values to a ts 57 | if (length(ts2) == 1) { 58 | out <- c(ts1, ts2) 59 | out <- ts(out, start = ts1s, frequency = freq) 60 | } else { 61 | out <- c(ts1[1:(which(abs(time(ts1) - ts2s) <= tol) - 1)], ts2) 62 | out <- ts(out, start = ts1s, frequency = freq) 63 | } 64 | } else if (ts1s < ts2s & ts1e >= ts2e) { 65 | a <- which(abs(time(ts1) - ts2s) <= tol) 66 | b <- which(abs(time(ts1) - ts2e) <= tol) 67 | ts1[a:b] <- ts2 68 | out <- ts1 69 | } else if (ts1s == ts2s & ts2e >= ts1e) { 70 | out <- ts2 71 | } else if (ts1s > ts2s & ts1e < ts2e) { 72 | a <- which(abs(time(ts2) - ts1s) <= tol) 73 | b <- which(abs(time(ts2) - ts1s) <= tol) 74 | if (!keep_ts2) { 75 | ts2[a:b] <- ts1 76 | } 77 | out <- ts2 78 | } else if (ts1s > ts2s & ts1e > ts2e) { 79 | out <- c(ts2[1:(which(abs(time(ts2) - ts1s) <= tol) - 1)], ts1) 80 | out <- ts(out, start = ts2s, frequency = freq) 81 | } else { 82 | stop("Case not covered, try switching ts1, ts2.") 83 | } 84 | out 85 | } 86 | -------------------------------------------------------------------------------- /R/set_month_to_NA.R: -------------------------------------------------------------------------------- 1 | #' Set Periods to NA 2 | #' 3 | #' This function is typically used to discard information in non-quarter month. 4 | #' I.e., data is only kept in January, April, July and December and otherwise set 5 | #' to NA. In combination with \code{\link{m_to_q}} this function is useful to 6 | #' turn monthly series into quarterly series by letting the quarter month values 7 | #' represent the entire quarter. This can be useful when data was interpolated 8 | #' because of mixing data of different frequencies and needs to be converted 9 | #' back to a regular, quarterly time series. 10 | #' 11 | #' @param series ts object 12 | #' @param keep_month integer vector denoting the months that not be set to NA. 13 | #' Defaults to c(1,4,7,10) 14 | #' 15 | #' @examples 16 | #' tsq <- ts(1:20, start = c(1990, 1), frequency = 4) 17 | #' aa <- tsqm(tsq) 18 | #' m_to_q(set_month_to_NA(aa)) 19 | #' 20 | #' @importFrom zoo index 21 | #' @export 22 | #' @importFrom zoo index 23 | set_month_to_NA <- function(series, keep_month = c(1, 4, 7, 10)) { 24 | # get the index of the keep periods 25 | # in order to replace the non-keep month with NA 26 | idx <- index(series) - floor(index(series)) 27 | series[!idx %in% idx[keep_month]] <- NA 28 | series 29 | } 30 | -------------------------------------------------------------------------------- /R/start_ts_after_internal_nas.R: -------------------------------------------------------------------------------- 1 | #' Start a Time Series after the Last Internal NA 2 | #' 3 | #' Internal NAs can cause trouble for time series operations such as 4 | #' X-13-ARIMA SEATS seasonal adjustment. Often, internal NAs only occur at 5 | #' at the beginning of a time series. Thus an easy solution to the problem 6 | #' is to discard the initial part of the data which contains the NA values. 7 | #' This way only a small part of the information is lost as opposed to 8 | #' not being able to seasonally adjust an entire series. 9 | #' 10 | #' @param series on object of class ts 11 | #' @seealso \code{\link{stripLeadingNAsFromTs}}, \code{\link{stripTrailingNAsFromTs}} 12 | #' @importFrom stats window 13 | #' @export 14 | #' @examples 15 | #' ts1 <- 1:30 16 | #' ts1[c(3, 6)] <- NA 17 | #' ts1 <- ts(ts1, start = c(2000, 1), frequency = 4) 18 | #' start_ts_after_internal_nas(ts1) 19 | start_ts_after_internal_nas <- function(series) { 20 | # returning the series right away saves time 21 | # if there are no nas 22 | if (!any(is.na(series))) { 23 | return(series) 24 | } 25 | na_pos <- which(is.na(series)) 26 | freq <- frequency(series) 27 | new_start_pos <- max(na_pos) + 1 28 | window(series, 29 | start = time(series)[new_start_pos], 30 | frequency = freq 31 | ) 32 | } 33 | -------------------------------------------------------------------------------- /R/strip_nas.R: -------------------------------------------------------------------------------- 1 | #' Strip Leading / Trailing NAs from a Time Series Object 2 | #' 3 | #' Removes NAs to begin with and starts time series index at the first non-NA value. 4 | #' 5 | #' 6 | #' @param s an object of class ts. 7 | #' @rdname strip_nas 8 | #' 9 | #' @importFrom stats window 10 | #' @export 11 | strip_ts_of_leading_nas <- function(s) { 12 | if (!is.na(s[1])) { 13 | s 14 | } else { 15 | nas <- which(is.na(s)) 16 | # when all difference are zero, just take the last 17 | # NA in line, otherwise only use the first to go beyond 1 18 | if (all(diff(nas) == 1)) { 19 | end <- nas[length(nas)] + 1 20 | } else { 21 | end <- min(which(diff(nas) > 1)) + 1 22 | } 23 | 24 | if (end == Inf) { 25 | start_time <- time(s)[which(!is.na(s))[1]] 26 | end_time <- time(s)[length(s)] 27 | } else { 28 | start_time <- time(s)[end] 29 | end_time <- time(s)[length(s)] 30 | } 31 | 32 | window(s, start = start_time, end = end_time) 33 | } 34 | } 35 | 36 | #' @rdname strip_nas 37 | #' @importFrom stats start 38 | #' @export 39 | strip_ts_of_trailing_nas <- function(s) { 40 | if (is.null(dim(s))) { 41 | ntf <- is.na(s) 42 | } else { 43 | ntf <- apply(s, 1, function(x) all(is.na(x))) 44 | } 45 | 46 | if (!any(ntf)) { 47 | return(s) 48 | } 49 | 50 | na_pos <- which(ntf) 51 | sqntl <- length(ntf) - na_pos 52 | if (rev(sqntl)[1] != 0) { 53 | return(s) 54 | } else { 55 | rmv <- na_pos[sqntl - 1 <= 1] 56 | if (is.null(dim(s))) { 57 | ts(s[-rmv], start = start(s), frequency = frequency(s)) 58 | } else { 59 | ts(s[-rmv, ], start = start(s), frequency = frequency(s)) 60 | } 61 | } 62 | } 63 | -------------------------------------------------------------------------------- /R/themes.R: -------------------------------------------------------------------------------- 1 | colors <- yaml::read_yaml(system.file("colors.yaml", package = "tstools")) 2 | 3 | #' Initiate Default Theme 4 | #' 5 | #' The \code{\link{tsplot}} methods provide a theme argument which is used to pass on a plethora of useful defaults. These defaults are essentially stored in a list. Sometimes the user may want to tweak some of these defaults while keeping most of them. 6 | #' Hence the init_tsplot_theme function create a fresh list object containing default values for lot of different layout parameters etc. By replacing single elements of the list and passing the entire list to the plot function, single aspects can be tweaked while keeping most defaults. Init defaultTheme does not need any parameters. 7 | #' 8 | #' @details 9 | #' Themes are essentially list that contain \code{\link{par}} parameters. Below all items are listed, some of them with comments. 10 | #' The per-line parameters (\code{line_colors, lwd, lty, show_points, point_symbol}) are recycled if more time series than elements on the corresponding 11 | #' theme vectors are supplied. e.g. if four time series are plotted but only two line_colors are supplied, the first and third series have the first color, 12 | #' while the second and fourth series have the second color. 13 | #' The list contains the following elements: 14 | #' @param auto_bottom_margin logical Should the bottom margin be automatically calculated? This will be overridden if margins[1] is not NA. Default FALSE 15 | #' @param band_fill_color character vector of hex colors for the bands if left_as_band == TRUE. 16 | #' @param bar_border character hex colors for the border around bars in bar charts. 17 | #' @param bar_border_lwd numeric The line width of the borders of bars in barplots. Default 1 18 | #' @param bar_fill_color character vector of hex colors for the bars if left_as_bar == TRUE 19 | #' @param bar_gap numeric The width of the gap between bars, in \% of space alloted to the bar. 20 | #' @param bar_group_gap numeric The width of the gap between groups of bars if group_bar_chart is TRUE. 21 | #' @param ci_alpha Numeric 0-255, numeric 0-1 or hey 00-FF, transparency of the confidence interval bands 22 | #' @param ci_colors Named colors or hex values Colors of the confidence interval bands 23 | #' @param ci_legend_label character A formatting template for how the ci bands should be labelled. May contain the 24 | #' placeholders. '\%ci_value\%' will be replaced with the ci label. '\%series\%' (will be replaced with the series name) 25 | #' exactly once. Defaults to '\%ci_value\% ci for \%series\%' 26 | #' @param default_bottom_margin numeric The bottom margin to use when margins[1] is NA but neither auto_legend nor auto_bottom_margin are true. Default 3 27 | #' @param fill_up_start logical shoule the start of the year also be filled? Has no effect if fill_year_with_nas == FALSE. Default FALSE 28 | #' @param fill_year_with_nas logical should year be filled up with missing in order to plot the entire year on the axis. Defaults to TRUE, 29 | #' @param highlight_color character hex color code of highlight background, defaults to "#e9e9e9". 30 | #' @param highlight_window logical should a particular time span be highlighted by different background color. Defaults to FALSE. 31 | #' @param highlight_window_end integer vector highlight window start position, defaults to NA., 32 | #' @param highlight_window_freq integer frequency of the higlight window defintion, defaults to 4. 33 | #' @param highlight_window_start integer vector highlight window start position, defaults to NA. 34 | #' @param highlight_y_values numeric Vector of y values to highlight with a bold line 35 | #' @param highlight_y_lwd integer Line width of the lines to highlight y values 36 | #' @param highlight_y_color character Color of the lines to highlight y values 37 | #' @param label_pos character, denotes where the x-axis label is at. defaults to "mid", alternative value: "start". 38 | #' @param legend_all_left logical Should all legend entries be drawn on the left side of the plot? Default FALSE 39 | #' @param legend_box_size numeric The size of the squares denoting bar colors in the legend. Default 2 40 | #' @param legend_col integer number of columns for the legend, defaults to 3. 41 | #' @param legend_font_size numeric passed on to the \code{cex} parameter of \code{\link{legend}}, defaults to 1 42 | #' @param legend_intersp_x numeric same as base \code{\link{legend}} parameter, defaults to 1 43 | #' @param legend_intersp_y numeric same as base \code{\link{legend}} parameter, defaults to 1 44 | #' @param legend_margin_bottom numeric Distance between bottom of legend and bottom of graphic in \% of device height, default 5 45 | #' @param legend_margin_top numeric Distance between bottom of plot and top of legends \% of device height, defaults to 12 46 | #' @param legend_seg.len numeric Length of the line segments in the legend. Default 2 47 | #' @param line_colors character vector of hex colors for 6 lines. 48 | #' @param line_to_middle logical try to put a line into the middle of the plot. defaults to TRUE. 49 | #' @param lty integer vector line type defaults to 1. 50 | #' @param lwd integer vector line width, defaults to c(2,3,1,4,2,4). 51 | #' @param lwd_box numeric Line width of the box around the plot. Default 1.5 52 | #' @param lwd_quarterly_ticks numeric, width of yearly ticks, defaults to 1. 53 | #' @param lwd_x_axis numeric The line width of the x axis. Default 1.5 54 | #' @param lwd_y_axis numeric The line width of the y axis. Default 1.5 55 | #' @param lwd_y_ticks numeric Line width of the y ticks. Default 1.5 56 | #' @param lwd_yearly_ticks numeric, width of yearly ticks, defaults to 1.5. 57 | #' @param margins integer vector defaults to c(NA, 4, 3, 3) + 0.1. Set margins[1] to NA to automatically determine the bottom margin such that the legend fits (if either auto_legend or auto_bottom_margin are TRUE) 58 | #' @param NA_continue_line boolean If true, NA values in time series are ignored and a contonuous line is drawn. Multiple values to turn this behavior on/off for indivitual series are supported. Default FALSE 59 | #' @param output_wide logical Should the output file be in a wide format (16:9) or (4:3)? Only if output_format is not "plot". Default FALSE 60 | #' @param point_symbol integer or character The symbol to use for marking data points. Multiple values can be supplied to set the symbol for each individual series See \code{pch} in \code{?par}. Default 1:18 61 | #' @param pointsize Numeric Point size of text, in 1/72 of an inch 62 | #' @param preferred_y_gap_sizes numeric c(25, 20, 15, 10, 5, 2.5, 1, 0.5), 63 | #' @param quarterly_ticks logical, should quarterly ticks be shown. Defaults to TRUE. 64 | #' @param range_must_not_cross_zero logical automatic range finders are forced to do not find ranges below zero. Defaults to TRUE. 65 | #' @param show_left_y_axis logical: should left y axis be shown, defaults to TRUE. 66 | #' @param show_points boolean Whether to draw the symbol specified by point_symbol at the data points. Multiple values can be supplied to enable/disable showing points for each individual series Default FALSE 67 | #' @param show_right_y_axis logical: should left y axis be shown, defaults to TRUE. 68 | #' @param show_x_axis locigal: should x axis be shown, defaults to TRUE 69 | #' @param show_y_grids logical should y_grids by shown at all, defaults to TRUE. 70 | #' @param subtitle_adj numeric same as base \code{\link{plot}} parameter, defaults to 0. 71 | #' @param subtitle_adj_r numeric same as base \code{\link{plot}} parameter, defaults to .9 72 | #' @param subtitle_cex numeric same as base \code{\link{plot}} parameter, defaults to 1. 73 | #' @param subtitle_margin numeric How far above the plot the title is placed in \% of the device height. Defaults to 2. 74 | #' @param subtitle_outer logical same as base \code{\link{plot}} parameter, defaults to TRUE 75 | #' @param subtitle_transform function to transform the subtitle, defaults to "toupper", 76 | #' @param sum_as_line logical should the sum of stacked time series be displayed as a line on top of stacked bar charts. Defaults to FALSE, 77 | #' @param sum_legend character Label for the sum line, defaults to "sum". Set to NULL to not label the line at all. 78 | #' @param sum_line_color character hex color of of sum_as_line, defaults "#91056a". 79 | #' @param sum_line_lty integer line type of sum_as_line, defaults to 1. 80 | #' @param sum_line_lwd integer line width of sum_as_line, defaults to 3. 81 | #' @param tcl_quarterly_ticks numeric, length of quarterly ticks. See tcl_yearly_ticks, defaults to -0.4 82 | #' @param tcl_y_ticks numeric Length of y ticks, see \code{tcl_yearly_ticks}. Default -0.75 83 | #' @param tcl_yearly_ticks numeric, length of yearly ticks. Analogous to \code{cex} for \code{\link{axis}}. defaults to -0.75. 84 | #' @param title_adj numeric, same as base \code{\link{plot}} parameter, defaults to 0. 85 | #' @param title_cex.main numeric, same as base \code{\link{plot}} parameter defaults to 1 86 | #' @param title_margin numeric How far above the plot the title is placed in \% of the device height. Default 8 87 | #' @param title_outer logical, currently undocumented. Defaults to TRUE. 88 | #' @param title_transform function to transform the title, defaults to NA. 89 | #' @param total_bar_margin_pct numeric defintion as in base plot, defaults to "i", defaults to .2, 90 | #' @param use_bar_gap_in_groups logical Should there be gaps of size bar_gap between the bars in a group if group_bar_chart = TRUE? Default FALSE 91 | #' @param use_box logical use a box around the plot. 92 | #' @param x_tick_dt numeric The distance between ticks on the x axis in years. The first tick will always be at the start of the plotted time series. Defaults to 1. 93 | #' @param xaxs character axis defintion as in base plot, defaults to "i". 94 | #' @param y_grid_color character hex color of grids. Defaults to gray "#CCCCCC". 95 | #' @param y_grid_count integer vector preferred y grid counts c(5,6,8,10). 96 | #' @param y_grid_count_strict logical should we strictly stick to preferred y grid count? Defaults to FALSE. 97 | #' @param y_las integer, same as base \code{\link{plot}} parameter defaults to 2. 98 | #' @param y_range_min_size = NULL , 99 | #' @param y_tick_force_integers logical Should y ticks be forced (rounded down) to whole numbers? Default FALSE 100 | #' @param y_tick_margin numeric, minimal percentage of horizontal grid that needs to be clean, i.e., without lines or bars. Defaults to 0.15 (15 percent). 101 | #' @param yaxs character axis defintion as in base plot, defaults to "i". 102 | #' @param yearly_ticks logical, should yearly ticks be shown. Defaults to TRUE. 103 | #' @examples 104 | #' \dontrun{ 105 | #' # create a list 106 | #' data(KOF) 107 | #' tt <- init_tsplot_theme() 108 | #' # adjust a single element 109 | #' tt$highlight_window <- TRUE 110 | #' # pass the list to tsplot 111 | #' tsplot(KOF$kofbarometer, theme = tt) 112 | #' # for more theme examples check the vignette 113 | #' vignette("tstools") 114 | #' } 115 | #' 116 | #' @author Matthias Bannert 117 | #' @export 118 | init_tsplot_theme <- function( 119 | auto_bottom_margin = FALSE, 120 | band_fill_color = c( 121 | ETH_Petrol = colors$ETH_Petrol$`100`, 122 | ETH_Petrol_60 = colors$ETH_Petrol$`60`, 123 | ETH_Petrol_40 = colors$ETH_Petrol$`40`, 124 | ETH_Petrol_20 = colors$ETH_Petrol$`20`, 125 | ETH_Purple = colors$ETH_Purple$`100`, 126 | ETH_Purple_60 = colors$ETH_Purple$`60`, 127 | ETH_Purple_40 = colors$ETH_Purple$`40` 128 | ), 129 | bar_border = "#000000", 130 | bar_border_lwd = 1, 131 | bar_fill_color = c( 132 | ETH_Petrol = colors$ETH_Petrol$`100`, 133 | ETH_Petrol_60 = colors$ETH_Petrol$`60`, 134 | ETH_Petrol_40 = colors$ETH_Petrol$`40`, 135 | ETH_Petrol_20 = colors$ETH_Petrol$`20`, 136 | ETH_Purple = colors$ETH_Purple$`100`, 137 | ETH_Purple_60 = colors$ETH_Purple$`60`, 138 | ETH_Purple_40 = colors$ETH_Purple$`40` 139 | ), 140 | bar_gap = 15, 141 | bar_group_gap = 30, 142 | ci_alpha = "44", 143 | ci_colors = line_colors, 144 | ci_legend_label = "%ci_value%% ci for %series%", 145 | default_bottom_margin = 15, 146 | fill_up_start = FALSE, 147 | fill_year_with_nas = TRUE, 148 | highlight_color = colors$ETH_Grey$`20`, 149 | highlight_window = FALSE, 150 | highlight_window_end = NA, 151 | highlight_window_freq = 4, 152 | highlight_window_start = NA, 153 | highlight_y_values = NA, 154 | highlight_y_lwd = 2, 155 | highlight_y_color = "#000000", 156 | label_pos = "mid", 157 | legend_all_left = FALSE, 158 | legend_box_size = 2, 159 | legend_col = 1, 160 | legend_font_size = 1, 161 | legend_intersp_x = 1, 162 | legend_intersp_y = 1, 163 | legend_margin_bottom = 5, 164 | legend_margin_top = 12, 165 | legend_seg.len = 2, 166 | line_colors = c( 167 | ETH_Green_60 = colors$ETH_Green$`60`, 168 | ETH_Green_100 = colors$ETH_Green$`100`, 169 | ETH_Petrol_20 = colors$ETH_Petrol$`20`, 170 | ETH_Purple_60 = colors$ETH_Purple$`60`, 171 | ETH_Petrol_60 = colors$ETH_Petrol$`60`, 172 | ETH_Purple_100 = colors$ETH_Purple$`100`, 173 | ETH_Petrol_100 = colors$ETH_Petrol$`100` 174 | ), 175 | line_to_middle = TRUE, 176 | lty = 1, 177 | lwd = c(2, 3, 1, 4, 2, 4), 178 | lwd_box = 1.5, 179 | lwd_quarterly_ticks = 1, 180 | lwd_x_axis = 1.5, 181 | lwd_y_axis = 1.5, 182 | lwd_y_ticks = 1.5, 183 | lwd_yearly_ticks = 1.5, 184 | margins = c(NA, 7, 12, 7), 185 | NA_continue_line = FALSE, 186 | output_wide = FALSE, 187 | point_symbol = 1:18, 188 | pointsize = 12, 189 | preferred_y_gap_sizes = c(25, 20, 15, 10, 5, 2.5, 1, 0.5), 190 | quarterly_ticks = TRUE, 191 | range_must_not_cross_zero = TRUE, 192 | show_left_y_axis = TRUE, 193 | show_points = FALSE, 194 | show_right_y_axis = TRUE, 195 | show_x_axis = TRUE, 196 | show_y_grids = TRUE, 197 | subtitle_adj = 0, 198 | subtitle_adj_r = .9, 199 | subtitle_cex = 1, 200 | subtitle_margin = 2, 201 | subtitle_outer = FALSE, 202 | subtitle_transform = "toupper", 203 | sum_as_line = FALSE, 204 | sum_legend = "sum", 205 | sum_line_color = c(ETH_Petrol_100 = colors$ETH_Petrol$`100`), 206 | sum_line_lty = 1, 207 | sum_line_lwd = 3, 208 | tcl_quarterly_ticks = -0.4, 209 | tcl_y_ticks = -0.75, 210 | tcl_yearly_ticks = -0.75, 211 | title_adj = 0, 212 | title_cex.main = 1, 213 | title_margin = 5, 214 | title_outer = FALSE, 215 | title_transform = NA, 216 | total_bar_margin_pct = .2, 217 | use_bar_gap_in_groups = FALSE, 218 | use_box = FALSE, 219 | x_tick_dt = 1, 220 | xaxs = "i", 221 | y_grid_color = colors$ETH_Grey$`40`, 222 | y_grid_count = c(5, 6, 8, 10), 223 | y_grid_count_strict = FALSE, 224 | y_las = 2, 225 | y_range_min_size = NULL, 226 | y_tick_force_integers = FALSE, 227 | y_tick_margin = 0.15, 228 | yaxs = "i", 229 | yearly_ticks = TRUE) { 230 | as.list(environment())[names(formals())] 231 | } 232 | 233 | scale_theme_param_for_print <- function(value, dims) { 234 | constant <- 6 235 | (dims[2] / constant) * value 236 | } 237 | 238 | #' Initialize a tsplot theme with parameters scaled to device size 239 | #' 240 | #' This function provides sensible defaults for margins, font size, line width etc. scaled to 241 | #' the dimensions of the output file. 242 | #' 243 | #' @param ... All the other arguments to \code{init_tsplot_thene} 244 | #' 245 | #' @rdname init_tsplot_theme 246 | #' 247 | #' @export 248 | init_tsplot_print_theme <- function( 249 | output_wide = FALSE, 250 | margins = c(NA, 10 / `if`(output_wide, 1 + 1 / 3, 1), 10, 7 / `if`(output_wide, 1 + 1 / 3, 1)), 251 | lwd = scale_theme_param_for_print(c(2, 3, 1, 4, 2, 4), `if`(output_wide, c(10 + 2 / 3, 6), c(8, 6))), 252 | sum_line_lwd = scale_theme_param_for_print(3, `if`(output_wide, c(10 + 2 / 3, 6), c(8, 6))), 253 | lwd_box = scale_theme_param_for_print(1.5, `if`(output_wide, c(10 + 2 / 3, 6), c(8, 6))), 254 | lwd_x_axis = scale_theme_param_for_print(1.5, `if`(output_wide, c(10 + 2 / 3, 6), c(8, 6))), 255 | lwd_yearly_ticks = scale_theme_param_for_print(1.5, `if`(output_wide, c(10 + 2 / 3, 6), c(8, 6))), 256 | lwd_quarterly_ticks = scale_theme_param_for_print(1, `if`(output_wide, c(10 + 2 / 3, 6), c(8, 6))), 257 | lwd_y_axis = scale_theme_param_for_print(1.5, `if`(output_wide, c(10 + 2 / 3, 6), c(8, 6))), 258 | lwd_y_ticks = scale_theme_param_for_print(1.5, `if`(output_wide, c(10 + 2 / 3, 6), c(8, 6))), 259 | legend_intersp_y = scale_theme_param_for_print(1, `if`(output_wide, c(10 + 2 / 3, 6), c(8, 6))), 260 | legend_box_size = scale_theme_param_for_print(2, `if`(output_wide, c(10 + 2 / 3, 6), c(8, 6))), 261 | legend_margin_top = 8, 262 | legend_margin_bottom = 3, 263 | legend_seg.len = scale_theme_param_for_print(2, `if`(output_wide, c(10 + 2 / 3, 6), c(8, 6))), 264 | pointsize = scale_theme_param_for_print(12, `if`(output_wide, c(10 + 2 / 3, 6), c(8, 6))), 265 | ...) { 266 | init_tsplot_theme( 267 | margins = margins, 268 | lwd = lwd, 269 | sum_line_lwd = sum_line_lwd, 270 | lwd_box = lwd_box, 271 | lwd_x_axis = lwd_x_axis, 272 | lwd_yearly_ticks = lwd_yearly_ticks, 273 | lwd_quarterly_ticks = lwd_quarterly_ticks, 274 | lwd_y_axis = lwd_y_axis, 275 | lwd_y_ticks = lwd_y_ticks, 276 | legend_intersp_y = legend_intersp_y, 277 | legend_box_size = legend_box_size, 278 | legend_margin_top = legend_margin_top, 279 | legend_margin_bottom = legend_margin_bottom, 280 | legend_seg.len = legend_seg.len, 281 | pointsize = pointsize, 282 | output_wide = output_wide, 283 | ... 284 | ) 285 | } 286 | -------------------------------------------------------------------------------- /R/tsqm.R: -------------------------------------------------------------------------------- 1 | #' Interpolate quarterly time series into monthly 2 | #' 3 | #' Repeat quarterly variables two times to generate a monthly variable. 4 | #' 5 | #' @param qts quarterly time series 6 | #' @examples 7 | #' tsq <- ts(1:20, start = c(1990, 1), frequency = 4) 8 | #' tsqm(tsq) 9 | #' 10 | #' @importFrom stats start 11 | #' @export 12 | tsqm <- function(qts) { 13 | if (frequency(qts) == 12) { 14 | return(qts) 15 | } 16 | start_date <- start(qts) 17 | mts <- as.vector(t(qts %*% t(c(1, 1, 1)))) 18 | mts <- ts(mts, start = quarter_to_month(start_date), frequency = 12) 19 | mts 20 | } 21 | 22 | quarter_to_month <- function(sdate) { 23 | y <- sdate[1] 24 | qms <- c(1, 4, 7, 10) 25 | out <- qms[sdate[2]] 26 | if (is.na(out)) { 27 | return(c(y, 1)) 28 | } 29 | c(y, out) 30 | } 31 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | #' Compute Decimal Time from a ts Period Vector 2 | #' 3 | #' Standard ts object use a vector of length two to store a period. E.g. 2010,1 means first quarter of 2010, 4 | #' if the series was quarterly and first month if the series was monthly etc. 5 | #' 6 | #' @param v integer vector denoting a point in time 7 | #' @param f frequency 8 | #' @export 9 | compute_decimal_time <- function(v, f) { 10 | multi <- 1 / f 11 | (v[2] - 1) * multi + v[1] 12 | } 13 | 14 | #' Compute the Period Vector representation of a Decimal Time value 15 | #' 16 | #' The period value will be rounded down to the nearest integer. 17 | #' This function is not vectorized so only a single value can be 18 | #' converted at a time. 19 | #' 20 | #' @param dtime numeric decimal time value denoting a point in time 21 | #' @param frq integer frequency 22 | get_date_vector <- function(dtime, frq) { 23 | y <- floor(dtime) 24 | p <- dtime - y 25 | c(y, floor(frq * p + 1 + 1 / (4 * frq))) 26 | } 27 | 28 | # function is called by tsplot, do not need to export 29 | # it but let's write a minimal comment on what it does. 30 | getGlobalXInfo <- function(tsl, tsr, fill_up, fill_up_start, dt, manual_ticks) { 31 | global_x <- list() 32 | 33 | if (!is.null(tsr)) { 34 | all_ts <- c(tsl, tsr) 35 | } else { 36 | all_ts <- tsl 37 | } 38 | 39 | if (is.null(manual_ticks)) { 40 | if (fill_up) { 41 | all_ts <- lapply(all_ts, fill_year_with_nas, fill_up_start = fill_up_start) 42 | } 43 | 44 | global_x$x_range <- range(unlist(lapply(all_ts, time))) 45 | 46 | # Set the lower bound to correspond with a quarterly tick, for pretties 47 | global_x$x_range[1] <- trunc(global_x$x_range[1] * 4) / 4 48 | global_x$x_range[2] <- trunc(global_x$x_range[2] * 4 + 0.76) / 4 49 | 50 | # Yearly tick positions 51 | global_x$yearly_tick_pos <- seq(floor(global_x$x_range[1]), global_x$x_range[2] + dt, dt) 52 | 53 | # labels 54 | global_x$year_labels_start <- seq(global_x$x_range[1], global_x$x_range[2] + dt, dt) 55 | } else { 56 | global_x$x_range <- range(manual_ticks) 57 | global_x$yearly_tick_pos <- manual_ticks 58 | global_x$year_labels_start <- manual_ticks 59 | } 60 | 61 | global_x$min_year <- trunc(global_x$x_range[1]) 62 | global_x$max_year <- trunc(global_x$x_range[2]) + 1 63 | 64 | if (dt == 1) { 65 | global_x$quarterly_tick_pos <- seq( 66 | from = global_x$min_year, 67 | to = global_x$max_year, 68 | by = .25 69 | ) 70 | # global_x$monthly_tick_pos <- seq(from = global_x$min_year, 71 | # to = global_x$max_year, 72 | # by = 1/12) 73 | global_x$year_labels_middle_q <- ifelse(global_x$quarterly_tick_pos - 74 | floor(global_x$quarterly_tick_pos) == 0.5, 75 | as.character(floor(global_x$quarterly_tick_pos)), 76 | NA 77 | ) 78 | # global_x$year_labels_middle_m <- ifelse(global_x$monthly_tick_pos - 79 | # floor(global_x$monthly_tick_pos) == 0.5, 80 | # as.character(floor(global_x$monthly_tick_pos)), 81 | # NA) 82 | } else { 83 | global_x$quarterly_tick_pos <- NA 84 | global_x$year_labels_middle_q <- NA 85 | } 86 | 87 | global_x 88 | } 89 | 90 | 91 | 92 | 93 | # Make sure right axis object is of appropriate class. 94 | sanitizeTsr <- function(tsr) { 95 | if (is.null(tsr)) { 96 | return(tsr) 97 | } else if (inherits(tsr, "mts")) { 98 | as.list(tsr) 99 | } else if (inherits(tsr, "ts")) { 100 | list(tsr) 101 | } else if (inherits(tsr, "list")) { 102 | tsr 103 | } else { 104 | stop("Time series object to be plotted on the right axis, 105 | has to be either of class ts, mts or list.") 106 | } 107 | } 108 | 109 | #' @importFrom graphics lines 110 | addYGrids <- function(tick_positions, xlim, theme) { 111 | for (hl in tick_positions[2:length(tick_positions)]) { 112 | lines( 113 | x = xlim, 114 | y = c(hl, hl), 115 | col = theme$y_grid_color, 116 | lwd = theme$lwd_y_ticks, 117 | xpd = TRUE 118 | ) 119 | } 120 | } 121 | 122 | #' @importFrom graphics lines 123 | addYHighlights <- function(xlim, theme) { 124 | for (hl in theme$highlight_y_values) { 125 | lines( 126 | x = xlim, 127 | y = c(hl, hl), 128 | col = theme$highlight_y_color, 129 | lwd = theme$highlight_y_lwd, 130 | xpd = TRUE 131 | ) 132 | } 133 | } 134 | 135 | 136 | findGapSize <- function(r, tick_count) { 137 | d <- diff(r) 138 | raw_tick_size <- d / (tick_count - 1) 139 | m <- ceiling(log(raw_tick_size, 10) - 1) 140 | pow10m <- 10^m 141 | ceil_tick_size <- ceiling(raw_tick_size / pow10m) * pow10m 142 | ceil_tick_size 143 | } 144 | 145 | 146 | findTicks <- function(r, tick_count, preferred_gap_sizes, round_ticks = FALSE, preserve_sign = FALSE) { 147 | # potential tick count needs to sorted otherwise, 148 | # automatic selection of 149 | gap_count <- tick_count - 1 150 | gaps <- findGapSize(r = r, sort(tick_count)) 151 | lb <- (r[1] %/% gaps) * gaps 152 | 153 | ub <- lb + (gap_count * gaps) 154 | 155 | # nudge the generated range around a bit to ensure the series are more or less "centered" 156 | # i.e. there are no empty ticks 157 | lb_too_low <- r[1] > lb + gaps & (!preserve_sign | (sign(ub) == sign(ub + gaps / 2) & sign(lb) == sign(lb + gaps / 2))) 158 | lb[lb_too_low] <- lb[lb_too_low] + gaps[lb_too_low] / 2 159 | ub[lb_too_low] <- ub[lb_too_low] + gaps[lb_too_low] / 2 160 | 161 | ub_too_high <- r[2] < ub - gaps & (!preserve_sign | (sign(ub) == sign(ub - gaps / 2) & sign(lb) == sign(lb - gaps / 2))) 162 | lb[ub_too_high] <- lb[ub_too_high] - gaps[ub_too_high] / 2 163 | ub[ub_too_high] <- ub[ub_too_high] - gaps[ub_too_high] / 2 164 | 165 | seqs <- list() 166 | for (i in seq_along(gaps)) { 167 | seqs[[i]] <- seq(lb[i], ub[i], gaps[i]) 168 | } 169 | 170 | # First take any best fitting range 171 | w <- which.max((lb - r[1]) + (r[2] - ub)) 172 | out <- seqs[[w]] 173 | 174 | # Try to select a reasonably pretty gap size 175 | preferred_gap_sizes <- sort(preferred_gap_sizes, decreasing = TRUE) 176 | for (gs in preferred_gap_sizes) { 177 | by_gs <- which(gaps %% gs == 0) 178 | 179 | # If one or more ranges with the desired gap size exist 180 | # return the one with the least number of ticks 181 | if (any(by_gs)) { 182 | out <- seqs[[min(by_gs)]] 183 | break 184 | } 185 | } 186 | 187 | if (round_ticks) { 188 | out <- floor(out) 189 | } 190 | 191 | out 192 | } 193 | 194 | formatNumericDate <- function(date, freq, date_format = NULL) { 195 | year <- floor(date + 1 / 24) 196 | if (freq[1] == 4) { 197 | if (is.null(date_format)) { 198 | quarter <- 4 * (date - year) + 1 199 | return(sprintf("%d Q%d", year, quarter)) 200 | } else { 201 | month <- floor(12 * (date - year)) + 1 202 | } 203 | } else { 204 | month <- floor(12 * (date - year + 1 / 24)) + 1 # Why "+ 1/24"? Because floating point arithmetic. 12*0.0833333 may not be 12. 205 | if (is.null(date_format)) { 206 | return(sprintf("%d-%02d", year, month)) 207 | } 208 | } 209 | 210 | format(as.Date(sprintf("%d-%d-01", year, month)), date_format) 211 | } 212 | 213 | alpha2Hex <- function(alpha) { 214 | if (is.character(alpha)) { 215 | return(alpha) 216 | } 217 | 218 | if (floor(alpha) == alpha) { 219 | alpha <- as.hexmode(alpha) 220 | } else { 221 | alpha <- as.hexmode(floor(256 * alpha)) 222 | } 223 | } 224 | 225 | #' @importFrom grDevices colors col2rgb rgb 226 | namedColor2Hex <- function(color, alpha = NULL) { 227 | if (is.numeric(alpha)) { 228 | alpha <- alpha2Hex(alpha) 229 | } 230 | 231 | known_colors <- color %in% colors() 232 | 233 | color[known_colors] <- rgb(t(col2rgb(color[known_colors])), maxColorValue = 255) 234 | 235 | no_alpha <- nchar(color) < 9 236 | 237 | color[no_alpha] <- paste0(color[no_alpha], alpha) 238 | 239 | color 240 | } 241 | 242 | 243 | #' Helper to calculate ci colors for legends 244 | #' 245 | #' @param color The color of the ci band 246 | #' @param n The number if ci bands 247 | #' @param alpha The alpha/transparency of the ci band 248 | #' 249 | #' @details 250 | #' Color may be specified as either a named color or a hex value 251 | #' Transparency may be specified as a hex value, number 0-255 or number 0-1 252 | #' 253 | #' @return A vector of non-transparent colors that result from 254 | #' oberlaying color over pure white 1:n times 255 | #' 256 | #' @importFrom grDevices col2rgb rgb 257 | getCiLegendColors <- function(color, n = 1, alpha = NULL) { 258 | colorRGBA <- col2rgb(color, alpha = TRUE) 259 | colorRGB <- colorRGBA[1:3, 1] 260 | 261 | alpha <- ifelse(is.null(alpha), colorRGBA["alpha", 1], as.numeric(paste0("0x", alpha2Hex(alpha)))) / 256 262 | 263 | out <- c() 264 | 265 | ca <- colorRGB 266 | cb <- col2rgb("white") 267 | 268 | for (i in seq(n)) { 269 | cb <- alpha * ca + (1 - alpha) * cb 270 | out[i] <- rgb(t(round(cb)), maxColorValue = 255) # paste(as.hexmode(floor(cb)), collapse = "") 271 | } 272 | 273 | out 274 | } 275 | -------------------------------------------------------------------------------- /R/write_ts.R: -------------------------------------------------------------------------------- 1 | #' Export a list of time series to a file. 2 | #' 3 | #' @param tl list of time series 4 | #' @param fname character file name. Defaults to NULL, displaying output on console. Set a file name without file extension in order to store a file. Default file names / location are not CRAN compliant which is why the file name defaults to NULL. 5 | #' @param format character denotes export formats. Defaults to .csv. "csv", "xlsx", "json", "rdata" are available. Spreadsheet formats like csv allow for further optional parameters. 6 | #' @param date_format character denotes the date format. Defaults to NULL. If set to null the default is used: Jan 2010. 7 | #' @param timestamp_to_fn If TRUE, the current date will be appended to the file name. Defaults to FALSE. 8 | #' @param round_digits integer, precision in digits. 9 | #' @param rdata_varname character name of the list of time series within the store RData. Defaults to "tslist". 10 | #' @param ... additional arguments used by spedific formats. 11 | #' @details 12 | #' Additional arguments covered by \code{...} 13 | #' \tabular{lll}{ 14 | #' \strong{Name} \tab \strong{Effect} \tab \strong{Format(s)} \cr 15 | #' \code{wide} \tab Export data in a wide format (one column per series) \tab CSV, XLSX \cr 16 | #' \code{transpose} \tab Transpose exported data (one row per series) \tab CSV, XLSX, only if wide = TRUE \cr 17 | #' \code{zip} \tab If set to TRUE, the file is compressed into a zip archive after export \tab any \cr 18 | #' } 19 | #' @importFrom jsonlite toJSON 20 | #' @importFrom utils zip 21 | #' @import data.table 22 | #' @export 23 | write_ts <- function(tl, 24 | fname = NULL, 25 | format = "csv", 26 | date_format = NULL, 27 | timestamp_to_fn = FALSE, 28 | round_digits = NULL, 29 | rdata_varname = "tslist", 30 | ...) { 31 | args <- list(...) 32 | 33 | if (!is.list(tl)) { 34 | stop("tl must be a list object!") 35 | } 36 | 37 | if (is.null(names(tl))) { 38 | warning("Unnamed list provided, using index as name!") 39 | names(tl) <- seq(1:length(tl)) 40 | } 41 | 42 | # Match format 43 | allowed_formats <- c("csv", "xlsx", "json", "rdata") 44 | format <- match.arg(format, allowed_formats) 45 | 46 | # Timestamp filename 47 | if (timestamp_to_fn & !is.null(fname)) { 48 | fname <- paste(fname, gsub("-", "_", Sys.Date()), sep = "_") 49 | } 50 | 51 | wide <- ifelse(!is.null(args$wide), args$wide, FALSE) 52 | transpose <- ifelse(!is.null(args$transpose), args$transpose, FALSE) 53 | 54 | # check for format compatability 55 | if (format %in% c("csv", "xlsx") && wide) { 56 | ts_lengths <- sapply(tl, length) 57 | if (!all(diff(ts_lengths) == 0)) { 58 | warning("list contains time series of different lengths. Export to wide .csv or xlsx is not recommended.") 59 | } 60 | } 61 | 62 | if (!is.null(round_digits)) { 63 | tl <- lapply(tl, round, digits = round_digits) 64 | } 65 | 66 | # Export data 67 | if (format == "rdata") { 68 | env <- new.env() 69 | env[[rdata_varname]] <- tl 70 | 71 | if (is.null(fname)) { 72 | return(tl) 73 | } 74 | 75 | write_name <- paste0(fname, ".RData") 76 | 77 | 78 | save(list = ls(env), file = write_name, envir = env) 79 | } else { 80 | nTs <- length(tl) 81 | 82 | if (format != "json") { 83 | if (!wide) { 84 | # convert the list into a pretty, long data.frame 85 | tl_lengths <- data.table(length = sapply(tl, length)) 86 | 87 | index <- seq(nrow(tl_lengths)) 88 | 89 | tsdf <- tl_lengths[, list(internal_index = seq(length)), by = index] 90 | 91 | tl_names <- names(tl) 92 | 93 | tsdf[, `:=`( 94 | freq = frequency(tl[[index]]), 95 | series = tl_names[index], 96 | value = as.numeric(tl[[index]][internal_index]), 97 | date_numeric = as.numeric(time(tl[[index]])) 98 | ), 99 | by = index 100 | ] 101 | 102 | tsdf[, date := formatNumericDate(date_numeric, freq, date_format), by = freq] 103 | 104 | tsdf[, `:=`(index = NULL, date_numeric = NULL, freq = NULL, internal_index = NULL)] 105 | setcolorder(tsdf, c("date", "value", "series")) 106 | } else { 107 | tsmat <- do.call("cbind", tl) 108 | dates <- time(tsmat) 109 | freq <- frequency(tl[[1]]) 110 | 111 | tsdf <- as.data.table(tsmat) 112 | tsdf[, t := dates] 113 | dates_formatted <- formatNumericDate(dates, freq, date_format) 114 | 115 | # Then cbinding xts, index is added as a column. We don't want that. 116 | # Alternatively: suppressWarnings? 117 | if ("index" %in% names(tsdf)) { 118 | tsdf <- tsdf[, -"index", with = FALSE] 119 | } 120 | 121 | if (transpose) { 122 | tsdf <- dcast(melt(tsdf, id.vars = "t", variable.name = "series"), series ~ t) 123 | names(tsdf)[2:ncol(tsdf)] <- dates_formatted 124 | } else { 125 | tsdf <- cbind(data.table(date = dates_formatted), tsdf) 126 | tsdf <- tsdf[, -"t", with = FALSE] 127 | } 128 | } 129 | } 130 | 131 | if (format == "json") { 132 | json_pretty <- ifelse(!is.null(args$json_pretty), args$json_pretty, FALSE) # TODO: getArgs helper? 133 | 134 | # Output an object of arrays of objects { "key": [{"date": time1, "value": value1}, ...], ...} 135 | jsondf <- lapply(tl, function(x) { 136 | t <- time(x) 137 | f <- frequency(x) 138 | 139 | t <- formatNumericDate(t, f, date_format) 140 | 141 | data.frame(date = t, value = x, row.names = NULL) 142 | }) 143 | json <- toJSON(jsondf, pretty = json_pretty, digits = 16) 144 | 145 | if (is.null(fname)) { 146 | return(jsondf) 147 | } 148 | 149 | write_name <- paste(fname, "json", sep = ".") 150 | 151 | # Write json as a "single element CSV" for speed 152 | fwrite(list(json), 153 | file = write_name, 154 | quote = FALSE, col.names = FALSE 155 | ) 156 | } else { 157 | if (wide) { 158 | # Check for frequency consistency 159 | frq <- unique(sapply(tl, frequency)) 160 | if (length(frq) != 1) { 161 | stop("All time series need to have the same frequency for proper wide export.") 162 | } 163 | } 164 | 165 | 166 | xlsx_available <- requireNamespace("openxlsx", quietly = TRUE) 167 | if (!xlsx_available) { 168 | format <- "csv" 169 | warning("package openxlsx not available, writing .csv") 170 | } 171 | 172 | if (format == "xlsx") { 173 | # TODO: Maybe move this up before the expensive operations. 174 | # Need to figure out nrow(tsdf) as nPoints <- length(unique(c(all the dates))) 175 | # or something though 176 | if (ncol(tsdf) > 1000) { 177 | stop("XSLX format can not handle more than 1000 time series") 178 | } else if (nrow(tsdf) > 1e6) { 179 | stop("XLSX format can not handle more than 1'000'000 rows") 180 | } 181 | 182 | # need to explicitly call print cause of data.table evaluation 183 | if (is.null(fname)) { 184 | return(print(tsdf)) 185 | } 186 | write_name <- paste0(fname, ".xlsx") 187 | openxlsx::write.xlsx( 188 | tsdf, 189 | paste0(fname, ".xlsx") 190 | ) 191 | } else { 192 | if (is.null(fname)) { 193 | return(print(tsdf)) 194 | } 195 | 196 | write_name <- paste0(fname, ".csv") 197 | fwrite(tsdf, write_name) 198 | } 199 | } 200 | } 201 | 202 | should_zip <- ifelse(!is.null(args$zip), args$zip, FALSE) 203 | 204 | if (should_zip) { 205 | zip_name <- paste0(fname, ".zip") 206 | unlink(zip_name) 207 | zip(zip_name, write_name) 208 | } 209 | } 210 | 211 | utils::globalVariables(c("internal_index", "date_numeric")) 212 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, include = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-", 12 | out.width = "100%" 13 | ) 14 | ``` 15 | 16 | # {tstools} -- a Time Series Toolbox for Official Statistics 17 | 18 | 19 | [![CRAN status](https://www.r-pkg.org/badges/version/tstools)](https://CRAN.R-project.org/package=tstools) 20 | [![R-CMD-check](https://github.com/kof-ch/tstools/workflows/R-CMD-check/badge.svg)](https://github.com/kof-ch/tstools/actions) 21 | [![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) 22 | 23 | [![CRAN RStudio mirror downloads](https://cranlogs.r-pkg.org/badges/grand-total/tstools?color=blue)](https://r-pkg.org/pkg/tstools) 24 | 25 | 26 | Plot official statistics' time series conveniently: automatic legends, highlight windows, stacked bar chars with positive and negative contributions, sum-as-line option, two y-axes with automatic horizontal grids that fit both axes and other popular chart types. 'tstools' comes with a plethora of defaults to let you plot without setting an abundance of parameters first, but gives you the flexibility to tweak the defaults. In addition to charts, 'tstools' provides a super fast, 'data.table' backed time series I/O that allows the user to export / import long format, wide format and transposed wide format data to various file types. 27 | 28 | -> [pkgdown documentation](https://kof-ch.github.io/tstools/) <- 29 | 30 | ## Installation 31 | 32 | You can install the development version of tstools from [GitHub](https://github.com/) with: 33 | 34 | ``` r 35 | # install.packages("remotes") 36 | remotes::install_github("kof-ch/tstools") 37 | ``` 38 | 39 | ## Example Use: Time Series Charts with Legends by Default 40 | 41 | {tstools} lets you draw time series line charts that come with a legend out-of-the-box. Simply 42 | feed the `tsplot()` function with a list of time series. 43 | 44 | 45 | ```{r example, message=FALSE} 46 | library(tstools) 47 | ## basic example code 48 | tsl <- list( 49 | AirPassengers = AirPassengers, 50 | JohnsonJohnson = JohnsonJohnson 51 | ) 52 | 53 | tsplot(tsl) 54 | ``` 55 | 56 | and use easily use 2 y-axis. (I know some argue those double axes are fundamentally flawed, but my peers didn't care and asked for it.) 57 | 58 | ```{r} 59 | tsplot( 60 | "Air Passengers" = tsl$AirPassengers, 61 | tsr = list("Johnson & Johnson" = tsl$JohnsonJohnson) 62 | ) 63 | ``` 64 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # {tstools} – a Time Series Toolbox for Official Statistics 5 | 6 | 7 | 8 | [![CRAN 9 | status](https://www.r-pkg.org/badges/version/tstools)](https://CRAN.R-project.org/package=tstools) 10 | [![R-CMD-check](https://github.com/kof-ch/tstools/workflows/R-CMD-check/badge.svg)](https://github.com/kof-ch/tstools/actions) 11 | [![Lifecycle: 12 | stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) 13 | 14 | [![CRAN RStudio mirror 15 | downloads](https://cranlogs.r-pkg.org/badges/grand-total/tstools?color=blue)](https://r-pkg.org/pkg/tstools) 16 | 17 | 18 | Plot official statistics’ time series conveniently: automatic legends, 19 | highlight windows, stacked bar chars with positive and negative 20 | contributions, sum-as-line option, two y-axes with automatic horizontal 21 | grids that fit both axes and other popular chart types. ‘tstools’ comes 22 | with a plethora of defaults to let you plot without setting an abundance 23 | of parameters first, but gives you the flexibility to tweak the 24 | defaults. In addition to charts, ‘tstools’ provides a super fast, 25 | ‘data.table’ backed time series I/O that allows the user to export / 26 | import long format, wide format and transposed wide format data to 27 | various file types. 28 | 29 | \-\> [pkgdown documentation](https://kof-ch.github.io/tstools/) \<- 30 | 31 | ## Installation 32 | 33 | You can install the development version of tstools from 34 | [GitHub](https://github.com/) with: 35 | 36 | ``` r 37 | # install.packages("remotes") 38 | remotes::install_github("kof-ch/tstools") 39 | ``` 40 | 41 | ## Example Use: Time Series Charts with Legends by Default 42 | 43 | {tstools} lets you draw time series line charts that come with a legend 44 | out-of-the-box. Simply feed the `tsplot()` function with a list of time 45 | series. 46 | 47 | ``` r 48 | library(tstools) 49 | ## basic example code 50 | tsl <- list( 51 | AirPassengers = AirPassengers, 52 | JohnsonJohnson = JohnsonJohnson 53 | ) 54 | 55 | tsplot(tsl) 56 | ``` 57 | 58 | 59 | 60 | and use easily use 2 y-axis. (I know some argue those double axes are 61 | fundamentally flawed, but my peers didn’t care and asked for it.) 62 | 63 | ``` r 64 | tsplot( 65 | "Air Passengers" = tsl$AirPassengers, 66 | tsr = list("Johnson & Johnson" = tsl$JohnsonJohnson) 67 | ) 68 | ``` 69 | 70 | 71 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: ~ 2 | template: 3 | bootstrap: 5 4 | navbar: 5 | structure: 6 | right: [search, github] 7 | 8 | -------------------------------------------------------------------------------- /data/CHGDP.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/KOF-ch/tstools/122c27b8b2a788ab1ecdfef9f96cef209fc90cd7/data/CHGDP.rda -------------------------------------------------------------------------------- /data/KOF.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/KOF-ch/tstools/122c27b8b2a788ab1ecdfef9f96cef209fc90cd7/data/KOF.rda -------------------------------------------------------------------------------- /inst/colors.yaml: -------------------------------------------------------------------------------- 1 | ETH_Blue: 2 | 100: "#007894" 3 | 60: "#66AFC0" 4 | 40: "#99CAD5" 5 | 20: "#CCE4EA" 6 | 7 | ETH_Petrol: 8 | 100: "#007894" 9 | 60: "#66AFC0" 10 | 40: "#99CAD5" 11 | 20: "#CCE4EA" 12 | 13 | ETH_Green: 14 | 100: "#627313" 15 | 80: "#818F42" 16 | 60: "#A1AB71" 17 | 18 | ETH_Bronze: 19 | 100: "#8E6713" 20 | 21 | ETH_Purple: 22 | 100: "#A7117A" 23 | 60: "#CA6CAE" 24 | 40: "#DC9EC9" 25 | 26 | ETH_Grey: 27 | 100: "#6F6F6F" 28 | 80: "#8C8C8C" 29 | 60: "#A9A9A9" 30 | 40: "#C5C5C5" 31 | 20: "#E2E2E2" 32 | 10: "#F1F1F1" 33 | dark: "#575757" 34 | -------------------------------------------------------------------------------- /man/CHGDP.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/CHGDP.R 3 | \docType{data} 4 | \name{CHGDP} 5 | \alias{CHGDP} 6 | \title{CH GDP Growth Contributions} 7 | \format{ 8 | List list of six time series of class ts, 9 | containing contributions to Swiss GDP growth 10 | \describe{ 11 | \item{manufacturing}{Growth contribution of manufacturing.} 12 | \item{energy}{Growth contribution of energy, water sector} 13 | \item{construction}{Growth contribution construction sector.} 14 | \item{hotels}{Growth contribution of hotels.} 15 | \item{fin_insur}{Growth contribution of financial services and insurances.} 16 | \item{other}{Growth contribution of other sectors.} 17 | } 18 | } 19 | \source{ 20 | \url{https://www.seco.admin.ch/seco/en/home/wirtschaftslage---wirtschaftspolitik/Wirtschaftslage/bip-quartalsschaetzungen-/daten.html} 21 | } 22 | \usage{ 23 | CHGDP 24 | } 25 | \description{ 26 | A list of time series containing sector contributions to Swiss GDP over time. 27 | } 28 | \keyword{datasets} 29 | -------------------------------------------------------------------------------- /man/KOF.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/KOF.R 3 | \docType{data} 4 | \name{KOF} 5 | \alias{KOF} 6 | \title{KOF Barometer - Swiss Business Cycle Indicator} 7 | \format{ 8 | A list of two time series of class ts 9 | \describe{ 10 | \item{kofbarometer}{KOF Barometer Indicator}' 11 | \item{reference}{Reference series to KOF Barometer, change in Swiss GDP compared to previous month} 12 | \item{baro_point_fc}{Auto Arima point forecast of the KOF Barometer} 13 | \item{baro_lo_80}{Auto Arima 80 percent CI lower bound of the KOF Barometer forecast} 14 | \item{baro_hi_80}{Auto Arima 80 percent CI upper bound of the KOF Barometer forecast} 15 | \item{baro_lo_95}{Auto Arima 95 percent CI lower bound of the KOF Barometer forecast} 16 | \item{baro_hi_95}{Auto Arima 95 percent CI upper bound of the KOF Barometer forecast} 17 | ... 18 | } 19 | } 20 | \source{ 21 | \url{https://kof.ethz.ch/en/forecasts-and-indicators/indicators/kof-economic-barometer.html} 22 | } 23 | \usage{ 24 | KOF 25 | } 26 | \description{ 27 | A list of time series containing two time series the KOF Barometer and the growth of Swiss GDP over time. KOF Barometer is a monthly business cycle indicator computed by the KOF Swiss Economic Institute. The GDP growth rate is used as a reference series to the Barometer. 28 | } 29 | \keyword{datasets} 30 | -------------------------------------------------------------------------------- /man/color_blind.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/color_blind.R 3 | \name{color_blind} 4 | \alias{color_blind} 5 | \title{Provide Colorblind Compliant Colors} 6 | \usage{ 7 | color_blind() 8 | } 9 | \description{ 10 | 8 Hex RGB color defintions suitable for charts for colorblind people. 11 | } 12 | -------------------------------------------------------------------------------- /man/compute_decimal_time.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{compute_decimal_time} 4 | \alias{compute_decimal_time} 5 | \title{Compute Decimal Time from a ts Period Vector} 6 | \usage{ 7 | compute_decimal_time(v, f) 8 | } 9 | \arguments{ 10 | \item{v}{integer vector denoting a point in time} 11 | 12 | \item{f}{frequency} 13 | } 14 | \description{ 15 | Standard ts object use a vector of length two to store a period. E.g. 2010,1 means first quarter of 2010, 16 | if the series was quarterly and first month if the series was monthly etc. 17 | } 18 | -------------------------------------------------------------------------------- /man/concat_ts.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/concat_ts.R 3 | \name{concat_ts} 4 | \alias{concat_ts} 5 | \title{Concatenate to Non-Overlapping Time Series} 6 | \usage{ 7 | concat_ts(ts1, ts2) 8 | } 9 | \arguments{ 10 | \item{ts1}{object of class ts1, typically the older of two time series.} 11 | 12 | \item{ts2}{object of class ts1, typically the younger of two time series.} 13 | } 14 | \description{ 15 | Append one time series to another. This only works for non-overlapping time series of the same frequency. 16 | For overlapping time series please see \code{\link{resolveOverlap}}. 17 | } 18 | -------------------------------------------------------------------------------- /man/create_cross_sec_overview.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/create_cross_sec_overview.R 3 | \name{create_cross_sec_overview} 4 | \alias{create_cross_sec_overview} 5 | \title{Create an Overview data.table of (last) observations} 6 | \usage{ 7 | create_cross_sec_overview(list_of_rows, col_labels, tsl, selected_period) 8 | } 9 | \arguments{ 10 | \item{list_of_rows}{list of time series names} 11 | 12 | \item{col_labels}{character list of column labels} 13 | 14 | \item{tsl}{list of time series object to select from} 15 | 16 | \item{selected_period}{numeric date as in defining ts objects.} 17 | } 18 | \description{ 19 | Create a data.table that shows the i-th obsersvation of 20 | several time series. 21 | } 22 | \examples{ 23 | tsl <- generate_random_ts(10, lengths = 20) 24 | list_of_rows <- list( 25 | "group 1" = c("ts1", "ts2", "ts3", "ts4"), 26 | "group 2" = c("ts5", "ts6", "ts7", "ts10") 27 | ) 28 | # These are no real +,=,- values just random data. 29 | create_cross_sec_overview( 30 | list_of_rows, 31 | c("+", "=", "-", "random"), 32 | tsl, c(1988, 12) 33 | ) 34 | } 35 | -------------------------------------------------------------------------------- /man/create_dummy_ts.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/create_dummies.R 3 | \name{create_dummy_ts} 4 | \alias{create_dummy_ts} 5 | \title{Flexible Function to Create Time Series Dummy Variables} 6 | \usage{ 7 | create_dummy_ts( 8 | end_basic, 9 | dummy_start, 10 | dummy_end = NULL, 11 | sp = T, 12 | start_basic = c(1980, 1), 13 | basic_value = 0, 14 | dummy_value = 1, 15 | frequency = 4 16 | ) 17 | } 18 | \arguments{ 19 | \item{end_basic}{numeric vector of form c(yyyy,p) defining the end of the time series.} 20 | 21 | \item{dummy_start}{numeric vector of form c(yyyy,p) defining the beginning of the period with different value.} 22 | 23 | \item{dummy_end}{numeric vector of form c(yyyy,p) defining the end of the period with different value. Defaults to NULL, using the end_date of the series.} 24 | 25 | \item{sp}{logical should NULL value for dummy_end lead to a single period dummy (TRUE) or to alternative values until the end.} 26 | 27 | \item{start_basic}{numeric vector of form c(yyyy,p) defining the start of the time series. Defaults to c(1980,1)} 28 | 29 | \item{basic_value}{default value of the time series, defaults to 0.} 30 | 31 | \item{dummy_value}{the alternative value, defaults to 1.} 32 | 33 | \item{frequency}{integer frequency of the regular time series, defaults to 4 (quarterly).} 34 | } 35 | \description{ 36 | Generate time series with a default value that is changed within a certain subperiod. 37 | The function allows for additional convenience when specifying single period dummies and dummies that go from a certain point in time to the end of the series. 38 | } 39 | \author{ 40 | Matthias Bannert 41 | } 42 | -------------------------------------------------------------------------------- /man/df_to_reg_ts.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/df_to_reg_ts.R 3 | \name{df_to_reg_ts} 4 | \alias{df_to_reg_ts} 5 | \title{Turn data.frame to Regular Monthly or Quarterly Time Series} 6 | \usage{ 7 | df_to_reg_ts( 8 | dframe, 9 | var_cols, 10 | year_col = "year", 11 | period_col = "month", 12 | freq = 12, 13 | return_ts = T, 14 | by = NULL 15 | ) 16 | } 17 | \arguments{ 18 | \item{dframe}{data.frame input} 19 | 20 | \item{var_cols}{columns that contain variables as opposed to date index.} 21 | 22 | \item{year_col}{integer, logical or character vector indicating the year 23 | position within the data.frame.} 24 | 25 | \item{period_col}{integer, logical or character vector indicating the period 26 | position within the data.frame.} 27 | 28 | \item{freq}{integer indicating the frequency of new time series.} 29 | 30 | \item{return_ts}{logical should a (list of) time series be returned? Defaults to TRUE. 31 | FALSE returns data.frame.} 32 | 33 | \item{by}{character overwrite automatically detected (from freq) by parameter. 34 | e.g. '1 day'. Defaults to NULL.} 35 | } 36 | \description{ 37 | Turn a data.frame with date columns to a regular time series object 38 | if possible. Design to work with quarterly and monthly data. 39 | } 40 | \examples{ 41 | start_m <- as.Date("2017-01-01") 42 | df_missing <- data.frame( 43 | date = seq(start_m, by = "2 months", length = 6), 44 | value = 1:6, 45 | another_value = letters[1:6], 46 | yet_another_col = letters[6:1] 47 | ) 48 | df_to_reg_ts(df_missing, c("value", "another_value")) 49 | df_to_reg_ts(df_missing, c("value", "another_value"), return_ts = FALSE) 50 | } 51 | -------------------------------------------------------------------------------- /man/dot-read_swissdata_meta_unknown_format.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/read_swissdata_meta.R 3 | \name{.read_swissdata_meta_unknown_format} 4 | \alias{.read_swissdata_meta_unknown_format} 5 | \title{Read Meta Data File w/o File Extension} 6 | \usage{ 7 | .read_swissdata_meta_unknown_format(path) 8 | } 9 | \arguments{ 10 | \item{path}{character file path.} 11 | } 12 | \value{ 13 | Meta list if file could be located, empty list otherwise 14 | } 15 | \description{ 16 | Read a meta file without extension -> unknown format 17 | Tries to determine format (yaml, json) and return the metadata 18 | path must point to the file without extension e.g. swissdata_wd/set_id/set_id 19 | } 20 | -------------------------------------------------------------------------------- /man/figures/README-example-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/KOF-ch/tstools/122c27b8b2a788ab1ecdfef9f96cef209fc90cd7/man/figures/README-example-1.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-2-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/KOF-ch/tstools/122c27b8b2a788ab1ecdfef9f96cef209fc90cd7/man/figures/README-unnamed-chunk-2-1.png -------------------------------------------------------------------------------- /man/fill_year_with_nas.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fill_year_with_nas.R 3 | \name{fill_year_with_nas} 4 | \alias{fill_year_with_nas} 5 | \title{Fill Up a Time Series with NAs} 6 | \usage{ 7 | fill_year_with_nas(x, add_periods = 1, fill_up_start = FALSE) 8 | } 9 | \arguments{ 10 | \item{x}{object of class ts} 11 | 12 | \item{add_periods}{integer periods to add.} 13 | 14 | \item{fill_up_start}{logical should start year be filled up? Defaults to FALSE.} 15 | } 16 | \description{ 17 | When plotting a time series you might want set the range of the plot a little wider than just the start and end date of the original series. This function add fills up the current period (typically year) with NA. 18 | } 19 | -------------------------------------------------------------------------------- /man/generate_random_ts.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/generate_random_ts.R 3 | \name{generate_random_ts} 4 | \alias{generate_random_ts} 5 | \title{Generate a list of random time series} 6 | \usage{ 7 | generate_random_ts( 8 | n = 1, 9 | lengths = 36, 10 | starts = 1988, 11 | frequencies = 12, 12 | ranges_min = -1, 13 | ranges_max = 1, 14 | shifts = 0, 15 | ts_names = sprintf("ts\%d", 1:n), 16 | seed = 30042018, 17 | random_NAs = FALSE, 18 | random_NA_proportions = 0.1, 19 | normally_distributed = FALSE, 20 | normal_means = 0, 21 | normal_sds = 1, 22 | frequency_shifts = FALSE, 23 | frequency_shift_after = 0.5 24 | ) 25 | } 26 | \arguments{ 27 | \item{n}{The number of ts objects to generate} 28 | 29 | \item{lengths}{The lengths of the time series} 30 | 31 | \item{starts}{The start points of the time series in single number notation (e.g. 1990.5)} 32 | 33 | \item{frequencies}{The frequencies of the time series} 34 | 35 | \item{ranges_min}{The minimum values of the time series (if normally_distributed == FALSE)} 36 | 37 | \item{ranges_max}{The maximum values of the time series (if normally_distributed == FALSE)} 38 | 39 | \item{shifts}{The shifts of time series values per series} 40 | 41 | \item{ts_names}{The names of the ts objects in the resulting list} 42 | 43 | \item{seed}{The random seed to be used} 44 | 45 | \item{random_NAs}{Whether or not to introcude NA values at random positions in the ts} 46 | 47 | \item{random_NA_proportions}{The fraction of values to be replaced with NAs if random_NAs is TRUE for the series} 48 | 49 | \item{normally_distributed}{Use normal distribution instead of uniform} 50 | 51 | \item{normal_means}{The means to use for normal distribution. Ignored unless normally_distributed is set to TRUE.} 52 | 53 | \item{normal_sds}{The sds to use for normal distribution. Ignored unless normally_distributed is set to TRUE.} 54 | 55 | \item{frequency_shifts}{Introduce frequency shifts (from 4 to 12) in the ts} 56 | 57 | \item{frequency_shift_after}{After what fraction of the ts to shift frequencies} 58 | } 59 | \value{ 60 | A list of ts objects 61 | } 62 | \description{ 63 | Useful for development or generating easily reproducible examples 64 | } 65 | \details{ 66 | Except for n and ts_names, all parameters accept either a single value or a vector of values. If a single value is 67 | supplied, that value is used for all time series being generated. If a vector is supplied, its values 68 | will be used for the corresponding series (e.g. starts[1] is used for the first series, starts[2] for 69 | the second and so on). Vectors are recycled if n is larger than their length. 70 | 71 | If a ts_names vector is supplied, it must have length n and must not contain duplicates. 72 | } 73 | \examples{ 74 | generate_random_ts() 75 | 76 | generate_random_ts(n = 3, ranges_min = c(-10, 0, 10), ranges_max = 20, starts = 2011) 77 | } 78 | -------------------------------------------------------------------------------- /man/getCiLegendColors.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{getCiLegendColors} 4 | \alias{getCiLegendColors} 5 | \title{Helper to calculate ci colors for legends} 6 | \usage{ 7 | getCiLegendColors(color, n = 1, alpha = NULL) 8 | } 9 | \arguments{ 10 | \item{color}{The color of the ci band} 11 | 12 | \item{n}{The number if ci bands} 13 | 14 | \item{alpha}{The alpha/transparency of the ci band} 15 | } 16 | \value{ 17 | A vector of non-transparent colors that result from 18 | oberlaying color over pure white 1:n times 19 | } 20 | \description{ 21 | Helper to calculate ci colors for legends 22 | } 23 | \details{ 24 | Color may be specified as either a named color or a hex value 25 | Transparency may be specified as a hex value, number 0-255 or number 0-1 26 | } 27 | -------------------------------------------------------------------------------- /man/get_date_vector.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{get_date_vector} 4 | \alias{get_date_vector} 5 | \title{Compute the Period Vector representation of a Decimal Time value} 6 | \usage{ 7 | get_date_vector(dtime, frq) 8 | } 9 | \arguments{ 10 | \item{dtime}{numeric decimal time value denoting a point in time} 11 | 12 | \item{frq}{integer frequency} 13 | } 14 | \description{ 15 | The period value will be rounded down to the nearest integer. 16 | This function is not vectorized so only a single value can be 17 | converted at a time. 18 | } 19 | -------------------------------------------------------------------------------- /man/init_tsplot_theme.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/themes.R 3 | \name{init_tsplot_theme} 4 | \alias{init_tsplot_theme} 5 | \alias{init_tsplot_print_theme} 6 | \title{Initiate Default Theme} 7 | \usage{ 8 | init_tsplot_theme( 9 | auto_bottom_margin = FALSE, 10 | band_fill_color = c(ETH_Petrol = colors$ETH_Petrol$`100`, ETH_Petrol_60 = 11 | colors$ETH_Petrol$`60`, ETH_Petrol_40 = colors$ETH_Petrol$`40`, ETH_Petrol_20 = 12 | colors$ETH_Petrol$`20`, ETH_Purple = colors$ETH_Purple$`100`, ETH_Purple_60 = 13 | colors$ETH_Purple$`60`, ETH_Purple_40 = colors$ETH_Purple$`40`), 14 | bar_border = "#000000", 15 | bar_border_lwd = 1, 16 | bar_fill_color = c(ETH_Petrol = colors$ETH_Petrol$`100`, ETH_Petrol_60 = 17 | colors$ETH_Petrol$`60`, ETH_Petrol_40 = colors$ETH_Petrol$`40`, ETH_Petrol_20 = 18 | colors$ETH_Petrol$`20`, ETH_Purple = colors$ETH_Purple$`100`, ETH_Purple_60 = 19 | colors$ETH_Purple$`60`, ETH_Purple_40 = colors$ETH_Purple$`40`), 20 | bar_gap = 15, 21 | bar_group_gap = 30, 22 | ci_alpha = "44", 23 | ci_colors = line_colors, 24 | ci_legend_label = "\%ci_value\%\% ci for \%series\%", 25 | default_bottom_margin = 15, 26 | fill_up_start = FALSE, 27 | fill_year_with_nas = TRUE, 28 | highlight_color = colors$ETH_Grey$`20`, 29 | highlight_window = FALSE, 30 | highlight_window_end = NA, 31 | highlight_window_freq = 4, 32 | highlight_window_start = NA, 33 | highlight_y_values = NA, 34 | highlight_y_lwd = 2, 35 | highlight_y_color = "#000000", 36 | label_pos = "mid", 37 | legend_all_left = FALSE, 38 | legend_box_size = 2, 39 | legend_col = 1, 40 | legend_font_size = 1, 41 | legend_intersp_x = 1, 42 | legend_intersp_y = 1, 43 | legend_margin_bottom = 5, 44 | legend_margin_top = 12, 45 | legend_seg.len = 2, 46 | line_colors = c(ETH_Green_60 = colors$ETH_Green$`60`, ETH_Green_100 = 47 | colors$ETH_Green$`100`, ETH_Petrol_20 = colors$ETH_Petrol$`20`, ETH_Purple_60 = 48 | colors$ETH_Purple$`60`, ETH_Petrol_60 = colors$ETH_Petrol$`60`, ETH_Purple_100 = 49 | colors$ETH_Purple$`100`, ETH_Petrol_100 = colors$ETH_Petrol$`100`), 50 | line_to_middle = TRUE, 51 | lty = 1, 52 | lwd = c(2, 3, 1, 4, 2, 4), 53 | lwd_box = 1.5, 54 | lwd_quarterly_ticks = 1, 55 | lwd_x_axis = 1.5, 56 | lwd_y_axis = 1.5, 57 | lwd_y_ticks = 1.5, 58 | lwd_yearly_ticks = 1.5, 59 | margins = c(NA, 7, 12, 7), 60 | NA_continue_line = FALSE, 61 | output_wide = FALSE, 62 | point_symbol = 1:18, 63 | pointsize = 12, 64 | preferred_y_gap_sizes = c(25, 20, 15, 10, 5, 2.5, 1, 0.5), 65 | quarterly_ticks = TRUE, 66 | range_must_not_cross_zero = TRUE, 67 | show_left_y_axis = TRUE, 68 | show_points = FALSE, 69 | show_right_y_axis = TRUE, 70 | show_x_axis = TRUE, 71 | show_y_grids = TRUE, 72 | subtitle_adj = 0, 73 | subtitle_adj_r = 0.9, 74 | subtitle_cex = 1, 75 | subtitle_margin = 2, 76 | subtitle_outer = FALSE, 77 | subtitle_transform = "toupper", 78 | sum_as_line = FALSE, 79 | sum_legend = "sum", 80 | sum_line_color = c(ETH_Petrol_100 = colors$ETH_Petrol$`100`), 81 | sum_line_lty = 1, 82 | sum_line_lwd = 3, 83 | tcl_quarterly_ticks = -0.4, 84 | tcl_y_ticks = -0.75, 85 | tcl_yearly_ticks = -0.75, 86 | title_adj = 0, 87 | title_cex.main = 1, 88 | title_margin = 5, 89 | title_outer = FALSE, 90 | title_transform = NA, 91 | total_bar_margin_pct = 0.2, 92 | use_bar_gap_in_groups = FALSE, 93 | use_box = FALSE, 94 | x_tick_dt = 1, 95 | xaxs = "i", 96 | y_grid_color = colors$ETH_Grey$`40`, 97 | y_grid_count = c(5, 6, 8, 10), 98 | y_grid_count_strict = FALSE, 99 | y_las = 2, 100 | y_range_min_size = NULL, 101 | y_tick_force_integers = FALSE, 102 | y_tick_margin = 0.15, 103 | yaxs = "i", 104 | yearly_ticks = TRUE 105 | ) 106 | 107 | init_tsplot_print_theme( 108 | output_wide = FALSE, 109 | margins = c(NA, 10/if (output_wide) 1 + 1/3 else 1, 10, 7/if (output_wide) 1 + 1/3 else 110 | 1), 111 | lwd = scale_theme_param_for_print(c(2, 3, 1, 4, 2, 4), if (output_wide) c(10 + 2/3, 6) 112 | else c(8, 6)), 113 | sum_line_lwd = scale_theme_param_for_print(3, if (output_wide) c(10 + 2/3, 6) else c(8, 114 | 6)), 115 | lwd_box = scale_theme_param_for_print(1.5, if (output_wide) c(10 + 2/3, 6) else c(8, 116 | 6)), 117 | lwd_x_axis = scale_theme_param_for_print(1.5, if (output_wide) c(10 + 2/3, 6) else c(8, 118 | 6)), 119 | lwd_yearly_ticks = scale_theme_param_for_print(1.5, if (output_wide) c(10 + 2/3, 6) 120 | else c(8, 6)), 121 | lwd_quarterly_ticks = scale_theme_param_for_print(1, if (output_wide) c(10 + 2/3, 6) 122 | else c(8, 6)), 123 | lwd_y_axis = scale_theme_param_for_print(1.5, if (output_wide) c(10 + 2/3, 6) else c(8, 124 | 6)), 125 | lwd_y_ticks = scale_theme_param_for_print(1.5, if (output_wide) c(10 + 2/3, 6) else 126 | c(8, 6)), 127 | legend_intersp_y = scale_theme_param_for_print(1, if (output_wide) c(10 + 2/3, 6) else 128 | c(8, 6)), 129 | legend_box_size = scale_theme_param_for_print(2, if (output_wide) c(10 + 2/3, 6) else 130 | c(8, 6)), 131 | legend_margin_top = 8, 132 | legend_margin_bottom = 3, 133 | legend_seg.len = scale_theme_param_for_print(2, if (output_wide) c(10 + 2/3, 6) else 134 | c(8, 6)), 135 | pointsize = scale_theme_param_for_print(12, if (output_wide) c(10 + 2/3, 6) else c(8, 136 | 6)), 137 | ... 138 | ) 139 | } 140 | \arguments{ 141 | \item{auto_bottom_margin}{logical Should the bottom margin be automatically calculated? This will be overridden if margins[1] is not NA. Default FALSE} 142 | 143 | \item{band_fill_color}{character vector of hex colors for the bands if left_as_band == TRUE.} 144 | 145 | \item{bar_border}{character hex colors for the border around bars in bar charts.} 146 | 147 | \item{bar_border_lwd}{numeric The line width of the borders of bars in barplots. Default 1} 148 | 149 | \item{bar_fill_color}{character vector of hex colors for the bars if left_as_bar == TRUE} 150 | 151 | \item{bar_gap}{numeric The width of the gap between bars, in \% of space alloted to the bar.} 152 | 153 | \item{bar_group_gap}{numeric The width of the gap between groups of bars if group_bar_chart is TRUE.} 154 | 155 | \item{ci_alpha}{Numeric 0-255, numeric 0-1 or hey 00-FF, transparency of the confidence interval bands} 156 | 157 | \item{ci_colors}{Named colors or hex values Colors of the confidence interval bands} 158 | 159 | \item{ci_legend_label}{character A formatting template for how the ci bands should be labelled. May contain the 160 | placeholders. '\%ci_value\%' will be replaced with the ci label. '\%series\%' (will be replaced with the series name) 161 | exactly once. Defaults to '\%ci_value\% ci for \%series\%'} 162 | 163 | \item{default_bottom_margin}{numeric The bottom margin to use when margins[1] is NA but neither auto_legend nor auto_bottom_margin are true. Default 3} 164 | 165 | \item{fill_up_start}{logical shoule the start of the year also be filled? Has no effect if fill_year_with_nas == FALSE. Default FALSE} 166 | 167 | \item{fill_year_with_nas}{logical should year be filled up with missing in order to plot the entire year on the axis. Defaults to TRUE,} 168 | 169 | \item{highlight_color}{character hex color code of highlight background, defaults to "#e9e9e9".} 170 | 171 | \item{highlight_window}{logical should a particular time span be highlighted by different background color. Defaults to FALSE.} 172 | 173 | \item{highlight_window_end}{integer vector highlight window start position, defaults to NA.,} 174 | 175 | \item{highlight_window_freq}{integer frequency of the higlight window defintion, defaults to 4.} 176 | 177 | \item{highlight_window_start}{integer vector highlight window start position, defaults to NA.} 178 | 179 | \item{highlight_y_values}{numeric Vector of y values to highlight with a bold line} 180 | 181 | \item{highlight_y_lwd}{integer Line width of the lines to highlight y values} 182 | 183 | \item{highlight_y_color}{character Color of the lines to highlight y values} 184 | 185 | \item{label_pos}{character, denotes where the x-axis label is at. defaults to "mid", alternative value: "start".} 186 | 187 | \item{legend_all_left}{logical Should all legend entries be drawn on the left side of the plot? Default FALSE} 188 | 189 | \item{legend_box_size}{numeric The size of the squares denoting bar colors in the legend. Default 2} 190 | 191 | \item{legend_col}{integer number of columns for the legend, defaults to 3.} 192 | 193 | \item{legend_font_size}{numeric passed on to the \code{cex} parameter of \code{\link{legend}}, defaults to 1} 194 | 195 | \item{legend_intersp_x}{numeric same as base \code{\link{legend}} parameter, defaults to 1} 196 | 197 | \item{legend_intersp_y}{numeric same as base \code{\link{legend}} parameter, defaults to 1} 198 | 199 | \item{legend_margin_bottom}{numeric Distance between bottom of legend and bottom of graphic in \% of device height, default 5} 200 | 201 | \item{legend_margin_top}{numeric Distance between bottom of plot and top of legends \% of device height, defaults to 12} 202 | 203 | \item{legend_seg.len}{numeric Length of the line segments in the legend. Default 2} 204 | 205 | \item{line_colors}{character vector of hex colors for 6 lines.} 206 | 207 | \item{line_to_middle}{logical try to put a line into the middle of the plot. defaults to TRUE.} 208 | 209 | \item{lty}{integer vector line type defaults to 1.} 210 | 211 | \item{lwd}{integer vector line width, defaults to c(2,3,1,4,2,4).} 212 | 213 | \item{lwd_box}{numeric Line width of the box around the plot. Default 1.5} 214 | 215 | \item{lwd_quarterly_ticks}{numeric, width of yearly ticks, defaults to 1.} 216 | 217 | \item{lwd_x_axis}{numeric The line width of the x axis. Default 1.5} 218 | 219 | \item{lwd_y_axis}{numeric The line width of the y axis. Default 1.5} 220 | 221 | \item{lwd_y_ticks}{numeric Line width of the y ticks. Default 1.5} 222 | 223 | \item{lwd_yearly_ticks}{numeric, width of yearly ticks, defaults to 1.5.} 224 | 225 | \item{margins}{integer vector defaults to c(NA, 4, 3, 3) + 0.1. Set margins[1] to NA to automatically determine the bottom margin such that the legend fits (if either auto_legend or auto_bottom_margin are TRUE)} 226 | 227 | \item{NA_continue_line}{boolean If true, NA values in time series are ignored and a contonuous line is drawn. Multiple values to turn this behavior on/off for indivitual series are supported. Default FALSE} 228 | 229 | \item{output_wide}{logical Should the output file be in a wide format (16:9) or (4:3)? Only if output_format is not "plot". Default FALSE} 230 | 231 | \item{point_symbol}{integer or character The symbol to use for marking data points. Multiple values can be supplied to set the symbol for each individual series See \code{pch} in \code{?par}. Default 1:18} 232 | 233 | \item{pointsize}{Numeric Point size of text, in 1/72 of an inch} 234 | 235 | \item{preferred_y_gap_sizes}{numeric c(25, 20, 15, 10, 5, 2.5, 1, 0.5),} 236 | 237 | \item{quarterly_ticks}{logical, should quarterly ticks be shown. Defaults to TRUE.} 238 | 239 | \item{range_must_not_cross_zero}{logical automatic range finders are forced to do not find ranges below zero. Defaults to TRUE.} 240 | 241 | \item{show_left_y_axis}{logical: should left y axis be shown, defaults to TRUE.} 242 | 243 | \item{show_points}{boolean Whether to draw the symbol specified by point_symbol at the data points. Multiple values can be supplied to enable/disable showing points for each individual series Default FALSE} 244 | 245 | \item{show_right_y_axis}{logical: should left y axis be shown, defaults to TRUE.} 246 | 247 | \item{show_x_axis}{locigal: should x axis be shown, defaults to TRUE} 248 | 249 | \item{show_y_grids}{logical should y_grids by shown at all, defaults to TRUE.} 250 | 251 | \item{subtitle_adj}{numeric same as base \code{\link{plot}} parameter, defaults to 0.} 252 | 253 | \item{subtitle_adj_r}{numeric same as base \code{\link{plot}} parameter, defaults to .9} 254 | 255 | \item{subtitle_cex}{numeric same as base \code{\link{plot}} parameter, defaults to 1.} 256 | 257 | \item{subtitle_margin}{numeric How far above the plot the title is placed in \% of the device height. Defaults to 2.} 258 | 259 | \item{subtitle_outer}{logical same as base \code{\link{plot}} parameter, defaults to TRUE} 260 | 261 | \item{subtitle_transform}{function to transform the subtitle, defaults to "toupper",} 262 | 263 | \item{sum_as_line}{logical should the sum of stacked time series be displayed as a line on top of stacked bar charts. Defaults to FALSE,} 264 | 265 | \item{sum_legend}{character Label for the sum line, defaults to "sum". Set to NULL to not label the line at all.} 266 | 267 | \item{sum_line_color}{character hex color of of sum_as_line, defaults "#91056a".} 268 | 269 | \item{sum_line_lty}{integer line type of sum_as_line, defaults to 1.} 270 | 271 | \item{sum_line_lwd}{integer line width of sum_as_line, defaults to 3.} 272 | 273 | \item{tcl_quarterly_ticks}{numeric, length of quarterly ticks. See tcl_yearly_ticks, defaults to -0.4} 274 | 275 | \item{tcl_y_ticks}{numeric Length of y ticks, see \code{tcl_yearly_ticks}. Default -0.75} 276 | 277 | \item{tcl_yearly_ticks}{numeric, length of yearly ticks. Analogous to \code{cex} for \code{\link{axis}}. defaults to -0.75.} 278 | 279 | \item{title_adj}{numeric, same as base \code{\link{plot}} parameter, defaults to 0.} 280 | 281 | \item{title_cex.main}{numeric, same as base \code{\link{plot}} parameter defaults to 1} 282 | 283 | \item{title_margin}{numeric How far above the plot the title is placed in \% of the device height. Default 8} 284 | 285 | \item{title_outer}{logical, currently undocumented. Defaults to TRUE.} 286 | 287 | \item{title_transform}{function to transform the title, defaults to NA.} 288 | 289 | \item{total_bar_margin_pct}{numeric defintion as in base plot, defaults to "i", defaults to .2,} 290 | 291 | \item{use_bar_gap_in_groups}{logical Should there be gaps of size bar_gap between the bars in a group if group_bar_chart = TRUE? Default FALSE} 292 | 293 | \item{use_box}{logical use a box around the plot.} 294 | 295 | \item{x_tick_dt}{numeric The distance between ticks on the x axis in years. The first tick will always be at the start of the plotted time series. Defaults to 1.} 296 | 297 | \item{xaxs}{character axis defintion as in base plot, defaults to "i".} 298 | 299 | \item{y_grid_color}{character hex color of grids. Defaults to gray "#CCCCCC".} 300 | 301 | \item{y_grid_count}{integer vector preferred y grid counts c(5,6,8,10).} 302 | 303 | \item{y_grid_count_strict}{logical should we strictly stick to preferred y grid count? Defaults to FALSE.} 304 | 305 | \item{y_las}{integer, same as base \code{\link{plot}} parameter defaults to 2.} 306 | 307 | \item{y_range_min_size}{= NULL ,} 308 | 309 | \item{y_tick_force_integers}{logical Should y ticks be forced (rounded down) to whole numbers? Default FALSE} 310 | 311 | \item{y_tick_margin}{numeric, minimal percentage of horizontal grid that needs to be clean, i.e., without lines or bars. Defaults to 0.15 (15 percent).} 312 | 313 | \item{yaxs}{character axis defintion as in base plot, defaults to "i".} 314 | 315 | \item{yearly_ticks}{logical, should yearly ticks be shown. Defaults to TRUE.} 316 | 317 | \item{...}{All the other arguments to \code{init_tsplot_thene}} 318 | } 319 | \description{ 320 | The \code{\link{tsplot}} methods provide a theme argument which is used to pass on a plethora of useful defaults. These defaults are essentially stored in a list. Sometimes the user may want to tweak some of these defaults while keeping most of them. 321 | Hence the init_tsplot_theme function create a fresh list object containing default values for lot of different layout parameters etc. By replacing single elements of the list and passing the entire list to the plot function, single aspects can be tweaked while keeping most defaults. Init defaultTheme does not need any parameters. 322 | 323 | This function provides sensible defaults for margins, font size, line width etc. scaled to 324 | the dimensions of the output file. 325 | } 326 | \details{ 327 | Themes are essentially list that contain \code{\link{par}} parameters. Below all items are listed, some of them with comments. 328 | The per-line parameters (\code{line_colors, lwd, lty, show_points, point_symbol}) are recycled if more time series than elements on the corresponding 329 | theme vectors are supplied. e.g. if four time series are plotted but only two line_colors are supplied, the first and third series have the first color, 330 | while the second and fourth series have the second color. 331 | The list contains the following elements: 332 | } 333 | \examples{ 334 | \dontrun{ 335 | # create a list 336 | data(KOF) 337 | tt <- init_tsplot_theme() 338 | # adjust a single element 339 | tt$highlight_window <- TRUE 340 | # pass the list to tsplot 341 | tsplot(KOF$kofbarometer, theme = tt) 342 | # for more theme examples check the vignette 343 | vignette("tstools") 344 | } 345 | 346 | } 347 | \author{ 348 | Matthias Bannert 349 | } 350 | -------------------------------------------------------------------------------- /man/long_to_ts.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/import_helpers.R 3 | \name{long_to_ts} 4 | \alias{long_to_ts} 5 | \title{Transform a long format data.frame of time series to a tslist} 6 | \usage{ 7 | long_to_ts( 8 | data, 9 | keep_last_freq_only = FALSE, 10 | force_xts = FALSE, 11 | strip_nas = TRUE 12 | ) 13 | } 14 | \arguments{ 15 | \item{data}{data.frame The data.frame to be transformed} 16 | 17 | \item{keep_last_freq_only}{in case there is a frequency change in a time series, 18 | should only the part of the series be returned that has the same frequency as 19 | the last observation. This is useful when data start out crappy and then stabilize} 20 | 21 | \item{force_xts}{logical} 22 | 23 | \item{strip_nas}{logical should NAs be stripped (no leading and trailing nas) ?} 24 | } 25 | \description{ 26 | The data.frame must have three columns "date", "value" and "series" (identifying the time series) 27 | } 28 | -------------------------------------------------------------------------------- /man/m_to_q.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/m_to_q.R 3 | \name{m_to_q} 4 | \alias{m_to_q} 5 | \title{Turn monthly series with regular NAs to quarter} 6 | \usage{ 7 | m_to_q(series) 8 | } 9 | \arguments{ 10 | \item{series}{an object of class ts with monthly frequency} 11 | } 12 | \description{ 13 | Monthly series with NAs in non-quarter months are turned to quarterly series. 14 | Series without NAs are just returned. 15 | } 16 | -------------------------------------------------------------------------------- /man/overlap_sorted_ts_lists.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/overlap_sorted_ts_lists.R 3 | \name{overlap_sorted_ts_lists} 4 | \alias{overlap_sorted_ts_lists} 5 | \title{Concat Time Series list wise} 6 | \usage{ 7 | overlap_sorted_ts_lists(listA, listB) 8 | } 9 | \arguments{ 10 | \item{listA}{list of time series} 11 | 12 | \item{listB}{list of time series} 13 | } 14 | \description{ 15 | Concat overlapping time series list wise. List needs 16 | to be of same length. Takes names of list B. 17 | } 18 | -------------------------------------------------------------------------------- /man/overlap_ts_lists_by_name.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/overlap_ts_lists_by_name.R 3 | \name{overlap_ts_lists_by_name} 4 | \alias{overlap_ts_lists_by_name} 5 | \title{Resolve Overlap Listwise, helpful with SA} 6 | \usage{ 7 | overlap_ts_lists_by_name(listA, listB, chunkA = "_f4", chunkB = "_f12") 8 | } 9 | \arguments{ 10 | \item{listA}{list of time series often of lower frequency} 11 | 12 | \item{listB}{list of time series often of higher frequency} 13 | 14 | \item{chunkA}{character chunk representing frequencies, defaults to _f4.} 15 | 16 | \item{chunkB}{character chunk representing frequences, defaults to _f12.} 17 | } 18 | \description{ 19 | Resolve Overlap Listwise, helpful with SA 20 | } 21 | -------------------------------------------------------------------------------- /man/read_swissdata.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/read_swissdata.R 3 | \name{read_swissdata} 4 | \alias{read_swissdata} 5 | \title{Read data generated by the Swissdata project} 6 | \usage{ 7 | read_swissdata( 8 | path, 9 | key_columns = NULL, 10 | filter = NULL, 11 | aggregates = NULL, 12 | keep_last_freq_only = FALSE 13 | ) 14 | } 15 | \arguments{ 16 | \item{path}{character full path to dataset.} 17 | 18 | \item{key_columns}{character vector specifying all columns that should be 19 | part of the key. Defaults to the dim.order specified by swissdata.} 20 | 21 | \item{filter}{function A function that is applied to the raw data.data table after it is read. Useful for 22 | filtering out undesired data.} 23 | 24 | \item{aggregates}{list A list of dimensions over which to aggregate data. The names of this list determing 25 | which function is used to calculate the aggregate (e.g. sum, mean etc.). Defaults to sum.} 26 | 27 | \item{keep_last_freq_only}{in case there is a frequency change in a time series, 28 | should only the part of the series be returned that has the same frequency as 29 | the last observation. This is useful when data start out crappy and then stabilize} 30 | } 31 | \description{ 32 | Read data from swissdata compliant .csv files and 33 | turn them into a list of time series. 34 | } 35 | \details{ 36 | The order of dimensions in key_columns determines their order in the key 37 | The resulting ts_key will be of the form .... 38 | } 39 | \examples{ 40 | ds_location <- system.file("example_data/ch.seco.css.csv", package = "tstools") 41 | tslist <- read_swissdata(ds_location, "idx_type") 42 | tsplot(tslist[1]) 43 | } 44 | -------------------------------------------------------------------------------- /man/read_swissdata_meta.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/read_swissdata_meta.R 3 | \name{read_swissdata_meta} 4 | \alias{read_swissdata_meta} 5 | \title{Read swissdata style yaml timeseries metadata} 6 | \usage{ 7 | read_swissdata_meta(path, locale = "de", as_list = FALSE) 8 | } 9 | \arguments{ 10 | \item{path}{Path to the yaml file to be read} 11 | 12 | \item{locale}{Locale in which to read the data (supported are "de", "fr", "it" and "en")} 13 | 14 | \item{as_list}{Should the output be converted to a list?} 15 | } 16 | \description{ 17 | read_swissdata_meta reads the given .yaml file and converts it into a 18 | per-timeseries format. 19 | } 20 | \details{ 21 | If as_list is set to TRUE, the function returns a nested list with one 22 | element per timeseries, otherwise a data.table with one row per series. 23 | } 24 | -------------------------------------------------------------------------------- /man/read_ts.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/read_ts.R 3 | \name{read_ts} 4 | \alias{read_ts} 5 | \title{Import time series data from a file.} 6 | \usage{ 7 | read_ts( 8 | file, 9 | format = c("csv", "xlsx", "json", "zip"), 10 | sep = ",", 11 | skip = 0, 12 | column_names = c("date", "value", "series"), 13 | keep_last_freq_only = FALSE, 14 | force_xts = FALSE 15 | ) 16 | } 17 | \arguments{ 18 | \item{file}{Path to the file to be read} 19 | 20 | \item{format}{Which file format is the data stored in? If no format is supplied, read_ts will attempt to guess 21 | from the file extension.} 22 | 23 | \item{sep}{character seperator for csv files. defaults to ','.} 24 | 25 | \item{skip}{numeric See data.table's fread.} 26 | 27 | \item{column_names}{character vector denoting column names, defaults to c("date","value","series).} 28 | 29 | \item{keep_last_freq_only}{in case there is a frequency change in a time series, 30 | should only the part of the series be returned that has the same frequency as 31 | the last observation. This is useful when data start out crappy and then stabilize 32 | after a while. Defaults to FALSE. Hence only the last part of the series is returned.} 33 | 34 | \item{force_xts}{If set to true, the time series will be returned as xts objects regargless of 35 | regularity. Setting this to TRUE means keep_last_freq_only is ignored.} 36 | } 37 | \value{ 38 | A named list of ts objects 39 | } 40 | \description{ 41 | If importing from a zip file, the archive should contain a single file with the extension .csv, .xlsx or .json. 42 | } 43 | -------------------------------------------------------------------------------- /man/regularize.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/regularize.R 3 | \name{regularize} 4 | \alias{regularize} 5 | \title{Turn an Irregular Time Series to a Regular, ts-Based Series} 6 | \usage{ 7 | regularize(x) 8 | } 9 | \arguments{ 10 | \item{x}{an irregular time series object of class zoo or xts.} 11 | } 12 | \description{ 13 | Adds missing values to turn an irregular time series into a regular one. This function is currently experimental. Only works or target frequencies 1,2,4,12. 14 | } 15 | \examples{ 16 | ts1 <- rnorm(5) 17 | dv <- c( 18 | seq(as.Date("2010-01-01"), length = 3, by = "3 years"), 19 | seq(as.Date("2018-01-01"), length = 2, by = "2 years") 20 | ) 21 | library(zoo) 22 | xx <- zoo(ts1, dv) 23 | regularize(xx) 24 | 25 | dv2 <- c(seq(as.Date("2010-01-01"), length = 20, by = "1 months")) 26 | dv2 <- dv2[c(1:10, 14:20)] 27 | xx2 <- zoo(rnorm(length(dv2)), dv2) 28 | regularize(xx2) 29 | 30 | } 31 | -------------------------------------------------------------------------------- /man/resolve_ts_overlap.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/resolve_ts_overlap.R 3 | \name{resolve_ts_overlap} 4 | \alias{resolve_ts_overlap} 5 | \title{Concatenate Time Series and Resolve Overlap Automatically} 6 | \usage{ 7 | resolve_ts_overlap(ts1, ts2, keep_ts2 = T, tolerance = 0.001) 8 | } 9 | \arguments{ 10 | \item{ts1}{ts time series, typically the older series} 11 | 12 | \item{ts2}{ts time series, typically the younger series} 13 | 14 | \item{keep_ts2}{logical should ts2 be kept? Defaults to TRUE.} 15 | 16 | \item{tolerance}{numeric when comparing min and max values with a index vector of a time series R runs in to trouble with precision handling, thus a tolerance needs to be set. Typically this does not need to be adjusted. E.g. 2010 != 2010.000. With the help of the tolerance parameter these two are equal.} 17 | } 18 | \description{ 19 | Append time series to each other. Resolve overlap determines 20 | which of two ts class time series is 21 | reaching further and arranges the two series into first and second 22 | series accordingly. Both time series are concatenated to one 23 | if both series had the same frequency. Typically this function is used 24 | concatenate two series that have a certain overlap, but one series clearly 25 | starts earlier while the other lasts longer. If one series starts earlier and 26 | stops later, all elements of the shorter series will be inserted into the 27 | larger series, i.e. elements of the smaller series will replace the elements 28 | of the longer series. Usually ts2 is kept. 29 | } 30 | \examples{ 31 | ts1 <- ts(rnorm(100), start = c(1990, 1), frequency = 4) 32 | ts2 <- ts(1:18, start = c(2000, 1), frequency = 4) 33 | resolve_ts_overlap(ts1, ts2) 34 | 35 | # automatical detection of correction sequence! 36 | ts1 <- ts(rnorm(90), start = c(1990, 1), frequency = 4) 37 | ts2 <- ts(1:60, start = c(2000, 1), frequency = 4) 38 | resolve_ts_overlap(ts1, ts2) 39 | 40 | # both series are of the same length use sequence of arguments. 41 | ts1 <- ts(rnorm(100), start = c(1990, 1), frequency = 4) 42 | ts2 <- ts(1:48, start = c(2003, 1), frequency = 4) 43 | resolve_ts_overlap(ts1, ts2) 44 | ts1 <- ts(rnorm(101), start = c(1990, 1), frequency = 4) 45 | ts2 <- ts(1:61, start = c(2000, 1), frequency = 4) 46 | resolve_ts_overlap(ts1, ts2) 47 | #' clearly dominatn ts2 series 48 | ts1 <- ts(rnorm(50), start = c(1990, 1), frequency = 4) 49 | ts2 <- ts(1:100, start = c(1990, 1), frequency = 4) 50 | resolve_ts_overlap(ts1, ts2) 51 | } 52 | -------------------------------------------------------------------------------- /man/set_month_to_NA.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/set_month_to_NA.R 3 | \name{set_month_to_NA} 4 | \alias{set_month_to_NA} 5 | \title{Set Periods to NA} 6 | \usage{ 7 | set_month_to_NA(series, keep_month = c(1, 4, 7, 10)) 8 | } 9 | \arguments{ 10 | \item{series}{ts object} 11 | 12 | \item{keep_month}{integer vector denoting the months that not be set to NA. 13 | Defaults to c(1,4,7,10)} 14 | } 15 | \description{ 16 | This function is typically used to discard information in non-quarter month. 17 | I.e., data is only kept in January, April, July and December and otherwise set 18 | to NA. In combination with \code{\link{m_to_q}} this function is useful to 19 | turn monthly series into quarterly series by letting the quarter month values 20 | represent the entire quarter. This can be useful when data was interpolated 21 | because of mixing data of different frequencies and needs to be converted 22 | back to a regular, quarterly time series. 23 | } 24 | \examples{ 25 | tsq <- ts(1:20, start = c(1990, 1), frequency = 4) 26 | aa <- tsqm(tsq) 27 | m_to_q(set_month_to_NA(aa)) 28 | 29 | } 30 | -------------------------------------------------------------------------------- /man/start_ts_after_internal_nas.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/start_ts_after_internal_nas.R 3 | \name{start_ts_after_internal_nas} 4 | \alias{start_ts_after_internal_nas} 5 | \title{Start a Time Series after the Last Internal NA} 6 | \usage{ 7 | start_ts_after_internal_nas(series) 8 | } 9 | \arguments{ 10 | \item{series}{on object of class ts} 11 | } 12 | \description{ 13 | Internal NAs can cause trouble for time series operations such as 14 | X-13-ARIMA SEATS seasonal adjustment. Often, internal NAs only occur at 15 | at the beginning of a time series. Thus an easy solution to the problem 16 | is to discard the initial part of the data which contains the NA values. 17 | This way only a small part of the information is lost as opposed to 18 | not being able to seasonally adjust an entire series. 19 | } 20 | \examples{ 21 | ts1 <- 1:30 22 | ts1[c(3, 6)] <- NA 23 | ts1 <- ts(ts1, start = c(2000, 1), frequency = 4) 24 | start_ts_after_internal_nas(ts1) 25 | } 26 | \seealso{ 27 | \code{\link{stripLeadingNAsFromTs}}, \code{\link{stripTrailingNAsFromTs}} 28 | } 29 | -------------------------------------------------------------------------------- /man/strip_nas.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strip_nas.R 3 | \name{strip_ts_of_leading_nas} 4 | \alias{strip_ts_of_leading_nas} 5 | \alias{strip_ts_of_trailing_nas} 6 | \title{Strip Leading / Trailing NAs from a Time Series Object} 7 | \usage{ 8 | strip_ts_of_leading_nas(s) 9 | 10 | strip_ts_of_trailing_nas(s) 11 | } 12 | \arguments{ 13 | \item{s}{an object of class ts.} 14 | } 15 | \description{ 16 | Removes NAs to begin with and starts time series index at the first non-NA value. 17 | } 18 | -------------------------------------------------------------------------------- /man/tsplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tsplot.R 3 | \name{tsplot} 4 | \alias{tsplot} 5 | \title{Plot Time Series} 6 | \usage{ 7 | tsplot( 8 | ..., 9 | tsr = NULL, 10 | ci = NULL, 11 | left_as_bar = FALSE, 12 | group_bar_chart = FALSE, 13 | relative_bar_chart = FALSE, 14 | left_as_band = FALSE, 15 | plot_title = NULL, 16 | plot_subtitle = NULL, 17 | plot_subtitle_r = NULL, 18 | find_ticks_function = "findTicks", 19 | overall_xlim = NULL, 20 | overall_ylim = NULL, 21 | manual_date_ticks = NULL, 22 | manual_value_ticks_l = NULL, 23 | manual_value_ticks_r = NULL, 24 | manual_ticks_x = NULL, 25 | theme = NULL, 26 | quiet = TRUE, 27 | auto_legend = TRUE, 28 | output_format = "plot", 29 | filename = "tsplot", 30 | close_graphics_device = TRUE 31 | ) 32 | } 33 | \arguments{ 34 | \item{...}{multiple objects of class ts or a list of time series. All objects passed through the ... parameter relate to the standard left y-axis.} 35 | 36 | \item{tsr}{list of time series objects of class ts.} 37 | 38 | \item{ci}{list of confidence intervals for time series} 39 | 40 | \item{left_as_bar}{logical should the series that relate to the left bar be drawn as (stacked) bar charts?} 41 | 42 | \item{group_bar_chart}{logical should a bar chart be grouped instead of stacked?} 43 | 44 | \item{relative_bar_chart}{logical Should time series be normalized such that bars range from 0 to 1? Defaults to FALSE. That way every sub bar (time series) is related to the global max. Hence do not expect every single bar to reach 1. This works for stacked and grouped charts and does not change anything but the scale of the chart.} 45 | 46 | \item{left_as_band}{logical Should the time series assigned to the left axis be displayed as stacked area charts?} 47 | 48 | \item{plot_title}{character title to be added to the plot} 49 | 50 | \item{plot_subtitle}{character subtitle to be added to the plot} 51 | 52 | \item{plot_subtitle_r}{character second subtitle to be added at the top right} 53 | 54 | \item{find_ticks_function}{function to compute ticks.} 55 | 56 | \item{overall_xlim}{integer overall x-axis limits, defaults to NULL.} 57 | 58 | \item{overall_ylim}{integer overall y-axis limits, defaults to NULL.} 59 | 60 | \item{manual_date_ticks}{character vector of manual date ticks.} 61 | 62 | \item{manual_value_ticks_l}{numeric vector, forcing ticks to the left y-axis} 63 | 64 | \item{manual_value_ticks_r}{numeric vector, forcing ticks to the right y-axis} 65 | 66 | \item{manual_ticks_x}{numeric vector, forcing ticks on the x axis} 67 | 68 | \item{theme}{list of default plot output parameters. Defaults to NULL, which leads to \code{\link{init_tsplot_theme}} being called. Please see the vignette for details about tweaking themes.} 69 | 70 | \item{quiet}{logical suppress output, defaults to TRUE.} 71 | 72 | \item{auto_legend}{logical should legends be printed automatically, defaults to TRUE.} 73 | 74 | \item{output_format}{character Should the plot be drawn on screen or written to a file? Possible values are "plot" for screen output and "pdf". Default "plot"} 75 | 76 | \item{filename}{character Path to the file to be written if \code{output_format} is "pdf". Default "tsplot.pdf"} 77 | 78 | \item{close_graphics_device}{logical Should the graphics device of the output file be closed after \code{tsplot}? Set this to FALSE to be able to make modifications to the plot after \code{tsplot} finishes. Default TRUE} 79 | } 80 | \description{ 81 | Conveniently plot time series. 82 | } 83 | \details{ 84 | The ci parameter is a 3-level list of the form 85 | list( 86 | ts1 = list( 87 | ci_value_1 = list( 88 | ub = upper_bound_ts_object, 89 | lb = lower_bound_ts_object 90 | ), 91 | ... 92 | ), 93 | ... 94 | ) 95 | 96 | See \code{vignette("tstools")} for details. 97 | } 98 | -------------------------------------------------------------------------------- /man/tsqm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tsqm.R 3 | \name{tsqm} 4 | \alias{tsqm} 5 | \title{Interpolate quarterly time series into monthly} 6 | \usage{ 7 | tsqm(qts) 8 | } 9 | \arguments{ 10 | \item{qts}{quarterly time series} 11 | } 12 | \description{ 13 | Repeat quarterly variables two times to generate a monthly variable. 14 | } 15 | \examples{ 16 | tsq <- ts(1:20, start = c(1990, 1), frequency = 4) 17 | tsqm(tsq) 18 | 19 | } 20 | -------------------------------------------------------------------------------- /man/tstools-deprecated.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/deprecated.R 3 | \name{tstools-deprecated} 4 | \alias{tstools-deprecated} 5 | \alias{computeDecimalTime} 6 | \alias{concatTs} 7 | \alias{fillupYearWitnNAs} 8 | \alias{importTimeSeries} 9 | \alias{initDefaultTheme} 10 | \alias{overlapSortedLists} 11 | \alias{overlapTslByName} 12 | \alias{resolveOverlap} 13 | \alias{stripLeadingNAsFromTs} 14 | \alias{stripTrailingNAsFromTs} 15 | \alias{writeTimeSeries} 16 | \title{Deprecated function(s) in tstools} 17 | \arguments{ 18 | \item{...}{Parameters to be passed to the modern version of the function} 19 | } 20 | \description{ 21 | These functions are provided for compatibility with older version of 22 | the tstools package. They may eventually be completely 23 | removed. 24 | } 25 | \section{Details}{ 26 | 27 | \tabular{rl}{ 28 | \code{computeDecimalTime} \tab now a synonym for \code{\link{compute_decimal_time}}\cr 29 | \code{concatTs} \tab now a synonym for \code{\link{concat_ts}}\cr 30 | \code{fillupYearWitnNAs} \tab now a synonym for \code{\link{fill_year_with_nas}}\cr 31 | \code{importTimeSeries} \tab now a synonym for \code{\link{read_ts}}\cr 32 | \code{init_tsplot_theme} \tab now a synonym for \code{\link{init_tsplot_theme}}\cr 33 | \code{overlapSortedLists} \tab now a synonym for \code{\link{overlap_sorted_ts_lists}}\cr 34 | \code{overlapTslByName} \tab now a synonym for \code{\link{overlap_ts_lists_by_name}}\cr 35 | \code{resolveOverlap} \tab now a synonym for \code{\link{resolve_ts_overlap}}\cr 36 | \code{stripLeadingNAsFromTs} \tab now a synonym for \code{\link{strip_ts_of_leading_nas}}\cr 37 | \code{stripTrailingNAsFromTs} \tab now a synonym for \code{\link{strip_ts_of_trailing_nas}}\cr 38 | \code{writeTimeSeries} \tab now a synonym for \code{\link{write_ts}}\cr 39 | } 40 | } 41 | 42 | -------------------------------------------------------------------------------- /man/wide_to_ts.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/import_helpers.R 3 | \name{wide_to_ts} 4 | \alias{wide_to_ts} 5 | \title{Transform a wide format data.frame into a tslist} 6 | \usage{ 7 | wide_to_ts(data, keep_last_freq_only = FALSE, force_xts = FALSE) 8 | } 9 | \arguments{ 10 | \item{data}{data.frame The data.frame to be transformed} 11 | 12 | \item{keep_last_freq_only}{in case there is a frequency change in a time series, 13 | should only the part of the series be returned that has the same frequency as 14 | the last observation. This is useful when data start out crappy and then stabilize 15 | after a while. Defaults to FALSE. Hence only the last part of the series is returned.} 16 | 17 | \item{force_xts}{boolean force xts format? Defaults to FALSE.} 18 | } 19 | \description{ 20 | The time series in the data.frame may be stored either rowwise or columnswise. 21 | The identifying column must be called date (for columnwise) or series (for rowwise) 22 | } 23 | -------------------------------------------------------------------------------- /man/write_ts.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/write_ts.R 3 | \name{write_ts} 4 | \alias{write_ts} 5 | \title{Export a list of time series to a file.} 6 | \usage{ 7 | write_ts( 8 | tl, 9 | fname = NULL, 10 | format = "csv", 11 | date_format = NULL, 12 | timestamp_to_fn = FALSE, 13 | round_digits = NULL, 14 | rdata_varname = "tslist", 15 | ... 16 | ) 17 | } 18 | \arguments{ 19 | \item{tl}{list of time series} 20 | 21 | \item{fname}{character file name. Defaults to NULL, displaying output on console. Set a file name without file extension in order to store a file. Default file names / location are not CRAN compliant which is why the file name defaults to NULL.} 22 | 23 | \item{format}{character denotes export formats. Defaults to .csv. "csv", "xlsx", "json", "rdata" are available. Spreadsheet formats like csv allow for further optional parameters.} 24 | 25 | \item{date_format}{character denotes the date format. Defaults to NULL. If set to null the default is used: Jan 2010.} 26 | 27 | \item{timestamp_to_fn}{If TRUE, the current date will be appended to the file name. Defaults to FALSE.} 28 | 29 | \item{round_digits}{integer, precision in digits.} 30 | 31 | \item{rdata_varname}{character name of the list of time series within the store RData. Defaults to "tslist".} 32 | 33 | \item{...}{additional arguments used by spedific formats.} 34 | } 35 | \description{ 36 | Export a list of time series to a file. 37 | } 38 | \details{ 39 | Additional arguments covered by \code{...} 40 | \tabular{lll}{ 41 | \strong{Name} \tab \strong{Effect} \tab \strong{Format(s)} \cr 42 | \code{wide} \tab Export data in a wide format (one column per series) \tab CSV, XLSX \cr 43 | \code{transpose} \tab Transpose exported data (one row per series) \tab CSV, XLSX, only if wide = TRUE \cr 44 | \code{zip} \tab If set to TRUE, the file is compressed into a zip archive after export \tab any \cr 45 | } 46 | } 47 | -------------------------------------------------------------------------------- /vignettes/tstools.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "tstools" 3 | subtitle: "A Time Series Toolbox for Official Statistics" 4 | author: "Matthias Bannert" 5 | date: "`r Sys.Date()`" 6 | output: rmarkdown::html_vignette 7 | vignette: > 8 | %\VignetteIndexEntry{A Time Series Toolbox for Official Statistics} 9 | %\VignetteEngine{knitr::rmarkdown} 10 | %\usepackage[utf8]{inputenc} 11 | --- 12 | 13 | # About tstools 14 | The *tstools* package provides convenience functions to process, plot and export time series. It was designed for users from the fields of official statistics and macroeconomics. The package is focused on regular time series of monthly and quarterly as well as yearly frequency. By summer 2018, most of the functionality provided by *tstools* deals with plotting and exporting time series and so does this manual. 15 | 16 | 17 | 18 | ## Why yet another time series package? 19 | If you have ever thought (or heard) ``I can't believe it's so disgusting to create simple plots with 2 y-axes of different scales.``, or ``This R thing can't do time series bar charts 'properly' - even Excel can do this. I don't get the hype.`` or ``Why isn't the 2010 label in the middle of the year?`` **tstools** is for you. 20 | 21 | In other words, whenever the 'business' directly works with code, they wonder why, e.g., legends are not placed automatically where they ought to be. In addition to make plotting more convenient and fun, the main goal of **tstools** is to provide a simple environment for production reports and a stand alone plots that focus around time series. 22 | 23 | Instead of claiming that the business is wrong, limits flexibility or that their visual concepts are flawed, **tstools** tries to provide a solution that helps economists and establishment statisticians to work and plot conveniently using R. 24 | 25 | Replace *automatically* with *by default* and you understand how **tstools** essentially works. The package uses R's base plot functionality and sets a plethora of defaults, that in combination with each other make the plots look nifty. All the package does when it comes to plotting, is try to guess what the user wants when they call *tsplot*. 26 | 27 | The following sections will show some examples of popular time series plots that *used* to be hard to get in R: 28 | 29 | - (line) charts with 2 y-axes but matching grids 30 | - charts with highlighted time spans 31 | - slick fan charts 32 | - time series bar charts with negative and positive growth contributions 33 | - charts with a continous time x-axis 34 | - charts with a default legend 35 | 36 | # Graphs 37 | *tstools* produces base R plots. Hence all resulting plots can simply be extended by further calls to base R plot functions. Base R plots look rather technical and raw, which is why **tstools** tries to set a ton of useful defaults to make time series plots look fresh and clean from the start. 38 | 39 | ## Basic usage 40 | Plotting with *tstools* is easy. There is only one generic plotting function called **tsplot**. Depending on what time series objects are passed on to the function, the method dispatcher chooses the right method and plots the graph. The following sections will walk through several applied plotting examples. Horizontal grids that suit two axes, automatic shifting of series to the middle of the period, colors, line types, filling up started years and many other features come as convenient defaults. Yet, all of these defaults can be adjusted using *themes*. 41 | 42 | ## Before we get started... 43 | 44 | ... let's set up some data for our reproducible examples first. 45 | Let's do this separately so we can really focus on the **tstools** specific code in our discussion of the examples. Don't get confused, plotting is really easy, creating random data or reading in data in order to make the examples reproducible is what costs us some extra lines of code here. 46 | 47 | ```{r,echo=TRUE,message=FALSE,warning=FALSE} 48 | library(tstools) 49 | data(KOF) 50 | short <- window(KOF$kofbarometer, 51 | start = c(2007, 1), 52 | end = c(2014, 1) 53 | ) 54 | 55 | # list of time series 56 | ts1 <- ts(runif(40, -10, 40), start = c(1995, 1), freq = 4) 57 | ts2 <- ts(runif(80, 0, 50), start = c(2000, 1), freq = 12) 58 | 59 | tslist <- list() 60 | tslist$ts1 <- ts1 61 | tslist$ts2 <- ts2 62 | 63 | # data for stacked bar charts... 64 | tsb1 <- ts(runif(30, -30, 20), start = c(2010, 1), frequency = 4) 65 | tsb2 <- ts(runif(30, 0, 50), start = c(2010, 1), frequency = 4) 66 | tsb3 <- ts(runif(30, 0, 50), start = c(2010, 1), frequency = 4) 67 | 68 | 69 | min_series <- ts(runif(10, -10, 40), start = c(1995, 1), freq = 4) 70 | min_series_2 <- ts(runif(25, -20, 40), start = c(1995, 1), freq = 12) 71 | 72 | min_series_3 <- ts(runif(25, -20, 40), start = c(1995, 1), freq = 4) 73 | 74 | 75 | 76 | min_li <- list( 77 | series1 = min_series, 78 | series2 = min_series_2, 79 | series3 = min_series_3 80 | ) 81 | 82 | 83 | missings <- ts(c(1, 2, 10, 3, 5, 6, NA, NA, 3, 2, 5, 3, 1, 1), 84 | start = c(1995, 1), freq = 4 85 | ) 86 | ``` 87 | 88 | 89 | 90 | ## Single time series: line chart 91 | The most basic example of a time series plot is a time series line chart. The object *short* is of class ts. 92 | 93 | ```{r,fig.width = 7,fig.height=6,message=FALSE} 94 | tsplot(short) 95 | ``` 96 | 97 | ## Multiple time series (same y-axis) in one line chart 98 | The function *tsplot* can handle multiple time series objects or lists at once. You can either throw multiple comma separated time series objects at *tsplot* 99 | 100 | ```{r,fig.width = 7,fig.height=6} 101 | tsplot(ts1, ts2, auto_legend = FALSE) 102 | ``` 103 | 104 | or a list of time series... 105 | 106 | ```{r,fig.width = 7,fig.height=6} 107 | tsplot(tslist, auto_legend = FALSE) 108 | ``` 109 | 110 | Even though *tsplot* supports *mts* and single time series, we clearly recommend to pass lists of time series to *tsplot* for the best and most tested experience. Lists are a convenient way to add legends to time series charts as *tsplot* automatically uses names of list elements in its legend. You may also define your lists adhoc within the *tsplot* call like so: 111 | 112 | ```{r,fig.width = 7,fig.height=6} 113 | tsplot(list( 114 | "Time Series 1" = ts1, 115 | "Time Series 2" = ts2 116 | )) 117 | ``` 118 | 119 | ## Auto-scale grids are there to help you, how to configure them! 120 | 121 | The latest release has considerably improved finding suitable scale and grids 122 | automatically. One improvement is the ability to detect not only the minimum 123 | necessary range, but also to check whether some value is so close the x-axis 124 | that most users prefer an extra grid to have a little extra breathing room. 125 | If there's less than 15 percent of the bottom or grid left, *tsplot* automatically adds another 126 | grid. 127 | 128 | The following example tweaks this 15 percent margin to an exaggerated 70 percent, 129 | in order to show that an extra grid up top is added because the *y_tick_margin* 130 | parameter implies now that 70 percent of the outer most grid needs to stay clean. 131 | 132 | 133 | ```{r} 134 | tsplot(short, 135 | theme = init_tsplot_theme(y_tick_margin = .7) 136 | ) 137 | ``` 138 | 139 | ## Manual value ticks 140 | Often you just want to have a fixed scale, e.g., for an index that ranges from 0 to 100. Simply use the ``manual_value_ticks_l`` and ``manual_value_ticks_r`` arguments to specify manual ticks and grids. 141 | In case you use 2 y-axes make sure both manual value tick vectors are of the same length. 142 | 143 | ```{r} 144 | tsplot(KOF["kofbarometer"], 145 | manual_value_ticks_l = seq(60, 120, by = 20) 146 | ) 147 | ``` 148 | 149 | 150 | 151 | ## Fan Charts: Plotting Confidence Intervals 152 | 153 | *tsplot* can assign confidence intervals to every 154 | time series line. Simply choose the line and confidence level and define an upper 155 | and lower bound *ts* object to draw shaded confidence bounds around a respective series. A confidence interval definition is basically a nested list. For the sake of clear code, it is recommended to define the CI list separately like so: 156 | 157 | ```{r,fig.width = 7,fig.height=6} 158 | # Define confidence intervals 159 | ci <- list( 160 | "KOF Barometer" = list( 161 | "80" = list( 162 | lb = KOF$baro_lo_80, 163 | ub = KOF$baro_hi_80 164 | ), 165 | "95" = list( 166 | lb = KOF$baro_lo_95, 167 | ub = KOF$baro_hi_95 168 | ) 169 | ) 170 | ) 171 | 172 | tsplot(list("KOF Barometer" = KOF$baro_point_fc), 173 | ci = ci 174 | ) 175 | ``` 176 | 177 | The KOF data example dataset contains an *auto.arima* point forecast of the KOF Barometer as well as upper and lower bound at the 80% and 95% confidence level. Notice that *tsplot* does **not** do any forecasting or estimation of confidence bands, it simply takes some time series as upper and lower bounds and assigns them to a particular series. Thus it's agnostic of the estimation method. 178 | 179 | ## Stacked Bar Chart 180 | Sometimes we want to display time series as bar charts. Most plotting engines 181 | understand bar charts as something that has a categorical x-axis. So even if 182 | you have time on the x-axis, periods are treated as categories, 183 | which implies that a bar is centered above the category tick for that period. 184 | *tstools* treats the x-axis for bar charts as continous and allows a quarterly series to truly represent an entire quarter. Note that stacked bar charts imply that all involved series have the same frequency. 185 | 186 | ```{r,fig.width = 7,fig.height=6} 187 | tsplot(tsb1, tsb2, tsb3, 188 | left_as_bar = TRUE, 189 | auto_legend = FALSE, 190 | theme = init_tsplot_theme(bar_gap = 10) 191 | ) 192 | ``` 193 | 194 | Notice that the gap size of the gap between the bars can be adjusted using the **bar_gap** theme parameter. 195 | 196 | 197 | ## Sum as line in stacked bar charts 198 | 199 | One of the reasons for using bar charts with time series is 200 | to add up positive and negative contributions. In this case it is also 201 | helpful to be able to add the sum of the components to plot on a per period 202 | basis. The following draws a line on top of the bars that represents the sum. 203 | 204 | ```{r,fig.width = 7,fig.height=6} 205 | tsl <- list(tsb1, tsb2, tsb3) 206 | tsplot(tsl, 207 | left_as_bar = TRUE, 208 | manual_value_ticks_l = seq(-40, 100, by = 20), 209 | auto_legend = FALSE, 210 | theme = init_tsplot_theme(sum_as_line = TRUE) 211 | ) 212 | ``` 213 | 214 | ## Stacked bar charts with different start and end dates 215 | 216 | It is even possible, to produce stacked bar charts from time series 217 | of different start and end dates. 218 | 219 | ```{r,fig.width = 7,fig.height=6} 220 | tsb1 <- ts(runif(30, -30, 20), start = c(2010, 1), frequency = 4) 221 | tsb2 <- ts(runif(30, 0, 50), start = c(2010, 1), frequency = 4) 222 | tsb3 <- ts(runif(30, 0, 50), start = c(2010, 1), frequency = 4) 223 | tsb4 <- ts(runif(30, -40, 10), start = c(2005, 1), frequency = 4) 224 | tsplot(tsb1, tsb2, tsb3, tsb4, 225 | left_as_bar = TRUE, 226 | auto_legend = FALSE 227 | ) 228 | ``` 229 | ### Grouped bar charts 230 | 231 | When different variables got the same scale, but cannot be aggregated 232 | we want to display time series bars next to each other instead of stacking 233 | them. In **tstools** stacking is the default but it can easily be tweaked using 234 | the *group_bar_chart parameter. 235 | 236 | ```{r,fig.width = 7,fig.height=6} 237 | tsb1 <- ts(runif(20, -30, 20), start = c(2010, 1), frequency = 12) 238 | tsb2 <- ts(runif(20, 0, 50), start = c(2010, 1), frequency = 12) 239 | tsb3 <- ts(runif(20, 0, 50), start = c(2010, 1), frequency = 12) 240 | tsplot(tsb1, tsb2, tsb3, 241 | left_as_bar = TRUE, 242 | group_bar_chart = TRUE, 243 | auto_legend = FALSE 244 | ) 245 | ``` 246 | 247 | 248 | ## Stacked Area Charts 249 | 250 | Stacked area charts are another way of stacking time series. 251 | They might be more illustrative than stacked bar charts, but are subject to 252 | certain limitations: plots always start at zero and all series need to be 253 | either positive or negative. 254 | 255 | ```{r,fig.width = 7,fig.height=6} 256 | set.seed(123) 257 | tslist <- generate_random_ts(4, 258 | starts = 1987:1990, 259 | ranges_min = 1, 260 | ranges_max = 3 261 | ) 262 | tsplot(tslist, left_as_band = TRUE) 263 | ``` 264 | 265 | 266 | 267 | ## Multiple Y-axis with different scales (line charts) 268 | In order to compare indicators it's covenient in some domains to plot 269 | two time series of completely different scale, e.g., a growth rate and 270 | an indicator indexed at 100, to each other. Whenever the absolute level 271 | is not overly interesting but rather the lead-lag structure and the 272 | co-movement, 2 y-axes with different scales are popular. Hence *tsplot* 273 | introduces a second argument, *tsr* (time series right), which takes either 274 | an object of class ts or a list of time series. 275 | 276 | ```{r,fig.width = 7,fig.height=6} 277 | data(KOF) 278 | tsplot(KOF$kofbarometer, 279 | tsr = KOF$reference, auto_legend = FALSE 280 | ) 281 | ``` 282 | 283 | 284 | ## Multiple Y-axes with different scales (bar and line charts) 285 | Sometimes you want a bar chart on one axis and an line chart on the other. 286 | Guess what, *tstools* also has a convenient way of creating these. Simply 287 | provide a list of time series to both the ... argument and the tsr argument 288 | and choose *left_as_bar = TRUE*. Note that the line chart is automatically moved 289 | to the middle of the quarterly bar. 290 | 291 | ```{r,fig.width = 7,fig.height=6} 292 | tsb1 <- ts(runif(30, -30, 20), start = c(2010, 1), frequency = 4) 293 | tsb2 <- ts(runif(30, 0, 30), start = c(2010, 1), frequency = 4) 294 | tsb3 <- ts(runif(30, 0, 30), start = c(2010, 1), frequency = 4) 295 | tsr1 <- ts(runif(30, -4, 6), start = c(2010, 1), frequency = 4) 296 | tsplot(tsb1, tsb2, tsb3, 297 | tsr = tsr1, 298 | left_as_bar = TRUE, 299 | auto_legend = FALSE 300 | ) 301 | ``` 302 | 303 | ## Y-Grids: automatic vs. manual 304 | *tstools* tries to guess a reasonable number of ticks (and horizontal grids). 305 | This can be tricky when several time series and multiple axes are involved. 306 | *tstools'* standard procedure uses value ranges and a logarithm based algorithm to find the order of magnitude of a scale. Further *tstools* brute forces through a number of reasonable tick counts and chooses a suitable number of ticks. In case there is more than one y-axis the choice will be passed on to the other axis. 307 | 308 | ## Using another function 309 | However, there are countless possibilities and the number of ticks and grids may come down to a matter of personal taste. Hence, *tstools* provides not only the flexibility to set grids manually, you can even pass another algorithm implemented in you very own R function that gives back a vector of ticks. Simply pass a function to the ``find_ticks_function`` argument. Currently range, and potential tick count are fixed as arguments to these functions, but hopefully passing other sets of arguments will be possible soon. 310 | 311 | 312 | ## Tweaking the defaults: Themes 313 | Font size, line color, bar color, grid color, show or not show grid, and a plethora of 314 | other options would lead to a ton of parameters. If you had to specify all of those, 315 | it would be time consuming task to create a quick explorative plot. So *tstools* 316 | suggests many defaults to many parameters and stores these parameters in lists called 317 | themes. To tweak a default, simply initialize the default theme, tweak a single list element 318 | and pass the entire theme to *tsplot*. By doing so you can also define 319 | properties of multiple plots just by passing the new theme to the *tsplot* call. 320 | 321 | ```{r} 322 | def_theme <- init_tsplot_theme() 323 | names(def_theme) 324 | ``` 325 | 326 | Please take a look at the help file (`?init_tsplot_theme`) for a comprehensive 327 | list and documenatation of all theme parameters. The hand-picked examples below 328 | should give you an idea of how much you can do with themes and how to use 'em. 329 | 330 | 331 | ### Highlight windows: mark a period 332 | 333 | Let's assume the last 2 years of the time series are a forecast which should be 334 | highlight by a shaded area behind the actual series. If you know in advance 335 | which default parameter -- in this case *highlight_window = FALSE* -- 336 | you want to overwrite, I recommend to do so right in your calll to *init_tsplot_theme*. 337 | The cool thing about it is: R Studio's auto auggest helps you find the parameter. 338 | **Pro tip**: If you do not plan to reuse your theme in another plot, specify the 339 | parameter directly in function call. 340 | 341 | ```{r,fig.width = 7,fig.height=6} 342 | tsplot(tsb1, tsb2, tsb3, 343 | left_as_bar = TRUE, 344 | theme = init_tsplot_theme(highlight_window = TRUE) 345 | ) 346 | ``` 347 | 348 | ### Add a Box Around Your Plot 349 | 350 | ```{r,fig.width = 7,fig.height=6} 351 | tt <- init_tsplot_theme(use_box = TRUE) 352 | tsplot(tsb1, tsb2, tsb3, 353 | tsr = tsr1, 354 | left_as_bar = TRUE, 355 | theme = tt 356 | ) 357 | ``` 358 | 359 | 360 | ### Change line types... 361 | 362 | Note how you can simply change existing themes 363 | 364 | ```{r,fig.width = 7,fig.height=6} 365 | tt$lty <- c(3, 2, 1) 366 | tsplot(tsb1, tsb2, tsb3, 367 | theme = tt 368 | ) 369 | ``` 370 | 371 | ### Adjust the highlight window 372 | 373 | ```{r,fig.width = 7,fig.height=6} 374 | nt <- init_tsplot_theme(highlight_window = TRUE) 375 | nt$highlight_window_start <- c(2017, 1) 376 | nt$highlight_window_end <- c(2018, 1) 377 | tsplot(tsb1, tsb2, 378 | theme = nt 379 | ) 380 | ``` 381 | 382 | ### Handling missings (NA Handling) 383 | 384 | 385 | ```{r,fig.width = 7,fig.height=6,echo=TRUE} 386 | tsplot(missings, 387 | theme = init_tsplot_theme( 388 | NA_continue_line = TRUE, 389 | show_points = TRUE 390 | ) 391 | ) 392 | ``` 393 | 394 | 395 | ### Fill up Year With NAs 396 | 397 | ```{r,fig.width = 7,fig.height=6,echo=TRUE} 398 | tsplot(ts2) 399 | ``` 400 | 401 | 402 | ## #Fill up Year With NAs 403 | 404 | 405 | ```{r,fig.width = 7,fig.height=6,echo=TRUE} 406 | tsplot(ts2, 407 | theme = init_tsplot_theme(fill_year_with_nas = FALSE) 408 | ) 409 | ``` 410 | 411 | 412 | ### Legends 413 | 414 | ## Assign Names to Single Objects 415 | 416 | ```{r,fig.width = 7,fig.height=6,echo=TRUE} 417 | tsplot( 418 | "An arbitrary ts object" = ts1, 419 | "another ts object" = ts2 420 | ) 421 | ``` 422 | 423 | 424 | 425 | ## Legends Based on Names of List Elements 426 | 427 | ```{r,echo=TRUE} 428 | names(tslist) 429 | ``` 430 | 431 | ## Legends Based on Names of List Elements 432 | 433 | ```{r,fig.width = 7,fig.height=6,echo=TRUE} 434 | tsplot(tslist) 435 | ``` 436 | 437 | 438 | 439 | ## Legends: multiple columns 440 | 441 | ```{r,fig.width = 7,fig.height=6,echo=TRUE} 442 | tsplot(min_li, 443 | theme = init_tsplot_theme(legend_col = 2) 444 | ) 445 | ``` 446 | 447 | 448 | ## Legends Left and Right Y-Axis 449 | 450 | ```{r,fig.width = 7,fig.height=6,echo=TRUE} 451 | tsplot(KOF["kofbarometer"], 452 | tsr = KOF["reference"] 453 | ) 454 | ``` 455 | 456 | 457 | ## Force all Legends to the Left 458 | 459 | ```{r,fig.width = 7,fig.height=6,echo=TRUE} 460 | tsplot(KOF["kofbarometer"], 461 | tsr = list("reference (right scale)" = KOF$reference), 462 | theme = init_tsplot_theme(legend_all_left = TRUE) 463 | ) 464 | ``` 465 | 466 | ## Line Breaks in Legends 467 | 468 | ```{r,fig.width = 7,fig.height=6,echo=TRUE} 469 | tsplot("Some like\n loooong legends\n with so many words" = ts1) 470 | ``` 471 | 472 | ## Remember: auto_legend = FALSE 473 | 474 | ```{r,fig.width = 7,fig.height=6,echo=TRUE} 475 | tsplot(KOF[1], auto_legend = FALSE) 476 | ``` 477 | 478 | 479 | 480 | 481 | 482 | 483 | 484 | 485 | 486 | 487 | 488 | 489 | 490 | 491 | 492 | 493 | 494 | 495 | 496 | 497 | 498 | 499 | 500 | 501 | 502 | 503 | 504 | 505 | 506 | # Export your chart to .pdf 507 | 508 | Saving your **tstools** chart to a .pdf document is as easy and convenient as 509 | 510 | ```{r,eval=FALSE} 511 | tsplot(KOF[1], 512 | output_format = "pdf", 513 | theme = init_tsplot_print_theme(output_wide = TRUE) 514 | ) 515 | ``` 516 | 517 | Notice the optional print theme and *output_wide* parameter: You can export 4:3 (default) format .pdf files as well as 16:9 (wide) using the convenience *output_format* theme parameter. Notice also that you do not necessarily have to use the print theme. What is important is not to wrap the call in `pdf()` and `dev.off()` calls 518 | when using the `output_format="pdf"` option. 519 | 520 | 521 | 522 | 523 | 524 | # Export lists of time series 525 | 526 | The latest release of **tstools** contains a major overhaul of its export 527 | functionality. Exporting time series to csv is up to 400 times faster than before, 528 | thanks to some profiling sessions and the inclusion of data.table (thanks Matt Dowle for the 529 | awesome package). While this may not be that big of an achievement for some, those 530 | who export hundreds of thousands or millions of time series will like it. 531 | 532 | Besides the default .csv, .json, .xlsx, and .RData are available. 533 | .csv allows for wide format and transposed wide format output. 534 | 535 | ## Csv: long format (default), wide format, transposed wide format. 536 | 537 | ```{r,eval=FALSE} 538 | data(KOF) 539 | write_ts(KOF, file.path(tempdir(), "test_export"), "csv") 540 | ``` 541 | 542 | ```{r,eval=FALSE} 543 | write_ts(KOF, file.path(tempdir(), "test_export_wide_trans"), 544 | "csv", 545 | wide = TRUE, 546 | transpose = TRUE 547 | ) 548 | ``` 549 | 550 | *transpose = TRUE* moves the time to the header (x-axis) and places all variables in rows 551 | below each other. Transposing data is a good solution if you have a larger amount 552 | of variables and at max about 200-300 periods. 553 | 554 | # Frequenctly asked questions (FAQs) 555 | 556 | ## 1. Can I combine **tsplot** calls with **ggplot** (themes)? 557 | 558 | No, **tsplot** is base R based. You can simply add enhancements to the plot using base R calls. Add text, additional lines by calling functions such as `mtext()`, `abline()` etc. 559 | 560 | ## 2. I set `legend_col=1` but **tsplot** seems to ignore it. Why is that? 561 | 562 | You're probably using 2 Y-axes. The default for two Y-axes is the have a left aligned and a right aligned axis. This allows you to leave out additions like '(left scale)', '(right scale)'. However, you can simply force all legends left. 563 | 564 | ```{r,eval=FALSE,echo=TRUE} 565 | init_tsplot_theme( 566 | legend_all_left = TRUE, 567 | legend_col = 1 568 | ) 569 | ``` 570 | 571 | ## 3. How can I change of my lines, bars and areas? 572 | 573 | We have multiple pre-defined vectors for different chart types. 574 | All of them are easy to adjust. Also 575 | 576 | ```{r,eval=FALSE,echo=TRUE} 577 | init_tsplot_theme( 578 | band_fill_color = c("#FF0000", "#00FF00"), 579 | line_colors = c("#FF0000", "#00FF00"), 580 | bar_fill_color = c("#FF0000", "#00FF00") 581 | ) 582 | ``` 583 | --------------------------------------------------------------------------------