├── .Rbuildignore ├── .github ├── .gitignore ├── CONTRIBUTING.md ├── issue_template.md ├── pull_request_template.md └── workflows │ ├── R-CMD-check.yaml │ └── test-coverage.yaml ├── .gitignore ├── DESCRIPTION ├── NAMESPACE ├── NEWS.md ├── R ├── 0_convert_data.R ├── check.R ├── convert_exact.R ├── convert_heuristic.R ├── data.table_helpers.R ├── date_helpers.R ├── date_utils.R ├── dts.R ├── dts_default.R ├── dts_helpers.R ├── expressions.R ├── guess_dts.R ├── guess_time_var_value.R ├── srr-stats-standards.R ├── sysdata.rda ├── to_from_all.R ├── to_from_data.frame.R ├── to_from_data.table.R ├── to_from_tibble.R ├── to_from_tibbletime.R ├── to_from_timeSeries.R ├── to_from_tis.R ├── to_from_ts.R ├── to_from_tseries.R ├── to_from_tsibble.R ├── to_from_tslist.R ├── to_from_xts.R ├── to_from_zoo.R ├── to_from_zooreg.R ├── ts_.R ├── ts_apply.R ├── ts_arithmetic.R ├── ts_bind.R ├── ts_c.R ├── ts_chain.R ├── ts_default.R ├── ts_examples.R ├── ts_first_of_period.R ├── ts_frequency.R ├── ts_ggplot.R ├── ts_index.R ├── ts_lag.R ├── ts_long_wide.R ├── ts_na_omit.R ├── ts_pc.R ├── ts_pick.R ├── ts_plot.R ├── ts_regular.R ├── ts_scale.R ├── ts_span.R ├── ts_summary.R ├── ts_trend.R ├── tsbox-defunct.R ├── tsbox-package.R └── utils.R ├── README.Rmd ├── README.md ├── _pkgdown.yml ├── codecov.yml ├── codemeta.json ├── inst ├── CITATION ├── WORDLIST └── upd_meta_freq_data.R ├── man ├── copy_class.Rd ├── relevant_class.Rd ├── ts_.Rd ├── ts_arithmetic.Rd ├── ts_bind.Rd ├── ts_boxable.Rd ├── ts_c.Rd ├── ts_default.Rd ├── ts_dts.Rd ├── ts_examples.Rd ├── ts_first_of_period.Rd ├── ts_frequency.Rd ├── ts_ggplot.Rd ├── ts_index.Rd ├── ts_lag.Rd ├── ts_long.Rd ├── ts_na_omit.Rd ├── ts_pc.Rd ├── ts_pick.Rd ├── ts_plot.Rd ├── ts_regular.Rd ├── ts_save.Rd ├── ts_scale.Rd ├── ts_span.Rd ├── ts_summary.Rd ├── ts_trend.Rd ├── ts_ts.Rd ├── tsbox-defunct.Rd └── tsbox-package.Rd ├── tests ├── spelling.R ├── testthat.R └── testthat │ ├── test-arithmetic.R │ ├── test-auto.R │ ├── test-date_utils.R │ ├── test-defects.R │ ├── test-dirty.R │ ├── test-edge.R │ ├── test-error_handling.R │ ├── test-high_freq.R │ ├── test-irregular.R │ ├── test-issues.R │ ├── test-missing.R │ ├── test-non_heuristic.R │ ├── test-nonstandard_cnames.R │ ├── test-nyc_flights.R │ ├── test-object_conversion.R │ ├── test-readme.R │ ├── test-subannual.R │ ├── test-time_conversion.R │ ├── test-tricky.R │ ├── test-ts_.R │ ├── test-ts_bind.R │ ├── test-ts_c.R │ ├── test-ts_chain.R │ ├── test-ts_default.R │ ├── test-ts_first_of_period.R │ ├── test-ts_frequency.R │ ├── test-ts_index.R │ ├── test-ts_lag.R │ ├── test-ts_long_wide.R │ ├── test-ts_low_freq.R │ ├── test-ts_na_omit.R │ ├── test-ts_pc.R │ ├── test-ts_pick.R │ ├── test-ts_plot.R │ ├── test-ts_regular.R │ ├── test-ts_scale.R │ ├── test-ts_span.R │ ├── test-ts_summary.R │ ├── test-tsibble.R │ ├── test-tslist.R │ ├── test-tzone.R │ └── test-units.R ├── tsbox.Rproj └── vignettes ├── convert.Rmd ├── fig ├── myfig.png └── plot1.png ├── ts-functions.Rmd └── tsbox.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^.*\.sublime-project 4 | .gitignore 5 | ^\.travis\.yml$ 6 | ^appveyor\.yml$ 7 | travis 8 | ^_pkgdown\.yml$ 9 | ^docs$ 10 | cran-comments.md 11 | ^codemeta\.json$ 12 | ^\.github$ 13 | contributing.md 14 | ^README\.Rmd$ 15 | ^codecov\.yml$ 16 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # CONTRIBUTING # 2 | 3 | ### Fixing typos 4 | 5 | Small typos or grammatical errors in documentation may be edited directly using 6 | the GitHub web interface, so long as the changes are made in the _source_ file. 7 | 8 | * YES: you edit a roxygen comment in a `.R` file below `R/`. 9 | * NO: you edit an `.Rd` file below `man/`. 10 | 11 | ### Prerequisites 12 | 13 | Before you make a substantial pull request, you should always file an issue and 14 | make sure someone from the team agrees that it’s a problem. If you’ve found a 15 | bug, create an associated issue and illustrate the bug with a minimal 16 | [reprex](https://www.tidyverse.org/help/#reprex). 17 | 18 | ### Pull request process 19 | 20 | * We recommend that you create a Git branch for each pull request (PR). 21 | * Look at the Travis and AppVeyor build status before and after making changes. 22 | The `README` should contain badges for any continuous integration services used 23 | by the package. 24 | * We recommend the tidyverse [style guide](http://style.tidyverse.org). 25 | You can use the [styler](https://CRAN.R-project.org/package=styler) package to 26 | apply these styles, but please don't restyle code that has nothing to do with 27 | your PR. 28 | * We use [roxygen2](https://cran.r-project.org/package=roxygen2). 29 | * We use [testthat](https://cran.r-project.org/package=testthat). Contributions 30 | with test cases included are easier to accept. 31 | * For user-facing changes, add a bullet to the top of `NEWS.md` below the 32 | current development version header describing the changes made followed by your 33 | GitHub username, and links to relevant issue(s)/PR(s). 34 | 35 | ### Code of Conduct 36 | 37 | Please note that the tsbox project is released with a 38 | [Contributor Code of Conduct](CODE_OF_CONDUCT.md). By contributing to this 39 | project you agree to abide by its terms. 40 | 41 | ### See rOpenSci [contributing guide](https://devguide.ropensci.org/contributingguide.html) 42 | for further details. 43 | 44 | ### Discussion forum 45 | 46 | Check out our [discussion forum](https://discuss.ropensci.org) if 47 | 48 | * you have a question, an use case, or otherwise not a bug or feature request for the software itself. 49 | * you think your issue requires a longer form discussion. 50 | 51 | ### Prefer to Email? 52 | 53 | Email the person listed as maintainer in the `DESCRIPTION` file of this repo. 54 | 55 | Though note that private discussions over email don't help others - of course email is totally warranted if it's a sensitive problem of any kind. 56 | 57 | ### Thanks for contributing! 58 | 59 | This contributing guide is adapted from the tidyverse contributing guide available at https://raw.githubusercontent.com/r-lib/usethis/master/inst/templates/tidy-contributing.md 60 | -------------------------------------------------------------------------------- /.github/issue_template.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 |
Session Info 6 | 7 | ```r 8 | 9 | ``` 10 |
11 | -------------------------------------------------------------------------------- /.github/pull_request_template.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | ## Description 8 | 9 | 10 | ## Related Issue 11 | 14 | 15 | ## Example 16 | 18 | 19 | 21 | -------------------------------------------------------------------------------- /.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 50 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.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: test-coverage 10 | 11 | jobs: 12 | test-coverage: 13 | runs-on: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | 17 | steps: 18 | - uses: actions/checkout@v3 19 | 20 | - uses: r-lib/actions/setup-r@v2 21 | with: 22 | use-public-rspm: true 23 | 24 | - uses: r-lib/actions/setup-r-dependencies@v2 25 | with: 26 | extra-packages: any::covr 27 | needs: coverage 28 | 29 | - name: Test coverage 30 | run: | 31 | covr::codecov( 32 | quiet = FALSE, 33 | clean = FALSE, 34 | install_path = file.path(Sys.getenv("RUNNER_TEMP"), "package") 35 | ) 36 | shell: Rscript {0} 37 | 38 | - name: Show testthat output 39 | if: always() 40 | run: | 41 | ## -------------------------------------------------------------------- 42 | find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true 43 | shell: bash 44 | 45 | - name: Upload test results 46 | if: failure() 47 | uses: actions/upload-artifact@v3 48 | with: 49 | name: coverage-test-failures 50 | path: ${{ runner.temp }}/package 51 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | inst/doc 6 | .DS_Store 7 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: tsbox 2 | Type: Package 3 | Title: Class-Agnostic Time Series 4 | Version: 0.4.2 5 | Authors@R: c( 6 | person("Christoph", "Sax", email = "christoph.sax@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7192-7044")), 7 | person("Cathy", "Chamberlin", role = c("rev")), 8 | person("Nunes", "Matt", role = c("rev")) 9 | ) 10 | Description: Time series toolkit with identical behavior for all 11 | time series classes: 'ts','xts', 'data.frame', 'data.table', 'tibble', 'zoo', 12 | 'timeSeries', 'tsibble', 'tis' or 'irts'. Also converts reliably between these classes. 13 | Imports: 14 | data.table (>= 1.10.0), 15 | anytime 16 | Suggests: 17 | testthat, 18 | dplyr, 19 | tibble, 20 | tidyr, 21 | forecast, 22 | seasonal, 23 | dygraphs, 24 | xts, 25 | ggplot2, 26 | scales, 27 | knitr, 28 | rmarkdown, 29 | tsibble (>= 0.8.2), 30 | tsibbledata, 31 | tibbletime, 32 | tseries, 33 | units, 34 | zoo, 35 | tis, 36 | timeSeries, 37 | nycflights13, 38 | imputeTS, 39 | spelling, 40 | covr 41 | License: GPL-3 42 | Encoding: UTF-8 43 | URL: https://docs.ropensci.org/tsbox/, https://github.com/ropensci/tsbox 44 | BugReports: https://github.com/ropensci/tsbox/issues 45 | Roxygen: list(markdown = TRUE, roclets = c ("namespace", "rd", "srr::srr_stats_roclet")) 46 | RoxygenNote: 7.3.2 47 | VignetteBuilder: knitr 48 | Depends: 49 | R (>= 2.10) 50 | Config/testthat/parallel: true 51 | Config/testthat/edition: 3 52 | Language: en-US 53 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(ts_dts,data.frame) 4 | S3method(ts_dts,data.table) 5 | S3method(ts_dts,dts) 6 | S3method(ts_dts,irts) 7 | S3method(ts_dts,tbl_time) 8 | S3method(ts_dts,tbl_ts) 9 | S3method(ts_dts,timeSeries) 10 | S3method(ts_dts,tis) 11 | S3method(ts_dts,ts) 12 | S3method(ts_dts,tslist) 13 | S3method(ts_dts,xts) 14 | S3method(ts_dts,zoo) 15 | S3method(ts_dts,zooreg) 16 | export("%ts*%") 17 | export("%ts+%") 18 | export("%ts-%") 19 | export("%ts/%") 20 | export(check_ts_boxable) 21 | export(colors_tsbox) 22 | export(copy_class) 23 | export(load_suggested) 24 | export(relevant_class) 25 | export(scale_color_tsbox) 26 | export(scale_fill_tsbox) 27 | export(theme_tsbox) 28 | export(ts_) 29 | export(ts_apply) 30 | export(ts_bind) 31 | export(ts_boxable) 32 | export(ts_c) 33 | export(ts_chain) 34 | export(ts_compound) 35 | export(ts_data.frame) 36 | export(ts_data.table) 37 | export(ts_default) 38 | export(ts_df) 39 | export(ts_diff) 40 | export(ts_diffy) 41 | export(ts_dt) 42 | export(ts_dts) 43 | export(ts_dygraphs) 44 | export(ts_end) 45 | export(ts_first_of_period) 46 | export(ts_forecast) 47 | export(ts_frequency) 48 | export(ts_ggplot) 49 | export(ts_index) 50 | export(ts_irts) 51 | export(ts_lag) 52 | export(ts_long) 53 | export(ts_na_interpolation) 54 | export(ts_na_omit) 55 | export(ts_pc) 56 | export(ts_pca) 57 | export(ts_pcy) 58 | export(ts_pick) 59 | export(ts_plot) 60 | export(ts_prcomp) 61 | export(ts_regular) 62 | export(ts_save) 63 | export(ts_scale) 64 | export(ts_seas) 65 | export(ts_span) 66 | export(ts_start) 67 | export(ts_summary) 68 | export(ts_tbl) 69 | export(ts_tibbletime) 70 | export(ts_timeSeries) 71 | export(ts_tis) 72 | export(ts_trend) 73 | export(ts_ts) 74 | export(ts_tsibble) 75 | export(ts_tslist) 76 | export(ts_wide) 77 | export(ts_xts) 78 | export(ts_zoo) 79 | export(ts_zooreg) 80 | importFrom(anytime,anydate) 81 | importFrom(anytime,anytime) 82 | importFrom(data.table,":=") 83 | importFrom(data.table,"as.data.table") 84 | importFrom(data.table,"copy") 85 | importFrom(data.table,"data.table") 86 | importFrom(data.table,"dcast") 87 | importFrom(data.table,"melt") 88 | importFrom(data.table,"rbindlist") 89 | importFrom(data.table,"setattr") 90 | importFrom(data.table,"setcolorder") 91 | importFrom(data.table,"setkey") 92 | importFrom(data.table,"setkeyv") 93 | importFrom(data.table,"setnames") 94 | importFrom(data.table,"setorder") 95 | importFrom(data.table,"shift") 96 | importFrom(data.table,"tstrsplit") 97 | importFrom(grDevices,bmp) 98 | importFrom(grDevices,dev.off) 99 | importFrom(grDevices,jpeg) 100 | importFrom(grDevices,pdf) 101 | importFrom(grDevices,png) 102 | importFrom(grDevices,tiff) 103 | importFrom(graphics,abline) 104 | importFrom(graphics,axTicks) 105 | importFrom(graphics,axis) 106 | importFrom(graphics,legend) 107 | importFrom(graphics,lines) 108 | importFrom(graphics,mtext) 109 | importFrom(graphics,par) 110 | importFrom(graphics,plot) 111 | importFrom(stats,"tsp<-") 112 | importFrom(stats,as.formula) 113 | importFrom(stats,as.ts) 114 | importFrom(stats,frequency) 115 | importFrom(stats,loess) 116 | importFrom(stats,na.omit) 117 | importFrom(stats,optimize) 118 | importFrom(stats,prcomp) 119 | importFrom(stats,predict) 120 | importFrom(stats,resid) 121 | importFrom(stats,setNames) 122 | importFrom(stats,start) 123 | importFrom(stats,time) 124 | importFrom(stats,ts) 125 | importFrom(stats,tsp) 126 | importFrom(stats,var) 127 | importFrom(stats,window) 128 | importFrom(utils,browseURL) 129 | importFrom(utils,getFromNamespace) 130 | importFrom(utils,relist) 131 | -------------------------------------------------------------------------------- /R/0_convert_data.R: -------------------------------------------------------------------------------- 1 | #' @importFrom data.table ":=" "data.table" "setcolorder" "as.data.table" 2 | #' @importFrom data.table "setattr" "setnames" "rbindlist" "tstrsplit" "copy" 3 | #' @importFrom data.table "dcast" "melt" "setkey" "setkeyv" "setorder" "shift" 4 | NULL 5 | 6 | 7 | # Make sure data.table knows we know we're using it 8 | .datatable.aware <- TRUE 9 | 10 | 11 | #' Utility Function to Find POSIXct Range (Coding Only) 12 | #' 13 | #' @noRd 14 | #' @examples 15 | #' find_range("1 hour") 16 | #' # 365.2425 # Gregorian Year 17 | find_range <- function(by = "1 month") { 18 | ser <- seq( 19 | from = as.POSIXct("1900-01-01"), 20 | to = as.POSIXct("2020-01-01"), 21 | by = by 22 | ) 23 | range(diff(as.numeric(as.POSIXct(ser)))) 24 | } 25 | 26 | 27 | #' Retrieve Meta Inforamtion 28 | #' @noRd 29 | meta_freq <- function() { 30 | meta_freq_data[] 31 | } 32 | 33 | 34 | #' Utility to Detect Regular Frequencies 35 | #' @param x Date, or POSIXct 36 | #' @noRd 37 | frequency_table <- function(x) { 38 | N <- freq <- share <- string <- NULL 39 | 40 | stopifnot(class(x)[1] %in% c("Date", "POSIXct")) 41 | check_frequency_detection(x) 42 | 43 | # table with unique differences 44 | diffdt <- data.table(table(diff(as.numeric(as.POSIXct(sort(x)))))) 45 | setnames(diffdt, "V1", "diff") 46 | diffdt[, diff := as.numeric(diff)] 47 | 48 | # which differences correspond to which frequency? 49 | i <- cut( 50 | diffdt$diff, 51 | breaks = meta_freq()$diff, 52 | labels = FALSE, 53 | include.lowest = TRUE 54 | ) 55 | 56 | z0 <- meta_freq()[i][, N := diffdt$N] 57 | z <- z0[, list(N = sum(N), freq = freq[1]), by = string] 58 | z[, share := N / (sum(N))] 59 | 60 | z[] 61 | } 62 | -------------------------------------------------------------------------------- /R/check.R: -------------------------------------------------------------------------------- 1 | 2 | stop0 <- function(...) { 3 | stop(..., call. = FALSE) 4 | } 5 | 6 | paste_quoted <- function(x) { 7 | paste(paste0("'", x, "'"), collapse = ", ") 8 | } 9 | 10 | 11 | #' @param x 'dts' 12 | #' 13 | #' @noRd 14 | check_frequency_detection <- function(x) { 15 | if (NROW(x) < 2) { 16 | stop0( 17 | "need at least two observations for frequency detection" 18 | ) 19 | } 20 | } 21 | 22 | 23 | #' @param by numeric, or character 24 | #' 25 | #' @noRd 26 | check_numeric_by <- function(by) { 27 | if (is.numeric(by)) { 28 | stop0( 29 | "'by' cannot be integer when used with irregular sequence" 30 | ) 31 | } 32 | } 33 | 34 | 35 | #' @param by numeric, or character 36 | #' 37 | #' @noRd 38 | check_start_end <- function(start, end) { 39 | if (start > end) { 40 | stop0( 41 | "'start' cannot be at or after 'end'" 42 | ) 43 | } 44 | } 45 | 46 | #' @param a character 47 | #' @param b character 48 | #' 49 | #' @noRd 50 | check_identical_ids <- function(a, b) { 51 | a <- sort(a) 52 | b <- sort(b) 53 | if (!identical(a, b)) { 54 | stop0( 55 | "[id] columns are not identical: ", 56 | paste(a, collapse = ", "), 57 | " (1); ", 58 | paste(b, collapse = ", "), 59 | " (2)" 60 | ) 61 | } 62 | } 63 | 64 | #' @param x Date or POSIXct 65 | #' 66 | #' @noRd 67 | check_missing_time <- function(x) { 68 | if (any(is.na(x))) { 69 | stop0("[time] column contains missing values") 70 | } 71 | } 72 | 73 | #' @param reg.time return value from regularize_date 74 | #' 75 | #' Fail if regularize_date() returns NULL 76 | #' 77 | #' @noRd 78 | check_regular_pattern <- function(reg.time) { 79 | if (is.null(reg.time)) { 80 | stop0("series has no regular pattern") 81 | } 82 | } 83 | 84 | 85 | -------------------------------------------------------------------------------- /R/convert_exact.R: -------------------------------------------------------------------------------- 1 | # --- Convertors for dectime to POSIXct and back ------------------------------- 2 | 3 | 4 | #' How many Seconds in Year? 5 | #' 6 | #' @param year Year 7 | #' @param tz Time Zone 8 | #' @examples 9 | #' seconds_in_year(1990, tz = "") 10 | #' @srrstats {G2.4c} *explicit conversion to character via `as.character()` (and not `paste` or `paste0`)* 11 | #' @noRd 12 | seconds_in_year <- function(year, tz) { 13 | diff(as.numeric(seq( 14 | as.POSIXct(paste0(as.character(year), "-01-01"), tz = tz), 15 | length.out = 2, by = "1 year" 16 | ))) 17 | } 18 | 19 | 20 | #' Seconds at the Start of a Year 21 | #' 22 | #' @param year Year 23 | #' @param tz Time Zone 24 | #' @examples 25 | #' seconds_at_start_of_year(1990, tz = "") 26 | #' @srrstats {G2.4c} *explicit conversion to character via `as.character()` (and not `paste` or `paste0`)* 27 | #' @noRd 28 | seconds_at_start_of_year <- function(year, tz) { 29 | diff(c( 30 | as.numeric(as.POSIXct("1970-01-01", tz = tz)), 31 | as.numeric(as.POSIXct(paste0(as.character(year), "-01-01"), tz = tz)) 32 | )) 33 | } 34 | 35 | 36 | #' Decimal Time to POSIXct 37 | #' 38 | #' @param x numeric, decimal time 39 | #' @examples 40 | #' dectime_to_POSIXct(1990.5) 41 | #' @noRd 42 | dectime_to_POSIXct <- function(x) { 43 | stopifnot(length(x) == 1L) 44 | year <- floor(x) 45 | intra <- x - year 46 | seconds_since_70 <- 47 | seconds_at_start_of_year(year, tz = "") + 48 | seconds_in_year(year, tz = "") * intra 49 | seconds_since_70 <- round(seconds_since_70, 4) 50 | as.POSIXct(seconds_since_70, origin = "1970-01-01", tz = "") 51 | } 52 | 53 | 54 | #' POSIXct to Decimal Time 55 | #' 56 | #' @param x POSIXct 57 | #' @examples 58 | #' POSIXct_to_dectime(Sys.time()) 59 | #' @noRd 60 | POSIXct_to_dectime <- function(x) { 61 | tz <- attributes(x)$tzone 62 | if (is.null(tz)) tz <- "" 63 | stopifnot(length(x) == 1L) 64 | year <- as.POSIXlt(x)$year + 1900L 65 | intra <- (as.numeric(x) - 66 | seconds_at_start_of_year(year, tz)) / 67 | seconds_in_year(year, tz) 68 | year + intra 69 | } 70 | 71 | 72 | # --- exact convertors --------------------------------------------------------- 73 | 74 | 75 | #' Extract POSIXct from ts Object 76 | #' 77 | #' @param x ts object 78 | #' @examples 79 | #' ts_to_POSIXct(mdeaths) 80 | #' @noRd 81 | ts_to_POSIXct <- function(x) { 82 | stopifnot(inherits(x, "ts")) 83 | if (NCOL(x) > 1) x <- x[, 1] 84 | z <- seq( 85 | from = dectime_to_POSIXct(tsp(x)[1]), 86 | to = dectime_to_POSIXct(tsp(x)[2]), 87 | length.out = length(x) 88 | ) 89 | z 90 | } 91 | 92 | 93 | #' Extract Start, End and Frequency from POSIXct 94 | #' 95 | #' @param x POSIXct 96 | #' @noRd 97 | POSIXct_to_tsp <- function(x) { 98 | stopifnot(inherits(x, "POSIXct")) 99 | dd <- diff(as.numeric(x)) 100 | if ((max(dd) - min(dd)) > 1) { 101 | stop0("some dates are not equally spaced.") 102 | } 103 | start <- POSIXct_to_dectime(x[1]) 104 | end <- POSIXct_to_dectime(x[length(x)]) 105 | f <- (length(x) - 1) / (end - start) 106 | c(start, end, f) 107 | } 108 | -------------------------------------------------------------------------------- /R/data.table_helpers.R: -------------------------------------------------------------------------------- 1 | # Function for easier access to data.table 2 | 3 | #' Combine Columns in a data.table 4 | #' 5 | #' @param dt `data.table`, or `dts` 6 | #' @param cols character vector, columns to combine 7 | #' @param sep character, separate columns by 8 | #' @examples 9 | #' combine_cols_data.table(data.table(cars), c("speed", "dist")) 10 | #' @noRd 11 | combine_cols_data.table <- function(dt, cols, sep = "_") { 12 | paste_sep <- function(...) paste(..., sep = sep) 13 | id <- NULL 14 | qq <- as.call(c(quote(paste_sep), lapply(cols, as.name))) 15 | z <- dt[, id := eval(qq)] 16 | z[, (setdiff(cols, "id")) := NULL] # but this is the right way to do it 17 | setcolorder(z, c("id", setdiff(names(z), "id"))) 18 | z[] 19 | } 20 | 21 | 22 | #' Merging dts by Time Column, Using Rolling Joins 23 | #' 24 | #' @param x `data.table`, or `dts` 25 | #' @param y `data.table`, or `dts` 26 | #' @param by.x character, column by which to merge 27 | #' @param by.y character, column by which to merge 28 | #' @noRd 29 | merge_time_date <- function(x, y, by.x = "time", by.y = "time") { 30 | `__time_seq` <- time.x <- time.y <- NULL 31 | 32 | x0 <- copy(x) 33 | y0 <- copy(y) 34 | 35 | setnames(x0, by.x, "time") 36 | setnames(y0, by.y, "time") 37 | 38 | class.x <- class(x0[["time"]])[1] 39 | class.y <- class(y0[["time"]])[1] 40 | 41 | class <- unique(c(class.x, class.y)) 42 | if (length(class) > 1) { 43 | x0[["time"]] <- as.POSIXct(x0[["time"]]) 44 | y0[["time"]] <- as.POSIXct(y0[["time"]]) 45 | class <- "POSIXct" 46 | } 47 | 48 | # rolling join 49 | x0[, `__time_seq` := seq_along(time)] 50 | x0[, time.x := time] 51 | y0[, time.y := time] 52 | y0[, time := time - 0.1] # for robustness 53 | rj <- y0[x0, roll = 1, on = "time"] 54 | 55 | if (!all(x0$`__time_seq` %in% rj$`__time_seq`)) { 56 | stop("incomplete merge - this should not occur") 57 | } 58 | 59 | rj[, time := NULL] 60 | 61 | # new time col name comes from x, the rest from y 62 | setnames(rj, "time.x", by.x) 63 | new.names <- c(names(x), setdiff(names(y), by.y)) 64 | z <- rj[, new.names, with = FALSE] 65 | 66 | z 67 | } 68 | -------------------------------------------------------------------------------- /R/date_helpers.R: -------------------------------------------------------------------------------- 1 | #' Convert Anything to Date or POSIXct 2 | #' 3 | #' @param x Date, POSIXct, or anything that can be coerced to character 4 | #' @examples 5 | #' as_time_or_date("2021.3") 6 | #' @noRd 7 | as_time_or_date <- function(x) { 8 | if (inherits(x, "Date")) { 9 | return(x) 10 | } 11 | if (inherits(x, "POSIXct")) { 12 | return(x) 13 | } 14 | # We want to return a date unless its really a time 15 | anydate(as.character(x)) 16 | } 17 | 18 | 19 | #' Regularize Dates 20 | #' 21 | #' If `x` is regular, it is as fast as possilbe, and checks reliably for 22 | #' regularity. 23 | #' 24 | #' @param x Date or POSIXct 25 | #' @noRd 26 | regularize_date <- function(x) { 27 | stopifnot(inherits(x, c("POSIXct", "Date"))) 28 | 29 | N <- NULL 30 | freq <- NULL 31 | share <- NULL 32 | string <- NULL 33 | 34 | x <- sort(x) 35 | 36 | diffdt <- frequency_table(x) 37 | fm <- diffdt[which.max(freq)] 38 | 39 | if (is_near(fm$freq, -1)) { 40 | return(regularize_non_heuristic(x)) 41 | } 42 | 43 | # regular, exit 44 | if (is_near(fm$share, 1)) { 45 | return(x) 46 | } 47 | 48 | from <- x[1] 49 | to <- x[length(x)] 50 | 51 | if (inherits(x, "POSIXct")) { 52 | 53 | # for some reason, POSIXct is not precise for quartals 54 | if (fm$freq <= 12 && fm$freq > -1) { 55 | z <- as.POSIXct( 56 | seq(from = as.Date(from), to = as.Date(to), by = fm$string), 57 | tz = attr(x, "tzone") 58 | ) 59 | if (!all(as.integer(x) %in% as.integer(z))) { 60 | # but sometimes it is, so give it a second try 61 | z <- seq(from = from, to = to + 0.1, by = fm$string) 62 | } 63 | } else { 64 | z <- seq(from = from, to = to + 0.1, by = fm$string) 65 | } 66 | } else { 67 | z <- seq(from = from, to = to, by = fm$string) 68 | } 69 | 70 | # return NULL if regularization failed 71 | if (!all(as.integer(x) %in% as.integer(z))) { 72 | return(NULL) 73 | } 74 | z 75 | } 76 | 77 | #' Regularize Dates without Heuristics 78 | #' 79 | #' If heuristics don't work, this slow routine used for Date regularization 80 | #' 81 | #' @param x Date or POSIXct 82 | #' @noRd 83 | regularize_non_heuristic <- function(x) { 84 | stopifnot(inherits(x, c("POSIXct", "Date"))) 85 | 86 | x.num <- as.numeric(x) 87 | dd <- unique(round(diff(x.num), 5)) 88 | 89 | if (length(dd) == 1L) { 90 | return(x) 91 | } # already regular 92 | 93 | min.dd <- min(dd) 94 | 95 | # all diffs must be integer multiples of minimal diff 96 | if (any((dd %% min.dd) > 0.1)) { 97 | return(NULL) 98 | } 99 | 100 | sq <- seq(from = x.num[1], to = x.num[length(x.num)] + 0.1, by = min.dd) 101 | 102 | if (inherits(x, "POSIXct")) { 103 | z <- as.POSIXct(sq, origin = "1970-01-01", tz = attr(x, "tzone")) 104 | } else { 105 | z <- as.Date(sq, origin = "1970-01-01", tz = attr(x, "tzone")) 106 | } 107 | 108 | dtx <- data.table(x, s = seq_along(x), x0 = x) 109 | dtz <- data.table(x = z + 0.1, z0 = z) 110 | rj <- dtx[dtz, roll = 1, on = "x"] 111 | if (!all(dtx$s %in% rj$s)) { 112 | return(NULL) 113 | } 114 | rj$z0 115 | } 116 | -------------------------------------------------------------------------------- /R/dts.R: -------------------------------------------------------------------------------- 1 | #' Internal Time Series Class 2 | #' 3 | #' @inherit ts_default 4 | #' @export 5 | ts_dts <- function(x) { 6 | check_ts_boxable(x) 7 | UseMethod("ts_dts") 8 | } 9 | 10 | #' @export 11 | #' @method ts_dts dts 12 | ts_dts.dts <- function(x) { 13 | x 14 | } 15 | -------------------------------------------------------------------------------- /R/dts_default.R: -------------------------------------------------------------------------------- 1 | #' Default Column Names for 'dts' 2 | #' 3 | #' @param x a 'dts' 4 | #' @noRd 5 | dts_default <- function(x) { 6 | stopifnot(inherits(x, "dts")) 7 | cname <- dts_cname(x) 8 | colorder <- copy(names(x)) 9 | 10 | setnames(x, cname$time, "time") 11 | setnames(x, cname$value, "value") 12 | setcolorder(x, c(cname$id, "time", "value")) 13 | 14 | cname_default <- cname 15 | cname_default$time <- "time" 16 | cname_default$value <- "value" 17 | setattr(x, "cname", cname_default) 18 | 19 | list( 20 | x = x, 21 | cname = cname, 22 | colorder = colorder 23 | ) 24 | } 25 | 26 | 27 | #' Default Column Names for 'dts' 28 | #' 29 | #' @param x 'data.table', or 'dts' 30 | #' @param d Attributes to apply on a 'dts' 31 | #' 32 | #' @noRd 33 | dts_restore <- function(x, d) { 34 | x <- dts_init_minimal(x) 35 | setnames(x, "time", d$cname$time) 36 | setnames(x, "value", d$cname$value) 37 | setcolorder(x, d$colorder) 38 | setattr(x, "cname", d$cname) 39 | x 40 | } 41 | 42 | 43 | #' Minimal 'dts' Initialization 44 | #' 45 | #' Adds 'dts' class attribute to a 'data.table' 46 | #' 47 | #' @param x 'data.table', or 'dts' 48 | #' @noRd 49 | dts_init_minimal <- function(x) { 50 | stopifnot(inherits(x, "data.table")) 51 | if (!inherits(x, "dts")) setattr(x, "class", c("dts", attr(x, "class"))) 52 | x 53 | } 54 | -------------------------------------------------------------------------------- /R/dts_helpers.R: -------------------------------------------------------------------------------- 1 | #' Create a Data Table Based Time Series Object 2 | #' 3 | #' @param x a `data.table` object 4 | #' @noRd 5 | #' @srrstats {TS1.5} *The software should ensure strict ordering of the time, frequency, or equivalent ordering index variable.* 6 | #' Sorts if not already ordered. 7 | #' @srrstats {TS1.6} *Any violations of ordering should be caught in the pre-processing stages of all functions.* 8 | #' Done here. 9 | dts_init <- function(x) { 10 | .SD <- NULL 11 | stopifnot(inherits(x, "data.frame")) 12 | x <- as.data.table(x) 13 | stopifnot(inherits(x, "data.table")) 14 | 15 | is_list_col <- vapply(x, function(e) "list" %in% class(e), TRUE) 16 | if (any(is_list_col)) { 17 | stop0("'x' contains list columns, which are not yet supported.") 18 | } 19 | 20 | setattr(x, "class", c("dts", attr(x, "class"))) 21 | stopifnot(inherits(x, "dts")) 22 | cname <- dts_cname(x) 23 | 24 | # do not allow duplicates 25 | is.dup <- duplicated(x[, c(cname$id, cname$time), with = FALSE]) 26 | if (any(is.dup)) { 27 | z <- as.data.frame(unique(x[is.dup, cname$id, with = FALSE])) 28 | paste_ <- function(...) paste(..., sep = "_") 29 | dups <- do.call(paste_, as.list(z)) 30 | if (length(dups) > 0) { 31 | stop0( 32 | "object contains series with duplicated information: ", 33 | paste(dups, collapse = ", ") 34 | ) 35 | } else { 36 | stop0( 37 | "series contains duplicated values in time column: ", 38 | unique(x[[cname$time]][duplicated(x[[cname$time]])]) 39 | ) 40 | } 41 | } 42 | if (!is.numeric(x[[cname$value]])) { 43 | stop0("'value' column [", cname$value, "] is not numeric.") 44 | } 45 | 46 | # new 47 | setnames(x, cname$time, "time") 48 | x[, time := as_time_or_date(time)] 49 | 50 | # ensure time is always ordered (if not done before) 51 | colorder <- names(x) 52 | .by <- by_expr(dts_cname(x)$id) 53 | x <- x[, setorder(.SD, time), by = eval(.by)] 54 | setcolorder(x, colorder) 55 | 56 | check_missing_time(x$time) 57 | 58 | setnames(x, "time", cname$time) 59 | setattr(x, "cname", cname) 60 | 61 | x 62 | } 63 | 64 | 65 | #' dts Helper: Remove dts attributes 66 | #' 67 | #' @param x 'dts' 68 | #' @return a 'data.table' 69 | #' 70 | #' @noRd 71 | dts_rm <- function(x) { 72 | setattr(x, "class", setdiff(attr(x, "class"), "dts")) 73 | setattr(x, "cname", NULL) 74 | setattr(x, "tattr", NULL) 75 | x 76 | } 77 | 78 | 79 | #' dts Helper: Extract (and optionally guess) Column Names 80 | #' 81 | #' Once guessed, they are added as an attribute, so cnames need to be guessed 82 | #' only once. 83 | #' 84 | #' @param x 'dts' 85 | #' 86 | #' @noRd 87 | dts_cname <- function(x) { 88 | stopifnot(inherits(x, "dts")) 89 | z <- attr(x, "cname") 90 | if (is.null(z)) { 91 | z <- guess_cname(x) 92 | setattr(x, "cname", z) 93 | } 94 | z 95 | } 96 | 97 | 98 | #' dts Helper: Extract (and optionally guess) Time Attribute 99 | #' 100 | #' Once guessed, they are added as an attribute, so cnames need to be guessed 101 | #' only once. 102 | #' 103 | #' @param x 'dts' 104 | #' 105 | #' @noRd 106 | dts_tattr <- function(x) { 107 | stopifnot(inherits(x, "dts")) 108 | z <- attr(x, "tattr") 109 | if (is.null(z)) { 110 | z <- guess_tattr(x) 111 | setattr(x, "tattr", z) 112 | } 113 | z 114 | } 115 | 116 | 117 | #' dts Helper: Determine the Number of Time Series 118 | #' 119 | #' @param x 'dts' 120 | #' 121 | #' @noRd 122 | number_of_series <- function(x) { 123 | stopifnot(inherits(x, "dts")) 124 | cid <- dts_cname(x)$id 125 | if ((length(cid)) == 0L) { 126 | 1 127 | } else { 128 | dt.id <- x[, cid, with = FALSE] 129 | nrow(unique(dt.id)) 130 | } 131 | } 132 | 133 | 134 | #' dts Helper: Combine Several Id Columns into One 135 | #' 136 | #' Calls `combine_cols_data.table()`. 137 | #' 138 | #' @param x 'dts' 139 | #' 140 | #' @noRd 141 | combine_id_cols <- function(x, sep = "_") { 142 | stopifnot(inherits(x, "dts")) 143 | if (NCOL(x) <= 3) { 144 | return(x) 145 | } 146 | cname <- dts_cname(x) 147 | z <- combine_cols_data.table(copy(x), dts_cname(x)$id, sep = sep) 148 | cname$id <- "id" 149 | setattr(z, "cname", cname) 150 | z 151 | } 152 | -------------------------------------------------------------------------------- /R/expressions.R: -------------------------------------------------------------------------------- 1 | #' Construct `by` Expression 2 | #' 3 | #' To be used in data.table() 4 | #' 5 | #' @param character grouping variables 6 | #' @examples 7 | #' by_expr(c("a", "b")) 8 | #' @noRd 9 | by_expr <- function(x) { 10 | as.call(c(quote(list), lapply(x, as.name))) 11 | } 12 | -------------------------------------------------------------------------------- /R/guess_dts.R: -------------------------------------------------------------------------------- 1 | #' Guess Time Attribute 2 | #' 3 | #' @param x a 'dts' 4 | #' 5 | #' - called by dts accessors, it attribute is not yet present. 6 | #' - can assume x is dts, not test needed 7 | #' - same name as dts accessor 8 | #' - should never manipulate x 9 | #' 10 | #' @examples 11 | #' guess_tattr(ts_dts(mdeaths)) 12 | #' @noRd 13 | guess_tattr <- function(x) { 14 | x.time <- x[[dts_cname(x)$time]] 15 | class <- class(x.time)[1] 16 | if (!(class %in% c("Date", "POSIXct"))) { 17 | stop0("[time] column is not of class 'Date' or 'POSIXct'") 18 | } 19 | if (identical(class, "POSIXct")) { 20 | tz <- attr(x.time, "tzone") 21 | } else { 22 | tz <- "" 23 | } 24 | list( 25 | class = class, 26 | tz = tz 27 | ) 28 | } 29 | 30 | 31 | #' Guess Column Names 32 | #' 33 | #' @param x a 'dts' 34 | #' 35 | #' - called by dts accessors, it attribute is not yet present. 36 | #' - can assume x is dts, not test needed 37 | #' - same name as dts accessor 38 | #' - should never manipulate x 39 | #' 40 | #' @examples 41 | #' guess_cname(ts_dts(mdeaths)) 42 | #' @noRd 43 | guess_cname <- function(x) { 44 | value.name <- guess_value(x) 45 | time.name <- guess_time(x, value.name = value.name) 46 | 47 | msg <- NULL 48 | if (time.name != "time") { 49 | msg <- paste0("[time]: '", time.name, "' ") 50 | } 51 | if (value.name != "value") { 52 | msg <- paste0(msg, "[value]: '", value.name, "' ") 53 | # check if data frame is incidentally wide (numeric id columns) 54 | non_value <- setdiff(colnames(x), value.name) 55 | numeric.id.cols <- vapply(x[, non_value, with = FALSE], is.numeric, TRUE) 56 | if (sum(numeric.id.cols) > 0) { 57 | message( 58 | "Found numeric [id] column(s): ", 59 | paste_quoted(names(numeric.id.cols)[numeric.id.cols]), 60 | ".\nAre you using a wide data frame? To convert, use 'ts_long()'.", 61 | "\nConvert column(s) to character or factor to silence this message.\n" 62 | ) 63 | } 64 | } 65 | 66 | if (!is.null(msg)) message(msg) 67 | 68 | list( 69 | id = setdiff(colnames(x), c(time.name, value.name)), 70 | time = time.name, 71 | value = value.name 72 | ) 73 | } 74 | -------------------------------------------------------------------------------- /R/guess_time_var_value.R: -------------------------------------------------------------------------------- 1 | # to determine id, time, value, when coverting from data frame likes 2 | 3 | # 3 times faster if we store .years 4 | .years <- as.character(1600:2200) 5 | 6 | 7 | #' Is This a time-like Vector? 8 | #' 9 | #' @param x any vector 10 | #' 11 | #' - Four digit integer are detected as years 12 | #' - Use anytime() to detect time stamps 13 | #' 14 | #' @examples 15 | #' is_time(ts_tbl(mdeaths)$time) 16 | #' is_time(ts_tbl(mdeaths)$value) 17 | #' @noRd 18 | is_time <- function(x) { 19 | if (class(x)[1] %in% c("Date", "POSIXct")) { 20 | return(TRUE) 21 | } # beyond doubt 22 | # use a short vector for time detection 23 | if (length(x) > 20) { 24 | x <- c( 25 | x[1:3], # first 3 26 | x[(length(x) %/% 2 - 1):(length(x) %/% 2 + 1)], # middle 3 27 | x[(length(x) - 2):(length(x))] 28 | ) # lost 3 29 | } 30 | x <- as.character(x) 31 | 32 | # detect years as column 33 | if (all(x %in% .years)) { 34 | return(TRUE) 35 | } 36 | 37 | tt <- anytime(x, useR = TRUE) 38 | 39 | # useR = FALSE crashes R session on Win 40 | # https://github.com/eddelbuettel/anytime/issues/76 41 | if (any(is.na(tt))) { 42 | return(FALSE) 43 | } 44 | 45 | # exclude unrealistic years 46 | if ((as.POSIXlt(max(tt))$year + 1900L) > 2500) { 47 | return(FALSE) 48 | } 49 | 50 | TRUE 51 | } 52 | 53 | 54 | #' Is This a value-like Vector? 55 | #' 56 | #' @param x any vector 57 | #' 58 | #' - is.numeric() works for double and integer 59 | #' 60 | #' @examples 61 | #' is_value(ts_tbl(mdeaths)$time) 62 | #' @noRd 63 | is_value <- function(x) { 64 | is.numeric(x) # also works for integer 65 | } 66 | 67 | 68 | #' Guess Time Column 69 | #' 70 | #' Using `is_time()`, this starts at the last column and determines the first 71 | #' value column. 72 | #' 73 | #' @param x a data.frame 74 | #' 75 | #' @examples 76 | #' guess_time(ts_tbl(mdeaths)) 77 | #' @noRd 78 | guess_time <- function(x, value.name = "value") { 79 | stopifnot(inherits(x, "data.frame")) 80 | cnames <- colnames(x) 81 | if ("time" %in% cnames) { 82 | return("time") 83 | } 84 | 85 | cnames <- setdiff(cnames, value.name) 86 | 87 | z <- NA 88 | # start from the right column 89 | for (cname.i in rev(cnames)) { 90 | if (is_time(x[[cname.i]])) { 91 | z <- cname.i 92 | break 93 | } 94 | } 95 | 96 | if (is.na(z)) { 97 | stop0( 98 | "no [time] column detected; ", 99 | "to be explicit, name time column as 'time'" 100 | ) 101 | } 102 | 103 | z 104 | } 105 | 106 | 107 | #' Guess Value Column 108 | #' 109 | #' Using `is_value()`, this starts at the last column and determines the first 110 | #' value column. 111 | #' 112 | #' @param x a data.frame 113 | #' 114 | #' @examples 115 | #' guess_value(ts_tbl(mdeaths)) 116 | #' @noRd 117 | guess_value <- function(x) { 118 | stopifnot(inherits(x, "data.frame")) 119 | cnames <- colnames(x) 120 | if ("value" %in% cnames) { 121 | return("value") 122 | } 123 | 124 | z <- NA 125 | for (cname.i in rev(cnames)) { 126 | if (is_value(x[[cname.i]])) { 127 | z <- cname.i 128 | break 129 | } 130 | } 131 | if (is.na(z)) { 132 | stop0( 133 | "no [value] column detected; ", 134 | "to be explicit, name value column as 'value'" 135 | ) 136 | } 137 | z 138 | } 139 | -------------------------------------------------------------------------------- /R/sysdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/tsbox/0a80208f0ff197d7dc88a2a43609be7f8a6cf544/R/sysdata.rda -------------------------------------------------------------------------------- /R/to_from_data.frame.R: -------------------------------------------------------------------------------- 1 | register_class("data.frame") 2 | 3 | # to --------------------------------------------------------------------------- 4 | 5 | #' Convert to Class 6 | #' @noRd 7 | ts_data.frame_dts <- function(x) { 8 | as.data.frame(ts_data.table(x)) 9 | } 10 | 11 | 12 | # from ------------------------------------------------------------------------- 13 | 14 | #' @export 15 | #' @method ts_dts data.frame 16 | ts_dts.data.frame <- function(x) { 17 | ts_dts(as.data.table(x)) 18 | } 19 | 20 | 21 | # main converter --------------------------------------------------------------- 22 | 23 | #' @name ts_ts 24 | #' @export 25 | ts_data.frame <- function(x) { 26 | check_ts_boxable(x) 27 | if (relevant_class(x) == "data.frame") { 28 | return(x) 29 | } 30 | ts_data.frame_dts(ts_dts(x)) 31 | } 32 | 33 | #' @name ts_ts 34 | #' @export 35 | ts_df <- function(x) { 36 | ts_data.frame(x) 37 | } 38 | -------------------------------------------------------------------------------- /R/to_from_data.table.R: -------------------------------------------------------------------------------- 1 | register_class("data.table") 2 | 3 | # to --------------------------------------------------------------------------- 4 | 5 | #' Convert to Class 6 | #' @noRd 7 | ts_data.table_dts <- function(x) { 8 | dts_rm(x)[] 9 | } 10 | 11 | 12 | # from ------------------------------------------------------------------------- 13 | 14 | #' @export 15 | #' @method ts_dts data.table 16 | ts_dts.data.table <- function(x) { 17 | dts_init(x) 18 | } 19 | 20 | 21 | # main converter --------------------------------------------------------------- 22 | 23 | #' @name ts_ts 24 | #' @export 25 | ts_data.table <- function(x) { 26 | check_ts_boxable(x) 27 | if (relevant_class(x) == "data.table") { 28 | return(x) 29 | } 30 | ts_data.table_dts(ts_dts(x)) 31 | } 32 | 33 | #' @name ts_ts 34 | #' @export 35 | ts_dt <- function(x) { 36 | ts_data.table(x) 37 | } 38 | -------------------------------------------------------------------------------- /R/to_from_tibble.R: -------------------------------------------------------------------------------- 1 | register_class("tbl", "tbl_df") 2 | 3 | # to --------------------------------------------------------------------------- 4 | 5 | #' Convert to Class 6 | #' @noRd 7 | ts_tbl_dts <- function(x) { 8 | stopifnot(requireNamespace("tibble")) 9 | tibble::as_tibble(as.data.frame(ts_data.table(x))) 10 | } 11 | 12 | #' Convert to Class 13 | #' @noRd 14 | as.tbl_df <- function(x) { 15 | stopifnot(requireNamespace("tibble")) 16 | tibble::as_tibble(x) 17 | } 18 | 19 | # from ------------------------------------------------------------------------- 20 | 21 | # not needed, uses ts_dts.data.frame 22 | 23 | 24 | # main converter --------------------------------------------------------------- 25 | 26 | #' @name ts_ts 27 | #' @export 28 | ts_tbl <- function(x) { 29 | check_ts_boxable(x) 30 | if (relevant_class(x) == "tbl") { 31 | return(x) 32 | } 33 | ts_tbl_dts(ts_dts(x)) 34 | } 35 | -------------------------------------------------------------------------------- /R/to_from_tibbletime.R: -------------------------------------------------------------------------------- 1 | register_class("tibbletime", "tbl_time") 2 | 3 | # to --------------------------------------------------------------------------- 4 | 5 | #' Convert to Class 6 | #' @noRd 7 | ts_tibbletime_dts <- function(x) { 8 | stopifnot(requireNamespace("tibbletime")) 9 | stopifnot(requireNamespace("tibble")) 10 | 11 | z <- wide_core(combine_id_cols(x)) 12 | ctime <- dts_cname(x)$time 13 | tibbletime::as_tbl_time(z, index = !!ctime) 14 | } 15 | 16 | 17 | # from ------------------------------------------------------------------------- 18 | 19 | #' @export 20 | #' @method ts_dts tbl_time 21 | ts_dts.tbl_time <- function(x) { 22 | stopifnot(requireNamespace("tibbletime")) 23 | stopifnot(requireNamespace("tibble")) 24 | 25 | z <- as.data.table(x) 26 | time <- tibbletime::get_index_char(x) 27 | 28 | # clean up attributes 29 | setattr(z, "sorted", NULL) 30 | setattr(z, "index_quo", NULL) 31 | setattr(z, "index_time_zone", NULL) 32 | 33 | # simplified, single id melt, instead of ts_long,from ts_ts, ts_xts 34 | # could be factrored out. 35 | if (ncol(z) == 2L) { 36 | names(z)[2] <- "value" 37 | setcolorder(z, c(time, "value")) 38 | id <- character(0) 39 | } else { 40 | z <- melt(z, id.vars = time, variable.name = "id", variable.factor = FALSE) 41 | setcolorder(z, c("id", time, "value")) 42 | id <- "id" 43 | } 44 | 45 | cname <- list( 46 | id = id, 47 | time = time, 48 | value = "value" 49 | ) 50 | 51 | z <- dts_init(z) 52 | setattr(z, "cname", cname) 53 | z 54 | } 55 | 56 | 57 | # main converter --------------------------------------------------------------- 58 | 59 | #' @name ts_ts 60 | #' @export 61 | ts_tibbletime <- function(x) { 62 | check_ts_boxable(x) 63 | if (relevant_class(x) == "tibbletime") { 64 | return(x) 65 | } 66 | ts_tibbletime_dts(ts_dts(x)) 67 | } 68 | -------------------------------------------------------------------------------- /R/to_from_timeSeries.R: -------------------------------------------------------------------------------- 1 | register_class("timeSeries") 2 | 3 | # to --------------------------------------------------------------------------- 4 | 5 | #' Convert to Class 6 | #' @noRd 7 | ts_timeSeries_dts <- function(x) { 8 | stopifnot(requireNamespace("timeSeries")) 9 | stopifnot(requireNamespace("xts")) 10 | stopifnot(requireNamespace("zoo")) 11 | z <- ts_xts(x) 12 | dta <- zoo::coredata(z) 13 | timeSeries::timeSeries(dta, zoo::index(z), zone = dts_tattr(x)$tz) 14 | } 15 | 16 | 17 | # from ------------------------------------------------------------------------- 18 | 19 | #' @export 20 | #' @method ts_dts timeSeries 21 | ts_dts.timeSeries <- function(x) { 22 | stopifnot(requireNamespace("timeSeries")) 23 | stopifnot(requireNamespace("xts")) 24 | stopifnot(requireNamespace("zoo")) 25 | 26 | dta <- timeSeries::series(x) 27 | 28 | if (!grepl("%H", x@format)) { 29 | time <- as.Date(rownames(dta), format = x@format) 30 | } else { 31 | time <- as.POSIXct(rownames(dta), format = x@format, tz = x@FinCenter) 32 | } 33 | rownames(dta) <- NULL 34 | ts_dts(xts::xts(x = dta, order.by = time)) 35 | } 36 | 37 | 38 | # main converter --------------------------------------------------------------- 39 | 40 | #' @name ts_ts 41 | #' @export 42 | ts_timeSeries <- function(x) { 43 | check_ts_boxable(x) 44 | if (relevant_class(x) == "timeSeries") { 45 | return(x) 46 | } 47 | ts_timeSeries_dts(ts_dts(x)) 48 | } 49 | -------------------------------------------------------------------------------- /R/to_from_tis.R: -------------------------------------------------------------------------------- 1 | register_class("tis") 2 | 3 | # to --------------------------------------------------------------------------- 4 | 5 | #' Convert to Class 6 | #' @noRd 7 | ts_tis_dts <- function(x) { 8 | stopifnot(requireNamespace("tis")) 9 | x.ts <- ts_ts(x) 10 | x.tis <- tis::as.tis(x.ts) 11 | colnames(x.tis) <- colnames(x.ts) 12 | x.tis 13 | } 14 | 15 | 16 | # from ------------------------------------------------------------------------- 17 | 18 | #' @export 19 | #' @method ts_dts tis 20 | ts_dts.tis <- function(x) { 21 | stopifnot(requireNamespace("tis")) 22 | ts_dts(as.ts(x)) 23 | } 24 | 25 | 26 | # main converter --------------------------------------------------------------- 27 | 28 | #' @name ts_ts 29 | #' @export 30 | ts_tis <- function(x) { 31 | check_ts_boxable(x) 32 | if (relevant_class(x) == "tis") { 33 | return(x) 34 | } 35 | ts_tis_dts(ts_dts(x)) 36 | } 37 | -------------------------------------------------------------------------------- /R/to_from_tseries.R: -------------------------------------------------------------------------------- 1 | register_class("irts") 2 | 3 | # to --------------------------------------------------------------------------- 4 | 5 | #' Convert to Class 6 | #' @noRd 7 | ts_irts_dts <- function(x) { 8 | stopifnot(requireNamespace("tseries")) 9 | x.dt <- ts_wide(ts_data.table(ts_default(x))) 10 | time <- as.POSIXct(x.dt$time) 11 | data <- as.matrix(x.dt[, setdiff(names(x.dt), "time"), with = FALSE]) 12 | tseries::irts(time, data) 13 | } 14 | 15 | 16 | # from ------------------------------------------------------------------------- 17 | 18 | #' @export 19 | #' @method ts_dts irts 20 | ts_dts.irts <- function(x) { 21 | stopifnot(requireNamespace("tseries")) 22 | time <- as.POSIXct(x$time) 23 | class(time) <- "POSIXct" # need to loose POSIXt class 24 | z <- data.table(time = time, x$value) 25 | if (ncol(z) >= 3) z <- ts_long(z) 26 | ts_dts(z) 27 | } 28 | 29 | 30 | # main converter --------------------------------------------------------------- 31 | 32 | #' @name ts_ts 33 | #' @export 34 | ts_irts <- function(x) { 35 | check_ts_boxable(x) 36 | if (relevant_class(x) == "irts") { 37 | return(x) 38 | } 39 | ts_irts_dts(ts_dts(x)) 40 | } 41 | -------------------------------------------------------------------------------- /R/to_from_tsibble.R: -------------------------------------------------------------------------------- 1 | register_class("tsibble", "tbl_ts") 2 | 3 | # to --------------------------------------------------------------------------- 4 | 5 | #' Convert to Class 6 | #' @noRd 7 | ts_tsibble_dts <- function(x) { 8 | stopifnot(requireNamespace("tsibble")) 9 | cid <- dts_cname(x)$id 10 | ctime <- dts_cname(x)$time 11 | x <- dts_rm(x) 12 | 13 | if (length(cid) > 0) { 14 | z <- tsibble::as_tsibble(x, key = !!cid, index = !!ctime) 15 | } else { 16 | z <- tsibble::as_tsibble(x, index = !!ctime) 17 | } 18 | z 19 | } 20 | 21 | 22 | # from ------------------------------------------------------------------------- 23 | 24 | #' @export 25 | #' @method ts_dts tbl_ts 26 | ts_dts.tbl_ts <- function(x) { 27 | stopifnot(requireNamespace("tsibble")) 28 | 29 | z <- as.data.table(x) 30 | 31 | # using tsibble meta data, we can confident about ctime 32 | cid <- tsibble::key_vars(x) 33 | measures <- tsibble::measured_vars(x) 34 | ctime <- setdiff(names(z), c(measures, cid)) 35 | # browser() 36 | setnames(z, ctime, "time") 37 | 38 | if (class(z$time)[1] %in% c("yearmonth", "yearquarter", "yearweek")) { 39 | z$time <- as.Date(z$time) 40 | } 41 | 42 | # Ignoring non-numeric measure columns 43 | is.non.num <- vapply(z[, measures, with = FALSE], is.numeric, TRUE) 44 | measures.non.num <- measures[!is.non.num] 45 | if (length(measures.non.num) > 0) { 46 | message( 47 | "ignoring non-numeric measure vars (", 48 | paste(measures.non.num, collapse = ", "), 49 | ")." 50 | ) 51 | z[, (measures.non.num) := NULL] 52 | } 53 | 54 | cvalue <- setdiff(names(z), c("time", cid)) 55 | 56 | 57 | # get rid of tsibble specifc classes, like yearweek 58 | if (inherits(z$time, "Date")) { 59 | z$time <- as.Date(z$time) 60 | } 61 | if (inherits(z$time, "POSIXct")) { 62 | z$time <- as.POSIXct(z$time) 63 | } 64 | 65 | if (length(cvalue) > 1) { 66 | # also works if 'cid' includes 'id' 67 | z <- melt( 68 | z, 69 | id.vars = c(cid, "time"), measure.vars = cvalue, variable.name = "id" 70 | ) 71 | cvalue <- "value" 72 | } 73 | 74 | setcolorder(z, c(setdiff(names(z), c("time", cvalue)), "time", cvalue)) 75 | setnames(z, "time", ctime) 76 | ts_dts(z) 77 | } 78 | 79 | 80 | 81 | # main converter --------------------------------------------------------------- 82 | 83 | #' @name ts_ts 84 | #' @export 85 | ts_tsibble <- function(x) { 86 | check_ts_boxable(x) 87 | if (relevant_class(x) == "tsibble") { 88 | return(x) 89 | } 90 | ts_tsibble_dts(ts_dts(x)) 91 | } 92 | -------------------------------------------------------------------------------- /R/to_from_tslist.R: -------------------------------------------------------------------------------- 1 | register_class("tslist") 2 | 3 | # to --------------------------------------------------------------------------- 4 | 5 | #' Convert to Class 6 | #' @noRd 7 | ts_tslist_dts <- function(x) { 8 | stopifnot(inherits(x, "dts")) 9 | x <- combine_id_cols(x) 10 | if (number_of_series(x) == 1L) { 11 | z <- list(ts_ts(x)) 12 | # if a single series has an id, use to name element 13 | cid <- dts_cname(x)$id 14 | if (length(cid) > 0) { 15 | names(z) <- unique(x[[cid]]) 16 | } 17 | } else { 18 | cid <- dts_cname(x)$id 19 | spl <- split(x, x[[cid]]) 20 | spl <- spl[unique(x[[cid]])] 21 | z <- lapply(spl, ts_ts) 22 | } 23 | class(z) <- c("tslist", "list") 24 | z 25 | } 26 | 27 | 28 | # from ------------------------------------------------------------------------- 29 | 30 | #' @export 31 | #' @method ts_dts tslist 32 | ts_dts.tslist <- function(x) { 33 | ll <- lapply(x, ts_dts) 34 | if (length(ll) > 1) { 35 | z <- rbindlist(ll, idcol = "id") 36 | } else { 37 | z <- ll[[1]] 38 | } 39 | ts_dts(z) 40 | } 41 | 42 | 43 | # main converter --------------------------------------------------------------- 44 | 45 | #' @name ts_ts 46 | #' @export 47 | ts_tslist <- function(x) { 48 | check_ts_boxable(x) 49 | if (relevant_class(x) == "tslist") { 50 | return(x) 51 | } 52 | ts_tslist_dts(ts_dts(x)) 53 | } 54 | -------------------------------------------------------------------------------- /R/to_from_xts.R: -------------------------------------------------------------------------------- 1 | register_class("xts") 2 | 3 | # to --------------------------------------------------------------------------- 4 | 5 | #' Convert to Class 6 | #' @noRd 7 | ts_xts_dts <- function(x) { 8 | stopifnot(inherits(x, "dts")) 9 | stopifnot(requireNamespace("xts")) 10 | z <- wide_core(combine_id_cols(x)) 11 | xts::xts(x = as.matrix(z[, -1]), order.by = z[[1]]) 12 | } 13 | 14 | 15 | # from ------------------------------------------------------------------------- 16 | 17 | #' @export 18 | #' @method ts_dts xts 19 | ts_dts.xts <- function(x) { 20 | stopifnot(requireNamespace("xts")) 21 | 22 | idx <- attr(x, "index") 23 | tclass <- attr(idx, "tclass") 24 | attributes(idx) <- NULL 25 | 26 | dta <- as.data.frame(x, row.names = FALSE) 27 | if (tclass[1] == "Date") { 28 | time <- as.Date(as.POSIXct(idx, origin = "1970-01-01")) 29 | } else if (tclass[1] == "POSIXct") { 30 | time <- as.POSIXct(idx, origin = "1970-01-01") 31 | } else { 32 | # if regular, use as.ts to convert to ts 33 | return(ts_dts(as.ts(zoo::as.zoo(x)))) 34 | } 35 | 36 | dta <- data.table(time = time, dta) 37 | if (NCOL(dta) == 2L) { 38 | setnames(dta, c("time", "value")) 39 | } else { 40 | dta <- melt( 41 | dta, 42 | id.vars = "time", variable.name = "id", variable.factor = FALSE 43 | ) 44 | setcolorder(dta, c("id", "time", "value")) 45 | } 46 | dts_init(dta) 47 | } 48 | 49 | 50 | # main converter --------------------------------------------------------------- 51 | 52 | #' @name ts_ts 53 | #' @export 54 | ts_xts <- function(x) { 55 | check_ts_boxable(x) 56 | if (relevant_class(x) == "xts") { 57 | return(x) 58 | } 59 | ts_xts_dts(ts_dts(x)) 60 | } 61 | -------------------------------------------------------------------------------- /R/to_from_zoo.R: -------------------------------------------------------------------------------- 1 | register_class("zoo") 2 | 3 | # to --------------------------------------------------------------------------- 4 | 5 | #' Convert to Class 6 | #' @noRd 7 | ts_zoo_dts <- function(x) { 8 | stopifnot(requireNamespace("zoo")) 9 | zoo::as.zoo(ts_xts(x)) 10 | } 11 | 12 | 13 | # from ------------------------------------------------------------------------- 14 | 15 | #' @export 16 | #' @method ts_dts zoo 17 | ts_dts.zoo <- function(x) { 18 | stopifnot(requireNamespace("zoo")) 19 | stopifnot(requireNamespace("xts")) 20 | ts_dts(xts::as.xts(x)) 21 | } 22 | 23 | 24 | # main converter --------------------------------------------------------------- 25 | 26 | #' @name ts_ts 27 | #' @export 28 | ts_zoo <- function(x) { 29 | check_ts_boxable(x) 30 | if (relevant_class(x) == "zoo") { 31 | return(x) 32 | } 33 | ts_zoo_dts(ts_dts(x)) 34 | } 35 | -------------------------------------------------------------------------------- /R/to_from_zooreg.R: -------------------------------------------------------------------------------- 1 | register_class("zooreg") 2 | 3 | # to --------------------------------------------------------------------------- 4 | 5 | #' Convert to Class 6 | #' @noRd 7 | ts_zooreg_dts <- function(x) { 8 | stopifnot(requireNamespace("zoo")) 9 | zoo::as.zoo(ts_ts(x)) 10 | } 11 | 12 | 13 | # from ------------------------------------------------------------------------- 14 | 15 | #' @export 16 | #' @method ts_dts zooreg 17 | ts_dts.zooreg <- function(x) { 18 | stopifnot(requireNamespace("zoo")) 19 | stopifnot(requireNamespace("xts")) 20 | ts_dts(as.ts(x)) 21 | } 22 | 23 | 24 | # main converter --------------------------------------------------------------- 25 | 26 | #' @name ts_ts 27 | #' @export 28 | ts_zooreg <- function(x) { 29 | check_ts_boxable(x) 30 | if (relevant_class(x) == "zooreg") { 31 | return(x) 32 | } 33 | ts_zooreg_dts(ts_dts(x)) 34 | } 35 | -------------------------------------------------------------------------------- /R/ts_apply.R: -------------------------------------------------------------------------------- 1 | # ts_apply works on dts, so it may cause quite a bit of overhead if applied, 2 | # e.g. on a ts object. 3 | 4 | # fun can rely on time and value colum beeing called 'time' and 'value' 5 | 6 | #' Convert to Class 7 | #' 8 | #' @param x ts-boxable object 9 | #' @param fun function to apply 10 | #' 11 | #' @noRd 12 | ts_apply_dts <- function(x, fun, ...) { 13 | .SD <- NULL 14 | stopifnot(inherits(x, "dts")) 15 | d <- dts_default(x) 16 | x <- d$x 17 | if (number_of_series(x) == 1L) { 18 | z <- fun(x, ...) 19 | # ensure id columns are preserved 20 | missing.cid <- setdiff(colnames(x), colnames(z)) 21 | if (length(missing.cid) > 0) { 22 | for (i in missing.cid) { 23 | z[[i]] <- unique(x[[i]]) 24 | } 25 | } 26 | } else { 27 | .by <- by_expr(dts_cname(x)$id) 28 | # modifiy cname, to reflect single series character of .SD 29 | cname.sd <- dts_cname(x) 30 | cname.sd$id <- character(0) 31 | setattr(x, "cname", cname.sd) 32 | z <- x[, fun(.SD, ...), by = eval(.by)] 33 | } 34 | dts_restore(z, d) 35 | } 36 | 37 | # ts_apply(ts_c(mdeaths, fdeaths), ts_diff) 38 | #' @export 39 | #' @inherit ts_default 40 | #' @param ... arguments passed to subfunction 41 | #' @name ts_ 42 | ts_apply <- function(x, fun, ...) { 43 | check_ts_boxable(x) 44 | z <- ts_apply_dts(ts_dts(x), fun, ...) 45 | copy_class(z, x) 46 | } 47 | -------------------------------------------------------------------------------- /R/ts_arithmetic.R: -------------------------------------------------------------------------------- 1 | #' Arithmetic Operators for ts-boxable objects 2 | #' 3 | #' Users will call the infix operators 4 | #' 5 | #' @param e1 ts-boxable object 6 | #' @param e2 ts-boxable object 7 | #' @param fun funcion to apply 8 | #' 9 | #' @noRd 10 | ts_arithmetic <- function(e1, e2, fun = `-`) { 11 | value <- value2 <- .id <- NULL 12 | z1 <- copy(ts_dts(e1)) 13 | 14 | if (identical(nrow(z1), 0L)) { 15 | return(e1) 16 | } 17 | 18 | # 'recycling', if a scalar is provided 19 | if (length(e2) == 1L && is.numeric(e2)) { 20 | z2 <- copy(z1) 21 | z2[[dts_cname(z2)$value]] <- e2 22 | } else { 23 | z2 <- copy(ts_dts(e2)) 24 | } 25 | 26 | cname <- dts_cname(z1) 27 | cname2 <- dts_cname(z2) 28 | cid <- cname$id 29 | 30 | check_identical_ids(cname$id, cname2$id) 31 | 32 | setnames(z1, cname$value, "value") 33 | setnames(z2, cname2$value, "value2") 34 | setnames(z1, cname$time, "time") 35 | setnames(z2, cname2$time, "time") 36 | 37 | if (length(cname$id) > 0) { 38 | if (length(cname$id) > 1) { 39 | sep.str <- "!%!#" 40 | 41 | cid <- cname$id 42 | dt.id <- unique(z1[, cid, with = FALSE]) 43 | 44 | paste2 <- function(...) paste(..., sep = sep.str) 45 | dt.id[, .id := do.call(paste2, as.list(dt.id))] 46 | 47 | z1 <- merge(z1, dt.id, by = cid, sort = FALSE)[, (cid) := NULL] 48 | z2 <- merge(z2, dt.id, by = cid, sort = FALSE)[, (cid) := NULL] 49 | setnames(z1, ".id", "id") 50 | setnames(z2, ".id", "id") 51 | cid <- "id" 52 | } 53 | 54 | ll1 <- split(z1, z1[[cid]])[unique(z1[[cid]])] 55 | ll2 <- split(z2, z2[[cid]])[unique(z2[[cid]])] 56 | 57 | ll1 <- lapply(ll1, function(e) e[, (cid) := NULL]) 58 | ll2 <- lapply(ll2, function(e) e[, (cid) := NULL]) 59 | 60 | z <- rbindlist(Map(merge_time_date, x = ll1, y = ll2), idcol = cid) 61 | 62 | # separate id cols 63 | if (length(cname$id) > 1) { 64 | setnames(z, "id", ".id") 65 | z <- merge(z, dt.id, by = ".id", sort = FALSE)[, .id := NULL] 66 | setcolorder(z, c(cname$id, "time", "value", "value2")) 67 | } 68 | } else { 69 | z <- merge_time_date(z1, z2) 70 | } 71 | 72 | z[, value := fun(value, value2)] 73 | z[, value2 := NULL] 74 | z <- z[!is.na(value)] 75 | 76 | setnames(z, "time", cname$time) 77 | setnames(z, "value", cname$value) 78 | setattr(z, "cname", cname) 79 | copy_class(z, e1)[] 80 | } 81 | 82 | 83 | #' Arithmetic Operators for ts-boxable objects 84 | #' 85 | #' @param e1 ts-boxable time series, an object of class `ts`, `xts`, `zoo`, 86 | #' `zooreg`, `data.frame`, `data.table`, `tbl`, `tbl_ts`, `tbl_time`, `tis`, 87 | #' `irts` or `timeSeries`. 88 | #' @param e2 ts-boxable time series, an object of class `ts`, `xts`, `zoo`, 89 | #' `zooreg`, `data.frame`, `data.table`, `tbl`, `tbl_ts`, `tbl_time`, `tis`, 90 | #' `irts` or `timeSeries`. 91 | #' @return a ts-boxable time series, with the same class as the left input. 92 | #' @examples 93 | #' head(fdeaths - mdeaths) 94 | #' head(fdeaths %ts-% mdeaths) 95 | #' head(ts_df(fdeaths) %ts-% mdeaths) 96 | #' @export 97 | #' @name ts_arithmetic 98 | #' @export 99 | `%ts+%` <- function(e1, e2) ts_arithmetic(e1, e2, fun = `+`) 100 | 101 | #' @name ts_arithmetic 102 | #' @export 103 | `%ts-%` <- function(e1, e2) ts_arithmetic(e1, e2, fun = `-`) 104 | 105 | #' @name ts_arithmetic 106 | #' @export 107 | `%ts*%` <- function(e1, e2) ts_arithmetic(e1, e2, fun = `*`) 108 | 109 | #' @name ts_arithmetic 110 | #' @export 111 | `%ts/%` <- function(e1, e2) ts_arithmetic(e1, e2, fun = `/`) 112 | -------------------------------------------------------------------------------- /R/ts_bind.R: -------------------------------------------------------------------------------- 1 | #' Bind Time Series 2 | #' 3 | #' Combine time series to a new, single time series. `ts_bind` combines time 4 | #' series as they are, `ts_chain` chains them together, using percentage change 5 | #' rates. 6 | #' 7 | #' @seealso [ts_c] to collect multiple time series 8 | #' @inherit ts_c 9 | #' 10 | #' @examples 11 | #' ts_bind(ts_span(mdeaths, end = "1975-12-01"), fdeaths) 12 | #' ts_bind(mdeaths, c(2, 2)) 13 | #' ts_bind(mdeaths, 3, ts_bind(fdeaths, c(99, 2))) 14 | #' ts_bind(ts_dt(mdeaths), AirPassengers) 15 | #' 16 | #' # numeric vectors 17 | #' ts_bind(12, AirPassengers, c(2, 3)) 18 | #' @export 19 | ts_bind <- function(...) { 20 | ll <- list(...) 21 | 22 | tsboxable <- vapply(ll, ts_boxable, TRUE) 23 | desired.class <- desired_class(ll[tsboxable]) 24 | 25 | z <- Reduce(bind_two, ll) 26 | 27 | as_class(desired.class)(z) 28 | } 29 | 30 | 31 | #' Bind 2 Time Series or Numeric Values 32 | #' 33 | #' Enables ts_bind() to work on scalars and vectors, too 34 | #' 35 | #' @param a ts-boxable object, or numeric, or one-dimensional input of any class 36 | #' @param b ts-boxable object 37 | #' @param backwards logical, should `b` be appended to `a`? 38 | #' 39 | #' @noRd 40 | #' @srrstats {G2.6} *Software which accepts one-dimensional input should ensure values are appropriately pre-processed regardless of class structures.* 41 | bind_numeric <- function(a, b, backwards = FALSE) { 42 | .SD <- NULL 43 | 44 | if (!ts_boxable(a)) { 45 | stop0("at least one object must be ts-boxable") 46 | } 47 | 48 | a <- ts_dts(copy(a)) 49 | cname <- dts_cname(a) 50 | 51 | # allow logical NAs 52 | if (all(is.na(b)) && is.logical(b)) b <- as.numeric(b) 53 | 54 | stopifnot(is.numeric(b)) 55 | a <- ts_regular(a) 56 | 57 | add_scalar_one <- function(x) { 58 | per.to.add <- length(b) 59 | 60 | if (!backwards) { 61 | # having at least 5 obs allows time_shift to detect frequency 62 | shft <- time_shift( 63 | x$time[max(length(x$time) - per.to.add - 5, 1):length(x$time)], per.to.add 64 | ) 65 | new.time.stamps <- shft[(length(shft) - per.to.add + 1):length(shft)] 66 | } else { 67 | shft <- time_shift(x$time[1:min(per.to.add + 5, length(x$time))], -per.to.add) 68 | new.time.stamps <- shft[1:per.to.add] 69 | } 70 | 71 | new.x <- data.table( 72 | time = new.time.stamps, 73 | value = as.numeric(b) 74 | ) 75 | 76 | z <- rbind(x, new.x) 77 | 78 | if (backwards) { 79 | setorder(z, time) 80 | } 81 | z 82 | } 83 | 84 | setnames(a, cname$time, "time") 85 | setnames(a, cname$value, "value") 86 | .by <- by_expr(cname$id) 87 | z <- a[ 88 | , 89 | add_scalar_one(.SD), 90 | by = eval(.by) 91 | ] 92 | setnames(z, "value", cname$value) 93 | setnames(z, "time", cname$time) 94 | 95 | return(z) 96 | } 97 | 98 | 99 | #' Bind 2 Time Series 100 | #' 101 | #' Successively called by ts_bind() 102 | #' 103 | #' @param a ts-boxable object 104 | #' @param b ts-boxable object 105 | #' 106 | #' @noRd 107 | bind_two <- function(a, b) { 108 | value <- NULL 109 | value_b <- NULL 110 | 111 | # append numeric to dts object 112 | if (!ts_boxable(b)) { 113 | return(bind_numeric(a, b)) 114 | } 115 | if (!ts_boxable(a)) { 116 | return(bind_numeric(b, a, backwards = TRUE)) 117 | } 118 | 119 | a <- ts_dts(copy(a)) 120 | b <- ts_dts(copy(b)) 121 | 122 | cols_a <- copy(names(a)) 123 | 124 | default_colnames <- function(x) { 125 | cname <- attr(x, "cname") 126 | setnames(x, cname$time, "time") 127 | setnames(x, cname$value, "value") 128 | x 129 | } 130 | 131 | cname <- dts_cname(a) 132 | cname_b <- dts_cname(b) 133 | 134 | setnames(a, cname$time, "time") 135 | setnames(b, cname_b$time, "time") 136 | 137 | setnames(a, cname$value, "value") 138 | setnames(b, cname_b$value, "value_b") 139 | 140 | check_identical_ids(cname$id, dts_cname(b)$id) 141 | 142 | z <- merge(a, b, by = c(cname$id, "time"), all = TRUE) 143 | # remove key added by merge 144 | setkey(z, NULL) 145 | z <- z[is.na(value), value := value_b] 146 | z[, value_b := NULL] 147 | 148 | setnames(z, "time", cname$time) 149 | setnames(z, "value", cname$value) 150 | # keep order of first object 151 | setcolorder(z, cols_a) 152 | setattr(z, "cname", cname) 153 | dts_init_minimal(z) 154 | } 155 | -------------------------------------------------------------------------------- /R/ts_chain.R: -------------------------------------------------------------------------------- 1 | #' @name ts_bind 2 | #' @export 3 | #' @examples 4 | #' ts_chain(ts_span(mdeaths, end = "1975-12-01"), fdeaths) 5 | #' \donttest{ 6 | #' ts_plot(ts_pc(ts_c( 7 | #' comb = ts_chain(ts_span(mdeaths, end = "1975-12-01"), fdeaths), 8 | #' fdeaths 9 | #' ))) 10 | #' } 11 | ts_chain <- function(...) { 12 | ll <- list(...) 13 | 14 | tsboxable <- vapply(ll, ts_boxable, TRUE) 15 | stopifnot(all(tsboxable)) 16 | 17 | desired.class <- desired_class(ll) 18 | 19 | z <- Reduce(chain_two, ll) 20 | as_class(desired.class)(z) 21 | } 22 | 23 | 24 | #' Position of first TRUE Value 25 | #' 26 | #' @noRd 27 | first_true <- function(x) { 28 | which(cumsum(as.integer(x)) == 1L)[1] 29 | } 30 | 31 | 32 | #' Position of last TRUE Value 33 | #' 34 | #' @noRd 35 | last_true <- function(x) { 36 | which(cumsum(as.integer(x)) == sum(as.integer(x)))[1] 37 | } 38 | 39 | 40 | #' Chain 2 Time Series 41 | #' 42 | #' Successively called by ts_chain() 43 | #' 44 | #' @param a ts-boxable object 45 | #' @param b ts-boxable object 46 | #' 47 | #' @noRd 48 | chain_two <- function(a, b) { 49 | b <- ts_dts(b) 50 | a <- ts_dts(a) 51 | 52 | if ((number_of_series(b) > 1) || (number_of_series(a) > 1)) { 53 | stop0("only single series can be chain-linked") 54 | } 55 | 56 | stopifnot(inherits(b, "dts"), inherits(a, "dts")) 57 | 58 | cname <- dts_cname(a) 59 | cname2 <- dts_cname(b) 60 | 61 | # unify time class if needed 62 | cls <- union(class(b[[cname2$time]]), class(a[[cname$time]])) 63 | if ("POSIXct" %in% cls && "Date" %in% cls) { 64 | b[[cname2$time]] <- as.POSIXct(b[[cname2$time]]) 65 | a[[cname$time]] <- as.POSIXct(a[[cname$time]]) 66 | } 67 | 68 | # b is longer than a into the future: extraploation 69 | if (max(b[[cname2$time]]) > max(a[[cname$time]])) { 70 | where.in.b <- last_true(b[[cname2$time]] %in% a[[cname$time]]) 71 | where.in.a <- a[[cname$time]] %in% b[[cname2$time]][where.in.b] 72 | anchor.a <- a[[cname$value]][where.in.a] 73 | extra.b <- b[where.in.b:nrow(b)] 74 | extra.b[[cname2$value]] <- extra.b[[cname2$value]] / 75 | extra.b[[cname2$value]][1] * anchor.a 76 | a <- ts_bind(a, extra.b[-1]) 77 | } 78 | 79 | # b is longer than a into the past: retropolation 80 | if (min(b[[cname2$time]]) < min(a[[cname$time]])) { 81 | where.in.b <- first_true(b[[cname2$time]] %in% a[[cname$time]]) 82 | where.in.a <- a[[cname$time]] %in% b[[cname2$time]][where.in.b] 83 | anchor.a <- a[[cname$value]][where.in.a] 84 | retro.b <- b[1:where.in.b] 85 | retro.b[[cname2$value]] <- retro.b[[cname2$value]] / 86 | retro.b[[cname2$value]][nrow(retro.b)] * anchor.a 87 | a <- ts_bind(a[-1], retro.b) 88 | } 89 | 90 | a 91 | } 92 | -------------------------------------------------------------------------------- /R/ts_default.R: -------------------------------------------------------------------------------- 1 | #' Default Column Names 2 | #' 3 | #' In data frame objects (`data.frame`, `tibble`, `data.table`), tsbox 4 | #' automatically detects the time and the value column. This function changes 5 | #' the column names to the defaults (`time`, `value`), so that auto-detection 6 | #' can be avoided in future operations. 7 | #' 8 | #' @param x ts-boxable time series, an object of class `ts`, `xts`, `zoo`, 9 | #' `zooreg`, `data.frame`, `data.table`, `tbl`, `tbl_ts`, `tbl_time`, `tis`, 10 | #' `irts` or `timeSeries`. 11 | #' @return a ts-boxable object of the same class as `x`, i.e., an object of 12 | #' class `ts`, `xts`, `zoo`, `zooreg`, `data.frame`, `data.table`, `tbl`, 13 | #' `tbl_ts`, `tbl_time`, `tis`, `irts` or `timeSeries`. 14 | #' @examples 15 | #' \donttest{ 16 | #' df <- ts_df(ts_c(mdeaths, fdeaths)) 17 | #' # non-default colnames 18 | #' colnames(df) <- c("id", "date", "count") 19 | #' # switch back to default colnames 20 | #' ts_default(df) 21 | #' } 22 | #' @export 23 | #' @srrstats {G2.9} *Software should issue diagnostic messages for type conversion in which information is lost (such as conversion of variables from factor to character; standardisation of variable names; or removal of meta-data such as those associated with [`sf`-format](https://r-spatial.github.io/sf/) data) or added (such as insertion of variable or column names where none were provided).* 24 | #' Auto detection issues diagnostic messages on [time] and [value] column. 25 | ts_default <- function(x) { 26 | if (inherits(x, "ts")) { 27 | return(x) 28 | } 29 | z <- ts_dts(x) 30 | cname <- dts_cname(z) 31 | if (identical(cname$time, "time") && identical(cname$value, "value")) { 32 | return(x) 33 | } 34 | setnames(z, cname$time, "time") 35 | setnames(z, cname$value, "value") 36 | 37 | cname$time <- "time" 38 | cname$value <- "value" 39 | 40 | setcolorder(z, c(setdiff(names(z), c("time", "value")), c("time", "value"))) 41 | setattr(z, "cname", cname) 42 | copy_class(z, x) 43 | } 44 | -------------------------------------------------------------------------------- /R/ts_examples.R: -------------------------------------------------------------------------------- 1 | #' Principal Components, Dygraphs, Forecasts, Seasonal Adjustment 2 | #' 3 | #' Example Functions, Generated by [ts_]. `ts_prcomp` calculates the principal 4 | #' components of multiple time series, `ts_dygraphs` generates an interactive 5 | #' graphical visualization, `ts_forecast` return an univariate forecast, 6 | #' `ts_seas` the seasonally adjusted series. `ts_na_interpolation` imputes 7 | #' missing values. 8 | #' 9 | #' With the exception of `ts_prcomp`, these functions depend on external 10 | #' packages. 11 | #' 12 | #' @inherit ts_default 13 | #' @param ... further arguments, passed to the underlying function. For help, 14 | #' consider these functions, e.g., [stats::prcomp]. 15 | #' 16 | #' @seealso [Vignette](https://docs.ropensci.org/tsbox/articles/ts-functions.html) on how 17 | #' to make arbitrary functions ts-boxable. 18 | #' 19 | #' @examples 20 | #' \donttest{ 21 | #' ts_plot( 22 | #' ts_scale(ts_c( 23 | #' Male = mdeaths, 24 | #' Female = fdeaths, 25 | #' `First principal compenent` = -ts_prcomp(ts_c(mdeaths, fdeaths))[, 1] 26 | #' )), 27 | #' title = "Deaths from lung diseases", 28 | #' subtitle = "Normalized values" 29 | #' ) 30 | #' 31 | #' ts_plot(ts_c( 32 | #' male = mdeaths, female = fdeaths, 33 | #' ts_forecast(ts_c(`male (fct)` = mdeaths, `female (fct)` = fdeaths)) 34 | #' ), 35 | #' title = "Deaths from lung diseases", 36 | #' subtitle = "Exponential smoothing forecast" 37 | #' ) 38 | #' 39 | #' ts_plot( 40 | #' `Raw series` = AirPassengers, 41 | #' `Adjusted series` = ts_seas(AirPassengers), 42 | #' title = "Airline passengers", 43 | #' subtitle = "X-13 seasonal adjustment" 44 | #' ) 45 | #' 46 | #' 47 | #' # See ?imputeTS::na_interpolation for options 48 | #' dta <- ts_c(mdeaths, fdeaths) 49 | #' dta[c(1, 3, 10), c(1, 2)] <- NA 50 | #' head(ts_na_interpolation(dta, option = "spline")) 51 | #' 52 | #' ts_dygraphs(ts_c(mdeaths, EuStockMarkets)) 53 | #' } 54 | #' @export 55 | #' @name ts_examples 56 | ts_prcomp <- ts_(function(x, ...) predict(prcomp(x, scale = TRUE, ...))) 57 | 58 | #' @export 59 | #' @name ts_examples 60 | ts_dygraphs <- ts_(dygraphs::dygraph, class = "xts", reclass = FALSE) 61 | 62 | #' @export 63 | #' @name ts_examples 64 | ts_forecast <- ts_( 65 | function(x, ...) forecast::forecast(ts_na_omit(x), ...)$mean, 66 | vectorize = TRUE 67 | ) 68 | 69 | #' @export 70 | #' @name ts_examples 71 | ts_seas <- ts_( 72 | function(x, ...) seasonal::final(seasonal::seas(x, ...)), 73 | vectorize = TRUE 74 | ) 75 | 76 | #' @export 77 | #' @name ts_examples 78 | ts_na_interpolation <- ts_( 79 | function(x, ...) imputeTS::na_interpolation(x, ...) 80 | ) 81 | -------------------------------------------------------------------------------- /R/ts_first_of_period.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | #' Use First Date of a Period 5 | #' 6 | #' Replace date or time values by the first of the period. tsbox usually relies 7 | #' on timestamps being the first value of a period. 8 | #' 9 | #' @inherit ts_default 10 | #' 11 | #' @examples 12 | #' x <- ts_c( 13 | #' a = ts_lag(ts_df(mdeaths), "14 days"), 14 | #' b = ts_lag(ts_df(mdeaths), "-2 days") 15 | #' ) 16 | #' ts_first_of_period(x) 17 | #' ts_first_of_period(ts_lag(ts_df(austres), "14 days")) 18 | #' @export 19 | ts_first_of_period <- function(x) { 20 | ts_apply(x, dts_first_of_period) 21 | } 22 | 23 | 24 | #' Use First Date of a Period (dts) 25 | #' 26 | #' @param x a 'dts' object 27 | #' 28 | #' @noRd 29 | dts_first_of_period <- function(x) { 30 | check_frequency_detection(x) 31 | 32 | value <- NULL 33 | has.value <- NULL 34 | time.orig <- NULL 35 | smry <- ts_summary(x) 36 | start <- date_year(smry$start) 37 | end <- as.Date(paste(data.table::year(smry$end) + 2, "1", "1", sep = "-")) 38 | 39 | if (isTRUE(smry$freq < 1)) { # e.g., decades 40 | start <- as.Date( 41 | paste(data.table::year(smry$start) %/% 10 * 10, "1", "1", sep = "-") 42 | ) 43 | end <- as.Date( 44 | paste( 45 | data.table::year(smry$end) %/% 10 * 10 + 10, "1", "1", sep = "-") 46 | ) 47 | } 48 | 49 | if (inherits(start, "POSIXct")) { 50 | end <- as.POSIXct(end) 51 | # make sure time is covered even if UTC start is in previous year 52 | start <- start - 3600 * 24 53 | } 54 | time <- seq(start, end, by = smry$diff) 55 | time_ad <- time[(max(which(time <= smry$start)):min(which(time >= smry$end)))] 56 | time.tmpl <- data.table(time = time_ad) 57 | x1 <- x[, list(time, value)] 58 | x1[, has.value := TRUE] 59 | x1[, time.orig := time] 60 | 61 | # next observation carried backward (NOCB) 62 | z <- x1[time.tmpl, roll = -Inf, on = "time"] 63 | 64 | # remove observations that are carried backward more than 1 times 65 | z <- z[time.orig < shift(time, n = -1)][has.value == TRUE] 66 | 67 | z[, has.value := NULL] 68 | z[, time.orig := NULL] 69 | 70 | z 71 | } 72 | -------------------------------------------------------------------------------- /R/ts_index.R: -------------------------------------------------------------------------------- 1 | #' @param denominator positive number. Set equal to 1 if percentage change rate is 2 | #' given a decimal fraction 3 | #' @name ts_index 4 | #' @export 5 | #' @srrstats {G2.4b} *explicit conversion to continuous via `as.numeric()`* 6 | ts_compound <- function(x, denominator = 100) { 7 | 8 | not_in_data <- NULL 9 | value <- NULL 10 | 11 | denominator <- as.numeric(denominator) 12 | stopifnot(denominator > 0) 13 | stopifnot(length(denominator) == 1L) 14 | z <- ts_dts(x) 15 | d <- dts_default(z) 16 | z <- d$x 17 | 18 | z <- ts_regular(ts_na_omit(z)) 19 | 20 | z[, value := value / denominator + 1] 21 | 22 | # Adding a future value to get the right length of time series 23 | z <- ts_bind(ts_lag(z, -1), -99999) 24 | 25 | .by <- by_expr(dts_cname(z)$id) 26 | z[ 27 | , 28 | value := c(1, cumprod(value[-length(value)])), 29 | by = eval(.by) 30 | ] 31 | z <- dts_restore(z, d) 32 | ts_na_omit(copy_class(z, x)) 33 | } 34 | 35 | 36 | #' Indices from Levels or Percentage Rates 37 | #' 38 | #' `ts_index` returns an indexed series, with value of 1 at the `base` date or 39 | #' range. 40 | #' `ts_compound` builds an index from percentage change rates, starting with 1 41 | #' and compounding the rates. 42 | #' 43 | #' @inherit ts_default 44 | #' @param base base date, character string, `Date` or `POSIXct`, at which the 45 | #' index is set to 1. If two dates are provided, the mean in the range is 46 | #' set equal to 1 (see examples). 47 | #' @examples 48 | #' x <- ts_pc(ts_c(fdeaths, mdeaths)) 49 | #' ts_compound(x) 50 | #' y <- ts_df(ts_c(fdeaths, mdeaths)) 51 | #' ts_index(y, "1974-02-01") 52 | #' \donttest{ 53 | #' ts_plot( 54 | #' `My Expert Knowledge` = ts_chain( 55 | #' mdeaths, 56 | #' ts_compound(ts_bind(ts_pc(mdeaths), 15, 23, 33)) 57 | #' ), 58 | #' `So Far` = mdeaths, 59 | #' title = "A Very Manual Forecast" 60 | #' ) 61 | #' 62 | #' # mean of 1974 = 1 63 | #' ts_index(mdeaths, c("1974-01-01", "1974-12-31")) 64 | #' } 65 | #' @export 66 | ts_index <- function(x, base = NULL) { 67 | not_in_data <- NULL 68 | value <- NULL 69 | base_value <- NULL 70 | .SD <- NULL 71 | . <- NULL 72 | 73 | z <- ts_dts(x) 74 | if (nrow(z) == 0L) return(x) 75 | d <- dts_default(z) 76 | z <- d$x 77 | 78 | cid <- dts_cname(z)$id 79 | .by <- by_expr(cid) 80 | 81 | if (all(is.na(d$x$value))) return(x) 82 | 83 | # use latest non na start point as base candidate 84 | if (is.null(base)) { 85 | dt_min_time <- z[ 86 | !is.na(value), 87 | list(min.time = min(time)), 88 | by = eval(.by) 89 | ] 90 | base <- max(dt_min_time$min.time) 91 | z.base <- z[is_near(time, base), .(base_value = mean(value)), by = eval(.by)] 92 | 93 | # single date specification 94 | } else if (length(base) == 1L) { 95 | # let ts_span parse base and make sure it exists in data 96 | base <- range(ts_span(z, start = base)$time)[1] 97 | z.base <- z[is_near(time, base), .(base_value = mean(value)), by = eval(.by)] 98 | 99 | # range of dates specification (use averages) 100 | } else if (length(base) == 2L) { 101 | # let ts_span parse base and make sure it exists in data 102 | base <- range(ts_span(z, start = base[1], end = base[2])$time) 103 | z.base <- z[ 104 | time >= base[1] & time <= base[2], 105 | .(base_value = mean(value)), 106 | by = eval(.by) 107 | ] 108 | } else { 109 | stop0("'base' must be of length 1 or 2, or NULL.") 110 | } 111 | 112 | if (length(cid) > 0) { 113 | z <- merge(z, z.base, by = cid, sort = FALSE) 114 | } else { 115 | z$base_value <- z.base$base_value 116 | } 117 | z[, value := value / base_value][, base_value := NULL] 118 | 119 | z <- dts_restore(z, d) 120 | copy_class(z, x) 121 | } 122 | -------------------------------------------------------------------------------- /R/ts_lag.R: -------------------------------------------------------------------------------- 1 | #' Lag or Lead of Time Series 2 | #' 3 | #' Shift time stamps in ts-boxable time series, either by a number of periods or 4 | #' by a fixed amount of time. 5 | #' 6 | #' The lag order, `by`, is defined the opposite way as in R base. Thus, -1 is a 7 | #' lead and +1 a lag. 8 | #' 9 | #' If `by` is integer, the time stamp is shifted by the number of periods. This 10 | #' requires the series to be regular. 11 | #' 12 | #' If `by` is character, the time stamp is shifted by a specific amount of time. 13 | #' This can be one of one of `"sec"`, `"min"`, `"hour"`, `"day"`, `"week"`, 14 | #' `"month"`, `"quarter" or `"year", optionally preceded by a (positive or 15 | #' negative) integer and a space, or followed by plural "s". This is passed to 16 | #' [base::seq.Date()]. This does not require the series to be regular. 17 | #' 18 | #' @inherit ts_default 19 | #' @param by integer or character, either the number of shifting periods 20 | #' (integer), or an absolute amount of time (character). See details. 21 | #' 22 | #' @examples 23 | #' \donttest{ 24 | #' ts_plot(AirPassengers, ts_lag(AirPassengers), title = "The need for glasses") 25 | #' } 26 | #' ts_lag(fdeaths, "1 month") 27 | #' ts_lag(fdeaths, "1 year") 28 | #' x <- ts_df(fdeaths) 29 | #' ts_lag(x, "2 day") 30 | #' ts_lag(x, "2 min") 31 | #' ts_lag(x, "-1 day") 32 | #' @export 33 | ts_lag <- function(x, by = 1) { 34 | stopifnot(length(by) == 1L) 35 | 36 | value <- NULL 37 | .SD <- NULL 38 | 39 | check_ts_boxable(x) 40 | z <- copy(ts_dts(x)) 41 | 42 | # numeric by only with regular series 43 | if (is.numeric(by)) { 44 | z <- ts_regular(z) 45 | } 46 | 47 | cname <- dts_cname(z) 48 | setnames(z, cname$time, "time") 49 | setnames(z, cname$value, "value") 50 | 51 | lag_one <- function(x) { 52 | check_frequency_detection(x) 53 | if (nrow(x) == 0L) return(x) 54 | x[, list(time = time_shift(time, by = by), value)] 55 | } 56 | .by <- by_expr(cname$id) 57 | z <- z[ 58 | , 59 | lag_one(.SD), 60 | by = eval(.by) 61 | ] 62 | 63 | setnames(z, "value", cname$value) 64 | setnames(z, "time", cname$time) 65 | setattr(z, "cname", cname) 66 | copy_class(z, x) 67 | } 68 | -------------------------------------------------------------------------------- /R/ts_long_wide.R: -------------------------------------------------------------------------------- 1 | #' Reshaping Multiple Time Series 2 | #' 3 | #' Functions to reshape multiple time series from 'wide' to 'long' and vice 4 | #' versa. Note that long format data frames are ts-boxable objects, where wide 5 | #' format data frames are not. `ts_long` automatically identifies a **time** 6 | #' column, and uses columns on the left as id columns. 7 | #' 8 | #' @param x a ts-boxable time series, or a wide `data.frame`, 9 | #' `data.table`, or `tibble`. 10 | #' 11 | #' @inherit ts_default return 12 | #' @examples 13 | #' x <- ts_df(ts_c(mdeaths, fdeaths)) 14 | #' df.wide <- ts_wide(x) 15 | #' df.wide 16 | #' ts_long(df.wide) 17 | #' @export 18 | ts_long <- function(x) { 19 | rc <- relevant_class(x) 20 | if (rc %in% c("xts", "ts")) { 21 | return(x) 22 | } 23 | z <- long_core_multi_id(as.data.table(x)) 24 | copy_class(z, x, preserve.names = FALSE) 25 | } 26 | 27 | 28 | #' Make Wide data.table Long 29 | #' 30 | #' Core function that works on data.table, called by ts_long() 31 | #' 32 | #' @param x data.table 33 | #' 34 | #' @noRd 35 | long_core_multi_id <- function(x) { 36 | stopifnot(inherits(x, "data.table")) 37 | time.name <- guess_time(x) 38 | # guess id: ids on the left of time colum 39 | all.names <- names(x) 40 | time.pos <- which(all.names == time.name) 41 | id.names <- setdiff(all.names[1:time.pos], time.name) 42 | value.names <- setdiff(all.names[time.pos:length(all.names)], time.name) 43 | 44 | # character cols or factors should be considered ids, with message 45 | value.classes <- vapply(x[, value.names, with = FALSE], class, "") 46 | value.names.that.are.ids <- names(value.classes)[value.classes %in% c("character", "factor")] 47 | 48 | if (length(value.names.that.are.ids) > 0) { 49 | message( 50 | "found columns right to the [time] column that will be treated as [id] ", 51 | "columns (character or factor): ", 52 | paste_quoted(value.names.that.are.ids), 53 | "." 54 | ) 55 | value.names <- setdiff(value.names, value.names.that.are.ids) 56 | id.names <- union(id.names, value.names.that.are.ids) 57 | } 58 | 59 | if (length(value.names) == 0L) { 60 | stop0("no [value] column(s) detected. \n[value] column(s) must be right of the [time] column.") 61 | } 62 | if (length(id.names) > 0) { 63 | message( 64 | "Additional [id] column(s): ", 65 | paste(paste0("'", id.names, "'"), collapse = ", ") 66 | ) 67 | id.vars <- c(id.names, time.name) 68 | } else { 69 | id.vars <- time.name 70 | } 71 | 72 | un <- make.unique(c(id.vars, "id")) 73 | new.id.name <- un[length(un)] 74 | 75 | z <- suppressWarnings( 76 | melt(x, id.vars = id.vars, variable.name = new.id.name, variable.factor = FALSE) 77 | ) 78 | setcolorder(z, c(id.names, new.id.name, time.name, "value")) 79 | ts_dts(z) 80 | } 81 | 82 | 83 | #' @export 84 | #' @name ts_long 85 | ts_wide <- function(x) { 86 | check_ts_boxable(x) 87 | rc <- relevant_class(x) 88 | if (rc %in% c("ts", "xts", "tbl_time", "tbl_ts", "tis")) { 89 | return(x) 90 | } 91 | x.dts <- combine_id_cols(ts_dts(x)) 92 | z <- wide_core(x.dts) 93 | # reclass 94 | rc <- relevant_class(x) 95 | as_class <- get(paste0("as.", rc)) 96 | as_class(z) 97 | } 98 | 99 | 100 | #' Make Wide dts a Long data.table 101 | #' 102 | #' Core function that works on dts and data.table, called by ts_wide() 103 | #' 104 | #' @param x dts 105 | #' 106 | #' @noRd 107 | wide_core <- function(x) { 108 | stopifnot(inherits(x, "dts")) 109 | if (ncol(x) == 2L) { 110 | return(x) 111 | } # nothing to do 112 | # no multi id 113 | stopifnot(ncol(x) == 3L) 114 | 115 | cname <- dts_cname(x) 116 | 117 | # tattr <- dts_tattr(x) 118 | 119 | n.non.unique <- nrow(x) - nrow(unique(x, by = c(cname$id, cname$time))) 120 | if (n.non.unique > 0) { 121 | stop("contains duplicate entries (this error should not occur.") 122 | } 123 | 124 | # dcast is confused by factors 125 | if (is.factor(x[[cname$id]])) x[[cname$id]] <- as.character(x[[cname$id]]) 126 | 127 | setnames(x, cname$time, "time") 128 | 129 | # # dcast is confused by some things 130 | # cname$id <- gsub("~", "_", cname$id, fixed = TRUE) 131 | # setnames(x, gsub("~", "_", names(x), fixed = TRUE)) 132 | # 133 | # Casting works fine for POSIXct as well. 134 | z <- dcast( 135 | x, 136 | as.formula(substitute(time ~ id, list(id = as.name(cname$id)))), 137 | value.var = cname$value, drop = FALSE 138 | ) 139 | setnames(z, "time", cname$time) 140 | 141 | # keep order as in input 142 | setcolorder(z, c(cname$time, unique(as.character(x[[cname$id]])))) 143 | z 144 | } 145 | -------------------------------------------------------------------------------- /R/ts_na_omit.R: -------------------------------------------------------------------------------- 1 | #' Omit NA values 2 | #' 3 | #' Remove NA values in ts-boxable objects, turning explicit into implicit 4 | #' missing values. 5 | #' 6 | #' Note that internal NAs in `ts` time series will not be removed, as this 7 | #' conflicts with the regular structure. 8 | #' 9 | #' @inherit ts_default 10 | #' 11 | #' @seealso [ts_regular], for the opposite, turning implicit into explicit 12 | #' missing values. 13 | #' 14 | #' @examples 15 | #' x <- AirPassengers 16 | #' x[c(2, 4)] <- NA 17 | #' 18 | #' # A ts object does only know explicit NAs 19 | #' ts_na_omit(x) 20 | #' 21 | #' # by default, NAs are implicit in data frames 22 | #' ts_df(x) 23 | #' 24 | #' # make NAs explicit 25 | #' ts_regular(ts_df(x)) 26 | #' 27 | #' # and implicit again 28 | #' ts_na_omit(ts_regular(ts_df(x))) 29 | #' @export 30 | ts_na_omit <- function(x) { 31 | value <- NULL 32 | z <- ts_dts(x) 33 | if (inherits(x, "dts")) z <- copy(z) 34 | cname <- dts_cname(z) 35 | cvalue <- cname$value 36 | setnames(z, cvalue, "value") 37 | z <- z[!is.na(value)] 38 | setnames(z, "value", cvalue) 39 | setattr(z, "cname", cname) 40 | as_class(relevant_class(x))(z) 41 | } 42 | -------------------------------------------------------------------------------- /R/ts_pc.R: -------------------------------------------------------------------------------- 1 | #' First Differences and Percentage Change Rates 2 | #' 3 | #' `ts_pcy` and `ts_diffy` calculate the percentage change rate and the 4 | #' difference compared to the previous period, `ts_pcy` and `ts_diffy` calculate 5 | #' the percentage change rate compared to the same period of the previous year. 6 | #' `ts_pca` calculates annualized percentage change rates compared to the 7 | #' previous period. 8 | #' 9 | #' @inherit ts_default 10 | #' @examples 11 | #' 12 | #' x <- ts_c(fdeaths, mdeaths) 13 | #' ts_diff(x) 14 | #' ts_pc(x) 15 | #' ts_pca(x) 16 | #' ts_pcy(x) 17 | #' ts_diffy(x) 18 | #' @export 19 | ts_pc <- function(x) { 20 | ts_apply(ts_regular(x), function(x) { 21 | check_frequency_detection(x) 22 | value <- NULL 23 | x[, list(time, value = 100 * (as.numeric(value) / c(NA_real_, as.numeric(value)[-length(value)]) - 1))] 24 | }) 25 | } 26 | 27 | 28 | #' @name ts_pc 29 | #' @export 30 | ts_diff <- function(x) { 31 | ts_apply(ts_regular(x), function(x) { 32 | check_frequency_detection(x) 33 | value <- NULL 34 | x[, list(time, value = as.numeric(value) - c(NA_real_, as.numeric(value)[-length(value)]))] 35 | }) 36 | } 37 | 38 | 39 | #' @name ts_pc 40 | #' @export 41 | ts_pca <- function(x) { 42 | ts_apply(ts_regular(x), function(x) { 43 | check_frequency_detection(x) 44 | fr <- frequency_one(x$time)$freq 45 | value <- NULL 46 | x[ 47 | , 48 | list(time, value = 100 * ((as.numeric(value) / c(NA_real_, as.numeric(value)[-length(value)]))^fr - 1)) 49 | ] 50 | }) 51 | } 52 | 53 | 54 | #' @name ts_pc 55 | #' @export 56 | ts_pcy <- function(x) { 57 | ts_apply(ts_regular(x), function(x) { 58 | check_frequency_detection(x) 59 | value <- NULL 60 | value_lag <- NULL 61 | xlag <- data.table(time = time_shift(x$time, "1 year"), value_lag = x$value) 62 | xlag[x, on = "time"][, list(time, value = (value / value_lag - 1) * 100)] 63 | }) 64 | } 65 | 66 | #' @name ts_pc 67 | #' @export 68 | ts_diffy <- function(x) { 69 | ts_apply(ts_regular(x), function(x) { 70 | check_frequency_detection(x) 71 | value <- NULL 72 | value_lag <- NULL 73 | xlag <- data.table(time = time_shift(x$time, "1 year"), value_lag = x$value) 74 | xlag[x, on = "time"][, list(time, value = value - value_lag)] 75 | }) 76 | } 77 | -------------------------------------------------------------------------------- /R/ts_pick.R: -------------------------------------------------------------------------------- 1 | #' Pick Series (Experimental) 2 | #' 3 | #' Pick (and optionally rename) series from multiple time series. 4 | #' 5 | #' @inherit ts_default 6 | #' @param ... character string(s), names of the series to be picked, or integer, 7 | #' with positions. If arguments are named, the series will be renamed. 8 | #' @examples 9 | #' # Interactive use 10 | #' \donttest{ 11 | #' ts_plot(ts_pick( 12 | #' EuStockMarkets, 13 | #' `My Dax` = "DAX", 14 | #' `My Smi` = "SMI" 15 | #' )) 16 | #' ts_pick(EuStockMarkets, c(1, 2)) 17 | #' ts_pick(EuStockMarkets, `My Dax` = "DAX", `My Smi` = "SMI") 18 | #' 19 | #' # Programming use 20 | #' to.be.picked.and.renamed <- c(`My Dax` = "DAX", `My Smi` = "SMI") 21 | #' ts_pick(EuStockMarkets, to.be.picked.and.renamed) 22 | #' } 23 | #' 24 | #' @export 25 | ts_pick <- function(x, ...) { 26 | check_ts_boxable(x) 27 | 28 | id <- NULL 29 | call.names <- unlist(lapply(substitute(placeholderFunction(...))[-1], deparse, 30 | width.cutoff = 500L 31 | )) 32 | 33 | .id <- c(...) 34 | 35 | if (is.null(names(.id))) names(.id) <- .id 36 | names(.id)[names(.id) == ""] <- .id[names(.id) == ""] 37 | 38 | x.dts <- ts_dts(x) 39 | if (ncol(x.dts) == 2L) { 40 | return(x) 41 | } # do nothing with singel time series 42 | 43 | z <- combine_id_cols(x.dts) 44 | 45 | cname <- dts_cname(z) 46 | 47 | if (is.numeric(.id)) { 48 | names.id <- names(.id) 49 | base.id <- as.character(unname(.id)) 50 | .id <- unique(z[[cname$id]])[.id] 51 | if (!identical(names.id, base.id)) { 52 | .id <- setNames(.id, names.id) 53 | } else { 54 | .id <- setNames(.id, .id) 55 | } 56 | } 57 | 58 | missing.in.data <- !(.id %in% z[[cname$id]]) 59 | if (any(missing.in.data)) { 60 | stop0( 61 | "values missing in data: ", 62 | paste(.id[missing.in.data], collapse = ", ") 63 | ) 64 | } 65 | 66 | setkeyv(z, cname$id) 67 | z <- z[.id] 68 | z[[cname$id]] <- as.factor(z[[cname$id]]) 69 | levels(z[[cname$id]]) <- names(.id)[match(levels(z[[cname$id]]), .id)] 70 | z[[cname$id]] <- as.character(z[[cname$id]]) 71 | 72 | copy_class(z, x) 73 | } 74 | -------------------------------------------------------------------------------- /R/ts_regular.R: -------------------------------------------------------------------------------- 1 | #' Enforce Regularity 2 | #' 3 | #' Enforces regularity in data frame and `xts` objects, by turning implicit 4 | #' `NA`s into explicit `NA`s. In `ts` objects, regularity is automatically 5 | #' enforced. 6 | #' 7 | #' @inherit ts_default 8 | #' @param fill numeric, instead of `NA`, an alternative value can be specified. 9 | #' E.g., 0, -99. 10 | #' @examples 11 | #' x0 <- AirPassengers 12 | #' x0[c(10, 15)] <- NA 13 | #' x <- ts_na_omit(ts_dts(x0)) 14 | #' ts_regular(x) 15 | #' ts_regular(x, fill = 0) 16 | #' 17 | #' m <- mdeaths 18 | #' m[c(10, 69)] <- NA 19 | #' f <- fdeaths 20 | #' f[c(1, 3, 15)] <- NA 21 | #' 22 | #' ts_regular(ts_na_omit(ts_dts(ts_c(f, m)))) 23 | #' @export 24 | ts_regular <- function(x, fill = NA) { 25 | check_ts_boxable(x) 26 | fill <- as.numeric(fill) 27 | if (length(fill) != 1) stop0("'fill' must be of length 1") 28 | 29 | if (inherits(x, "ts")) { # to save time 30 | if (!is.na(fill)) { 31 | x[is.na(x)] <- fill 32 | } 33 | return(x) 34 | } 35 | # standard routine 36 | z <- regular_core(ts_dts(x)) 37 | if (!is.na(fill)) { 38 | cvalue <- dts_cname(z)$value 39 | z[[cvalue]][is.na(z[[cvalue]])] <- fill 40 | } 41 | copy_class(z, x) 42 | } 43 | 44 | 45 | #' Basic Test for Regularity 46 | #' 47 | #' Fast, but misses some regular series 48 | #' 49 | #' @param x Date or POSIXct 50 | #' 51 | #' @noRd 52 | is_regular_one_basic <- function(x) { 53 | if (length(x) == 0L) { 54 | return(TRUE) 55 | } 56 | if (length(x) == 1L) { 57 | return(TRUE) 58 | } 59 | rng <- range(diff(as.numeric(x))) 60 | (rng[2] - rng[1]) < 1 61 | } 62 | 63 | 64 | #' Enforce Regularity 65 | #' 66 | #' Core function that works on dts, called by ts_regular() 67 | #' 68 | #' @param x data.table 69 | #' 70 | #' @noRd 71 | regular_core <- function(x) { 72 | stopifnot(inherits(x, "dts")) 73 | 74 | cname <- dts_cname(x) 75 | ctime <- cname$time 76 | cid <- cname$id 77 | .SD <- NULL 78 | 79 | names.x <- copy(names(x)) 80 | setnames(x, ctime, "time") 81 | 82 | regular_core_one <- function(x) { 83 | check_missing_time(x$time) 84 | if (is_regular_one_basic(x$time)) { 85 | return(x) 86 | } 87 | reg.time <- regularize_date(x$time) 88 | check_regular_pattern(reg.time) 89 | merge_time_date( 90 | data.table(time = reg.time), 91 | x, 92 | by.x = "time", 93 | by.y = "time" 94 | ) 95 | } 96 | 97 | if (length(cid) == 0L) { 98 | z <- regular_core_one(x) 99 | } else { 100 | .by <- by_expr(cid) 101 | z <- x[, regular_core_one(.SD), by = eval(.by)] 102 | } 103 | 104 | setattr(z, "cname", cname) 105 | 106 | # resulting time column name should be ctime 107 | setnames(z, "time", ctime) 108 | # preserve original col order 109 | setcolorder(z, names.x) 110 | z 111 | } 112 | -------------------------------------------------------------------------------- /R/ts_scale.R: -------------------------------------------------------------------------------- 1 | # A blueprint for new functions? If possible, functions should work on dts, not 2 | # on other objects. Faster and keeps time stamp intact. 3 | 4 | #' Scale and Center Time Series 5 | #' 6 | #' Subtract mean (*sum(x)/n*) and divide by standard deviation 7 | #' (*sqrt(sum(x^2)/(n-1))*). Based on [base::scale()]. 8 | #' 9 | #' @inherit ts_default 10 | #' @param center logical 11 | #' @param scale logical 12 | #' @export 13 | #' @examples 14 | #' \donttest{ 15 | #' ts_plot(ts_scale((ts_c(airmiles, co2, JohnsonJohnson, discoveries)))) 16 | #' ts_plot(ts_scale(ts_c(AirPassengers, DAX = EuStockMarkets[, "DAX"]))) 17 | #' } 18 | #' @srrstats {G1.3} *All statistical terminology should be clarified and unambiguously defined.* 19 | ts_scale <- function(x, center = TRUE, scale = TRUE) { 20 | value <- NULL 21 | z <- ts_dts(x) 22 | 23 | cid <- dts_cname(z)$id 24 | cvalue <- dts_cname(z)$value 25 | setnames(z, cvalue, "value") 26 | 27 | scale_core <- function(value) { 28 | z <- scale(value, center = center, scale = scale) 29 | attr(z, "scaled:center") <- NULL 30 | attr(z, "scaled:scale") <- NULL 31 | z 32 | } 33 | 34 | .by <- by_expr(cid) 35 | z[ 36 | , 37 | value := scale_core(value), 38 | by = eval(.by) 39 | ] 40 | setnames(z, "value", cvalue) 41 | ts_na_omit(copy_class(z, x)) 42 | } 43 | -------------------------------------------------------------------------------- /R/ts_trend.R: -------------------------------------------------------------------------------- 1 | #' Loess Trend Estimation 2 | #' 3 | #' Trend estimation that uses [stats::loess()]. 4 | #' 5 | #' @inherit ts_default 6 | #' @param ... arguments, passed to [stats::loess()]: 7 | #' - `degree` degree of Loess smoothing 8 | #' - `span` smoothing parameter, if `NULL`, an automated search performed (see 9 | #' Details) 10 | #' @references Cleveland, William S., Eric Grosse, and William M. Shyu. "Local regression models." Statistical models in S. Routledge, 2017. 309-376. 11 | #' @srrstats {G1.0} *Statistical Software should list at least one primary reference from published academic literature.* 12 | #' This is an upldated reference from ?loess 13 | #' 14 | #' @examples 15 | #' \donttest{ 16 | #' ts_plot( 17 | #' `Raw series` = fdeaths, 18 | #' `Loess trend` = ts_trend(fdeaths), 19 | #' title = "Deaths from Lung Diseases", 20 | #' subtitle = "per month" 21 | #' ) 22 | #' } 23 | #' @export 24 | ts_trend <- function(x, ...) { 25 | value <- NULL 26 | z <- ts_na_omit(ts_dts(x)) 27 | 28 | predict_loess <- function(.SD, ...) { 29 | z <- copy(.SD) 30 | 31 | if (nrow(z) < 7) { 32 | message( 33 | "no trend estimation for series with less than 7 obs. ", 34 | "Return input series" 35 | ) 36 | return(z) 37 | } 38 | value_loess <- predict(loess( 39 | as.numeric(value) ~ as.numeric(as.POSIXct(time)), 40 | ..., 41 | data = z 42 | )) 43 | z[, value := value_loess] 44 | z 45 | } 46 | z <- ts_apply_dts(z, predict_loess, ...) 47 | copy_class(z, x) 48 | } 49 | -------------------------------------------------------------------------------- /R/tsbox-defunct.R: -------------------------------------------------------------------------------- 1 | #' Start and end of time series 2 | #' 3 | #' @inherit ts_default 4 | #' @export 5 | #' @name tsbox-defunct 6 | ts_start <- function(x) { 7 | .Defunct("ts_summary") 8 | x.dts <- ts_dts(x) 9 | range(x.dts[[dts_cname(x.dts)$time]])[1] 10 | } 11 | 12 | 13 | #' @export 14 | #' @name tsbox-defunct 15 | ts_end <- function(x) { 16 | .Deprecated("ts_summary") 17 | x.dts <- ts_dts(x) 18 | range(x.dts[[dts_cname(x.dts)$time]])[2] 19 | } 20 | -------------------------------------------------------------------------------- /R/tsbox-package.R: -------------------------------------------------------------------------------- 1 | #' tsbox: Class-Agnostic Time Series 2 | #' 3 | #' The R ecosystem knows a vast number of time series classes: ts, xts, zoo, 4 | #' tsibble, tibbletime, tis, or timeSeries. The plethora of standards causes 5 | #' confusion. 6 | #' As different packages rely on different classes, it is hard to use them in 7 | #' the same analysis. tsbox provides a set of tools that make it easy to switch 8 | #' between these classes. It also allows the user to treat time series as plain 9 | #' data frames, facilitating the use with tools that assume rectangular data. 10 | #' 11 | #' The package is built around a set of functions that convert time series of 12 | #' different classes to each other. They are frequency-agnostic, and allow the 13 | #' user to combine multiple non-standard and irregular frequencies. Because 14 | #' coercion works reliably, it is easy to write functions that work identically 15 | #' for all classes. So whether we want to smooth, scale, differentiate, 16 | #' chain-link, forecast, regularize or seasonally adjust a time series, we can 17 | #' use the same tsbox-command for any time series classes. 18 | #' 19 | #' The best way to start is to check out the package 20 | #' [website](https://docs.ropensci.org/tsbox/). 21 | #' 22 | #' In the *ropensci* classification, this package is *An improvement on other 23 | #' implementations of similar algorithms in **R***. Many time series packages, 24 | #' e.g., [zoo](https://CRAN.R-project.org/package=zoo) or 25 | #' [tsibble](https://CRAN.R-project.org/package=tsibble) contain converter 26 | #' functions from one class to another. They often convert from their class 27 | #' to `ts` objects and back, but lack converters to other time series class. 28 | #' 29 | #' In most cases, tsbox transforms an object into an augmented `data.table`. And 30 | #' uses the `data.table` infrastructure for efficient joining and reshaping. After 31 | #' computation, it restores the original input class. This restoring feature is 32 | #' was also used in the `xts::reclass()` function of the 33 | #' [xts](https://CRAN.R-project.org/package=xts) package. 34 | #' 35 | #' @srrstats {G1.1} *Statistical Software should document whether the algorithm(s) it implements are:* - *The first implementation of a novel algorithm*; or - *The first implementation within **R** of an algorithm which has previously been implemented in other languages or contexts*; or - *An improvement on other implementations of similar algorithms in **R***. 36 | #' @name tsbox-package 37 | #' @aliases tsbox 38 | #' @docType package 39 | #' @author Christoph Sax \email{christoph.sax@@gmail.com} 40 | #' @keywords package 41 | #' @srrstats {G1.4} *Software should use [`roxygen2`](https://roxygen2.r-lib.org/) to document all functions.* 42 | #' roxygen2 is used for all documentation. 43 | NULL 44 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | # dplyr::near 2 | is_near <- function(x, y, tol = .Machine$double.eps^0.5) { 3 | abs(x - y) < tol 4 | } 5 | -------------------------------------------------------------------------------- /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 | # tsbox: Class-Agnostic Time Series in R 17 | 18 | 19 | [![Project Status: Active – The project has reached a stable, usable state and is being actively developed.](https://www.repostatus.org/badges/latest/active.svg)](https://www.repostatus.org/#active) 20 | [![Codecov test coverage](https://codecov.io/gh/ropensci/tsbox/branch/main/graph/badge.svg)](https://app.codecov.io/gh/ropensci/tsbox?branch=main) 21 | [![Status at rOpenSci Software Peer 22 | Review](https://badges.ropensci.org/464_status.svg)](https://github.com/ropensci/software-review/issues/464) 23 | [![R-CMD-check](https://github.com/ropensci/tsbox/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/ropensci/tsbox/actions/workflows/R-CMD-check.yaml) 24 | 25 | 26 | The R ecosystem knows a [vast 27 | number](https://CRAN.R-project.org/view=TimeSeries) of time series 28 | standards. Instead of creating the ultimate [15th](https://xkcd.com/927/) time 29 | series class, tsbox provides a set of tools that are **agnostic towards the 30 | existing standards**. The tools also allow you to handle time series as plain 31 | data frames, thus making it easy to deal with time series in a 32 | [dplyr](https://CRAN.R-project.org/package=dplyr) or 33 | [data.table](https://CRAN.R-project.org/package=data.table) workflow. 34 | 35 | See [tsbox.help](https://docs.ropensci.org/tsbox/) for the full documentation of 36 | the package. 37 | 38 | To install the stable version from CRAN: 39 | ```r 40 | install.packages("tsbox") 41 | ``` 42 | 43 | To install the development version: 44 | ```r 45 | # install.packages("remotes") 46 | remotes::install_github("ropensci/tsbox") 47 | install.packages("ropensci/tsbox", repos = "https://ropensci.r-universe.dev") 48 | ``` 49 | 50 | ### Convert everything to everything 51 | 52 | tsbox is built around a set of converters, which convert time series stored as 53 | **ts**, **xts**, **data.frame**, **data.table**, **tibble**, **zoo**, 54 | **zooreg**, **tsibble**, **tibbletime**, **timeSeries**, **irts** or **tis** to 55 | each other: 56 | 57 | ```r 58 | library(tsbox) 59 | x.ts <- ts_c(fdeaths, mdeaths) 60 | x.xts <- ts_xts(x.ts) 61 | x.df <- ts_df(x.xts) 62 | x.dt <- ts_dt(x.df) 63 | x.tbl <- ts_tbl(x.dt) 64 | x.zoo <- ts_zoo(x.tbl) 65 | x.zooreg <- ts_zoo(x.zoo) 66 | x.tsibble <- ts_tsibble(x.zooreg) 67 | x.tibbletime <- ts_tibbletime(x.tsibble) 68 | x.timeSeries <- ts_timeSeries(x.tibbletime) 69 | x.irts <- ts_irts(x.tibbletime) 70 | x.tis <- ts_tis(x.irts) 71 | all.equal(ts_ts(x.tis), x.ts) 72 | #> [1] TRUE 73 | ``` 74 | 75 | ### Use same functions for time series classes 76 | 77 | Because this works reliably, it is easy to write 78 | functions that work for all classes. So whether we want to **smooth**, 79 | **scale**, **differentiate**, **chain**, **forecast**, **regularize** or 80 | **seasonally adjust** a time series, we can use the same commands to whatever 81 | time series class at hand: 82 | 83 | ```r 84 | ts_trend(x.ts) 85 | ts_pc(x.xts) 86 | ts_pcy(x.df) 87 | ts_lag(x.dt) 88 | ``` 89 | 90 | ### Time series of the world, unite! 91 | 92 | A set of helper functions makes it easy to combine or align multiple time 93 | series of all classes: 94 | 95 | ```r 96 | # collect time series as multiple time series 97 | ts_c(ts_dt(EuStockMarkets), AirPassengers) 98 | ts_c(EuStockMarkets, mdeaths) 99 | 100 | # combine time series to a new, single time series 101 | ts_bind(ts_dt(mdeaths), AirPassengers) 102 | ts_bind(ts_xts(AirPassengers), ts_tbl(mdeaths)) 103 | ``` 104 | 105 | ### And plot just about everything 106 | 107 | Plotting all kinds of classes and frequencies is as simple as it should be. And 108 | we finally get a legend! 109 | 110 | ``` 111 | ts_plot(ts_scale(ts_c(mdeaths, austres, AirPassengers, DAX = EuStockMarkets[ ,'DAX']))) 112 | ``` 113 | 114 | ![](https://raw.githubusercontent.com/ropensci/tsbox/master/vignettes/fig/myfig.png) 115 | 116 | 117 | ### Cheatsheet 118 | 119 | 120 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # tsbox: Class-Agnostic Time Series in R 5 | 6 | 7 | 8 | [![Project Status: Active – The project has reached a stable, usable 9 | state and is being actively 10 | developed.](https://www.repostatus.org/badges/latest/active.svg)](https://www.repostatus.org/#active) 11 | [![Codecov test 12 | coverage](https://codecov.io/gh/ropensci/tsbox/branch/main/graph/badge.svg)](https://app.codecov.io/gh/ropensci/tsbox?branch=main) 13 | [![Status at rOpenSci Software Peer 14 | Review](https://badges.ropensci.org/464_status.svg)](https://github.com/ropensci/software-review/issues/464) 15 | [![R-CMD-check](https://github.com/ropensci/tsbox/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/ropensci/tsbox/actions/workflows/R-CMD-check.yaml) 16 | 17 | 18 | The R ecosystem knows a [vast 19 | number](https://CRAN.R-project.org/view=TimeSeries) of time series 20 | standards. Instead of creating the ultimate 21 | [15th](https://xkcd.com/927/) time series class, tsbox provides a set of 22 | tools that are **agnostic towards the existing standards**. The tools 23 | also allow you to handle time series as plain data frames, thus making 24 | it easy to deal with time series in a 25 | [dplyr](https://CRAN.R-project.org/package=dplyr) or 26 | [data.table](https://CRAN.R-project.org/package=data.table) workflow. 27 | 28 | See [tsbox.help](https://docs.ropensci.org/tsbox/) for the full 29 | documentation of the package. 30 | 31 | To install the stable version from CRAN: 32 | 33 | ``` r 34 | install.packages("tsbox") 35 | ``` 36 | 37 | To install the development version: 38 | 39 | ``` r 40 | # install.packages("remotes") 41 | remotes::install_github("ropensci/tsbox") 42 | install.packages("ropensci/tsbox", repos = "https://ropensci.r-universe.dev") 43 | ``` 44 | 45 | ### Convert everything to everything 46 | 47 | tsbox is built around a set of converters, which convert time series 48 | stored as **ts**, **xts**, **data.frame**, **data.table**, **tibble**, 49 | **zoo**, **zooreg**, **tsibble**, **tibbletime**, **timeSeries**, 50 | **irts** or **tis** to each other: 51 | 52 | ``` r 53 | library(tsbox) 54 | x.ts <- ts_c(fdeaths, mdeaths) 55 | x.xts <- ts_xts(x.ts) 56 | x.df <- ts_df(x.xts) 57 | x.dt <- ts_dt(x.df) 58 | x.tbl <- ts_tbl(x.dt) 59 | x.zoo <- ts_zoo(x.tbl) 60 | x.zooreg <- ts_zoo(x.zoo) 61 | x.tsibble <- ts_tsibble(x.zooreg) 62 | x.tibbletime <- ts_tibbletime(x.tsibble) 63 | x.timeSeries <- ts_timeSeries(x.tibbletime) 64 | x.irts <- ts_irts(x.tibbletime) 65 | x.tis <- ts_tis(x.irts) 66 | all.equal(ts_ts(x.tis), x.ts) 67 | #> [1] TRUE 68 | ``` 69 | 70 | ### Use same functions for time series classes 71 | 72 | Because this works reliably, it is easy to write functions that work for 73 | all classes. So whether we want to **smooth**, **scale**, 74 | **differentiate**, **chain**, **forecast**, **regularize** or 75 | **seasonally adjust** a time series, we can use the same commands to 76 | whatever time series class at hand: 77 | 78 | ``` r 79 | ts_trend(x.ts) 80 | ts_pc(x.xts) 81 | ts_pcy(x.df) 82 | ts_lag(x.dt) 83 | ``` 84 | 85 | ### Time series of the world, unite! 86 | 87 | A set of helper functions makes it easy to combine or align multiple 88 | time series of all classes: 89 | 90 | ``` r 91 | # collect time series as multiple time series 92 | ts_c(ts_dt(EuStockMarkets), AirPassengers) 93 | ts_c(EuStockMarkets, mdeaths) 94 | 95 | # combine time series to a new, single time series 96 | ts_bind(ts_dt(mdeaths), AirPassengers) 97 | ts_bind(ts_xts(AirPassengers), ts_tbl(mdeaths)) 98 | ``` 99 | 100 | ### And plot just about everything 101 | 102 | Plotting all kinds of classes and frequencies is as simple as it should 103 | be. And we finally get a legend! 104 | 105 | ts_plot(ts_scale(ts_c(mdeaths, austres, AirPassengers, DAX = EuStockMarkets[ ,'DAX']))) 106 | 107 | ![](https://raw.githubusercontent.com/ropensci/tsbox/master/vignettes/fig/myfig.png) 108 | 109 | ### Cheatsheet 110 | 111 | 112 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://docs.ropensci.org/tsbox/ 2 | 3 | template: 4 | bootstrap: 5 5 | package: rotemplate 6 | 7 | development: 8 | mode: auto 9 | version_label: default 10 | version_tooltip: "Version" 11 | 12 | reference: 13 | - title: Convert 14 | desc: > 15 | tsbox is built around a set of converters, which convert time series to each other 16 | contents: 17 | - ts_ts 18 | - ts_xts 19 | - ts_df 20 | - ts_dt 21 | - ts_tbl 22 | - ts_zoo 23 | - ts_tsibble 24 | - ts_tibbletime 25 | - ts_timeSeries 26 | 27 | - title: Combine and Separate 28 | desc: > 29 | A set of helper functions to combine multiple time series 30 | contents: 31 | - ts_c 32 | - ts_bind 33 | - ts_chain 34 | - ts_span 35 | - ts_pick 36 | 37 | - title: Transform 38 | desc: > 39 | Transformation functions with a unified interface for common time series 40 | opperations 41 | contents: 42 | - ts_scale 43 | - ts_trend 44 | - ts_pc 45 | - ts_pca 46 | - ts_pcy 47 | - ts_diff 48 | - ts_diffy 49 | - ts_index 50 | - ts_lag 51 | 52 | - title: Plot and Summary 53 | desc: > 54 | Simple and fast plotting and summary functions 55 | contents: 56 | - ts_summary 57 | - ts_plot 58 | - ts_ggplot 59 | - theme_tsbox 60 | - ts_save 61 | - ts_default 62 | 63 | - title: Reshape 64 | desc: > 65 | Reshaping wide data frames into long data frames and back 66 | contents: 67 | - ts_wide 68 | - ts_long 69 | 70 | - title: Frequency 71 | desc: > 72 | Functions to manipulate frequency 73 | contents: 74 | - ts_frequency 75 | - ts_regular 76 | - ts_na_omit 77 | - ts_first_of_period 78 | 79 | - title: User defined ts-functions 80 | desc: > 81 | `ts_` turns existing functions into functions that can deal with any ts- 82 | boxable time series object. The example functions are useful themself. 83 | contents: 84 | - ts_prcomp 85 | - ts_forecast 86 | - ts_seas 87 | - ts_dygraphs 88 | - ts_ 89 | - copy_class 90 | - relevant_class 91 | - ts_boxable 92 | - ts_dts 93 | 94 | - title: Arithmetic operators 95 | desc: > 96 | Arithmetic operators can be applied on ts-boxable objects 97 | contents: 98 | - ts_arithmetic 99 | 100 | - title: Others 101 | contents: 102 | - tsbox-defunct 103 | - tsbox-package 104 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | informational: true 10 | patch: 11 | default: 12 | target: auto 13 | threshold: 1% 14 | informational: true 15 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | bibentry( 2 | bibtype = "Manual", 3 | title = "tsbox: Class-Agnostic Time Series in in {R}", 4 | author = c(person(given = "Christoph", 5 | family = "Sax", 6 | email = "christoph.sax@gmail.com")), 7 | note = "{R package}", 8 | url = "https://docs.ropensci.org/tsbox/", 9 | year = 2021, 10 | 11 | header = "To cite tsbox in publications use:" 12 | ) 13 | 14 | -------------------------------------------------------------------------------- /inst/WORDLIST: -------------------------------------------------------------------------------- 1 | Boxable 2 | CMD 3 | Cheatsheet 4 | Codecov 5 | Dygraphs 6 | Grosse 7 | Loess 8 | POSIXct 9 | Routledge 10 | Shyu 11 | boxable 12 | colorder 13 | customizability 14 | dplyr 15 | ggplot 16 | irts 17 | loess 18 | misspecified 19 | na 20 | prcomp 21 | rOpenSci 22 | retransform 23 | ropensci 24 | stopifnot 25 | subfunction 26 | subfunctions 27 | td 28 | tempdisagg 29 | th 30 | tibble 31 | tibbles 32 | tibbletime 33 | timeSeries 34 | timetk 35 | tis 36 | tseries 37 | tsibble 38 | tsibbledata 39 | tslist 40 | vectorized 41 | vectorizes 42 | xts 43 | ylab 44 | zooreg 45 | -------------------------------------------------------------------------------- /inst/upd_meta_freq_data.R: -------------------------------------------------------------------------------- 1 | 2 | meta_freq_data <- data.table::fread(" 3 | freq , diff , string , tol 4 | -1 , 0 , NA , 0 5 | 31556952 , 1 , 1 sec , 0.1 6 | -1 , 1 , NA , 0.1 7 | 15778476 , 2 , 2 sec , 0.1 8 | -1 , 2 , NA , 0.1 9 | 6311390 , 5 , 5 sec , 0.1 10 | -1 , 5 , NA , 0.1 11 | 3155695 , 10 , 10 sec , 0.1 12 | -1 , 10 , NA , 0.1 13 | 2103797 , 15 , 15 sec , 0.1 14 | -1 , 15 , NA , 0.1 15 | 1577848 , 20 , 20 sec , 0.1 16 | -1 , 20 , NA , 0.1 17 | 1051898 , 30 , 30 sec , 0.1 18 | -1 , 30 , NA , 0.1 19 | 525949.2 , 60 , 1 min , 1 20 | -1 , 60 , NA , 1 21 | 262974.6 , 120 , 2 min , 1 22 | -1 , 120 , NA , 1 23 | 105189.8 , 300 , 5 min , 1 24 | -1 , 300 , NA , 1 25 | 52594.92 , 600 , 10 min , 1 26 | -1 , 600 , NA , 1 27 | 35063.28 , 900 , 15 min , 1 28 | -1 , 900 , NA , 1 29 | 26297.46 , 1200 , 20 min , 5 30 | -1 , 1200 , NA , 5 31 | 17531.64 , 1800 , 30 min , 5 32 | -1 , 1800 , NA , 5 33 | 8765.82 , 3600 , 1 hour , 5 34 | -1 , 3600 , NA , 5 35 | 4382.91 , 7200 , 2 hour , 10 36 | -1 , 7200 , NA , 10 37 | 2921.94 , 10800 , 3 hour , 10 38 | -1 , 10800 , NA , 10 39 | 2191.455 , 14400 , 4 hour , 30 40 | -1 , 14400 , NA , 30 41 | 1460.97 , 21600 , 6 hour , 30 42 | -1 , 21600 , NA , 30 43 | 730.485 , 43200 , 12 hour , 30 44 | -1 , 43200 , NA , 30 45 | 365.2425 , 86400 , 1 day , 60 46 | -1 , 86400 , NA , 60 47 | 12 , 2419200 , 1 month , 200 48 | -1 , 2682000 , NA , 200 49 | 6 , 5097600 , 2 month , 200 50 | -1 , 5356800 , NA , 200 51 | 4 , 7772400 , 3 month , 200 52 | -1 , 7952400 , NA , 200 53 | 3 , 10364400 , 4 month , 400 54 | -1 , 10627200 , NA , 400 55 | 2 , 15631200 , 6 month , 400 56 | -1 , 15904800 , NA , 400 57 | 1 , 31536000 , 1 year , 1000 58 | -1 , 31622400 , NA , 1000 59 | 0.5 , 63072000 , 2 year , 1000 60 | -1 , 63158400 , NA , 1000 61 | 0.33333333333 , 94608000 , 3 year , 1000 62 | -1 , 94698000 , NA , 1000 63 | 0.25 , 126144000 , 4 year , 1000 64 | -1 , 126230400 , NA , 1000 65 | 0.2 , 157766400 , 5 year , 5000 66 | -1 , 157852800 , NA , 5000 67 | 0.1 , 315532800 , 10 year , 10000 68 | -1 , 315619200 , NA , 10000 69 | ") 70 | 71 | # add tolerance 72 | meta_freq_data[, diff := as.numeric(diff)] 73 | meta_freq_data[freq == -1, diff := diff + tol] 74 | meta_freq_data[freq != -1, diff := diff - tol] 75 | 76 | meta_freq_data 77 | usethis::use_data(meta_freq_data, internal = TRUE, overwrite = TRUE) 78 | -------------------------------------------------------------------------------- /man/copy_class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/to_from_all.R 3 | \name{copy_class} 4 | \alias{copy_class} 5 | \title{Re-Class ts-Boxable Object} 6 | \usage{ 7 | copy_class( 8 | x, 9 | template, 10 | preserve.mode = TRUE, 11 | preserve.names = FALSE, 12 | preserve.time = FALSE, 13 | preserve.attr = TRUE 14 | ) 15 | } 16 | \arguments{ 17 | \item{x}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 18 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 19 | \code{irts} or \code{timeSeries}.} 20 | 21 | \item{template}{ts-boxable time series, an object of class \code{ts}, \code{xts}, 22 | \code{zoo}, \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, 23 | \code{tis}, \code{irts} or \code{timeSeries}.} 24 | 25 | \item{preserve.mode}{should the mode the time column be preserved 26 | (data frame only)} 27 | 28 | \item{preserve.names}{should the name of the time column be preserved 29 | (data frame only)} 30 | 31 | \item{preserve.time}{should the values time column be preserved 32 | (data frame only)} 33 | 34 | \item{preserve.attr}{should the attributes of the value column be preserved 35 | (data frame only)} 36 | } 37 | \value{ 38 | a ts-boxable object of the same class as \code{template}, 39 | i.e., an object of class \code{ts}, \code{xts}, \code{zoo}, 40 | \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, \code{irts} or 41 | \code{timeSeries}. 42 | } 43 | \description{ 44 | Copies class attributes from an existing ts-boxable series. Mainly used 45 | internally. 46 | } 47 | \details{ 48 | Inspired by \code{xts::reclass}, which does something similar. 49 | } 50 | \examples{ 51 | copy_class(mdeaths, ts_tbl(fdeaths)) 52 | } 53 | -------------------------------------------------------------------------------- /man/relevant_class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/to_from_all.R 3 | \name{relevant_class} 4 | \alias{relevant_class} 5 | \title{Extract Relevant Class} 6 | \usage{ 7 | relevant_class(x) 8 | } 9 | \arguments{ 10 | \item{x}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 11 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 12 | \code{irts} or \code{timeSeries}.} 13 | } 14 | \value{ 15 | character, the relevant class of ts-boxable object 16 | } 17 | \description{ 18 | Mainly used internally. 19 | } 20 | \examples{ 21 | relevant_class(AirPassengers) 22 | x <- ts_df(AirPassengers) 23 | relevant_class(x) 24 | } 25 | -------------------------------------------------------------------------------- /man/ts_.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_.R, R/ts_apply.R 3 | \name{ts_} 4 | \alias{ts_} 5 | \alias{load_suggested} 6 | \alias{ts_apply} 7 | \title{Constructing ts-Functions} 8 | \usage{ 9 | load_suggested(pkg) 10 | 11 | ts_(fun, class = "ts", vectorize = FALSE, reclass = TRUE) 12 | 13 | ts_apply(x, fun, ...) 14 | } 15 | \arguments{ 16 | \item{pkg}{external package, to be suggested (automatically added by \code{ts_}) 17 | \code{predict()}. (See examples)} 18 | 19 | \item{fun}{function, to be made available to all time series classes} 20 | 21 | \item{class}{class that the function uses as its first argument} 22 | 23 | \item{vectorize}{should the function be vectorized? (not yet implemented)} 24 | 25 | \item{reclass}{logical, should the new function return the same same 26 | ts-boxable output as imputed?} 27 | 28 | \item{x}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 29 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 30 | \code{irts} or \code{timeSeries}.} 31 | 32 | \item{...}{arguments passed to subfunction} 33 | } 34 | \value{ 35 | A function that accepts ts-boxable time series as an input. 36 | } 37 | \description{ 38 | \code{ts_} turns an existing function into a function that can deal with 39 | ts-boxable time series objects. 40 | } 41 | \details{ 42 | The \code{ts_} function is a constructor function for tsbox time series functions. 43 | It can be used to wrap any function that works with time series. The default 44 | is set to R base \code{"ts"} class. \code{ts_} deals with the conversion stuff, 45 | 'vectorizes' the function so that it can be used with multiple time series. 46 | } 47 | \examples{ 48 | \donttest{ 49 | ts_(rowSums)(ts_c(mdeaths, fdeaths)) 50 | ts_plot(mean = ts_(rowMeans)(ts_c(mdeaths, fdeaths)), mdeaths, fdeaths) 51 | ts_(function(x) predict(prcomp(x)))(ts_c(mdeaths, fdeaths)) 52 | ts_(function(x) predict(prcomp(x, scale = TRUE)))(ts_c(mdeaths, fdeaths)) 53 | ts_(dygraphs::dygraph, class = "xts") 54 | 55 | # attach series to serach path 56 | ts_attach <- ts_(attach, class = "tslist", reclass = FALSE) 57 | ts_attach(EuStockMarkets) 58 | ts_plot(DAX, SMI) 59 | detach() 60 | } 61 | } 62 | \seealso{ 63 | \link{ts_examples}, for a few useful examples of functions generated by 64 | \code{ts_}. 65 | 66 | \href{https://docs.ropensci.org/tsbox/articles/ts-functions.html}{Vignette} on how 67 | to make arbitrary functions ts-boxable. 68 | } 69 | -------------------------------------------------------------------------------- /man/ts_arithmetic.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_arithmetic.R 3 | \name{ts_arithmetic} 4 | \alias{ts_arithmetic} 5 | \alias{\%ts+\%} 6 | \alias{\%ts-\%} 7 | \alias{\%ts*\%} 8 | \alias{\%ts/\%} 9 | \title{Arithmetic Operators for ts-boxable objects} 10 | \usage{ 11 | e1 \%ts+\% e2 12 | 13 | e1 \%ts-\% e2 14 | 15 | e1 \%ts*\% e2 16 | 17 | e1 \%ts/\% e2 18 | } 19 | \arguments{ 20 | \item{e1}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 21 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 22 | \code{irts} or \code{timeSeries}.} 23 | 24 | \item{e2}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 25 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 26 | \code{irts} or \code{timeSeries}.} 27 | } 28 | \value{ 29 | a ts-boxable time series, with the same class as the left input. 30 | } 31 | \description{ 32 | Arithmetic Operators for ts-boxable objects 33 | } 34 | \examples{ 35 | head(fdeaths - mdeaths) 36 | head(fdeaths \%ts-\% mdeaths) 37 | head(ts_df(fdeaths) \%ts-\% mdeaths) 38 | } 39 | -------------------------------------------------------------------------------- /man/ts_bind.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_bind.R, R/ts_chain.R 3 | \name{ts_bind} 4 | \alias{ts_bind} 5 | \alias{ts_chain} 6 | \title{Bind Time Series} 7 | \usage{ 8 | ts_bind(...) 9 | 10 | ts_chain(...) 11 | } 12 | \arguments{ 13 | \item{...}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 14 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 15 | \code{irts} or \code{timeSeries}.} 16 | } 17 | \value{ 18 | a ts-boxable object of the same class as the input, i.e., an object 19 | of class \code{ts}, \code{xts}, \code{zoo}, \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, 20 | \code{tbl_ts}, \code{tbl_time}, \code{tis}, \code{irts} or \code{timeSeries}. 21 | If series of different classes are combined, the class of the first series 22 | is used (if possible). 23 | } 24 | \description{ 25 | Combine time series to a new, single time series. \code{ts_bind} combines time 26 | series as they are, \code{ts_chain} chains them together, using percentage change 27 | rates. 28 | } 29 | \details{ 30 | In data frame objects, multiple time series are stored in a long data frame. 31 | In \code{ts} and \code{xts} objects, time series are combined horizontally. 32 | } 33 | \examples{ 34 | ts_bind(ts_span(mdeaths, end = "1975-12-01"), fdeaths) 35 | ts_bind(mdeaths, c(2, 2)) 36 | ts_bind(mdeaths, 3, ts_bind(fdeaths, c(99, 2))) 37 | ts_bind(ts_dt(mdeaths), AirPassengers) 38 | 39 | # numeric vectors 40 | ts_bind(12, AirPassengers, c(2, 3)) 41 | ts_chain(ts_span(mdeaths, end = "1975-12-01"), fdeaths) 42 | \donttest{ 43 | ts_plot(ts_pc(ts_c( 44 | comb = ts_chain(ts_span(mdeaths, end = "1975-12-01"), fdeaths), 45 | fdeaths 46 | ))) 47 | } 48 | } 49 | \seealso{ 50 | \link{ts_c} to collect multiple time series 51 | } 52 | -------------------------------------------------------------------------------- /man/ts_boxable.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/to_from_all.R 3 | \name{ts_boxable} 4 | \alias{ts_boxable} 5 | \alias{check_ts_boxable} 6 | \title{Test if an Object is ts-Boxable} 7 | \usage{ 8 | ts_boxable(x) 9 | 10 | check_ts_boxable(x) 11 | } 12 | \arguments{ 13 | \item{x}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 14 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 15 | \code{irts} or \code{timeSeries}.} 16 | } 17 | \value{ 18 | logical, either \code{TRUE} or \code{FALSE}. \code{check_ts_boxable()} fails if not 19 | \code{TRUE} 20 | } 21 | \description{ 22 | Mainly used internally. 23 | } 24 | \examples{ 25 | ts_boxable(AirPassengers) 26 | ts_boxable(lm) 27 | } 28 | -------------------------------------------------------------------------------- /man/ts_c.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_c.R 3 | \name{ts_c} 4 | \alias{ts_c} 5 | \title{Collect Time Series} 6 | \usage{ 7 | ts_c(...) 8 | } 9 | \arguments{ 10 | \item{...}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 11 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 12 | \code{irts} or \code{timeSeries}.} 13 | } 14 | \value{ 15 | a ts-boxable object of the same class as the input, i.e., an object 16 | of class \code{ts}, \code{xts}, \code{zoo}, \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, 17 | \code{tbl_ts}, \code{tbl_time}, \code{tis}, \code{irts} or \code{timeSeries}. 18 | If series of different classes are combined, the class of the first series 19 | is used (if possible). 20 | } 21 | \description{ 22 | Collect time series as multiple time series. 23 | } 24 | \details{ 25 | In data frame objects, multiple time series are stored in a long data frame. 26 | In \code{ts} and \code{xts} objects, time series are combined horizontally. 27 | } 28 | \examples{ 29 | ts_c(mdeaths, fdeaths) 30 | \donttest{ 31 | ts_c(ts_df(EuStockMarkets), AirPassengers) 32 | 33 | # labeling 34 | x1 <- ts_c( 35 | `International Airline Passengers` = ts_xts(AirPassengers), 36 | `Deaths from Lung Diseases` = ldeaths 37 | ) 38 | head(x1) 39 | } 40 | 41 | } 42 | \seealso{ 43 | \link{ts_bind}, to bind multiple time series to a single series. 44 | } 45 | -------------------------------------------------------------------------------- /man/ts_default.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_default.R 3 | \name{ts_default} 4 | \alias{ts_default} 5 | \title{Default Column Names} 6 | \usage{ 7 | ts_default(x) 8 | } 9 | \arguments{ 10 | \item{x}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 11 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 12 | \code{irts} or \code{timeSeries}.} 13 | } 14 | \value{ 15 | a ts-boxable object of the same class as \code{x}, i.e., an object of 16 | class \code{ts}, \code{xts}, \code{zoo}, \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, 17 | \code{tbl_ts}, \code{tbl_time}, \code{tis}, \code{irts} or \code{timeSeries}. 18 | } 19 | \description{ 20 | In data frame objects (\code{data.frame}, \code{tibble}, \code{data.table}), tsbox 21 | automatically detects the time and the value column. This function changes 22 | the column names to the defaults (\code{time}, \code{value}), so that auto-detection 23 | can be avoided in future operations. 24 | } 25 | \examples{ 26 | \donttest{ 27 | df <- ts_df(ts_c(mdeaths, fdeaths)) 28 | # non-default colnames 29 | colnames(df) <- c("id", "date", "count") 30 | # switch back to default colnames 31 | ts_default(df) 32 | } 33 | } 34 | -------------------------------------------------------------------------------- /man/ts_dts.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dts.R 3 | \name{ts_dts} 4 | \alias{ts_dts} 5 | \title{Internal Time Series Class} 6 | \usage{ 7 | ts_dts(x) 8 | } 9 | \arguments{ 10 | \item{x}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 11 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 12 | \code{irts} or \code{timeSeries}.} 13 | } 14 | \value{ 15 | a ts-boxable object of the same class as \code{x}, i.e., an object of 16 | class \code{ts}, \code{xts}, \code{zoo}, \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, 17 | \code{tbl_ts}, \code{tbl_time}, \code{tis}, \code{irts} or \code{timeSeries}. 18 | } 19 | \description{ 20 | In data frame objects (\code{data.frame}, \code{tibble}, \code{data.table}), tsbox 21 | automatically detects the time and the value column. This function changes 22 | the column names to the defaults (\code{time}, \code{value}), so that auto-detection 23 | can be avoided in future operations. 24 | } 25 | \examples{ 26 | \donttest{ 27 | df <- ts_df(ts_c(mdeaths, fdeaths)) 28 | # non-default colnames 29 | colnames(df) <- c("id", "date", "count") 30 | # switch back to default colnames 31 | ts_default(df) 32 | } 33 | } 34 | -------------------------------------------------------------------------------- /man/ts_examples.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_examples.R 3 | \name{ts_examples} 4 | \alias{ts_examples} 5 | \alias{ts_prcomp} 6 | \alias{ts_dygraphs} 7 | \alias{ts_forecast} 8 | \alias{ts_seas} 9 | \alias{ts_na_interpolation} 10 | \title{Principal Components, Dygraphs, Forecasts, Seasonal Adjustment} 11 | \usage{ 12 | ts_prcomp(x, ...) 13 | 14 | ts_dygraphs(x, ...) 15 | 16 | ts_forecast(x, ...) 17 | 18 | ts_seas(x, ...) 19 | 20 | ts_na_interpolation(x, ...) 21 | } 22 | \arguments{ 23 | \item{x}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 24 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 25 | \code{irts} or \code{timeSeries}.} 26 | 27 | \item{...}{further arguments, passed to the underlying function. For help, 28 | consider these functions, e.g., \link[stats:prcomp]{stats::prcomp}.} 29 | } 30 | \value{ 31 | a ts-boxable object of the same class as \code{x}, i.e., an object of 32 | class \code{ts}, \code{xts}, \code{zoo}, \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, 33 | \code{tbl_ts}, \code{tbl_time}, \code{tis}, \code{irts} or \code{timeSeries}. 34 | } 35 | \description{ 36 | Example Functions, Generated by \link{ts_}. \code{ts_prcomp} calculates the principal 37 | components of multiple time series, \code{ts_dygraphs} generates an interactive 38 | graphical visualization, \code{ts_forecast} return an univariate forecast, 39 | \code{ts_seas} the seasonally adjusted series. \code{ts_na_interpolation} imputes 40 | missing values. 41 | } 42 | \details{ 43 | With the exception of \code{ts_prcomp}, these functions depend on external 44 | packages. 45 | } 46 | \examples{ 47 | \donttest{ 48 | ts_plot( 49 | ts_scale(ts_c( 50 | Male = mdeaths, 51 | Female = fdeaths, 52 | `First principal compenent` = -ts_prcomp(ts_c(mdeaths, fdeaths))[, 1] 53 | )), 54 | title = "Deaths from lung diseases", 55 | subtitle = "Normalized values" 56 | ) 57 | 58 | ts_plot(ts_c( 59 | male = mdeaths, female = fdeaths, 60 | ts_forecast(ts_c(`male (fct)` = mdeaths, `female (fct)` = fdeaths)) 61 | ), 62 | title = "Deaths from lung diseases", 63 | subtitle = "Exponential smoothing forecast" 64 | ) 65 | 66 | ts_plot( 67 | `Raw series` = AirPassengers, 68 | `Adjusted series` = ts_seas(AirPassengers), 69 | title = "Airline passengers", 70 | subtitle = "X-13 seasonal adjustment" 71 | ) 72 | 73 | 74 | # See ?imputeTS::na_interpolation for options 75 | dta <- ts_c(mdeaths, fdeaths) 76 | dta[c(1, 3, 10), c(1, 2)] <- NA 77 | head(ts_na_interpolation(dta, option = "spline")) 78 | 79 | ts_dygraphs(ts_c(mdeaths, EuStockMarkets)) 80 | } 81 | } 82 | \seealso{ 83 | \href{https://docs.ropensci.org/tsbox/articles/ts-functions.html}{Vignette} on how 84 | to make arbitrary functions ts-boxable. 85 | } 86 | -------------------------------------------------------------------------------- /man/ts_first_of_period.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_first_of_period.R 3 | \name{ts_first_of_period} 4 | \alias{ts_first_of_period} 5 | \title{Use First Date of a Period} 6 | \usage{ 7 | ts_first_of_period(x) 8 | } 9 | \arguments{ 10 | \item{x}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 11 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 12 | \code{irts} or \code{timeSeries}.} 13 | } 14 | \value{ 15 | a ts-boxable object of the same class as \code{x}, i.e., an object of 16 | class \code{ts}, \code{xts}, \code{zoo}, \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, 17 | \code{tbl_ts}, \code{tbl_time}, \code{tis}, \code{irts} or \code{timeSeries}. 18 | } 19 | \description{ 20 | Replace date or time values by the first of the period. tsbox usually relies 21 | on timestamps being the first value of a period. 22 | } 23 | \examples{ 24 | x <- ts_c( 25 | a = ts_lag(ts_df(mdeaths), "14 days"), 26 | b = ts_lag(ts_df(mdeaths), "-2 days") 27 | ) 28 | ts_first_of_period(x) 29 | ts_first_of_period(ts_lag(ts_df(austres), "14 days")) 30 | } 31 | -------------------------------------------------------------------------------- /man/ts_frequency.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_frequency.R 3 | \name{ts_frequency} 4 | \alias{ts_frequency} 5 | \title{Change Frequency} 6 | \usage{ 7 | ts_frequency( 8 | x, 9 | to = c("year", "quarter", "month", "week", "day", "hour", "min", "sec"), 10 | aggregate = "mean", 11 | na.rm = FALSE 12 | ) 13 | } 14 | \arguments{ 15 | \item{x}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 16 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 17 | \code{irts} or \code{timeSeries}.} 18 | 19 | \item{to}{desired frequency, either a character string (\code{"year"}, 20 | \code{"quarter"}, \code{"month"}) or an integer (\code{1}, \code{4}, \code{12}).} 21 | 22 | \item{aggregate}{character string, or function. Either \code{"mean"}, \code{"sum"}, 23 | \code{"first"}, or \code{"last"}, or any aggregate function, such as \code{\link[base:mean]{base::mean()}}.} 24 | 25 | \item{na.rm}{logical, if \code{TRUE}, incomplete periods are aggregated as 26 | well. For irregular series, incomplete periods are always aggregated.} 27 | } 28 | \value{ 29 | a ts-boxable time series, with the same class as the input. 30 | } 31 | \description{ 32 | Changes the frequency of a time series. By default, incomplete 33 | periods of regular series are omitted. 34 | } 35 | \details{ 36 | The \href{https://CRAN.R-project.org/package=tempdisagg}{tempdisagg package} 37 | can convert low frequency to high frequency data and 38 | has support for ts-boxable objects. See 39 | \code{vignette("hf-disagg", package = "tempdisagg")}. 40 | } 41 | \examples{ 42 | \donttest{ 43 | ts_frequency(cbind(mdeaths, fdeaths), "year", "sum") 44 | ts_frequency(cbind(mdeaths, fdeaths), "quarter", "last") 45 | 46 | ts_frequency(AirPassengers, 4, "sum") 47 | 48 | # Note that incomplete years are omited by default 49 | ts_frequency(EuStockMarkets, "year") 50 | ts_frequency(EuStockMarkets, "year", na.rm = TRUE) 51 | } 52 | } 53 | -------------------------------------------------------------------------------- /man/ts_ggplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_ggplot.R 3 | \name{ts_ggplot} 4 | \alias{ts_ggplot} 5 | \alias{theme_tsbox} 6 | \alias{colors_tsbox} 7 | \alias{scale_color_tsbox} 8 | \alias{scale_fill_tsbox} 9 | \title{Plot Time Series, Using ggplot2} 10 | \usage{ 11 | ts_ggplot(..., title, subtitle, ylab = "") 12 | 13 | theme_tsbox(base_family = getOption("ts_font", ""), base_size = 12) 14 | 15 | colors_tsbox() 16 | 17 | scale_color_tsbox(...) 18 | 19 | scale_fill_tsbox(...) 20 | } 21 | \arguments{ 22 | \item{...}{ts-boxable time series, objects of class \code{ts}, \code{xts}, 23 | \code{data.frame}, \code{data.table}, or \code{tibble}. For \code{scale_} functions, arguments 24 | passed to subfunctions.} 25 | 26 | \item{title}{title (optional)} 27 | 28 | \item{subtitle}{subtitle (optional)} 29 | 30 | \item{ylab}{ylab (optional)} 31 | 32 | \item{base_family}{base font family (can also be set via \code{options})} 33 | 34 | \item{base_size}{base font size} 35 | } 36 | \description{ 37 | \code{ts_ggplot()} has the same syntax and produces a similar plot as \code{\link[=ts_plot]{ts_plot()}}, 38 | but uses the \href{https://ggplot2.tidyverse.org/}{ggplot2} graphic system, and 39 | can be customized. With \code{\link[=theme_tsbox]{theme_tsbox()}} and \code{\link[=scale_color_tsbox]{scale_color_tsbox()}}, the output 40 | of \code{ts_ggplot} has a similar look and feel. 41 | } 42 | \details{ 43 | Both \code{\link[=ts_plot]{ts_plot()}} and \code{ts_ggplot()} combine multiple ID dimensions into a 44 | single dimension. To plot multiple dimensions in different shapes, facets, 45 | etc., use standard ggplot (see examples). 46 | } 47 | \examples{ 48 | \donttest{ 49 | # using the ggplot2 graphic system 50 | p <- ts_ggplot(total = ldeaths, female = fdeaths, male = mdeaths) 51 | p 52 | 53 | # with themes for the look and feel of ts_plot() 54 | p + theme_tsbox() + scale_color_tsbox() 55 | 56 | # also use themes with standard ggplot 57 | suppressMessages(library(ggplot2)) 58 | df <- ts_df(ts_c(total = ldeaths, female = fdeaths, male = mdeaths)) 59 | ggplot(df, aes(x = time, y = value)) + 60 | facet_wrap("id") + 61 | geom_line() + 62 | theme_tsbox() + 63 | scale_color_tsbox() 64 | } 65 | 66 | \dontrun{ 67 | library(dataseries) 68 | dta <- ds(c("GDP.PBRTT.A.R", "CCI.CCIIR"), "xts") 69 | ts_ggplot(ts_scale(ts_span( 70 | ts_c( 71 | `GDP Growth` = ts_pc(dta[, "GDP.PBRTT.A.R"]), 72 | `Consumer Sentiment Index` = dta[, "CCI.CCIIR"] 73 | ), 74 | start = "1995-01-01" 75 | ))) + 76 | ggplot2::ggtitle("GDP and Consumer Sentiment", subtitle = "normalized") + 77 | theme_tsbox() + 78 | scale_color_tsbox() 79 | } 80 | } 81 | \seealso{ 82 | \code{\link[=ts_plot]{ts_plot()}}, for a simpler and faster plotting function. 83 | \code{\link[=ts_dygraphs]{ts_dygraphs()}}, for interactive time series plots. 84 | } 85 | -------------------------------------------------------------------------------- /man/ts_index.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_index.R 3 | \name{ts_index} 4 | \alias{ts_index} 5 | \alias{ts_compound} 6 | \title{Indices from Levels or Percentage Rates} 7 | \usage{ 8 | ts_compound(x, denominator = 100) 9 | 10 | ts_index(x, base = NULL) 11 | } 12 | \arguments{ 13 | \item{x}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 14 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 15 | \code{irts} or \code{timeSeries}.} 16 | 17 | \item{denominator}{positive number. Set equal to 1 if percentage change rate is 18 | given a decimal fraction} 19 | 20 | \item{base}{base date, character string, \code{Date} or \code{POSIXct}, at which the 21 | index is set to 1. If two dates are provided, the mean in the range is 22 | set equal to 1 (see examples).} 23 | } 24 | \value{ 25 | a ts-boxable object of the same class as \code{x}, i.e., an object of 26 | class \code{ts}, \code{xts}, \code{zoo}, \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, 27 | \code{tbl_ts}, \code{tbl_time}, \code{tis}, \code{irts} or \code{timeSeries}. 28 | } 29 | \description{ 30 | \code{ts_index} returns an indexed series, with value of 1 at the \code{base} date or 31 | range. 32 | \code{ts_compound} builds an index from percentage change rates, starting with 1 33 | and compounding the rates. 34 | } 35 | \examples{ 36 | x <- ts_pc(ts_c(fdeaths, mdeaths)) 37 | ts_compound(x) 38 | y <- ts_df(ts_c(fdeaths, mdeaths)) 39 | ts_index(y, "1974-02-01") 40 | \donttest{ 41 | ts_plot( 42 | `My Expert Knowledge` = ts_chain( 43 | mdeaths, 44 | ts_compound(ts_bind(ts_pc(mdeaths), 15, 23, 33)) 45 | ), 46 | `So Far` = mdeaths, 47 | title = "A Very Manual Forecast" 48 | ) 49 | 50 | # mean of 1974 = 1 51 | ts_index(mdeaths, c("1974-01-01", "1974-12-31")) 52 | } 53 | } 54 | -------------------------------------------------------------------------------- /man/ts_lag.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_lag.R 3 | \name{ts_lag} 4 | \alias{ts_lag} 5 | \title{Lag or Lead of Time Series} 6 | \usage{ 7 | ts_lag(x, by = 1) 8 | } 9 | \arguments{ 10 | \item{x}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 11 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 12 | \code{irts} or \code{timeSeries}.} 13 | 14 | \item{by}{integer or character, either the number of shifting periods 15 | (integer), or an absolute amount of time (character). See details.} 16 | } 17 | \value{ 18 | a ts-boxable object of the same class as \code{x}, i.e., an object of 19 | class \code{ts}, \code{xts}, \code{zoo}, \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, 20 | \code{tbl_ts}, \code{tbl_time}, \code{tis}, \code{irts} or \code{timeSeries}. 21 | } 22 | \description{ 23 | Shift time stamps in ts-boxable time series, either by a number of periods or 24 | by a fixed amount of time. 25 | } 26 | \details{ 27 | The lag order, \code{by}, is defined the opposite way as in R base. Thus, -1 is a 28 | lead and +1 a lag. 29 | 30 | If \code{by} is integer, the time stamp is shifted by the number of periods. This 31 | requires the series to be regular. 32 | 33 | If \code{by} is character, the time stamp is shifted by a specific amount of time. 34 | This can be one of one of \code{"sec"}, \code{"min"}, \code{"hour"}, \code{"day"}, \code{"week"}, 35 | \code{"month"}, \verb{"quarter" or }"year", optionally preceded by a (positive or 36 | negative) integer and a space, or followed by plural "s". This is passed to 37 | \code{\link[base:seq.Date]{base::seq.Date()}}. This does not require the series to be regular. 38 | } 39 | \examples{ 40 | \donttest{ 41 | ts_plot(AirPassengers, ts_lag(AirPassengers), title = "The need for glasses") 42 | } 43 | ts_lag(fdeaths, "1 month") 44 | ts_lag(fdeaths, "1 year") 45 | x <- ts_df(fdeaths) 46 | ts_lag(x, "2 day") 47 | ts_lag(x, "2 min") 48 | ts_lag(x, "-1 day") 49 | } 50 | -------------------------------------------------------------------------------- /man/ts_long.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_long_wide.R 3 | \name{ts_long} 4 | \alias{ts_long} 5 | \alias{ts_wide} 6 | \title{Reshaping Multiple Time Series} 7 | \usage{ 8 | ts_long(x) 9 | 10 | ts_wide(x) 11 | } 12 | \arguments{ 13 | \item{x}{a ts-boxable time series, or a wide \code{data.frame}, 14 | \code{data.table}, or \code{tibble}.} 15 | } 16 | \value{ 17 | a ts-boxable object of the same class as \code{x}, i.e., an object of 18 | class \code{ts}, \code{xts}, \code{zoo}, \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, 19 | \code{tbl_ts}, \code{tbl_time}, \code{tis}, \code{irts} or \code{timeSeries}. 20 | } 21 | \description{ 22 | Functions to reshape multiple time series from 'wide' to 'long' and vice 23 | versa. Note that long format data frames are ts-boxable objects, where wide 24 | format data frames are not. \code{ts_long} automatically identifies a \strong{time} 25 | column, and uses columns on the left as id columns. 26 | } 27 | \examples{ 28 | x <- ts_df(ts_c(mdeaths, fdeaths)) 29 | df.wide <- ts_wide(x) 30 | df.wide 31 | ts_long(df.wide) 32 | } 33 | -------------------------------------------------------------------------------- /man/ts_na_omit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_na_omit.R 3 | \name{ts_na_omit} 4 | \alias{ts_na_omit} 5 | \title{Omit NA values} 6 | \usage{ 7 | ts_na_omit(x) 8 | } 9 | \arguments{ 10 | \item{x}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 11 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 12 | \code{irts} or \code{timeSeries}.} 13 | } 14 | \value{ 15 | a ts-boxable object of the same class as \code{x}, i.e., an object of 16 | class \code{ts}, \code{xts}, \code{zoo}, \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, 17 | \code{tbl_ts}, \code{tbl_time}, \code{tis}, \code{irts} or \code{timeSeries}. 18 | } 19 | \description{ 20 | Remove NA values in ts-boxable objects, turning explicit into implicit 21 | missing values. 22 | } 23 | \details{ 24 | Note that internal NAs in \code{ts} time series will not be removed, as this 25 | conflicts with the regular structure. 26 | } 27 | \examples{ 28 | x <- AirPassengers 29 | x[c(2, 4)] <- NA 30 | 31 | # A ts object does only know explicit NAs 32 | ts_na_omit(x) 33 | 34 | # by default, NAs are implicit in data frames 35 | ts_df(x) 36 | 37 | # make NAs explicit 38 | ts_regular(ts_df(x)) 39 | 40 | # and implicit again 41 | ts_na_omit(ts_regular(ts_df(x))) 42 | } 43 | \seealso{ 44 | \link{ts_regular}, for the opposite, turning implicit into explicit 45 | missing values. 46 | } 47 | -------------------------------------------------------------------------------- /man/ts_pc.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_pc.R 3 | \name{ts_pc} 4 | \alias{ts_pc} 5 | \alias{ts_diff} 6 | \alias{ts_pca} 7 | \alias{ts_pcy} 8 | \alias{ts_diffy} 9 | \title{First Differences and Percentage Change Rates} 10 | \usage{ 11 | ts_pc(x) 12 | 13 | ts_diff(x) 14 | 15 | ts_pca(x) 16 | 17 | ts_pcy(x) 18 | 19 | ts_diffy(x) 20 | } 21 | \arguments{ 22 | \item{x}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 23 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 24 | \code{irts} or \code{timeSeries}.} 25 | } 26 | \value{ 27 | a ts-boxable object of the same class as \code{x}, i.e., an object of 28 | class \code{ts}, \code{xts}, \code{zoo}, \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, 29 | \code{tbl_ts}, \code{tbl_time}, \code{tis}, \code{irts} or \code{timeSeries}. 30 | } 31 | \description{ 32 | \code{ts_pcy} and \code{ts_diffy} calculate the percentage change rate and the 33 | difference compared to the previous period, \code{ts_pcy} and \code{ts_diffy} calculate 34 | the percentage change rate compared to the same period of the previous year. 35 | \code{ts_pca} calculates annualized percentage change rates compared to the 36 | previous period. 37 | } 38 | \examples{ 39 | 40 | x <- ts_c(fdeaths, mdeaths) 41 | ts_diff(x) 42 | ts_pc(x) 43 | ts_pca(x) 44 | ts_pcy(x) 45 | ts_diffy(x) 46 | } 47 | -------------------------------------------------------------------------------- /man/ts_pick.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_pick.R 3 | \name{ts_pick} 4 | \alias{ts_pick} 5 | \title{Pick Series (Experimental)} 6 | \usage{ 7 | ts_pick(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 11 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 12 | \code{irts} or \code{timeSeries}.} 13 | 14 | \item{...}{character string(s), names of the series to be picked, or integer, 15 | with positions. If arguments are named, the series will be renamed.} 16 | } 17 | \value{ 18 | a ts-boxable object of the same class as \code{x}, i.e., an object of 19 | class \code{ts}, \code{xts}, \code{zoo}, \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, 20 | \code{tbl_ts}, \code{tbl_time}, \code{tis}, \code{irts} or \code{timeSeries}. 21 | } 22 | \description{ 23 | Pick (and optionally rename) series from multiple time series. 24 | } 25 | \examples{ 26 | # Interactive use 27 | \donttest{ 28 | ts_plot(ts_pick( 29 | EuStockMarkets, 30 | `My Dax` = "DAX", 31 | `My Smi` = "SMI" 32 | )) 33 | ts_pick(EuStockMarkets, c(1, 2)) 34 | ts_pick(EuStockMarkets, `My Dax` = "DAX", `My Smi` = "SMI") 35 | 36 | # Programming use 37 | to.be.picked.and.renamed <- c(`My Dax` = "DAX", `My Smi` = "SMI") 38 | ts_pick(EuStockMarkets, to.be.picked.and.renamed) 39 | } 40 | 41 | } 42 | -------------------------------------------------------------------------------- /man/ts_plot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_plot.R 3 | \name{ts_plot} 4 | \alias{ts_plot} 5 | \title{Plot Time Series} 6 | \usage{ 7 | ts_plot(..., title, subtitle, ylab = "", family = getOption("ts_font", "sans")) 8 | } 9 | \arguments{ 10 | \item{...}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 11 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 12 | \code{irts} or \code{timeSeries}.} 13 | 14 | \item{title}{title (optional)} 15 | 16 | \item{subtitle}{subtitle (optional)} 17 | 18 | \item{ylab}{ylab (optional)} 19 | 20 | \item{family}{font family (optional, can also be set via \code{options})} 21 | } 22 | \description{ 23 | \code{ts_plot()} is a fast and simple plotting function for ts-boxable time 24 | series, with limited customizability. For more theme options, use 25 | \code{\link[=ts_ggplot]{ts_ggplot()}}. 26 | } 27 | \details{ 28 | Both \code{ts_plot()} and \code{\link[=ts_ggplot]{ts_ggplot()}} combine multiple ID dimensions into a 29 | single dimension. To plot multiple dimensions in different shapes, facets, 30 | etc., use standard ggplot. 31 | 32 | Limited customizability of \code{ts_plot} is available via options. See examples. 33 | } 34 | \examples{ 35 | \donttest{ 36 | ts_plot( 37 | AirPassengers, 38 | title = "Airline passengers", 39 | subtitle = "The classic Box & Jenkins airline data" 40 | ) 41 | 42 | # naming arguments 43 | ts_plot(total = ldeaths, female = fdeaths, male = mdeaths) 44 | 45 | # using different ts-boxable objects 46 | ts_plot(ts_scale(ts_c( 47 | ts_xts(airmiles), 48 | ts_tbl(co2), 49 | JohnsonJohnson, 50 | ts_df(discoveries) 51 | ))) 52 | 53 | # customize ts_plot 54 | op <- options( 55 | tsbox.lwd = 3, 56 | tsbox.col = c("gray51", "gray11"), 57 | tsbox.lty = "dashed" 58 | ) 59 | ts_plot( 60 | "Female" = fdeaths, 61 | "Male" = mdeaths 62 | ) 63 | options(op) # restore defaults 64 | } 65 | } 66 | \seealso{ 67 | \code{\link[=ts_ggplot]{ts_ggplot()}}, for a plotting function based on ggplot2. 68 | \code{\link[=ts_dygraphs]{ts_dygraphs()}}, for interactive time series plots. \code{\link[=ts_save]{ts_save()}} to 69 | save a plot to the file system. 70 | } 71 | -------------------------------------------------------------------------------- /man/ts_regular.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_regular.R 3 | \name{ts_regular} 4 | \alias{ts_regular} 5 | \title{Enforce Regularity} 6 | \usage{ 7 | ts_regular(x, fill = NA) 8 | } 9 | \arguments{ 10 | \item{x}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 11 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 12 | \code{irts} or \code{timeSeries}.} 13 | 14 | \item{fill}{numeric, instead of \code{NA}, an alternative value can be specified. 15 | E.g., 0, -99.} 16 | } 17 | \value{ 18 | a ts-boxable object of the same class as \code{x}, i.e., an object of 19 | class \code{ts}, \code{xts}, \code{zoo}, \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, 20 | \code{tbl_ts}, \code{tbl_time}, \code{tis}, \code{irts} or \code{timeSeries}. 21 | } 22 | \description{ 23 | Enforces regularity in data frame and \code{xts} objects, by turning implicit 24 | \code{NA}s into explicit \code{NA}s. In \code{ts} objects, regularity is automatically 25 | enforced. 26 | } 27 | \examples{ 28 | x0 <- AirPassengers 29 | x0[c(10, 15)] <- NA 30 | x <- ts_na_omit(ts_dts(x0)) 31 | ts_regular(x) 32 | ts_regular(x, fill = 0) 33 | 34 | m <- mdeaths 35 | m[c(10, 69)] <- NA 36 | f <- fdeaths 37 | f[c(1, 3, 15)] <- NA 38 | 39 | ts_regular(ts_na_omit(ts_dts(ts_c(f, m)))) 40 | } 41 | -------------------------------------------------------------------------------- /man/ts_save.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_plot.R 3 | \name{ts_save} 4 | \alias{ts_save} 5 | \title{Save Previous Plot} 6 | \usage{ 7 | ts_save( 8 | filename = tempfile(fileext = ".pdf"), 9 | width = 10, 10 | height = 5, 11 | device = NULL, 12 | open = TRUE 13 | ) 14 | } 15 | \arguments{ 16 | \item{filename}{filename} 17 | 18 | \item{width}{width} 19 | 20 | \item{height}{height} 21 | 22 | \item{device}{device} 23 | 24 | \item{open}{logical, should the saved plot be opened?} 25 | } 26 | \value{ 27 | invisible \code{TRUE}, if successful 28 | } 29 | \description{ 30 | Save Previous Plot 31 | } 32 | \examples{ 33 | \donttest{ 34 | ts_plot(AirPassengers) 35 | tf <- tempfile(fileext = ".pdf") 36 | ts_save(tf) 37 | unlink(tf) 38 | } 39 | 40 | } 41 | -------------------------------------------------------------------------------- /man/ts_scale.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_scale.R 3 | \name{ts_scale} 4 | \alias{ts_scale} 5 | \title{Scale and Center Time Series} 6 | \usage{ 7 | ts_scale(x, center = TRUE, scale = TRUE) 8 | } 9 | \arguments{ 10 | \item{x}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 11 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 12 | \code{irts} or \code{timeSeries}.} 13 | 14 | \item{center}{logical} 15 | 16 | \item{scale}{logical} 17 | } 18 | \value{ 19 | a ts-boxable object of the same class as \code{x}, i.e., an object of 20 | class \code{ts}, \code{xts}, \code{zoo}, \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, 21 | \code{tbl_ts}, \code{tbl_time}, \code{tis}, \code{irts} or \code{timeSeries}. 22 | } 23 | \description{ 24 | Subtract mean (\emph{sum(x)/n}) and divide by standard deviation 25 | (\emph{sqrt(sum(x^2)/(n-1))}). Based on \code{\link[base:scale]{base::scale()}}. 26 | } 27 | \examples{ 28 | \donttest{ 29 | ts_plot(ts_scale((ts_c(airmiles, co2, JohnsonJohnson, discoveries)))) 30 | ts_plot(ts_scale(ts_c(AirPassengers, DAX = EuStockMarkets[, "DAX"]))) 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /man/ts_span.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_span.R 3 | \name{ts_span} 4 | \alias{ts_span} 5 | \title{Limit Time Span} 6 | \usage{ 7 | ts_span(x, start = NULL, end = NULL, template = NULL, extend = FALSE) 8 | } 9 | \arguments{ 10 | \item{x}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 11 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 12 | \code{irts} or \code{timeSeries}.} 13 | 14 | \item{start}{start date, character string of length 1, \code{Date} or \code{POSIXct}} 15 | 16 | \item{end}{end date, character string of length 1, \code{Date} or \code{POSIXct}.} 17 | 18 | \item{template}{ts-boxable time series, an object of class \code{ts}, \code{xts}, 19 | \code{data.frame}, \code{data.table}, or \code{tibble}. If provided, \code{from} and \code{to} 20 | will be extracted from the object.} 21 | 22 | \item{extend}{logical. If true, the start and end values are allowed to 23 | extend the series (by adding \code{NA} values).} 24 | } 25 | \value{ 26 | a ts-boxable object of the same class as \code{x}, i.e., an object of 27 | class \code{ts}, \code{xts}, \code{zoo}, \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, 28 | \code{tbl_ts}, \code{tbl_time}, \code{tis}, \code{irts} or \code{timeSeries}. 29 | } 30 | \description{ 31 | Filter time series for a time span. 32 | } 33 | \details{ 34 | All date and times, when entered as character strings, are processed by 35 | \code{anytime::anydate()} or \code{anytime::anytime()}. Thus a wide range of inputs are 36 | possible. See examples. 37 | 38 | \code{start} and \code{end} can be specified relative to each other, 39 | using one of \code{"sec"}, \code{"min"}, \code{"hour"}, \code{"day"}, \code{"week"}, 40 | \code{"month"}, \verb{"quarter" or }"year", or an abbreviation. If the series are of 41 | the same frequency, the shift can be specified in periods. See examples. 42 | } 43 | \examples{ 44 | 45 | # use 'anytime' shortcuts 46 | ts_span(mdeaths, start = "1979") # shortcut for 1979-01-01 47 | ts_span(mdeaths, start = "1979-4") # shortcut for 1979-04-01 48 | ts_span(mdeaths, start = "197904") # shortcut for 1979-04-01 49 | 50 | # it's fine to use an to date outside of series span 51 | ts_span(mdeaths, end = "2001-01-01") 52 | 53 | # use strings to set start or end relative to each other 54 | 55 | ts_span(mdeaths, start = "-7 month") # last 7 months 56 | ts_span(mdeaths, start = -7) # last 7 periods 57 | ts_span(mdeaths, start = -1) # last single value 58 | ts_span(mdeaths, end = "1e4 hours") # first 10000 hours 59 | 60 | \donttest{ 61 | ts_plot( 62 | ts_span(mdeaths, start = "-3 years"), 63 | title = "Three years ago", 64 | subtitle = "The last three years of available data" 65 | ) 66 | 67 | ts_ggplot( 68 | ts_span(mdeaths, end = "28 weeks"), 69 | title = "28 weeks later", 70 | subtitle = "The first 28 weeks of available data" 71 | ) + theme_tsbox() + scale_color_tsbox() 72 | } 73 | 74 | # Limit span of 'discoveries' to the same span as 'AirPassengers' 75 | ts_span(discoveries, template = AirPassengers) 76 | ts_span(mdeaths, end = "19801201", extend = TRUE) 77 | } 78 | -------------------------------------------------------------------------------- /man/ts_summary.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_summary.R 3 | \name{ts_summary} 4 | \alias{ts_summary} 5 | \title{Time Series Properties} 6 | \usage{ 7 | ts_summary(x, spark = FALSE) 8 | } 9 | \arguments{ 10 | \item{x}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 11 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 12 | \code{irts} or \code{timeSeries}.} 13 | 14 | \item{spark}{logical should an additional column with a spark-line added to 15 | the data frame (experimental, ASCII only on Windows.)} 16 | } 17 | \value{ 18 | \code{ts_summary} returns a \code{data.frame}. Individual column can be 19 | accessed through the \code{$} notation (see examples). 20 | } 21 | \description{ 22 | Extract time series properties, such as the number of observations 23 | (\code{obs}), the time differences between observations (\code{obs}), the number 24 | of observations per year (\code{freq}), and the start time stamp (\code{start}) 25 | and the end time stamp (\code{end}) of the series. 26 | } 27 | \examples{ 28 | ts_summary(ts_c(mdeaths, austres)) 29 | ts_summary(ts_c(mdeaths, austres), spark = TRUE) 30 | # Extracting specific properties 31 | ts_summary(AirPassengers)$start 32 | ts_summary(AirPassengers)$freq 33 | ts_summary(AirPassengers)$obs 34 | } 35 | -------------------------------------------------------------------------------- /man/ts_trend.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_trend.R 3 | \name{ts_trend} 4 | \alias{ts_trend} 5 | \title{Loess Trend Estimation} 6 | \usage{ 7 | ts_trend(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 11 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 12 | \code{irts} or \code{timeSeries}.} 13 | 14 | \item{...}{arguments, passed to \code{\link[stats:loess]{stats::loess()}}: 15 | \itemize{ 16 | \item \code{degree} degree of Loess smoothing 17 | \item \code{span} smoothing parameter, if \code{NULL}, an automated search performed (see 18 | Details) 19 | }} 20 | } 21 | \value{ 22 | a ts-boxable object of the same class as \code{x}, i.e., an object of 23 | class \code{ts}, \code{xts}, \code{zoo}, \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, 24 | \code{tbl_ts}, \code{tbl_time}, \code{tis}, \code{irts} or \code{timeSeries}. 25 | } 26 | \description{ 27 | Trend estimation that uses \code{\link[stats:loess]{stats::loess()}}. 28 | } 29 | \examples{ 30 | \donttest{ 31 | ts_plot( 32 | `Raw series` = fdeaths, 33 | `Loess trend` = ts_trend(fdeaths), 34 | title = "Deaths from Lung Diseases", 35 | subtitle = "per month" 36 | ) 37 | } 38 | } 39 | \references{ 40 | Cleveland, William S., Eric Grosse, and William M. Shyu. "Local regression models." Statistical models in S. Routledge, 2017. 309-376. 41 | } 42 | -------------------------------------------------------------------------------- /man/tsbox-defunct.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tsbox-defunct.R 3 | \name{tsbox-defunct} 4 | \alias{tsbox-defunct} 5 | \alias{ts_start} 6 | \alias{ts_end} 7 | \title{Start and end of time series} 8 | \usage{ 9 | ts_start(x) 10 | 11 | ts_end(x) 12 | } 13 | \arguments{ 14 | \item{x}{ts-boxable time series, an object of class \code{ts}, \code{xts}, \code{zoo}, 15 | \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, \code{tbl_ts}, \code{tbl_time}, \code{tis}, 16 | \code{irts} or \code{timeSeries}.} 17 | } 18 | \value{ 19 | a ts-boxable object of the same class as \code{x}, i.e., an object of 20 | class \code{ts}, \code{xts}, \code{zoo}, \code{zooreg}, \code{data.frame}, \code{data.table}, \code{tbl}, 21 | \code{tbl_ts}, \code{tbl_time}, \code{tis}, \code{irts} or \code{timeSeries}. 22 | } 23 | \description{ 24 | In data frame objects (\code{data.frame}, \code{tibble}, \code{data.table}), tsbox 25 | automatically detects the time and the value column. This function changes 26 | the column names to the defaults (\code{time}, \code{value}), so that auto-detection 27 | can be avoided in future operations. 28 | } 29 | \examples{ 30 | \donttest{ 31 | df <- ts_df(ts_c(mdeaths, fdeaths)) 32 | # non-default colnames 33 | colnames(df) <- c("id", "date", "count") 34 | # switch back to default colnames 35 | ts_default(df) 36 | } 37 | } 38 | -------------------------------------------------------------------------------- /man/tsbox-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tsbox-package.R 3 | \docType{package} 4 | \name{tsbox-package} 5 | \alias{tsbox-package} 6 | \alias{tsbox} 7 | \title{tsbox: Class-Agnostic Time Series} 8 | \description{ 9 | The R ecosystem knows a vast number of time series classes: ts, xts, zoo, 10 | tsibble, tibbletime, tis, or timeSeries. The plethora of standards causes 11 | confusion. 12 | As different packages rely on different classes, it is hard to use them in 13 | the same analysis. tsbox provides a set of tools that make it easy to switch 14 | between these classes. It also allows the user to treat time series as plain 15 | data frames, facilitating the use with tools that assume rectangular data. 16 | } 17 | \details{ 18 | The package is built around a set of functions that convert time series of 19 | different classes to each other. They are frequency-agnostic, and allow the 20 | user to combine multiple non-standard and irregular frequencies. Because 21 | coercion works reliably, it is easy to write functions that work identically 22 | for all classes. So whether we want to smooth, scale, differentiate, 23 | chain-link, forecast, regularize or seasonally adjust a time series, we can 24 | use the same tsbox-command for any time series classes. 25 | 26 | The best way to start is to check out the package 27 | \href{https://docs.ropensci.org/tsbox/}{website}. 28 | 29 | In the \emph{ropensci} classification, this package is \emph{An improvement on other 30 | implementations of similar algorithms in \strong{R}}. Many time series packages, 31 | e.g., \href{https://CRAN.R-project.org/package=zoo}{zoo} or 32 | \href{https://CRAN.R-project.org/package=tsibble}{tsibble} contain converter 33 | functions from one class to another. They often convert from their class 34 | to \code{ts} objects and back, but lack converters to other time series class. 35 | 36 | In most cases, tsbox transforms an object into an augmented \code{data.table}. And 37 | uses the \code{data.table} infrastructure for efficient joining and reshaping. After 38 | computation, it restores the original input class. This restoring feature is 39 | was also used in the \code{xts::reclass()} function of the 40 | \href{https://CRAN.R-project.org/package=xts}{xts} package. 41 | } 42 | \seealso{ 43 | Useful links: 44 | \itemize{ 45 | \item \url{https://docs.ropensci.org/tsbox/} 46 | \item \url{https://github.com/ropensci/tsbox} 47 | \item Report bugs at \url{https://github.com/ropensci/tsbox/issues} 48 | } 49 | 50 | } 51 | \author{ 52 | Christoph Sax \email{christoph.sax@gmail.com} 53 | } 54 | \keyword{package} 55 | -------------------------------------------------------------------------------- /tests/spelling.R: -------------------------------------------------------------------------------- 1 | if (requireNamespace("spelling", quietly = TRUE)) { 2 | spelling::spell_check_test( 3 | vignettes = TRUE, error = FALSE, 4 | skip_on_cran = TRUE 5 | ) 6 | } 7 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(tsbox) 3 | library(dplyr) 4 | 5 | test_check("tsbox") 6 | -------------------------------------------------------------------------------- /tests/testthat/test-arithmetic.R: -------------------------------------------------------------------------------- 1 | 2 | library(testthat) 3 | library(tsbox) 4 | 5 | 6 | test_that("arithmetic operations work properly", { 7 | expect_equal( 8 | fdeaths + mdeaths, 9 | ts_ts(ts_df(fdeaths) %ts+% mdeaths) 10 | ) 11 | 12 | expect_equal( 13 | fdeaths - mdeaths, 14 | ts_ts(ts_df(fdeaths) %ts-% mdeaths) 15 | ) 16 | 17 | expect_equal( 18 | fdeaths * mdeaths, 19 | ts_ts(ts_df(fdeaths) %ts*% mdeaths) 20 | ) 21 | 22 | expect_equal( 23 | fdeaths / mdeaths, 24 | ts_ts(ts_df(fdeaths) %ts/% mdeaths) 25 | ) 26 | 27 | 28 | 29 | # functional test 30 | library(dplyr) 31 | a <- bind_rows( 32 | mutate(ts_tbl(ts_c(mdeaths, fdeaths)), id2 = "a"), 33 | mutate(ts_tbl(ts_c(mdeaths, fdeaths)), id2 = "b") 34 | ) 35 | expect_s3_class(a %ts/% a, "data.frame") 36 | 37 | z <- ts_df(ts_c(mdeaths, fdeaths) %ts/% 1) 38 | expect_s3_class(z, "data.frame") 39 | }) 40 | -------------------------------------------------------------------------------- /tests/testthat/test-auto.R: -------------------------------------------------------------------------------- 1 | # automated tests for all supported classes 2 | 3 | # install.packages( 4 | # c("tsibble", "xts", "timeSeries", "zoo", "tibbletime", "tseries") 5 | # ) 6 | 7 | #' @srrstats {G5.4} **Correctness tests** *to test that statistical algorithms produce expected results to some fixed test data sets (potentially through comparisons using binding frameworks such as [RStata](https://github.com/lbraglia/RStata)).* 8 | #' @srrstats {G5.4a} *For new methods, it can be difficult to separate out correctness of the method from the correctness of the implementation, as there may not be reference for comparison. In this case, testing may be implemented against simple, trivial cases or against multiple implementations such as an initial R implementation compared with results from a C/C++ implementation.* 9 | #' All conversions are tested both-ways, ensuring that transforming into another class and back results in the orignal values. For this to go wrong an error must cancel itself, which is unlikely. 10 | test_that("two way conversion", { 11 | skip_if_not_installed("tibbletime") 12 | skip_if_not_installed("tsibble") 13 | skip_if_not_installed("timeSeries") 14 | skip_if_not_installed("zoo") 15 | skip_if_not_installed("tis") 16 | 17 | for (class in names(tsbox:::supported_classes())) { 18 | message(class) 19 | 20 | ts_fun <- get(paste0("ts_", class)) 21 | 22 | # single series 23 | expect_equal(ts_ts(ts_fun(AirPassengers)), AirPassengers) 24 | 25 | # tsibble alphabetically reorders key column, separate test below 26 | if (class == "tsibble") next 27 | 28 | # tis: does not deal correctly with 'as.tis(EuStockMarkets)' 29 | # timeSeries: stored in seconds only, which prevents back covnersion to ts 30 | if (!(class %in% c("timeSeries", "tis", "irts"))) { 31 | expect_equal(ts_ts(ts_fun(EuStockMarkets)), EuStockMarkets) 32 | } 33 | 34 | # mixed frequencies 35 | expect_equal( 36 | ts_ts(ts_fun(ts_c(austres, AirPassengers))), 37 | ts_c(austres, AirPassengers) 38 | ) 39 | # non alphabetical order, multi series 40 | expect_equal(ts_ts(ts_fun(ts_c(mdeaths, fdeaths))), ts_c(mdeaths, fdeaths)) 41 | # non alphabetical order, multi series 42 | expect_equal( 43 | ts_ts(ts_fun(ts_c(mdeaths, AirPassengers))), 44 | ts_c(mdeaths, AirPassengers) 45 | ) 46 | } 47 | }) 48 | -------------------------------------------------------------------------------- /tests/testthat/test-date_utils.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(tsbox) 3 | library(dplyr) 4 | 5 | test_that("time_shift is working", { 6 | x <- ts_tbl(ts_c(mdeaths, fdeaths)) 7 | expect_equal(x$time, tsbox:::time_shift(x$time)) 8 | 9 | x1 <- ts_tbl(ts_c(mdeaths, fdeaths)) %>% 10 | mutate(time = tsbox:::time_shift(time, by = "month")) 11 | xlag <- ts_lag(x) 12 | 13 | expect_equal(xlag, x1) 14 | }) 15 | 16 | 17 | test_that("non heuristic reguarization works for Date", { 18 | x <- as.Date(c( 19 | "2001-01-02", "2001-01-04", "2001-01-06", "2001-01-08", 20 | "2001-01-10", "2001-01-14" 21 | )) 22 | expect_s3_class(regularize_non_heuristic(x), "Date") 23 | }) 24 | 25 | test_that("time shift works in special situations", { 26 | z <- time_shift( 27 | c( 28 | seq(as.POSIXct("2001-01-01"), as.POSIXct("2001-01-02"), by = "hour"), 29 | as.POSIXct("2001-01-02 00:02:11 CET") 30 | ), 31 | by = "hour" 32 | ) 33 | expect_s3_class(z, "POSIXct") 34 | }) 35 | 36 | 37 | test_that("find_range() utility works", { 38 | expect_type(find_range("month"), "double") 39 | }) 40 | 41 | 42 | 43 | # test_that("time zones are not removed", { 44 | # x <- ts_tbl(EuStockMarkets) 45 | # attr(x$time, "tzone") <- "UTC" 46 | # # ts_pc(x) 47 | # }) 48 | -------------------------------------------------------------------------------- /tests/testthat/test-defects.R: -------------------------------------------------------------------------------- 1 | # fixed defects shuld not appear again 2 | 3 | test_that("concatenation when using data.frame format #166 (1)", { 4 | with_id <- wo_id <- ts_df(mdeaths) 5 | with_id$id <- "mdeaths" 6 | expect_identical(unique(ts_c(wo_id, with_id)$id), c("wo_id", "mdeaths")) 7 | }) 8 | 9 | test_that("pc keeps single id #166 (2)", { 10 | with_id <- ts_df(mdeaths) 11 | with_id$id <- "mdeaths" 12 | expect_identical(unique(ts_pc(with_id)$id), "mdeaths") 13 | expect_identical(unique(ts_(diff, vectorize = TRUE)(with_id)$id), "mdeaths") 14 | }) 15 | 16 | test_that("ts to df conversion works with offset #186", { 17 | a <- ts(c(1, 2, 3), start = 2015, frequency = 12) 18 | attr(a, "tsp")[1] <- attr(a, "tsp")[1] - 1e-11 19 | ans <- ts_df(a) 20 | expect_s3_class(ans, "data.frame") 21 | }) 22 | -------------------------------------------------------------------------------- /tests/testthat/test-dirty.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(tsbox) 3 | 4 | 5 | test_that("works with df with improper col classes", { 6 | library(dplyr) 7 | x.chr <- ts_tbl(mdeaths) %>% 8 | mutate(time = as.character(time)) 9 | 10 | expect_s3_class(ts_ts(x.chr), "ts") 11 | 12 | x.fct <- ts_tbl(mdeaths) %>% 13 | mutate(time = as.factor(as.character(time))) 14 | 15 | expect_s3_class(ts_ts(x.fct), "ts") 16 | }) 17 | 18 | 19 | 20 | test_that("time column of daily data is treated as Date (#114)", { 21 | x <- tibble( 22 | time = seq.Date(as.Date("2000-01-01"), length.out = 10, by = "day"), 23 | value = rnorm(10) 24 | ) 25 | 26 | z <- ts_dts(ts_ts(x)) 27 | expect_s3_class(z$time, "Date") 28 | }) 29 | 30 | 31 | test_that("time column of daily data is survives two way conversion (#137)", { 32 | x <- structure(list(time = structure(c( 33 | 16030, 16031, 16034, 16035, 34 | 16036 35 | ), class = "Date"), value = c( 36 | 18680.35, 18766.53, 18741.95, 37 | 18759.68, 18812.33 38 | )), class = "data.frame", row.names = c( 39 | NA, 40 | -5L 41 | )) 42 | 43 | z <- ts_na_omit(ts_tbl(ts_ts(x))) 44 | expect_equal(z$time, x$time) 45 | }) 46 | -------------------------------------------------------------------------------- /tests/testthat/test-high_freq.R: -------------------------------------------------------------------------------- 1 | library(dplyr) 2 | 3 | from_date <- as.POSIXct("2000-01-01") 4 | 5 | test_that("no NA when converting second data ", { 6 | x <- data.frame( 7 | time = seq(from = from_date, length.out = 10, by = "1 sec"), 8 | value = 1:10 9 | ) 10 | expect_true(all(!is.na(ts_ts(x)))) 11 | }) 12 | 13 | 14 | 15 | 16 | test_that("heuristic high frequency data works", { 17 | x <- ts_ts(data.frame( 18 | time = seq(from = from_date, length.out = 10, by = "1 sec"), 19 | value = 1:10 20 | )) 21 | expect_s3_class(x, "ts") 22 | 23 | x <- ts_ts(data.frame( 24 | time = seq(from = from_date, length.out = 10, by = "4 hour"), 25 | value = 1:10 26 | )) 27 | expect_s3_class(x, "ts") 28 | 29 | x <- ts_ts(data.frame( 30 | time = seq(from = from_date, length.out = 10, by = "1 day"), 31 | value = 1:10 32 | )) 33 | expect_s3_class(x, "ts") 34 | 35 | 36 | x <- data.frame( 37 | time = seq(from = from_date, length.out = 10, by = "1 sec"), 38 | value = 1:10 39 | ) 40 | expect_equal(x, ts_df(ts_ts(x))) 41 | 42 | x <- data.frame( 43 | time = seq(from = from_date, length.out = 10, by = "5 sec"), 44 | value = 1:10 45 | ) 46 | expect_equal(x, ts_df(ts_ts(x))) 47 | 48 | x <- data.frame( 49 | time = seq(from = from_date, length.out = 10, by = "10 sec"), 50 | value = 1:10 51 | ) 52 | expect_equal(x, ts_df(ts_ts(x))) 53 | 54 | x <- data.frame( 55 | time = seq(from = from_date, length.out = 10, by = "1 min"), 56 | value = 1:10 57 | ) 58 | expect_equal(x, ts_df(ts_ts(x))) 59 | 60 | x <- data.frame( 61 | time = seq(from = from_date, length.out = 10, by = "10 min"), 62 | value = 1:10 63 | ) 64 | expect_equal(x, ts_df(ts_ts(x))) 65 | 66 | x <- data.frame( 67 | time = seq(from = from_date, length.out = 10, by = "15 min"), 68 | value = 1:10 69 | ) 70 | expect_equal(x, ts_df(ts_ts(x))) 71 | 72 | x <- data.frame( 73 | time = seq(from = from_date, length.out = 10, by = "20 min"), 74 | value = 1:10 75 | ) 76 | expect_equal(x, ts_df(ts_ts(x))) 77 | 78 | x <- data.frame( 79 | time = seq(from = from_date, length.out = 10, by = "60 min"), 80 | value = 1:10 81 | ) 82 | expect_equal(x, ts_df(ts_ts(x))) 83 | 84 | # fails on some systems, time zones, needs investigation 85 | 86 | # x <- data.frame( 87 | # time = seq(from = from_date, length.out = 10, by = "1 day"), 88 | # value = 1:10 89 | # ) 90 | # expect_equal(x, ts_df(ts_ts(x))) 91 | }) 92 | 93 | 94 | 95 | 96 | test_that("non regular high frequency data works", { 97 | x <- data.frame( 98 | time = seq(from = from_date, length.out = 10, by = "10 days"), 99 | value = 1:10 100 | ) 101 | expect_equal(x, ts_df(ts_ts(x))) 102 | 103 | x <- data.frame( 104 | time = seq(from = from_date, length.out = 10, by = "17 days"), 105 | value = 1:10 106 | ) 107 | expect_equal(x, ts_df(ts_ts(x))) 108 | 109 | x <- data.frame( 110 | time = seq(from = from_date, length.out = 10, by = "17 secs"), 111 | value = 1:10 112 | ) 113 | expect_equal(x, ts_df(ts_ts(x))) 114 | 115 | x <- data.frame( 116 | time = seq(from = from_date, length.out = 10, by = "17 mins"), 117 | value = 1:10 118 | ) 119 | expect_equal(x, ts_df(ts_ts(x))) 120 | }) 121 | -------------------------------------------------------------------------------- /tests/testthat/test-irregular.R: -------------------------------------------------------------------------------- 1 | test_that("deals with true irregular series", { 2 | x <- data.frame( 3 | time = as.POSIXct(c( 4 | "2000-01-01", "2001-01-01", "2005-03-03", "2007-03-03", "2007-03-05", 5 | "2007-03-09", "2007-05-03", "2007-09-03" 6 | )), 7 | value = 1:8 8 | ) 9 | 10 | expect_error(ts_ts(x)) 11 | expect_equal(x, ts_df(ts_tbl(x))) 12 | 13 | 14 | x <- data.frame( 15 | time = as.Date(c("2000-01-01", "2001-01-01", "2005-03-03", "2007-03-03")), 16 | value = 1:4 17 | ) 18 | 19 | expect_error(ts_ts(x)) 20 | expect_equal(x, ts_df(ts_tbl(x))) 21 | }) 22 | 23 | 24 | test_that("universal functions work with irregular series", { 25 | x <- data.frame( 26 | time = as.Date(c( 27 | "2000-01-01", "2001-01-01", "2005-03-03", "2007-03-03", "2007-03-05", 28 | "2007-03-09", "2007-05-03", "2007-09-03" 29 | )), 30 | value = 1:8 31 | ) 32 | expect_error(ts_ts(x)) 33 | 34 | expect_s3_class(ts_c(x, ts_trend(x)), "data.frame") 35 | expect_s3_class(ts_c(x, ts_index(x, base = "2007-03-03")), "data.frame") 36 | 37 | expect_s3_class(ts_c(x, ts_scale(x)), "data.frame") 38 | }) 39 | -------------------------------------------------------------------------------- /tests/testthat/test-issues.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(tsbox) 3 | 4 | 5 | test_that("ts_trend does retransform (#193)", { 6 | ans <- ts_trend(AirPassengers) 7 | expect_s3_class(ans, "ts") 8 | }) 9 | 10 | 11 | test_that("regular zoo and xts can be processed", { 12 | library(zoo) 13 | z <- as.zoo(USAccDeaths) 14 | expect_s3_class(ts_tbl(z), "tbl") 15 | expect_s3_class(ts_tbl(xts::as.xts(z)), "tbl") 16 | }) 17 | 18 | test_that("ensure time is always ordered (#202)", { 19 | unorderd <- ts_tbl(ts(1:3, start = 2000))[c(2, 3, 1), ] 20 | expect_true(all(diff(ts_tbl(unorderd)$time) > 0)) 21 | }) 22 | -------------------------------------------------------------------------------- /tests/testthat/test-missing.R: -------------------------------------------------------------------------------- 1 | library(dplyr) 2 | 3 | #' @srrstats {G2.15} *Functions should never assume non-missingness, and should 4 | #' never pass data with potential missing values to any base routines with 5 | #' default `na.rm = FALSE`-type parameters (such as 6 | #' [`mean()`](https://stat.ethz.ch/R-manual/R-devel/library/base/html/mean.html), 7 | #' [`sd()`](https://stat.ethz.ch/R-manual/R-devel/library/stats/html/sd.html) or 8 | #' [`cor()`](https://stat.ethz.ch/R-manual/R-devel/library/stats/html/cor.html)).* 9 | 10 | test_that("Functions work with missing values", { 11 | 12 | x <- fdeaths 13 | x[5] <- NA_real_ 14 | 15 | # functions that keep NA 16 | fl <- lst( 17 | ts_bind, 18 | ts_c, 19 | ts_chain, 20 | ts_default, 21 | ts_diff, 22 | ts_diffy, 23 | ts_first_of_period, 24 | # ts_forecast, # 25 | ts_index, 26 | ts_lag, 27 | # ts_na_interpolation, 28 | ts_pc, 29 | ts_pca, 30 | ts_regular, 31 | # ts_seas, 32 | ts_span 33 | ) 34 | 35 | for (i in seq(fl)){ 36 | message(names(fl)[i]) 37 | z <- fl[[i]](x) 38 | expect_identical(z[5], NA_real_) 39 | } 40 | 41 | # functions that remvoe NA 42 | expect_false(is.na(ts_na_interpolation(x)[5])) 43 | # expect_false(is.na(ts_seas(x, na.action = seasonal::na.x13)[5])) 44 | 45 | }) 46 | 47 | 48 | #' @srrstats {G2.16} *All functions should also provide options to handle 49 | #' undefined values (e.g., `NaN`, `Inf` and `-Inf`), including potentially 50 | #' ignoring or removing such values.* 51 | test_that("Functions keep NaN values", { 52 | 53 | x <- fdeaths 54 | x[5] <- NaN 55 | 56 | # functions that keep NA 57 | fl <- lst( 58 | ts_bind, 59 | ts_c, 60 | ts_chain, 61 | ts_default, 62 | ts_diff, 63 | # ts_diffy, 64 | ts_first_of_period, 65 | # ts_forecast, # 66 | ts_index, 67 | ts_lag, 68 | # ts_na_interpolation, 69 | ts_pc, 70 | ts_pca, 71 | ts_regular, 72 | # ts_seas, 73 | ts_span 74 | ) 75 | 76 | for (i in seq(fl)){ 77 | message(names(fl)[i]) 78 | z <- fl[[i]](x) 79 | expect_identical(z[5], NaN) 80 | } 81 | 82 | expect_identical(ts_diffy(x)[5 + 12], NaN) 83 | 84 | # functions that remvoe NA 85 | expect_false(is.na(ts_na_interpolation(x)[5])) 86 | 87 | }) 88 | 89 | 90 | 91 | 92 | 93 | 94 | #' @srrstats {TS2.0} *Time Series Software which presumes or requires 95 | #' regular data should only allow **explicit** missing values, and should 96 | #' issue appropriate diagnostic messages, potentially including errors, in 97 | #' response to any **implicit** missing values.* 98 | test_that("Implicit and explicit NAs are treated the same", { 99 | 100 | x <- fdeaths 101 | x[5] <- NA_real_ 102 | explicit <- ts_tbl(x) 103 | implicit <- ts_na_omit(explicit) 104 | 105 | expect_equal(ts_ts(ts_trend(explicit)), ts_ts(ts_trend(implicit))) 106 | expect_equal(ts_ts(ts_bind(explicit)), ts_ts(ts_bind(implicit))) 107 | expect_equal(ts_ts(ts_chain(explicit)), ts_ts(ts_chain(implicit))) 108 | expect_equal(ts_ts(ts_diff(explicit)), ts_ts(ts_diff(implicit))) 109 | expect_equal(ts_ts(ts_diffy(explicit)), ts_ts(ts_diffy(implicit))) 110 | expect_equal(ts_ts(ts_first_of_period(explicit)), ts_ts(ts_first_of_period(implicit))) 111 | expect_equal(ts_ts(ts_index(explicit)), ts_ts(ts_index(implicit))) 112 | expect_equal(ts_ts(ts_lag(explicit)), ts_ts(ts_lag(implicit))) 113 | expect_equal(ts_ts(ts_pc(explicit)), ts_ts(ts_pc(implicit))) 114 | expect_equal(ts_ts(ts_pca(explicit)), ts_ts(ts_pca(implicit))) 115 | expect_equal(ts_ts(ts_span(explicit)), ts_ts(ts_span(implicit))) 116 | 117 | }) 118 | -------------------------------------------------------------------------------- /tests/testthat/test-non_heuristic.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(tsbox) 3 | 4 | 5 | test_that("regular non standard series work with NA", { 6 | x0 <- EuStockMarkets 7 | x0[5:10, ] <- NA 8 | expect_equal(ts_ts(ts_tbl(x0)), x0) 9 | 10 | x0[c(100, 200), c(2, 4)] <- NA 11 | expect_equal(ts_ts(ts_tbl(x0)), x0) 12 | }) 13 | -------------------------------------------------------------------------------- /tests/testthat/test-nonstandard_cnames.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(tsbox) 3 | 4 | test_that("main functions work with non standard cnames", { 5 | x <- ts_tbl(ts_c(mdeaths, AirPassengers)) 6 | x2 <- ts_tbl(ts_c(fdeaths, mdeaths)) 7 | 8 | names(x) <- c("hey", "heyhey", "Hey") 9 | names(x2) <- c("hey", "heyhey2", "Hey2") 10 | 11 | expect_s3_class(ts_span(x, start = 1958), "tbl_df") 12 | expect_s3_class(ts_c(x, x2), "tbl_df") 13 | expect_s3_class(ts_bind(x, x2), "tbl_df") 14 | expect_s3_class(ts_scale(x), "tbl_df") 15 | expect_s3_class(ts_frequency(x, "year"), "tbl_df") 16 | expect_s3_class(ts_index(x2), "tbl_df") 17 | expect_s3_class(ts_lag(x), "tbl_df") 18 | expect_s3_class(ts_pick(x, "mdeaths"), "tbl_df") 19 | 20 | skip_on_cran() 21 | # expect_type(ts_plot(x), "language") 22 | }) 23 | 24 | test_that("first object determines col order and col names (#166)", { 25 | ts1 <- ts_df(mdeaths) 26 | ts2 <- ts_df(fdeaths) 27 | colnames(ts1) <- c("time1", "value1") 28 | colnames(ts2) <- c("time2", "value2") 29 | ts2 <- ts_span(ts2[, c(2, 1)], end = 1977) 30 | expect_identical(names(ts_c(ts2, ts1)), c("id", names(ts2))) 31 | expect_identical(names(ts_bind(ts2, ts1)), names(ts2)) 32 | expect_identical(names(ts_chain(ts2, ts1)), names(ts2)) 33 | 34 | expect_identical(names(ts_index(ts2)), names(ts2)) 35 | expect_identical(names(ts_compound(ts2)), names(ts2)) 36 | expect_identical(names(ts_diff(ts2)), names(ts2)) 37 | expect_identical(names(ts_pc(ts2)), names(ts2)) 38 | expect_identical(names(ts_forecast(ts2)), names(ts2)) 39 | }) 40 | 41 | 42 | test_that("invalid colnames are handled correctly", { 43 | x <- ts_tbl(ts_c(mdeaths, AirPassengers)) 44 | x2 <- ts_tbl(ts_c(fdeaths, mdeaths)) 45 | 46 | names(x) <- c("Ö oe", "ha ha", "h h~dfsd") 47 | names(x2) <- c("Ö oe", "ha ha", "h h~dfsd") 48 | 49 | expect_s3_class(ts_span(x, start = 1958), "tbl_df") 50 | expect_s3_class(ts_c(x, x2), "tbl_df") 51 | expect_s3_class(ts_bind(x, x2), "tbl_df") 52 | expect_s3_class(ts_scale(x), "tbl_df") 53 | expect_s3_class(ts_frequency(x, "year"), "tbl_df") 54 | expect_s3_class(ts_index(x2), "tbl_df") 55 | expect_s3_class(ts_lag(x), "tbl_df") 56 | expect_s3_class(ts_pick(x, "mdeaths"), "tbl_df") 57 | 58 | skip_on_cran() 59 | # expect_type(ts_plot(x), "language") 60 | }) 61 | 62 | 63 | test_that("years are detected as time", { 64 | df <- data.frame(year = 2000:2009, value = 1:10) 65 | expect_equal(ts_summary(ts_ts(df))$end, as.Date("2009-01-01")) 66 | }) 67 | -------------------------------------------------------------------------------- /tests/testthat/test-nyc_flights.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(tsbox) 3 | 4 | test_that("minimal example works", { 5 | skip_if_not_installed("nycflights13") 6 | 7 | library(dplyr) 8 | library(nycflights13) 9 | dta <- weather %>% 10 | select(origin, time = time_hour, temp, humid, precip) %>% 11 | ts_long() 12 | 13 | expect_s3_class(dta, "tbl_df") 14 | expect_s3_class(ts_ts(ts_pc(dta)), "ts") 15 | }) 16 | -------------------------------------------------------------------------------- /tests/testthat/test-readme.R: -------------------------------------------------------------------------------- 1 | test_that("examples from README.md work properly", { 2 | skip_on_cran() 3 | 4 | x.ts <- ts_c(mdeaths, fdeaths) 5 | x.xts <- ts_xts(x.ts) 6 | x.df <- ts_df(x.xts) 7 | x.dt <- ts_dt(x.df) 8 | x.tbl <- ts_tbl(x.dt) 9 | 10 | ts_scale(x.ts) # normalization 11 | ts_scale(x.xts) 12 | ts_scale(x.df) 13 | ts_scale(x.dt) 14 | ts_scale(x.tbl) 15 | 16 | ts_trend(x.ts) # loess trend line 17 | ts_pc(x.xts) 18 | ts_pcy(x.df) 19 | ts_lag(x.dt) 20 | 21 | # with external packages 22 | ts_forecast(x.tbl) # ets forecast 23 | 24 | # collect time series as multiple time series 25 | ts_c(ts_dt(EuStockMarkets), AirPassengers) 26 | ts_c(EuStockMarkets, mdeaths) 27 | 28 | # combine time series to a new, single time series 29 | ts_bind(ts_dt(mdeaths), AirPassengers) 30 | ts_bind(ts_xts(AirPassengers), ts_tbl(mdeaths)) 31 | 32 | 33 | ts_df(ts_c(fdeaths, mdeaths)) 34 | 35 | # ts_plot(ts_scale(ts_c( 36 | # mdeaths, 37 | # austres, 38 | # AirPassengers, 39 | # DAX = EuStockMarkets[, "DAX"] 40 | # ))) 41 | p <- ts_ggplot(ts_scale(ts_c( 42 | mdeaths, 43 | austres, 44 | AirPassengers, 45 | DAX = EuStockMarkets[, "DAX"] 46 | ))) 47 | expect_true(ggplot2::is.ggplot(p)) 48 | 49 | ts_(diff)(AirPassengers) 50 | ts_(rowSums)(ts_c(mdeaths, fdeaths)) 51 | 52 | ts_prcomp <- ts_(function(x) predict(prcomp(x, scale = TRUE))) 53 | ts_prcomp(ts_c(mdeaths, fdeaths)) 54 | 55 | ts_dygraphs <- ts_(dygraphs::dygraph, class = "xts") 56 | ts_forecast <- ts_(function(x) forecast::forecast(x)$mean, vectorize = TRUE) 57 | ts_seas <- ts_( 58 | function(x) seasonal::final(seasonal::seas(x)), 59 | vectorize = TRUE 60 | ) 61 | 62 | ans <- ts_dygraphs(ts_c(mdeaths, EuStockMarkets)) 63 | ts_forecast(ts_c(mdeaths, fdeaths)) 64 | ts_seas(ts_c(mdeaths, fdeaths)) 65 | 66 | library(dplyr) 67 | library(tsbox) 68 | 69 | ts_tbl(ts_c(mdeaths, fdeaths)) %>% 70 | ts_seas() 71 | 72 | 73 | dta <- ts_df(ts_c(mdeaths, fdeaths)) 74 | expect_s3_class(dta, "data.frame") 75 | }) 76 | -------------------------------------------------------------------------------- /tests/testthat/test-time_conversion.R: -------------------------------------------------------------------------------- 1 | test_that("two way date time conversion (non heuristic)", { 2 | expect_equal( 3 | tsbox:::POSIXct_to_tsp(tsbox:::ts_to_POSIXct(AirPassengers)), 4 | tsp(AirPassengers) 5 | ) 6 | expect_equal( 7 | tsbox:::POSIXct_to_tsp(tsbox:::ts_to_POSIXct(EuStockMarkets)), 8 | tsp(EuStockMarkets) 9 | ) 10 | expect_equal( 11 | tsbox:::POSIXct_to_tsp(tsbox:::ts_to_POSIXct(discoveries)), 12 | tsp(discoveries) 13 | ) 14 | expect_equal( 15 | tsbox:::POSIXct_to_tsp(tsbox:::ts_to_POSIXct(mdeaths)), 16 | tsp(mdeaths) 17 | ) 18 | expect_equal( 19 | tsbox:::POSIXct_to_tsp(tsbox:::ts_to_POSIXct(uspop)), 20 | tsp(uspop) 21 | ) 22 | expect_equal( 23 | tsbox:::POSIXct_to_tsp(tsbox:::ts_to_POSIXct(austres)), 24 | tsp(austres) 25 | ) 26 | }) 27 | 28 | test_that("two way date time conversion (heuristic)", { 29 | expect_equal( 30 | tsbox:::date_time_to_tsp(tsbox:::ts_to_date_time(AirPassengers)), 31 | tsp(AirPassengers) 32 | ) 33 | expect_equal( 34 | tsbox:::date_time_to_tsp(tsbox:::ts_to_date_time(EuStockMarkets)), 35 | tsp(EuStockMarkets) 36 | ) 37 | expect_equal( 38 | tsbox:::date_time_to_tsp(tsbox:::ts_to_date_time(discoveries)), 39 | tsp(discoveries) 40 | ) 41 | expect_equal( 42 | tsbox:::date_time_to_tsp(tsbox:::ts_to_date_time(mdeaths)), 43 | tsp(mdeaths) 44 | ) 45 | expect_equal( 46 | tsbox:::date_time_to_tsp(tsbox:::ts_to_date_time(uspop)), 47 | tsp(uspop) 48 | ) 49 | expect_equal( 50 | tsbox:::date_time_to_tsp(tsbox:::ts_to_date_time(austres)), 51 | tsp(austres) 52 | ) 53 | }) 54 | -------------------------------------------------------------------------------- /tests/testthat/test-tricky.R: -------------------------------------------------------------------------------- 1 | test_that("Latest tricky stuff works.", { 2 | expect_equal( 3 | mdeaths, 4 | ts_ts(subset( 5 | ts_c(mdeaths, austres, AirPassengers, DAX = EuStockMarkets[, "DAX"]), 6 | id == "mdeaths" 7 | )) 8 | ) 9 | 10 | # names must be unique!! 11 | a <- ts_dts(ts_c(AirPassengers, AirPassengers)) 12 | expect_true(length(unique(a[["id"]])) == 2) 13 | 14 | # ts_c for ts objects 15 | expect_s3_class(ts_c(ts_c(fdeaths, mdeaths), AirPassengers), "ts") 16 | }) 17 | 18 | 19 | 20 | 21 | 22 | 23 | test_that("Some trickier stuff works.", { 24 | expect_s3_class(ts_c(EuStockMarkets, mdeaths, fdeaths), "data.frame") 25 | 26 | x <- ts_c(ts_df(ts_c(mdeaths, fdeaths)), AirPassengers) 27 | expect_equal(ts_ts(subset(x, id == "AirPassengers")), AirPassengers) 28 | 29 | # series of length 2 30 | a <- ts_dts(window(AirPassengers, end = c(1949, 2))) 31 | ts_ts(a) 32 | }) 33 | 34 | 35 | 36 | test_that("Irregular regular series work.", { 37 | expect_s3_class( 38 | data.frame( 39 | time = c( 40 | seq.Date(as.Date("2010-01-01"), by = "day", length.out = 10), 41 | seq.Date(as.Date("2010-02-01"), by = "day", length.out = 10), 42 | seq.Date(as.Date("2010-03-01"), by = "day", length.out = 10) 43 | ), 44 | value = rnorm(30) 45 | ) %>% 46 | ts_ts(), 47 | "ts" 48 | ) 49 | }) 50 | 51 | 52 | test_that("No Invalid .internal.selfref detected.", { 53 | x <- ts_dts(AirPassengers) 54 | expect_silent(x[, s := "sdfsd"]) 55 | }) 56 | 57 | 58 | test_that("Unordered time works", { 59 | suppressMessages(library(dplyr)) 60 | ap.rev <- arrange(ts_df(AirPassengers), desc(time)) 61 | 62 | expect_equal(ts_ts(ap.rev), AirPassengers) 63 | expect_equal(ts_ts(ts_diff(ap.rev)), ts_diff(AirPassengers)) 64 | }) 65 | 66 | 67 | test_that("Non unique colnames work fine", { 68 | expect_equal( 69 | ts_ts(ts_c(mdeaths, fdeaths, ts_df(ts_c(mdeaths, fdeaths)))), 70 | ts_c(mdeaths, fdeaths, ts_c(mdeaths, fdeaths)) 71 | ) 72 | 73 | expect_equal( 74 | ts_c(mdeaths, EuStockMarkets, ts_tbl(ts_c(mdeaths, EuStockMarkets))), 75 | ts_tbl(ts_c(mdeaths, EuStockMarkets, ts_c(mdeaths, EuStockMarkets))) 76 | ) 77 | 78 | expect_equal( 79 | ts_ts(ts_c(mdeaths, mdeaths = ts_df(ts_c(mdeaths)))), 80 | ts_c(mdeaths, mdeaths = ts_c(mdeaths)) 81 | ) 82 | }) 83 | 84 | 85 | test_that("Only combined ids are unique", { 86 | 87 | # individual ids columns don't matter 88 | df1 <- df2 <- ts_df(ts_c(mdeaths, fdeaths)) 89 | df1$cat <- "1" 90 | df2$cat <- "2" 91 | comb <- ts_c(df1, df2) 92 | expect_equal(unique(comb$id), c("mdeaths", "fdeaths")) 93 | 94 | df1 <- df2 <- ts_df(ts_c(mdeaths, mdeaths, fdeaths)) 95 | df1$cat <- "1" 96 | df2$cat <- "2" 97 | comb <- ts_c(df1, df2) 98 | expect_equal(unique(comb$id), c("mdeaths", "mdeaths.1", "fdeaths")) 99 | 100 | df1 <- df2 <- ts_df(ts_c(mdeaths, fdeaths)) 101 | df1$cat <- "1" 102 | df2$cat <- "1" 103 | comb <- ts_c(df1, df2) 104 | expect_equal(unique(comb$cat), c("1", "1.1")) 105 | }) 106 | 107 | 108 | test_that("No duplicated series are allowed", { 109 | dta <- 110 | bind_rows( 111 | tibble(id = "reihe_1", time = 2011:2018, value = 2:9), 112 | tibble(id = "reihe_1", time = 2011:2018, value = 1:8) 113 | ) 114 | expect_error(ts_ts(dta)) 115 | # mutliple ids 116 | dta <- 117 | bind_rows( 118 | tibble(rr = "a", id = "reihe_1", time = 2011:2018, value = 2:9), 119 | tibble(rr = "a", id = "reihe_1", time = 2011:2018, value = 1:8) 120 | ) 121 | expect_error(ts_ts(dta)) 122 | }) 123 | -------------------------------------------------------------------------------- /tests/testthat/test-ts_.R: -------------------------------------------------------------------------------- 1 | test_that("ts_ works with more exotic options", { 2 | skip_if_not_installed("dygraphs") 3 | 4 | expect_equal(ts_(rowSums)(ts_c(mdeaths, fdeaths)), mdeaths + fdeaths) 5 | ts_(dygraphs::dygraph, class = "xts") 6 | 7 | expect_equal( 8 | ts_(function(x) x, class = "ts", vectorize = TRUE)(ts_c(mdeaths, fdeaths)), 9 | ts_c(mdeaths, fdeaths) 10 | ) 11 | 12 | 13 | expect_error(load_suggested("blabla")) 14 | expect_error(ts_(function(x) x, reclass = FALSE, vectorize = TRUE)) 15 | }) 16 | 17 | 18 | test_that("ts_ based functions pass arguments in seasonal", { 19 | skip_on_cran() 20 | skip_if_not_installed("seasonal") 21 | 22 | # copied from x13binary::supportedPlatform 23 | supportedPlatform <- function() { 24 | z <- FALSE 25 | if (.Platform$OS.type == "windows") { 26 | z <- TRUE 27 | } 28 | if (Sys.info()["sysname"] %in% c("Linux")) { 29 | z <- TRUE 30 | } 31 | if (Sys.info()["sysname"] %in% c("Darwin")) { 32 | z <- compareVersion(Sys.info()["release"], "11.0.0") >= 33 | 0 34 | } 35 | if ((.Platform$OS.type == "unix") && !(Sys.info()["sysname"] %in% 36 | c("Darwin", "Linux"))) { 37 | z <- FALSE 38 | } 39 | z 40 | } 41 | 42 | if (!supportedPlatform()) { 43 | skip("x13binary is not supported on this platform") 44 | } 45 | 46 | sa <- ts_seas(ts_c(mdeaths, fdeaths), x11 = "") 47 | expect_equal( 48 | ts_pick(sa, "mdeaths"), 49 | predict(seasonal::seas(mdeaths, x11 = "")) 50 | ) 51 | expect_equal( 52 | ts_pick(sa, "fdeaths"), 53 | predict(seasonal::seas(fdeaths, x11 = "")) 54 | ) 55 | }) 56 | -------------------------------------------------------------------------------- /tests/testthat/test-ts_bind.R: -------------------------------------------------------------------------------- 1 | test_that("ts_bind works as it should.", { 2 | expect_equal( 3 | AirPassengers, 4 | ts_bind( 5 | ts_span(AirPassengers, start = "1950-01-01"), 6 | ts_span(AirPassengers, end = "1949-12-01") 7 | ) 8 | ) 9 | expect_equal( 10 | ts_dt(AirPassengers), 11 | ts_bind( 12 | ts_span(ts_dt(AirPassengers), start = "1950-01-01"), 13 | ts_span(ts_dt(AirPassengers), end = "1949-12-01") 14 | ) 15 | ) 16 | expect_equal( 17 | ts_df(AirPassengers), 18 | ts_bind( 19 | AirPassengers = ts_span(ts_df(AirPassengers), start = "1950-01-01"), 20 | ts_span(ts_df(AirPassengers), end = "1949-12-01") 21 | ) 22 | ) 23 | expect_equal( 24 | ts_tbl(AirPassengers), 25 | ts_bind( 26 | AirPassengers = ts_span(ts_tbl(AirPassengers), start = "1950-01-01"), 27 | ts_span(ts_tbl(AirPassengers), end = "1949-12-01") 28 | ) 29 | ) 30 | 31 | expect_s3_class(ts_bind(ts_dt(mdeaths), AirPassengers), "data.table") 32 | 33 | expect_equal( 34 | c(ts_span(ts_bind(mdeaths, 1:10), start = "1980-09-01")), 35 | c(9, 10) 36 | ) 37 | }) 38 | 39 | 40 | test_that("ts_chain gives correct results", { 41 | x <- ts_chain( 42 | ts_span(mdeaths, start = "1975-01-01", end = "1975-12-01"), 43 | fdeaths 44 | ) 45 | 46 | expect_equal( 47 | sum(ts_span((ts_pc(x) - ts_pc(fdeaths)), start = "1976-01-01")), 48 | 0 49 | ) 50 | expect_equal( 51 | sum(ts_span((ts_pc(x) - ts_pc(fdeaths)), end = "1974-12-01"), na.rm = TRUE), 52 | 0 53 | ) 54 | 55 | x.df <- ts_chain( 56 | ts_span(ts_df(mdeaths), start = "1975-01-01", end = "1975-12-01"), 57 | ts_df(fdeaths) 58 | ) 59 | x.xts <- ts_chain( 60 | ts_span(ts_xts(mdeaths), start = "1975-01-01", end = "1975-12-01"), 61 | ts_xts(fdeaths) 62 | ) 63 | x.tbl <- ts_chain( 64 | ts_span(ts_tbl(mdeaths), start = "1975-01-01", end = "1975-12-01"), 65 | ts_tbl(fdeaths) 66 | ) 67 | 68 | expect_equal(x.df, ts_df(x)) 69 | expect_equal(x.xts, ts_xts(x)) 70 | expect_equal(x.tbl, ts_tbl(x)) 71 | }) 72 | 73 | 74 | test_that("ts_bind works with scalars", { 75 | expect_equal(as.numeric(window(ts_bind(mdeaths, 1), start = 1980)), 1) 76 | twoseries <- ts_bind(ts_c(mdeaths, fdeaths), 1) 77 | expect_equal(as.numeric(window(twoseries, start = 1980)[, "mdeaths"]), 1) 78 | expect_s3_class(ts_bind(EuStockMarkets, 1), "ts") 79 | }) 80 | 81 | test_that("ts_bind works with short series and scalars (#197)", { 82 | ans <- ts_bind(ts_tbl(mdeaths)[1:1, ], 1) 83 | expect_s3_class(ans, "tbl_df") 84 | }) 85 | 86 | #' @srrstats {G2.6} *Software which accepts one-dimensional input should ensure values are appropriately pre-processed regardless of class structures.* 87 | test_that("ensure values are appropriately pre-processed regardless of class structures.", { 88 | x <- c(2, 2) 89 | class(x) <- "myclass" 90 | ans <- ts_bind(mdeaths, x) 91 | expect_s3_class(ans, "ts") 92 | }) 93 | 94 | 95 | 96 | 97 | 98 | 99 | -------------------------------------------------------------------------------- /tests/testthat/test-ts_c.R: -------------------------------------------------------------------------------- 1 | test_that("combining ids with same name works and keeps order", { 2 | library(dplyr) 3 | library(tidyr) 4 | 5 | a <- 6 | tibble(id1 = c("m", "f"), id2 = "A") %>% 7 | crossing(time = 2000:2003) %>% 8 | arrange(desc(id1), id2, time) %>% 9 | mutate(value = 1:n()) %>% 10 | ts_regular() 11 | 12 | ans <- ts_c(a, a) 13 | expect_identical(unique(ans$id1), c("m", "f")) 14 | expect_identical(unique(ans$id2), c("A", "A.1")) 15 | }) 16 | 17 | 18 | -------------------------------------------------------------------------------- /tests/testthat/test-ts_chain.R: -------------------------------------------------------------------------------- 1 | test_that("retropolation gives the correct results", { 2 | short.ts <- ts_span(mdeaths, start = "1976-01") 3 | retro <- ts_chain(short.ts, fdeaths) 4 | 5 | # anchor value 6 | expect_equal( 7 | ts_span(retro, start = 1976.1, end = 1976.1), 8 | ts_span(short.ts, start = 1976.1, end = 1976.1) 9 | ) 10 | 11 | # pc rates 12 | expect_equal( 13 | ts_span(ts_pc(retro), end = 1976.1), 14 | ts_span(ts_pc(fdeaths), end = 1976.1) 15 | ) 16 | expect_equal( 17 | ts_span(ts_pc(retro), start = 1976.2), 18 | ts_span(ts_pc(mdeaths), start = 1976.2) 19 | ) 20 | }) 21 | -------------------------------------------------------------------------------- /tests/testthat/test-ts_default.R: -------------------------------------------------------------------------------- 1 | test_that("ts_default works", { 2 | df0 <- ts_df(ts_c(mdeaths, fdeaths)) 3 | # non-default colnames 4 | colnames(df0) <- c("id", "date", "count") 5 | # switch back to default colnames 6 | df <- ts_default(df0) 7 | 8 | expect_identical(colnames(df), c("id", "time", "value")) 9 | }) 10 | -------------------------------------------------------------------------------- /tests/testthat/test-ts_first_of_period.R: -------------------------------------------------------------------------------- 1 | skip_on_cran() 2 | 3 | test_that("ts_first_of_period works", { 4 | x <- ts_c( 5 | a = ts_lag(ts_df(mdeaths), "14 days"), 6 | b = ts_lag(ts_df(mdeaths), "-2 days") 7 | ) 8 | ans <- ts_first_of_period(x) 9 | expect_true(all(data.table::mday(ans$time) == 1)) 10 | expect_identical(nrow(ans), nrow(x)) 11 | 12 | ans <- ts_first_of_period(ts_lag(ts_df(austres), "14 days")) 13 | expect_true(all(data.table::mday(ans$time) == 1)) 14 | 15 | x <- ts_lag(data.table( 16 | time = seq(anytime::anytime(1970), length.out = 10, by = "10 sec"), 17 | value = rnorm(10) 18 | ), "3 sec") 19 | ans <- ts_first_of_period(x) 20 | expect_identical(nrow(ans), nrow(x)) 21 | 22 | expect_true(all(as.integer(ans$time) %% 10 == 0)) 23 | }) 24 | 25 | test_that("ts_first_of_period works in western time zones", { 26 | x <- ts_lag(data.table( 27 | time = seq(anytime::anytime(1970, tz = "America/Los_Angeles"), length.out = 10, by = "10 sec"), 28 | value = rnorm(10) 29 | ), "3 sec") 30 | ans <- ts_first_of_period(x) 31 | expect_identical(nrow(ans), nrow(x)) 32 | }) 33 | 34 | 35 | 36 | test_that("ts_first_of_period works with POSIXct #210", { 37 | x <- ts_lag(data.frame( 38 | time = seq(as.POSIXct("1970-01-01"), length.out = 10, by = "10 sec"), 39 | value = rnorm(10) 40 | ), "3 sec") 41 | expect_true(nrow(ts_first_of_period(x)) == 10) 42 | }) 43 | -------------------------------------------------------------------------------- /tests/testthat/test-ts_frequency.R: -------------------------------------------------------------------------------- 1 | library(dplyr) 2 | 3 | test_that("ts_frequency survives freq conversion", { 4 | expect_equal( 5 | ts_frequency(EuStockMarkets, 1), 6 | ts_ts(ts_frequency(ts_xts(EuStockMarkets), 1)) 7 | ) 8 | }) 9 | 10 | test_that("ts_frequency handles na.rm correctly", { 11 | x <- ts_c(mdeaths, austres) 12 | window(x, start = c(1985, 6), end = c(1985, 12)) <- NA 13 | 14 | x0 <- ts_frequency(x) 15 | x1 <- ts_frequency(x, na.rm = TRUE) 16 | 17 | expect_identical(colnames(x0), colnames(x)) 18 | expect_identical(colnames(x1), colnames(x)) 19 | 20 | expect_true(is.na(window(x0, start = 1985, end = 1985)[, "austres"])) 21 | expect_false(is.na(window(x1, start = 1985, end = 1985)[, "austres"])) 22 | }) 23 | 24 | 25 | 26 | test_that("ts_frequency works with fancier frequencies", { 27 | 28 | skip_on_cran() 29 | 30 | z <- ts_frequency( 31 | EuStockMarkets, 32 | to = "week", 33 | aggregate = "mean", 34 | na.rm = TRUE 35 | ) 36 | 37 | expect_equal(tail(z, 1)[1], 5414.375) 38 | 39 | expect_s3_class( 40 | ts_frequency(mdeaths, to = "year", aggregate = "sum", na.rm = TRUE), 41 | "ts" 42 | ) 43 | 44 | expect_s3_class( 45 | ts_frequency(mdeaths, to = "month", aggregate = "sum", na.rm = TRUE), 46 | "ts" 47 | ) 48 | 49 | expect_s3_class( 50 | ts_frequency(mdeaths, to = "quarter", aggregate = "sum", na.rm = TRUE), 51 | "ts" 52 | ) 53 | }) 54 | 55 | 56 | test_that("ts_frequency works with POSIXct", { 57 | x <- tibble( 58 | time = seq(Sys.time(), length.out = 20, by = "10 sec"), 59 | value = 1 60 | ) 61 | 62 | expect_s3_class( 63 | ts_frequency(x, to = "min", aggregate = "sum", na.rm = TRUE), 64 | "tbl_df" 65 | ) 66 | 67 | expect_s3_class( 68 | ts_frequency(x, to = "hour", aggregate = "sum", na.rm = TRUE), 69 | "tbl_df" 70 | ) 71 | }) 72 | -------------------------------------------------------------------------------- /tests/testthat/test-ts_index.R: -------------------------------------------------------------------------------- 1 | # skip_on_appveyor() # it works on my windows machine not clear what's wrong 2 | skip_on_cran() 3 | 4 | library(dplyr) 5 | 6 | test_that("ts_index series have same pc rates", { 7 | expect_equal( 8 | ts_pc(mdeaths), 9 | ts_pc(ts_index(mdeaths, "1977-01-01")) 10 | ) 11 | 12 | expect_equal( 13 | ts_pc(austres), 14 | ts_pc(ts_index(austres, "1977-01-01")) 15 | ) 16 | }) 17 | 18 | 19 | test_that("ts_index drops errors", { 20 | expect_error(ts_index(mdeaths, "2000-01-01")) 21 | expect_error(ts_index(ts_c(mdeaths, fdeaths), "2000-01-01")) 22 | expect_error(ts_index(EuStockMarkets, "2100-01-01")) 23 | }) 24 | 25 | test_that("ts_index works with multi ids", { 26 | x <- bind_rows( 27 | mutate(ts_tbl(ts_c(fdeaths, mdeaths)), id2 = "one"), 28 | mutate(ts_tbl(ts_c(fdeaths, mdeaths)), id2 = "two") 29 | ) %>% 30 | ts_df() %>% 31 | ts_tbl() 32 | 33 | expect_equal( 34 | ts_df(ts_pc(x)), 35 | ts_df(ts_pc(ts_index(x, "1977-01-01"))) 36 | ) 37 | }) 38 | 39 | test_that("ts_index keeps NA", { 40 | expect_identical(ts_index(ts_bind(NA, mdeaths), 1977)[1], NA_real_) 41 | }) 42 | 43 | test_that("ts_compound works", { 44 | expect_equal(ts_compound(ts_pc(mdeaths)), ts_index(mdeaths, "1974")) 45 | }) 46 | 47 | test_that("ts_index works with ranges", { 48 | base74 <- mdeaths / ts_frequency(mdeaths, "year")[1] 49 | expect_equal(base74, ts_index(mdeaths, c("1974", "1974-12-31"))) 50 | expect_equal( 51 | ts_pc(ts_index(mdeaths)), 52 | ts_pc(ts_index(mdeaths, c("1974", "1975"))) 53 | ) 54 | }) 55 | -------------------------------------------------------------------------------- /tests/testthat/test-ts_lag.R: -------------------------------------------------------------------------------- 1 | test_that("integer and character shifting works the same", { 2 | expect_equal(ts_lag(mdeaths), ts_lag(mdeaths, "month")) 3 | expect_equal(ts_lag(austres), ts_lag(austres, "quarter")) 4 | 5 | expect_equal(ts_lag(mdeaths, 5), ts_lag(mdeaths, "5 month")) 6 | expect_equal(ts_lag(austres, -3), ts_lag(austres, "-3 quarter")) 7 | 8 | expect_equal(ts_lag(discoveries, -300), ts_lag(discoveries, "-300 years")) 9 | expect_equal(ts_lag(fdeaths, 11), ts_lag(fdeaths, "11 month")) 10 | }) 11 | 12 | 13 | #' @srrstats {G5.4b} *For new implementations of existing methods, correctness tests should include tests against previous implementations. Such testing may explicitly call those implementations in testing, preferably from fixed-versions of other software, or use stored outputs from those where that is not possible.* 14 | #' Compaare ts_lag with stats::lag 15 | test_that("ts_lag works as stats::lag", { 16 | expect_equal(ts_lag(mdeaths), stats::lag(mdeaths, -1)) 17 | expect_equal(ts_lag(mdeaths, -1), stats::lag(mdeaths, 1)) 18 | 19 | expect_equal(ts_lag(mdeaths, 12), stats::lag(mdeaths, -12)) 20 | expect_equal(ts_lag(mdeaths, -12), stats::lag(mdeaths, 12)) 21 | }) 22 | 23 | test_that("ts_lag works both ways", { 24 | expect_equal(ts_lag(ts_lag(mdeaths, -1)), ts_lag(ts_lag(mdeaths), -1)) 25 | expect_equal(ts_lag(ts_lag(mdeaths, -12)), ts_lag(ts_lag(mdeaths), -12)) 26 | }) 27 | 28 | 29 | 30 | 31 | -------------------------------------------------------------------------------- /tests/testthat/test-ts_long_wide.R: -------------------------------------------------------------------------------- 1 | test_that("ts_long returns correct class.", { 2 | a <- ts_df(ts_c(ts_dt(AirPassengers), mdeaths, fdeaths)) 3 | expect_equal(class(ts_long(ts_wide(a)))[1], "data.frame") 4 | }) 5 | 6 | 7 | test_that("ts_long and ts_wide work both ways.", { 8 | a <- ts_df(ts_c(AirPassengers, mdeaths, fdeaths)) 9 | expect_equal(a, ts_long(ts_wide(a))) 10 | 11 | b <- ts_tbl(ts_dt(EuStockMarkets)) 12 | expect_equal(b, ts_long(ts_wide(b))) 13 | }) 14 | 15 | 16 | test_that("ts_wide works has correct time stamps.", { 17 | a <- ts_df(ts_c(ts_dt(AirPassengers), mdeaths, fdeaths)) 18 | expect_equal(ts_wide(ts_xts(a)), ts_xts(a)) 19 | expect_equal(ts_wide(ts_ts(a)), ts_ts(a)) 20 | }) 21 | 22 | test_that("economics dataset can be converted to long format", { 23 | library(ggplot2) 24 | library(tsbox) 25 | expect_s3_class(ts_long(economics), "tbl_df") 26 | }) 27 | -------------------------------------------------------------------------------- /tests/testthat/test-ts_low_freq.R: -------------------------------------------------------------------------------- 1 | test_that("regular low frequency data works with POSIXct", { 2 | 3 | # fails on some systems, time zones 4 | # x <- data.frame( 5 | # time = seq(from = as.POSIXct("2000-01-01"), 6 | # length.out = 10, by = "1 month"), 7 | # value = 1:10 8 | # ) 9 | # 10 | # z <- ts_df(ts_ts(x)) 11 | # x$time <- seq(from = as.Date("2000-01-01"), length.out = 10, by = "1 month") 12 | # expect_equal(x, z) 13 | 14 | 15 | 16 | x <- EuStockMarkets[, "DAX"] %>% 17 | ts_df() %>% 18 | ts_regular() 19 | 20 | expect_s3_class(x, "data.frame") 21 | }) 22 | -------------------------------------------------------------------------------- /tests/testthat/test-ts_na_omit.R: -------------------------------------------------------------------------------- 1 | #' @srrstats {G5.3} *For functions which are expected to return objects containing no missing (`NA`) or undefined (`NaN`, `Inf`) values, the absence of any such values in return objects should be explicitly tested.* 2 | test_that("functions which are expected to return objects containing no missing values do so.", { 3 | 4 | x <- fdeaths 5 | x[5] <- NA_real_ 6 | x <- ts_tbl(x) 7 | expect_true(any(is.na(x$value))) 8 | 9 | z <- ts_na_omit(x) 10 | expect_false(any(is.na(z$value))) 11 | 12 | z <- ts_na_interpolation(x) 13 | expect_false(any(is.na(z$value))) 14 | }) 15 | 16 | 17 | -------------------------------------------------------------------------------- /tests/testthat/test-ts_pc.R: -------------------------------------------------------------------------------- 1 | test_that("colname guessing works as expected", { 2 | 3 | # 3 cols 4 | library(dplyr) 5 | x.df <- ts_tbl(ts_c(mdeaths, fdeaths)) %>% 6 | setNames(c("Haha", "Hoho", "Hihi")) 7 | 8 | expect_equal( 9 | ts_pc(mdeaths), 10 | ts_ts(ts_xts(ts_df(ts_pc(x.df))))[, "mdeaths"] 11 | ) 12 | expect_equal( 13 | ts_diff(mdeaths), 14 | ts_ts(ts_xts(ts_df(ts_diff(x.df))))[, "mdeaths"] 15 | ) 16 | expect_equal( 17 | ts_pcy(mdeaths), 18 | ts_ts(ts_xts(ts_df(ts_pcy(x.df))))[, "mdeaths"] 19 | ) 20 | expect_equal( 21 | ts_diffy(mdeaths), 22 | ts_ts(ts_xts(ts_df(ts_diffy(x.df))))[, "mdeaths"] 23 | ) 24 | 25 | # 2 cols 26 | x.df <- ts_tbl(AirPassengers) %>% 27 | setNames(c("Haha", "Hoho")) 28 | 29 | expect_equal(ts_pc(AirPassengers), ts_ts(ts_xts(ts_df(ts_pc(x.df))))) 30 | expect_equal(ts_diff(AirPassengers), ts_ts(ts_xts(ts_df(ts_diff(x.df))))) 31 | expect_equal(ts_pcy(AirPassengers), ts_ts(ts_xts(ts_df(ts_pcy(x.df))))) 32 | expect_equal(ts_diffy(AirPassengers), ts_ts(ts_xts(ts_df(ts_diffy(x.df))))) 33 | }) 34 | 35 | 36 | test_that("ts_compound, ts_index and ts_pc are consistent", { 37 | expect_equal(ts_pc(mdeaths), ts_pc(ts_index(mdeaths))) 38 | expect_equal(ts_pc(AirPassengers), ts_pc(ts_index(AirPassengers))) 39 | 40 | expect_equal( 41 | ts_compound(ts_pc(EuStockMarkets)), 42 | ts_index(EuStockMarkets) 43 | ) 44 | 45 | expect_equal( 46 | ts_compound(ts_pc(ts_c(mdeaths, fdeaths))), 47 | ts_index(ts_c(mdeaths, fdeaths)) 48 | ) 49 | 50 | expect_equal( 51 | ts_pc(ts_compound(ts_pc(ts_c(mdeaths, fdeaths)))), 52 | ts_pc(ts_index(ts_c(mdeaths, fdeaths))) 53 | ) 54 | 55 | expect_equal( 56 | ts_compound(ts_pc(ts_c(AirPassengers))), 57 | ts_index(ts_c(AirPassengers)) 58 | ) 59 | }) 60 | 61 | 62 | test_that("pc and ts_index works with NA", { 63 | x0 <- mdeaths 64 | x0[5:10] <- NA 65 | expect_s3_class(ts_index(ts_pc(x0)), "ts") 66 | 67 | x1 <- EuStockMarkets 68 | x1[5:10, ] <- NA 69 | expect_s3_class(ts_index(ts_pc(x1)), "ts") 70 | }) 71 | 72 | 73 | test_that("formulas are correct", { 74 | x <- ts(c(1:8), start = 2000, frequency = 4) 75 | expect_equal(ts_pc(x)[8], 100 * (8 / 7 - 1)) 76 | expect_equal(ts_pcy(x)[8], 100 * (8 / 4 - 1)) 77 | expect_equal(ts_diff(x)[8], 8 - 7) 78 | expect_equal(ts_diffy(x)[8], 8 - 4) 79 | expect_equal(ts_pca(x)[8], 100 * ((8 / 7)^4 - 1)) 80 | }) 81 | 82 | 83 | test_that("time order does not affect outcome", { 84 | x0 <- ts(1:5, start = 2000) 85 | x <- ts_df(ts_c(a = x0, b = x0)) 86 | ud <- x[c(5:1, 10:6), ] 87 | 88 | expect_equal(ts_lag(ud), ts_lag(x)) 89 | expect_equal(ts_pc(ud), ts_pc(x)) 90 | expect_equal(ts_pc(ud), ts_pc(x)) 91 | expect_equal(ts_pca(ud), ts_pca(x)) 92 | }) 93 | -------------------------------------------------------------------------------- /tests/testthat/test-ts_pick.R: -------------------------------------------------------------------------------- 1 | test_that("ts_pick works", { 2 | # Programming use 3 | to.be.picked.and.renamed <- c(`My Dax` = "DAX", `My Smi` = "SMI") 4 | a <- ts_pick(EuStockMarkets, to.be.picked.and.renamed) 5 | b <- ts_pick(EuStockMarkets, `My Dax` = "DAX", `My Smi` = "SMI") 6 | expect_equal(a, b) 7 | 8 | b <- ts_pick(EuStockMarkets, `My Dax` = 1, `My Smi` = 2) 9 | expect_equal(a, b) 10 | 11 | expect_equal(EuStockMarkets[, c(1, 2)], ts_pick(EuStockMarkets, c(1, 2))) 12 | }) 13 | 14 | test_that("unknown series drops an error", { 15 | expect_error(ts_pick(ts_df(ts_c(mdeaths, fdeaths)), "hallo")) 16 | }) 17 | -------------------------------------------------------------------------------- /tests/testthat/test-ts_plot.R: -------------------------------------------------------------------------------- 1 | test_that("ts_plot works", { 2 | skip_on_cran() 3 | 4 | tf <- tempfile(fileext = ".pdf") 5 | pdf(file = tf) 6 | ts_plot(AirPassengers, title = "AirPassengers", subtitle = "Heyhey") 7 | dev.off() 8 | unlink(tf) 9 | 10 | # tf <- tempfile(fileext = ".pdf") 11 | # ts_save(tf, open = FALSE) 12 | # expect_true(file.size(tf) > 3000) 13 | 14 | # tf <- tempfile(fileext = ".png") 15 | # ts_save(tf, open = FALSE) 16 | # expect_true(file.size(tf) > 3000) 17 | 18 | # tf <- tempfile(fileext = ".bmp") 19 | # ts_save(tf, open = FALSE) 20 | # expect_true(file.size(tf) > 3000) 21 | 22 | # tf <- tempfile(fileext = ".jpeg") 23 | # ts_save(tf, open = FALSE) 24 | # expect_true(file.size(tf) > 3000) 25 | 26 | # tf <- tempfile(fileext = ".tiff") 27 | # ts_save(tf, open = TRUE) 28 | # expect_true(file.size(tf) > 3000) 29 | 30 | p <- ts_ggplot(AirPassengers, mdeaths) + theme_tsbox() + scale_color_tsbox() 31 | expect_s3_class(p, "ggplot") 32 | }) 33 | -------------------------------------------------------------------------------- /tests/testthat/test-ts_regular.R: -------------------------------------------------------------------------------- 1 | test_that("conversion produces right classes", { 2 | x0 <- AirPassengers 3 | x0[c(10, 15)] <- NA 4 | x <- ts_na_omit(ts_dts(x0)) 5 | expect_equal(ts_ts(ts_regular(x)), x0) 6 | 7 | m <- mdeaths 8 | m[c(10, 69)] <- NA 9 | f <- fdeaths 10 | f[c(1, 3, 15)] <- NA 11 | 12 | comb <- ts_ts(ts_regular(ts_na_omit(ts_dts(ts_c(f, m))))) 13 | expect_equal(comb, cbind(f, m)) 14 | }) 15 | 16 | 17 | 18 | test_that("handles, regular, non standard series correctly", { 19 | expect_equal(EuStockMarkets, ts_regular(EuStockMarkets)) 20 | 21 | expect_error( 22 | ts_regular(data.frame( 23 | time = as.Date(c("2001-01-01", "2002-01-01", "2010-06-01")), 24 | value = 1 25 | )) 26 | ) 27 | }) 28 | 29 | 30 | test_that("does not change colnames in non standard order", { 31 | x <- ts_df(ts_c(mdeaths, fdeaths)) 32 | setcolorder(x, c("time", "id", "value")) 33 | expect_equal(ts_regular(x), x) 34 | }) 35 | 36 | test_that("fill argument works", { 37 | x0 <- AirPassengers 38 | x0[2] <- NA 39 | x <- ts_na_omit(ts_dts(x0)) 40 | z <- ts_regular(x, -9999) 41 | expect_equal(z[[2]][2], -9999) 42 | expect_equal(ts_regular(x0, 0)[2], 0) 43 | }) 44 | -------------------------------------------------------------------------------- /tests/testthat/test-ts_scale.R: -------------------------------------------------------------------------------- 1 | test_that("ts_scale does not modify time column", { 2 | expect_equal( 3 | ts_c(AirPassengers, EuStockMarkets[, "DAX"])$time, 4 | ts_scale(ts_c(AirPassengers, DAX = EuStockMarkets[, "DAX"]))$time 5 | ) 6 | }) 7 | 8 | test_that("POSIXct time col does not get modified.", { 9 | ap <- ts_df(AirPassengers) 10 | ap$time <- as.POSIXct(ap$time) 11 | expect_s3_class(ts_scale(ap)$time, "POSIXct") 12 | }) 13 | -------------------------------------------------------------------------------- /tests/testthat/test-ts_span.R: -------------------------------------------------------------------------------- 1 | test_that("ts_span does the same as base window", { 2 | ts_win2 <- ts_(window) 3 | expect_equal( 4 | ts_win2(ts_c(mdeaths, fdeaths), start = c(1978, 3)), 5 | ts_span(ts_c(mdeaths, fdeaths), start = "1978-03-01") 6 | ) 7 | 8 | expect_equal( 9 | ts_win2(ts_c(austres), start = c(1978, 2)), 10 | ts_span(ts_c(austres), start = "1978-04-01") 11 | ) 12 | 13 | expect_equal( 14 | ts_win2(ts_c(mdeaths, fdeaths), end = c(1978, 3)), 15 | ts_span(ts_c(mdeaths, fdeaths), end = "1978-03-01") 16 | ) 17 | 18 | expect_equal( 19 | ts_win2(ts_c(austres), end = c(1978, 2)), 20 | ts_span(ts_c(austres), end = "1978-04-01") 21 | ) 22 | 23 | expect_error( 24 | ts_span(ts_c(austres), start = "1978-06-01", end = "1978-04-01") 25 | ) 26 | 27 | x <- ts_df(austres) 28 | 29 | expect_equal(x[1, 1], ts_summary(austres)$start) 30 | expect_equal(x[nrow(x), 1], ts_summary(austres)$end) 31 | }) 32 | 33 | test_that("'by' strings are accepted (#106)", { 34 | expect_equal( 35 | ts_span(mdeaths, start = "197903"), 36 | ts_span(mdeaths, start = "-10 month") 37 | ) 38 | expect_equal( 39 | ts_span(mdeaths, end = "197402"), 40 | ts_span(mdeaths, end = 2) 41 | ) 42 | }) 43 | 44 | test_that("works with non-heuristic frequencies (#106)", { 45 | expect_equal( 46 | ts_span(EuStockMarkets, start = "-1 year"), 47 | ts_span(EuStockMarkets, start = "19970827") 48 | ) 49 | 50 | expect_equal( 51 | time(ts_span(EuStockMarkets, end = 5))[1:5], 52 | time(EuStockMarkets)[1:5] 53 | ) 54 | 55 | expect_equal( 56 | time(ts_span(EuStockMarkets, end = 1))[1], 57 | time(EuStockMarkets)[1] 58 | ) 59 | }) 60 | 61 | 62 | 63 | test_that("extending by NA works", { 64 | expect_equal( 65 | ts_span(mdeaths, end = "19801201", extend = TRUE), 66 | window(mdeaths, end = c(1980, 12), extend = TRUE) 67 | ) 68 | 69 | expect_equal( 70 | ts_span(mdeaths, start = "1973", extend = TRUE), 71 | window(mdeaths, start = 1973, extend = TRUE) 72 | ) 73 | }) 74 | 75 | test_that("extending by NA works for different frequencies", { 76 | x <- ts_span(ts_df(ts_c(AirPassengers, austres)), start = 1930, extend = TRUE) 77 | expect_identical( 78 | ts_span(x, start = "1930-01-01", end = "1930-01-01")$value, 79 | c(NA_real_, NA_real_) 80 | ) 81 | }) 82 | 83 | 84 | test_that("extending by template works", { 85 | target <- 86 | ts_span(ts_span(discoveries, template = AirPassengers, extend = FALSE), template = AirPassengers, extend = TRUE) 87 | actual <- ts_span(ts_span(discoveries, template = AirPassengers, extend = TRUE)) 88 | expect_equal(target, actual) 89 | }) 90 | -------------------------------------------------------------------------------- /tests/testthat/test-ts_summary.R: -------------------------------------------------------------------------------- 1 | 2 | library(testthat) 3 | library(tsbox) 4 | library(dplyr) 5 | 6 | test_that("ts_summary works with irregular series", { 7 | skip_on_cran() 8 | x <- ts_c( 9 | mdeaths, 10 | irreg = data.frame( 11 | time = as.POSIXct(c( 12 | "2000-01-01", "2001-01-01", "2005-03-03", "2007-03-03", "2007-03-05", 13 | "2007-03-09", "2007-05-03", "2007-09-03" 14 | )), 15 | value = 1:8 16 | ) 17 | ) 18 | smry <- ts_summary(x) 19 | expect_true(is.na(smry[2, 3])) 20 | }) 21 | 22 | 23 | test_that("ts_summary works with single series", { 24 | expect_s3_class(ts_summary(AirPassengers), "data.frame") 25 | expect_s3_class(ts_summary(AirPassengers, spark = TRUE), "data.frame") 26 | }) 27 | 28 | 29 | test_that("ts_summary works with single observations", { 30 | expect_s3_class(ts_summary(ts_span(mdeaths, -1)), "data.frame") 31 | expect_s3_class(ts_summary(ts_span(mdeaths, -1), spark = TRUE), "data.frame") 32 | }) 33 | 34 | test_that("ts_summary works with irregular observations", { 35 | series_irreg <- tribble( 36 | ~time, ~value, 37 | "1988-01-01", 1, 38 | "2015-11-01", 2 39 | ) %>% 40 | mutate(time = as.Date(time)) 41 | 42 | expect_s3_class(ts_summary(series_irreg), "data.frame") 43 | expect_s3_class(ts_summary(series_irreg, spark = TRUE), "data.frame") 44 | }) 45 | -------------------------------------------------------------------------------- /tests/testthat/test-tsibble.R: -------------------------------------------------------------------------------- 1 | # install.packages(c("tsibble", "xts", "timeSeries", "zoo", "tibbletime")) 2 | 3 | library(dplyr) 4 | 5 | test_that("two way conversion works for tsibbles, too.", { 6 | skip_if_not_installed("tsibble") 7 | library(tsibble) 8 | 9 | # tsibble alphabetically reorders key column 10 | # mixed frequencies 11 | expect_equal( 12 | ts_ts(ts_tsibble(ts_c(austres, AirPassengers))), 13 | ts_c(AirPassengers, austres) 14 | ) 15 | # non alphabetical order, multi series 16 | expect_equal( 17 | ts_ts(ts_tsibble(ts_c(mdeaths, fdeaths))), 18 | ts_c(fdeaths, mdeaths) 19 | ) 20 | # non alphabetical order, multi series 21 | expect_equal( 22 | ts_ts(ts_tsibble(ts_c(mdeaths, AirPassengers))), 23 | ts_c(AirPassengers, mdeaths) 24 | ) 25 | }) 26 | 27 | 28 | test_that("tsibble back-conversion works properly", { 29 | skip_if_not_installed("nycflights13") 30 | skip_if_not_installed("tsibble") 31 | library(tsibble) 32 | 33 | weather <- nycflights13::weather %>% 34 | select(origin, time_hour, temp, humid, precip) 35 | weather_tsbl <- as_tsibble(weather, key = origin, index = time_hour) 36 | ans <- weather_tsbl %>% 37 | ts_default() 38 | expect_s3_class(ans, "tbl_ts") 39 | }) 40 | 41 | 42 | test_that("tsibbledata sets can be read", { 43 | skip_if_not_installed("tsibble") 44 | skip_on_cran() 45 | skip_on_travis() 46 | skip_on_appveyor() 47 | 48 | # slow tests are commented out 49 | 50 | # expect_s3_class(ts_ts(tsibbledata::PBS), "ts") 51 | # expect_s3_class(ts_ts(tsibbledata::global_economy), "ts") 52 | expect_s3_class(ts_ts(tsibbledata::ansett), "ts") 53 | expect_s3_class(ts_ts(tsibbledata::hh_budget), "ts") 54 | expect_s3_class(ts_ts(tsibbledata::aus_livestock), "ts") 55 | expect_s3_class(ts_tbl(tsibbledata::nyc_bikes), "tbl_df") 56 | expect_s3_class(ts_ts(tsibbledata::aus_production), "ts") 57 | expect_s3_class(ts_ts(tsibbledata::olympic_running), "ts") 58 | # expect_s3_class(ts_ts(tsibbledata::aus_retail), "ts") 59 | expect_s3_class(ts_ts(tsibbledata::pelt), "ts") 60 | expect_s3_class(ts_ts(tsibbledata::gafa_stock), "ts") 61 | expect_s3_class(ts_ts(tsibbledata::vic_elec), "ts") 62 | }) 63 | -------------------------------------------------------------------------------- /tests/testthat/test-tslist.R: -------------------------------------------------------------------------------- 1 | test_that("tslist works on single series", { 2 | expect_s3_class(ts_tslist(AirPassengers), "tslist") 3 | }) 4 | 5 | 6 | test_that("tslist of lenght 1 dont have an id", { 7 | expect_equal( 8 | ts_dts(ts_pick(ts_tslist(EuStockMarkets), "DAX")), 9 | ts_dts(ts_pick(EuStockMarkets, "DAX")) 10 | ) 11 | }) 12 | -------------------------------------------------------------------------------- /tests/testthat/test-tzone.R: -------------------------------------------------------------------------------- 1 | 2 | library(testthat) 3 | library(tsbox) 4 | 5 | #' @srrstats {G5.9b} *Running under different random seeds or initial conditions does not meaningfully change results* 6 | #' Test that operations do not depend on time zone 7 | test_that("operations do not depend on time zone", { 8 | skip_on_cran() 9 | 10 | # temp set tz 11 | old.tz <- Sys.getenv("TZ") 12 | on.exit(Sys.setenv(TZ = old.tz)) 13 | Sys.setenv(TZ = "America/Los_Angeles") 14 | 15 | 16 | expect_equal( 17 | mdeaths, 18 | ts_ts(subset( 19 | ts_c(mdeaths, austres, AirPassengers, DAX = EuStockMarkets[, "DAX"]), 20 | id == "mdeaths" 21 | )) 22 | ) 23 | 24 | # fails in some time zones and some systems. needs more investigation 25 | 26 | # x <- data.frame( 27 | # time = seq(from = as.POSIXct("2000-01-01"), length.out = 10, 28 | # by = "1 day"), value = 1:10 29 | # ) 30 | # expect_equal(x, ts_df(ts_ts(x))) 31 | 32 | # revert to system time zone 33 | Sys.setenv(TZ = old.tz) 34 | }) 35 | -------------------------------------------------------------------------------- /tests/testthat/test-units.R: -------------------------------------------------------------------------------- 1 | library(dplyr) 2 | library(units) 3 | 4 | #' @srrstats {G2.11} *Software should ensure that `data.frame`-like tabular 5 | #' objects which have columns which do not themselves have standard class 6 | #' attributes (typically, `vector`) are appropriately processed, and do not 7 | #' error without reason. This behaviour should be tested. Again, columns 8 | #' created by the `units` package provide a good test case.* 9 | test_that("tsbox works with units", { 10 | 11 | x <- 12 | ts_tbl(ts_c(mdeaths, fdeaths)) %>% 13 | mutate(value = set_units(value, m)) 14 | 15 | z <- ts_pick(x, "fdeaths") 16 | expect_identical(units(z$value)$numerator, "m") 17 | 18 | # functions that should work with units 19 | fl <- lst( 20 | ts_bind, 21 | ts_c, 22 | ts_chain, 23 | ts_default, 24 | ts_diff, 25 | ts_diffy, 26 | ts_first_of_period, 27 | ts_forecast, 28 | ts_index, 29 | ts_lag, 30 | ts_na_interpolation, 31 | ts_pc, 32 | ts_pca, 33 | ts_regular, 34 | ts_seas, 35 | ts_span 36 | ) 37 | 38 | for (i in seq(fl)){ 39 | message(names(fl)[i]) 40 | z <- fl[[i]](x) 41 | expect_identical(units(z$value)$numerator, "m", label = names(fl)[i]) 42 | } 43 | 44 | }) 45 | -------------------------------------------------------------------------------- /tsbox.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: pdfLaTeX 14 | 15 | BuildType: Package 16 | PackageUseDevtools: Yes 17 | PackageInstallArgs: --no-multiarch --with-keep.source 18 | -------------------------------------------------------------------------------- /vignettes/fig/myfig.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/tsbox/0a80208f0ff197d7dc88a2a43609be7f8a6cf544/vignettes/fig/myfig.png -------------------------------------------------------------------------------- /vignettes/fig/plot1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/tsbox/0a80208f0ff197d7dc88a2a43609be7f8a6cf544/vignettes/fig/plot1.png -------------------------------------------------------------------------------- /vignettes/ts-functions.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "User defined ts-functions" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{User defined ts-functions} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | 11 | ## Writing ts-functions 12 | 13 | It is straightforward to turn existing functions into functions that can deal 14 | with any ts-boxable object. 15 | 16 | The `ts_` function is a constructor function for tsbox time series functions. It 17 | can be used to wrap any function that works with time series. The default is set 18 | to R base `"ts"` class, so wrapping functions for `"ts"` time series (or vectors 19 | or matrices) is as simple as: 20 | 21 | ```r 22 | ts_rowsums <- ts_(rowSums) 23 | ts_rowsums(ts_c(mdeaths, fdeaths)) 24 | 25 | ``` 26 | Note that `ts_` returns a function, which can be with or without a name. Let' have a closer look at how `ts_rowsums` looks like: 27 | 28 | ```r 29 | ts_rowsums 30 | #> function (x, ...) 31 | #> { 32 | #> stopifnot(ts_boxable(x)) 33 | #> z <- rowSums(ts_ts(x), ...) 34 | #> copy_class(z, x) 35 | #> } 36 | 37 | ``` 38 | 39 | This is how most ts-functions work. They use a specific converter function 40 | (here: `ts_ts`) to convert a ts-boxable object to the desired class. They then 41 | perform the main operation on the object (here: `rowSums`). Finally they convert 42 | the result back to the original class, using `copy_class`. 43 | 44 | The resulting function has a `...` argument. You can use it to pass 45 | arguments to the underlying functions. E.g., 46 | 47 | ```r 48 | ts_rowsums(ts_c(mdeaths, fdeaths), na.rm = TRUE) 49 | ``` 50 | 51 | 52 | ## Functions from external packages 53 | 54 | Here is a slightly more complex example, which uses a post processing function: 55 | 56 | ```r 57 | ts_prcomp <- ts_(function(x) predict(prcomp(x, scale = TRUE))) 58 | ts_prcomp(ts_c(mdeaths, fdeaths)) 59 | ``` 60 | 61 | It is easy to make functions from external packages ts-boxable, by wrapping them 62 | into `ts_`. 63 | 64 | ```r 65 | ts_dygraphs <- ts_(dygraphs::dygraph, class = "xts") 66 | ts_forecast <- ts_(function(x, ...) forecast::forecast(x, ...)$mean, vectorize = TRUE) 67 | ts_seas <- ts_(function(x, ...) seasonal::final(seasonal::seas(x, ...)), vectorize = TRUE) 68 | 69 | ts_dygraphs(ts_c(mdeaths, EuStockMarkets)) 70 | ts_forecast(ts_c(mdeaths, fdeaths)) 71 | ts_seas(ts_c(mdeaths, fdeaths)) 72 | ``` 73 | 74 | If you are explicit about the namespace (e.g., `dygraphs::dygraph`), 75 | `ts_` recognized the package in use and delivers a meaningful message if the 76 | package is not installed. 77 | 78 | Note that the `ts_` function deals with the conversion stuff, 'vectorizes' the 79 | function so that it can be used with multiple time series. 80 | 81 | Let' have another look at `ts_forecast`: 82 | 83 | ```r 84 | ts_forecast 85 | #> function (x, ...) 86 | #> { 87 | #> load_suggested("forecast") 88 | #> ff <- function(x, ...) { 89 | #> stopifnot(ts_boxable(x)) 90 | #> z <- (function(x, ...) forecast::forecast(ts_na_omit(x), 91 | #> ...)$mean)(ts_ts(x), ...) 92 | #> copy_class(z, x) 93 | #> } 94 | #> ts_apply(x, ff, ...) 95 | #> } 96 | ``` 97 | 98 | There three differences to the `ts_rowsum` example: First, the function requires 99 | the forecast package. If it is not installed, `load_suggested` will ask the user 100 | to do so. Second, the function in use is an anonymous function, `function(x) 101 | forecast::forecast(x, ...)$mean`, that also extracts the `$mean` component from 102 | the result. Third, the function is 'vectorized', using `ts_apply`. This causes 103 | the process to be repeated for each time series in the object. 104 | 105 | 106 | 107 | --------------------------------------------------------------------------------