├── .github ├── .gitignore ├── ISSUE_TEMPLATE │ ├── feature_request.md │ └── bug_report.md ├── PULL_REQUEST_TEMPLATE │ └── pull_request_template.md └── workflows │ ├── R-CMD-check.yaml │ ├── test-coverage.yaml │ └── pkgdown.yaml ├── .lintr ├── LICENSE ├── figure ├── si-1.png ├── onset-1.png ├── onset-2.png ├── plots-1.png ├── epicurve-1.png ├── interval-1.png ├── offset-1.png ├── other_si-1.png ├── pred_2-1.png ├── pred_2-2.png ├── predictions-1.png ├── predictions-2.png ├── predictions-3.png ├── adding_forecasts-1.png ├── adding_forecasts-2.png ├── plot_with_incidence-1.png └── plot_with_incidence-2.png ├── docs ├── figure │ ├── si-1.png │ ├── onset-1.png │ ├── onset-2.png │ ├── plots-1.png │ ├── epicurve-1.png │ ├── interval-1.png │ ├── offset-1.png │ ├── other_si-1.png │ ├── pred_2-1.png │ ├── pred_2-2.png │ ├── predictions-1.png │ ├── predictions-2.png │ ├── predictions-3.png │ ├── adding_forecasts-1.png │ ├── adding_forecasts-2.png │ ├── plot_with_incidence-1.png │ └── plot_with_incidence-2.png ├── reference │ ├── project-1.png │ ├── project-2.png │ ├── plot.projections-1.png │ ├── cumulate.projections-1.png │ ├── merge_add_projections-1.png │ ├── print.projections.html │ ├── conversions.html │ ├── build_projections.html │ ├── subset.html │ ├── summary.projections.html │ └── index.html ├── pkgdown.yml ├── link.svg ├── bootstrap-toc.css ├── docsearch.js ├── pkgdown.js ├── bootstrap-toc.js ├── LICENSE-text.html ├── 404.html ├── authors.html ├── CONDUCT.html └── pkgdown.css ├── man ├── figures │ ├── README-si-1.png │ ├── README-offset-1.png │ ├── README-onset-1.png │ ├── README-onset-2.png │ ├── README-plots-1.png │ ├── README-pred_2-1.png │ ├── README-pred_2-2.png │ ├── README-other_si-1.png │ ├── README-predictions-1.png │ ├── README-predictions-2.png │ ├── README-adding_forecasts-1.png │ ├── README-adding_forecasts-2.png │ └── README-plot_with_incidence-1.png ├── print.projections.Rd ├── conversions.Rd ├── merge_projections.Rd ├── build_projections.Rd ├── projections_accessors.Rd ├── cumulate.projections.Rd ├── subset.Rd ├── merge_add_projections.Rd ├── summary.projections.Rd ├── plot.projections.Rd └── project.Rd ├── .gitignore ├── R ├── global.R ├── print.projections.R ├── accessors.R ├── cumulate.R ├── conversion.R ├── internals.R ├── compute_relative_infectivity.R ├── compute_force_infection.R ├── subset.R ├── build_projections.R ├── summary.R ├── merge_projections.R ├── merge_add_projections.R └── plot.projections.R ├── tests ├── testthat.R └── testthat │ ├── test-cumulate.R │ ├── test-accessors.R │ ├── test-internals.R │ ├── test-print.R │ ├── test-conversion.R │ ├── test-merge_projections.R │ ├── test-build_projections.R │ ├── test-subset.R │ ├── test-summary.R │ ├── test-merge_add_projections.R │ ├── test-plots.R │ └── _snaps │ └── plots │ └── evd-proj-red-ribbon.svg ├── .Rbuildignore ├── projections.Rproj ├── cran-comments.md ├── NAMESPACE ├── CONDUCT.md ├── DESCRIPTION └── NEWS.md /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.lintr: -------------------------------------------------------------------------------- 1 | linters: with_defaults() 2 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2017 2 | COPYRIGHT HOLDER: Thibaut Jombart -------------------------------------------------------------------------------- /figure/si-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/figure/si-1.png -------------------------------------------------------------------------------- /figure/onset-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/figure/onset-1.png -------------------------------------------------------------------------------- /figure/onset-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/figure/onset-2.png -------------------------------------------------------------------------------- /figure/plots-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/figure/plots-1.png -------------------------------------------------------------------------------- /docs/figure/si-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/figure/si-1.png -------------------------------------------------------------------------------- /figure/epicurve-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/figure/epicurve-1.png -------------------------------------------------------------------------------- /figure/interval-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/figure/interval-1.png -------------------------------------------------------------------------------- /figure/offset-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/figure/offset-1.png -------------------------------------------------------------------------------- /figure/other_si-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/figure/other_si-1.png -------------------------------------------------------------------------------- /figure/pred_2-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/figure/pred_2-1.png -------------------------------------------------------------------------------- /figure/pred_2-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/figure/pred_2-2.png -------------------------------------------------------------------------------- /docs/figure/onset-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/figure/onset-1.png -------------------------------------------------------------------------------- /docs/figure/onset-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/figure/onset-2.png -------------------------------------------------------------------------------- /docs/figure/plots-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/figure/plots-1.png -------------------------------------------------------------------------------- /docs/figure/epicurve-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/figure/epicurve-1.png -------------------------------------------------------------------------------- /docs/figure/interval-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/figure/interval-1.png -------------------------------------------------------------------------------- /docs/figure/offset-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/figure/offset-1.png -------------------------------------------------------------------------------- /docs/figure/other_si-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/figure/other_si-1.png -------------------------------------------------------------------------------- /docs/figure/pred_2-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/figure/pred_2-1.png -------------------------------------------------------------------------------- /docs/figure/pred_2-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/figure/pred_2-2.png -------------------------------------------------------------------------------- /figure/predictions-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/figure/predictions-1.png -------------------------------------------------------------------------------- /figure/predictions-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/figure/predictions-2.png -------------------------------------------------------------------------------- /figure/predictions-3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/figure/predictions-3.png -------------------------------------------------------------------------------- /docs/reference/project-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/reference/project-1.png -------------------------------------------------------------------------------- /docs/reference/project-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/reference/project-2.png -------------------------------------------------------------------------------- /man/figures/README-si-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/man/figures/README-si-1.png -------------------------------------------------------------------------------- /docs/figure/predictions-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/figure/predictions-1.png -------------------------------------------------------------------------------- /docs/figure/predictions-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/figure/predictions-2.png -------------------------------------------------------------------------------- /docs/figure/predictions-3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/figure/predictions-3.png -------------------------------------------------------------------------------- /figure/adding_forecasts-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/figure/adding_forecasts-1.png -------------------------------------------------------------------------------- /figure/adding_forecasts-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/figure/adding_forecasts-2.png -------------------------------------------------------------------------------- /man/figures/README-offset-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/man/figures/README-offset-1.png -------------------------------------------------------------------------------- /man/figures/README-onset-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/man/figures/README-onset-1.png -------------------------------------------------------------------------------- /man/figures/README-onset-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/man/figures/README-onset-2.png -------------------------------------------------------------------------------- /man/figures/README-plots-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/man/figures/README-plots-1.png -------------------------------------------------------------------------------- /man/figures/README-pred_2-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/man/figures/README-pred_2-1.png -------------------------------------------------------------------------------- /man/figures/README-pred_2-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/man/figures/README-pred_2-2.png -------------------------------------------------------------------------------- /figure/plot_with_incidence-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/figure/plot_with_incidence-1.png -------------------------------------------------------------------------------- /figure/plot_with_incidence-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/figure/plot_with_incidence-2.png -------------------------------------------------------------------------------- /man/figures/README-other_si-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/man/figures/README-other_si-1.png -------------------------------------------------------------------------------- /docs/figure/adding_forecasts-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/figure/adding_forecasts-1.png -------------------------------------------------------------------------------- /docs/figure/adding_forecasts-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/figure/adding_forecasts-2.png -------------------------------------------------------------------------------- /docs/pkgdown.yml: -------------------------------------------------------------------------------- 1 | pandoc: 2.3.1 2 | pkgdown: 1.5.1 3 | pkgdown_sha: ~ 4 | articles: [] 5 | last_built: 2020-06-29T14:53Z 6 | 7 | -------------------------------------------------------------------------------- /man/figures/README-predictions-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/man/figures/README-predictions-1.png -------------------------------------------------------------------------------- /man/figures/README-predictions-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/man/figures/README-predictions-2.png -------------------------------------------------------------------------------- /docs/figure/plot_with_incidence-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/figure/plot_with_incidence-1.png -------------------------------------------------------------------------------- /docs/figure/plot_with_incidence-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/figure/plot_with_incidence-2.png -------------------------------------------------------------------------------- /docs/reference/plot.projections-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/reference/plot.projections-1.png -------------------------------------------------------------------------------- /docs/reference/cumulate.projections-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/reference/cumulate.projections-1.png -------------------------------------------------------------------------------- /man/figures/README-adding_forecasts-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/man/figures/README-adding_forecasts-1.png -------------------------------------------------------------------------------- /man/figures/README-adding_forecasts-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/man/figures/README-adding_forecasts-2.png -------------------------------------------------------------------------------- /docs/reference/merge_add_projections-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/docs/reference/merge_add_projections-1.png -------------------------------------------------------------------------------- /man/figures/README-plot_with_incidence-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reconhub/projections/HEAD/man/figures/README-plot_with_incidence-1.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | .httr-oauth 6 | inst/doc 7 | README.html 8 | *~ 9 | *.tar.gz 10 | *.Rcheck 11 | -------------------------------------------------------------------------------- /R/global.R: -------------------------------------------------------------------------------- 1 | 2 | # This fixes a NOTE during checks due to undefined variable names - used in 3 | # ggplot2 syntax. 4 | 5 | utils::globalVariables(c(".data")) 6 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(distcrete) 3 | library(incidence) 4 | library(projections) 5 | library(outbreaks) 6 | library(magrittr) 7 | 8 | test_check("projections") 9 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^README\.Rmd$ 4 | ^README\.md 5 | ^README-.*\.png$ 6 | ^\.travis\.yml$ 7 | ^\.lintr$ 8 | ^appveyor\.yml$ 9 | ^codecov\.yml$ 10 | ^cran-comments\.md$ 11 | ^CONDUCT\.md$ 12 | ^figure* 13 | ^docs* 14 | .*tar.gz$ 15 | ^README.html$ 16 | ^\.github$ 17 | -------------------------------------------------------------------------------- /projections.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: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## Reason for updated release 2 | * We no longer use vdiffr for tests (further to email from Brin Ripley) 3 | 4 | ## Test environments 5 | * local Fedora 33, R 4.0.3 (2020-10-10) 6 | * local Fedora 33, R Under development (unstable) (2020-12-15 r79637) 7 | * winbuilder, R Under development (unstable) (2020-12-13 r79623) 8 | 9 | ## R CMD check results 10 | There were no ERRORS, WARNINGS or NOTES 11 | 12 | ## Downstream dependencies 13 | I have also run R CMD check on downstream, suggested dependency earlyR and there 14 | were no problems 15 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/feature_request.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Feature request 3 | about: Suggest an idea for this project 4 | title: '' 5 | labels: '' 6 | assignees: '' 7 | 8 | --- 9 | 10 | **Is your feature request related to a problem? Please describe.** 11 | A clear and concise description of what the problem is. Ex. I'm always frustrated when [...] 12 | 13 | **Describe the solution you'd like** 14 | A clear and concise description of what you want to happen. 15 | 16 | **Additional context** 17 | Add any other context or screenshots about the feature request here. 18 | -------------------------------------------------------------------------------- /man/print.projections.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/print.projections.R 3 | \name{print.projections} 4 | \alias{print.projections} 5 | \title{Print method for projections objects} 6 | \usage{ 7 | \method{print}{projections}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{A \code{projections} object.} 11 | 12 | \item{...}{further parameters to be passed to other methods (currently not 13 | used)} 14 | } 15 | \description{ 16 | This method prints the content of \code{projections} objects. 17 | } 18 | \author{ 19 | Thibaut Jombart (\email{thibautjombart@gmail.com}) 20 | } 21 | -------------------------------------------------------------------------------- /tests/testthat/test-cumulate.R: -------------------------------------------------------------------------------- 1 | test_that("Test cumulate()", { 2 | skip_on_cran() 3 | 4 | ## simulate basic epicurve 5 | dat <- c(0, 2, 2, 3, 3, 5, 5, 5, 6, 6, 6, 6) 6 | i <- incidence::incidence(dat) 7 | 8 | 9 | ## example with a function for SI 10 | si <- distcrete::distcrete("gamma", interval = 1L, 11 | shape = 1.5, 12 | scale = 2, w = 0) 13 | 14 | set.seed(1) 15 | x <- project(i, runif(100, 0.8, 1.9), si, n_days = 30) 16 | y <- cumulate(x) 17 | 18 | expect_identical(apply(x, 2, cumsum), unclass(as.matrix(y))) 19 | expect_error(cumulate(y), "x already contains cumulative incidence") 20 | 21 | }) 22 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/bug_report.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Bug report 3 | about: Create a report to help us improve 4 | title: '' 5 | labels: '' 6 | assignees: '' 7 | 8 | --- 9 | 10 | Please place an "x" in all the boxes that apply 11 | --------------------------------------------- 12 | 13 | - [ ] I have the most recent version of reportfactory and R 14 | - [ ] I have found a bug 15 | - [ ] I have a [reproducible example](http://reprex.tidyverse.org/articles/reprex-dos-and-donts.html) 16 | - [ ] I want to request a new feature 17 | 18 | -------- 19 | 20 | Please include a brief description of the problem with a code example: 21 | 22 | ```r 23 | # insert reprex here 24 | ``` 25 | 26 | --------- 27 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method("+",projections) 4 | S3method("[",projections) 5 | S3method(as.data.frame,projections) 6 | S3method(as.matrix,projections) 7 | S3method(cumulate,projections) 8 | S3method(get_dates,projections) 9 | S3method(plot,projections) 10 | S3method(print,projections) 11 | S3method(subset,projections) 12 | S3method(summary,projections) 13 | export(add_projections) 14 | export(build_projections) 15 | export(get_dates) 16 | export(merge_add_projections) 17 | export(merge_projections) 18 | export(project) 19 | importFrom(graphics,plot) 20 | importFrom(incidence,cumulate) 21 | importFrom(incidence,get_dates) 22 | importFrom(methods,is) 23 | importFrom(stats,as.ts) 24 | -------------------------------------------------------------------------------- /tests/testthat/test-accessors.R: -------------------------------------------------------------------------------- 1 | test_that("Accessors return the right thing", { 2 | skip_on_cran() 3 | 4 | ## simulate basic epicurve 5 | dat <- c(0, 2, 2, 3, 3, 5, 5, 5, 6, 6, 6, 6) 6 | i <- incidence::incidence(dat) 7 | 8 | ## example with a function for SI 9 | si <- distcrete::distcrete("gamma", interval = 1L, 10 | shape = 1.5, 11 | scale = 2, w = 0) 12 | 13 | 14 | pred_1 <- project(i, runif(100, 0.8, 1.9), si, n_days = 30) 15 | expect_equal(attr(pred_1, "dates"), get_dates(pred_1)) 16 | 17 | }) 18 | 19 | 20 | test_that("Expected errors", { 21 | skip_on_cran() 22 | 23 | expect_error(get_dates("toto"), 24 | "Not implemented for class character") 25 | }) 26 | -------------------------------------------------------------------------------- /tests/testthat/test-internals.R: -------------------------------------------------------------------------------- 1 | test_that("Errors are thrown when they should", { 2 | skip_on_cran() 3 | 4 | expect_error(projections:::assert_reporting("asasd"), 5 | "reporting is not numeric") 6 | 7 | expect_error(projections:::assert_reporting(Inf), 8 | "reporting is not a finite value") 9 | 10 | expect_error(projections:::assert_reporting(NA_integer_), 11 | "reporting is not a finite value") 12 | 13 | expect_error(projections:::assert_reporting(0), 14 | "reporting <= 0") 15 | 16 | expect_error(projections:::assert_reporting(-123), 17 | "reporting <= 0") 18 | 19 | expect_error(projections:::assert_reporting(1.1), 20 | "reporting > 1") 21 | 22 | }) 23 | 24 | -------------------------------------------------------------------------------- /.github/PULL_REQUEST_TEMPLATE/pull_request_template.md: -------------------------------------------------------------------------------- 1 | * **Please check if the PR fulfills these requirements** 2 | 3 | - [ ] I have read the CONTRIBUTING guidelines 4 | - [ ] The commit message follows our guidelines 5 | - [ ] Tests for the changes have been added (for bug fixes / features) 6 | - [ ] Docs have been added / updated (for bug fixes / features) 7 | 8 | 9 | * **What kind of change does this PR introduce?** (Bug fix, feature, docs update, ...) 10 | 11 | 12 | 13 | * **What is the current behavior?** (You can also link to an open issue here) 14 | 15 | 16 | 17 | * **What is the new behavior (if this is a feature change)?** 18 | 19 | 20 | 21 | * **Does this PR introduce a breaking change?** (What changes might users need to make in their application due to this PR?) 22 | 23 | 24 | 25 | * **Other information**: 26 | -------------------------------------------------------------------------------- /tests/testthat/test-print.R: -------------------------------------------------------------------------------- 1 | test_that("Printing as planned", { 2 | skip_on_cran() 3 | 4 | ## simulate basic epicurve 5 | dat <- c(0, 2, 2, 3, 3, 5, 5, 5, 6, 6, 6, 6) 6 | i <- incidence::incidence(dat) 7 | 8 | 9 | ## example with a function for SI 10 | si <- distcrete::distcrete("gamma", interval = 1L, 11 | shape = 1.5, 12 | scale = 2, w = 0) 13 | 14 | set.seed(1) 15 | x <- project(i, runif(100, 0.8, 1.9), si, n_days = 30) 16 | y <- cumulate(x) 17 | 18 | expect_output(print(x), " // 30 dates \\(rows\\); 100 simulations \\(columns\\)") 19 | expect_output(print(y), " // 30 dates \\(rows\\); 100 simulations \\(columns\\)") 20 | 21 | expect_output(print(y), " // cumulative projections") 22 | expect_failure(expect_output(print(x), " // cumulative projections")) 23 | 24 | }) 25 | -------------------------------------------------------------------------------- /docs/link.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 5 | 8 | 12 | 13 | -------------------------------------------------------------------------------- /.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: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | R_KEEP_PKG_SOURCE: yes 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::rcmdcheck 27 | needs: check 28 | 29 | - uses: r-lib/actions/check-r-package@v2 30 | -------------------------------------------------------------------------------- /man/conversions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/conversion.R 3 | \name{as.matrix.projections} 4 | \alias{as.matrix.projections} 5 | \alias{as.data.frame.projections} 6 | \title{Conversion of projections objects} 7 | \usage{ 8 | \method{as.matrix}{projections}(x, ...) 9 | 10 | \method{as.data.frame}{projections}(x, ..., long = FALSE) 11 | } 12 | \arguments{ 13 | \item{x}{An \code{projections} object, or an object to be converted as 14 | \code{projections} (see details).} 15 | 16 | \item{...}{Further arguments passed to other functions (no used).} 17 | 18 | \item{long}{A logical indicating if the output data.frame should be 'long', 19 | i.e. where a single column containing 'groups' is added in case of data 20 | computed on several groups.} 21 | } 22 | \description{ 23 | These functions convert \code{projections} objects into other classes. 24 | } 25 | \seealso{ 26 | the \code{\link{project}} function to generate the 'projections' objects. 27 | } 28 | \author{ 29 | Thibaut Jombart \email{thibautjombart@gmail.com} 30 | } 31 | -------------------------------------------------------------------------------- /R/print.projections.R: -------------------------------------------------------------------------------- 1 | #' Print method for projections objects 2 | #' 3 | #' This method prints the content of \code{projections} objects. 4 | #' 5 | #' @export 6 | #' 7 | #' @author Thibaut Jombart (\email{thibautjombart@@gmail.com}) 8 | #' 9 | #' @param x A \code{projections} object. 10 | #' 11 | #' @param ... further parameters to be passed to other methods (currently not 12 | #' used) 13 | #' 14 | print.projections <- function(x, ...){ 15 | cat("\n/// Incidence projections //\n") 16 | cat("\n // class:", paste(class(x), collapse = ", ")) 17 | cat("\n //", format(nrow(x), big.mark = ","), 18 | "dates (rows);", 19 | format(ncol(x), big.mark = ","), 20 | "simulations (columns)\n") 21 | 22 | cat("\n // first rows/columns:\n") 23 | p <- min(6, ncol(x)) 24 | n <- min(4, nrow(x)) 25 | print(unclass(x)[seq_len(n), seq_len(p), drop = FALSE]) 26 | if (n < nrow(x)) replicate(3, cat(" .\n")) 27 | 28 | cat("\n // dates:\n") 29 | print(attr(x, "dates")) 30 | if (isTRUE(attr(x, "cumulative"))) { 31 | cat("\n // cumulative projections") 32 | } 33 | cat("\n") 34 | } 35 | -------------------------------------------------------------------------------- /tests/testthat/test-conversion.R: -------------------------------------------------------------------------------- 1 | test_that("Test against reference results", { 2 | skip_on_cran() 3 | 4 | ## simulate basic epicurve 5 | dat <- as.Date("2001-01-01") + c(0, 2, 2, 3, 3, 5, 5, 5, 6, 6, 6, 6) 6 | i <- incidence::incidence(dat) 7 | 8 | 9 | ## example with a function for SI 10 | si <- distcrete::distcrete("gamma", 11 | interval = 1L, 12 | shape = 1.5, 13 | scale = 2, w = 0) 14 | 15 | x <- project(i, runif(100, 0.8, 1.9), si, n_days = 30) 16 | 17 | 18 | ## basic export 19 | df_1 <- as.data.frame(x) 20 | expect_identical(get_dates(x), df_1$dates) 21 | expect_identical(as.vector(x), unname(unlist(df_1[-1]))) 22 | 23 | 24 | ## long format 25 | df_2 <- as.data.frame(x, long = TRUE) 26 | expect_identical(3L, ncol(df_2)) 27 | expect_identical(c("date", "incidence", "sim"), names(df_2)) 28 | expect_identical(get_dates(x), unique(df_2$date)) 29 | expect_identical(as.vector(x), unname(unlist(df_2[[2]]))) 30 | expect_identical(ncol(x), length(unique(df_2[[3]]))) 31 | }) 32 | 33 | 34 | -------------------------------------------------------------------------------- /man/merge_projections.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/merge_projections.R 3 | \name{merge_projections} 4 | \alias{merge_projections} 5 | \title{Merge a list of projections objects} 6 | \usage{ 7 | merge_projections(x) 8 | } 9 | \arguments{ 10 | \item{x}{A \code{list} of \code{projections} objects to be merged.} 11 | } 12 | \description{ 13 | This function merges \code{projections} objects, binding them by columns, making 14 | sure that they all use the same dates, adding rows of '0' where needed. 15 | } 16 | \examples{ 17 | 18 | ## generate toy data 19 | dates <- Sys.Date() + c(0, 0, 2, 5, 6, 6, 7) 20 | i <- incidence::incidence(dates) 21 | si <- c(0.2, 0.5, 0.2, 0.1) 22 | R0 <- 3.5 23 | 24 | ## make several projections objects 25 | x <- lapply(1:10, 26 | function(j) 27 | project(x = i, 28 | si = si, 29 | R = R0, 30 | n_sim = 2 * j, 31 | R_fix_within = TRUE, 32 | n_days = j, 33 | model = "poisson" 34 | )) 35 | ## see all dimensions 36 | lapply(x, dim) 37 | merge_projections(x) 38 | } 39 | \author{ 40 | Thibaut Jombart 41 | } 42 | -------------------------------------------------------------------------------- /man/build_projections.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/build_projections.R 3 | \name{build_projections} 4 | \alias{build_projections} 5 | \title{Constructor for projections objects} 6 | \usage{ 7 | build_projections(x, dates = NULL, cumulative = FALSE, order_dates = TRUE) 8 | } 9 | \arguments{ 10 | \item{x}{A \code{matrix} of simulated incidence stored as integers, where 11 | rows correspond to dates and columns to simulations.} 12 | 13 | \item{dates}{A vector of dates containing one value per row in \code{x}; 14 | acceptable formats are: \code{integer}, \code{Date}, and \code{POSIXct}; if 15 | NULL, the time steps will be counted, with the first dates corresponding to 16 | 0.} 17 | 18 | \item{cumulative}{A logical indicating if data represent cumulative 19 | incidence; defaults to \code{FALSE}.} 20 | 21 | \item{order_dates}{A logical indicating whether the dates should be ordered, 22 | from the oldest to the most recent one; \code{TRUE} by default.} 23 | } 24 | \description{ 25 | This function builds a valid \code{projections} object from some input 26 | simulations and dates. 27 | } 28 | \seealso{ 29 | the \code{\link{project}} function to generate the 'projections' 30 | objects. 31 | } 32 | \author{ 33 | Thibaut Jombart \email{thibautjombart@gmail.com} 34 | } 35 | -------------------------------------------------------------------------------- /man/projections_accessors.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/accessors.R 3 | \name{get_dates} 4 | \alias{get_dates} 5 | \alias{get_dates.projections} 6 | \title{Access content projections objects} 7 | \usage{ 8 | \method{get_dates}{projections}(x, ...) 9 | } 10 | \arguments{ 11 | \item{x}{A \code{projections} object.} 12 | 13 | \item{...}{Further arguments passed to methods; currently not used.} 14 | } 15 | \description{ 16 | These simple helper functions retrieve content from \code{projections} 17 | objects. They currently include: 18 | } 19 | \details{ 20 | \itemize{ 21 | \item \code{get_dates}: get dates of the predictions. 22 | 23 | } 24 | } 25 | \examples{ 26 | 27 | 28 | if (require(distcrete) && require(incidence)) { withAutoprint({ 29 | 30 | ## prepare input: epicurve and serial interval 31 | dat <- c(0, 2, 2, 3, 3, 5, 5, 5, 6, 6, 6, 6) 32 | i <- incidence(dat) 33 | si <- distcrete("gamma", interval = 1L, 34 | shape = 1.5, 35 | scale = 2, w = 0) 36 | 37 | 38 | ## make predictions 39 | pred_1 <- project(i, 1.2, si, n_days = 30) 40 | pred_1 41 | 42 | 43 | ## retrieve content 44 | get_dates(pred_1) 45 | max(i$dates) # predictions start 1 day after last incidence 46 | 47 | })} 48 | } 49 | \author{ 50 | Thibaut Jombart \email{thibautjombart@gmail.com} 51 | } 52 | -------------------------------------------------------------------------------- /man/cumulate.projections.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cumulate.R 3 | \name{cumulate.projections} 4 | \alias{cumulate.projections} 5 | \title{Compute cumulative projections} 6 | \usage{ 7 | \method{cumulate}{projections}(x) 8 | } 9 | \arguments{ 10 | \item{x}{A \code{projections} object.} 11 | } 12 | \description{ 13 | \code{cumulate} is an S3 generic to compute cumulative numbers defined in the 14 | package \code{incidence}. The method for \code{projections} objects turns 15 | predicted incidences into cumulative incidences over time. 16 | } 17 | \examples{ 18 | 19 | if (require(distcrete) && 20 | require(incidence)) { 21 | 22 | ## simulate basic epicurve 23 | dat <- c(0, 2, 2, 3, 3, 5, 5, 5, 6, 6, 6, 6) 24 | i <- incidence(dat) 25 | 26 | 27 | ## example with a function for SI 28 | si <- distcrete("gamma", interval = 1L, 29 | shape = 1.5, 30 | scale = 2, w = 0) 31 | set.seed(1) 32 | pred_1 <- project(i, runif(100, 0.8, 1.9), si, n_days = 30) 33 | plot_1 <- plot(pred_1) 34 | 35 | ## cumulative predictions 36 | pred_1_cum <- cumulate(pred_1) 37 | pred_1_cum 38 | plot(pred_1_cum) 39 | } 40 | 41 | 42 | } 43 | \seealso{ 44 | The \code{\link{project}} function to generate the 45 | \code{projections} objects. 46 | } 47 | \author{ 48 | Thibaut Jombart \email{thibautjombart@gmail.com} 49 | } 50 | -------------------------------------------------------------------------------- /man/subset.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/subset.R 3 | \name{[.projections} 4 | \alias{[.projections} 5 | \alias{"subset.projections"} 6 | \alias{"[.projections"} 7 | \alias{subset.projections} 8 | \title{Subsetting 'projections' objects} 9 | \usage{ 10 | \method{[}{projections}(x, i, j) 11 | 12 | \method{subset}{projections}(x, ..., from = NULL, to = NULL, sim = TRUE) 13 | } 14 | \arguments{ 15 | \item{x}{An projections object, generated by the function 16 | \code{\link{project}}.} 17 | 18 | \item{i}{a subset of dates to retain} 19 | 20 | \item{j}{a subset of groups to retain} 21 | 22 | \item{...}{Further arguments passed to other methods (not used).} 23 | 24 | \item{from}{The starting date; data strictly before this date are discarded.} 25 | 26 | \item{to}{The ending date; data strictly after this date are discarded.} 27 | 28 | \item{sim}{(optional) The simulations to retained, indicated as subsets of 29 | the columns of x.} 30 | } 31 | \description{ 32 | Two functions can be used to subset projections objects. The operator "[" can 33 | be used as for matrices, using the syntax \code{x[i,j]} where 'i' is a subset 34 | of dates, and 'j' is a subset of simulations. 35 | } 36 | \seealso{ 37 | The \code{\link{project}} function to generate the 'projections' 38 | objects. 39 | } 40 | \author{ 41 | Thibaut Jombart \email{thibautjombart@gmail.com} 42 | } 43 | -------------------------------------------------------------------------------- /R/accessors.R: -------------------------------------------------------------------------------- 1 | #' Access content projections objects 2 | #' 3 | #' These simple helper functions retrieve content from \code{projections} 4 | #' objects. They currently include: 5 | #' 6 | #' \itemize{ 7 | #' \item \code{get_dates}: get dates of the predictions. 8 | #' 9 | #' } 10 | #' @name get_dates 11 | #' @rdname projections_accessors 12 | #' 13 | #' @author Thibaut Jombart \email{thibautjombart@@gmail.com} 14 | #' 15 | #' 16 | #' @param x A \code{projections} object. 17 | #' 18 | #' @param ... Further arguments passed to methods; currently not used. 19 | #' 20 | #' @examples 21 | #' 22 | #' 23 | #' if (require(distcrete) && require(incidence)) { withAutoprint({ 24 | #' 25 | #' ## prepare input: epicurve and serial interval 26 | #' dat <- c(0, 2, 2, 3, 3, 5, 5, 5, 6, 6, 6, 6) 27 | #' i <- incidence(dat) 28 | #' si <- distcrete("gamma", interval = 1L, 29 | #' shape = 1.5, 30 | #' scale = 2, w = 0) 31 | #' 32 | #' 33 | #' ## make predictions 34 | #' pred_1 <- project(i, 1.2, si, n_days = 30) 35 | #' pred_1 36 | #' 37 | #' 38 | #' ## retrieve content 39 | #' get_dates(pred_1) 40 | #' max(i$dates) # predictions start 1 day after last incidence 41 | #' 42 | #' })} 43 | #' @aliases get_dates.projections 44 | #' @aliases get_dates 45 | #' @importFrom incidence get_dates 46 | #' @export get_dates 47 | #' @export 48 | get_dates.projections <- function(x, ...) { 49 | attr(x, "dates") 50 | } 51 | 52 | 53 | -------------------------------------------------------------------------------- /tests/testthat/test-merge_projections.R: -------------------------------------------------------------------------------- 1 | test_that("Merging works", { 2 | i <- incidence::incidence(as.Date('2020-01-23')) 3 | si <- c(0.2, 0.5, 0.2, 0.1) 4 | R0 <- 10 5 | 6 | x <- project(x = i, 7 | si = si, 8 | R = R0, 9 | n_sim = 2, 10 | R_fix_within = TRUE, 11 | n_days = 10, 12 | model = "poisson" 13 | ) 14 | 15 | 16 | ## test basic merge 17 | x_2 <- merge_projections(list(x, x)) 18 | expect_equal(as.vector(x_2[, 1:2]), as.vector(x)) 19 | 20 | 21 | ## different dates, 3 objects 22 | x_3 <- merge_projections(list(x, x[1:3, 1], x[5:6, 1:2])) 23 | expect_equal(ncol(x_3), ncol(x) + 3) 24 | expect_equal(as.vector(x_3[, 1:2]), as.vector(x)) 25 | expect_equal(as.vector(x_3[1:3, 3]), as.vector(x[1:3, 1])) 26 | expect_equal(as.vector(x_3[5:6, 4:5]), as.vector(x[5:6, 1:2])) 27 | expect_equal(get_dates(x), get_dates(x_3)) # check dates 28 | expect_true(all(x_3[-c(1:3), 3] == 0)) # check zeros in right place 29 | }) 30 | 31 | 32 | 33 | 34 | 35 | test_that("Errors are issued as they should", { 36 | 37 | msg <- "x is not a `list` but a character" 38 | expect_error(merge_projections(letters), msg) 39 | 40 | msg <- "some input objects are not `projections` objects" 41 | expect_error(merge_projections(list(letters)), msg) 42 | 43 | msg <- "x is an empty `list`" 44 | expect_error(merge_projections(list()), msg) 45 | 46 | }) 47 | -------------------------------------------------------------------------------- /CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Code of Conduct 2 | 3 | As contributors and maintainers of this project, we pledge to respect all people who 4 | contribute through reporting issues, posting feature requests, updating documentation, 5 | submitting pull requests or patches, and other activities. 6 | 7 | We are committed to making participation in this project a harassment-free experience for 8 | everyone, regardless of level of experience, gender, gender identity and expression, 9 | sexual orientation, disability, personal appearance, body size, race, ethnicity, age, or religion. 10 | 11 | Examples of unacceptable behavior by participants include the use of sexual language or 12 | imagery, derogatory comments or personal attacks, trolling, public or private harassment, 13 | insults, or other unprofessional conduct. 14 | 15 | Project maintainers have the right and responsibility to remove, edit, or reject comments, 16 | commits, code, wiki edits, issues, and other contributions that are not aligned to this 17 | Code of Conduct. Project maintainers who do not follow the Code of Conduct may be removed 18 | from the project team. 19 | 20 | Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by 21 | opening an issue or contacting one or more of the project maintainers. 22 | 23 | This Code of Conduct is adapted from the Contributor Covenant 24 | (http:contributor-covenant.org), version 1.0.0, available at 25 | http://contributor-covenant.org/version/1/0/0/ 26 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: 4 | - main 5 | - master 6 | pull_request: 7 | branches: 8 | - main 9 | - master 10 | 11 | name: test-coverage 12 | 13 | jobs: 14 | test-coverage: 15 | runs-on: macOS-latest 16 | env: 17 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 18 | steps: 19 | - uses: actions/checkout@v2 20 | 21 | - uses: r-lib/actions/setup-r@v1 22 | 23 | - uses: r-lib/actions/setup-pandoc@v1 24 | 25 | - name: Query dependencies 26 | run: | 27 | install.packages('remotes') 28 | saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) 29 | writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") 30 | shell: Rscript {0} 31 | 32 | - name: Cache R packages 33 | uses: actions/cache@v2 34 | with: 35 | path: ${{ env.R_LIBS_USER }} 36 | key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} 37 | restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- 38 | 39 | - name: Install dependencies 40 | run: | 41 | install.packages(c("remotes")) 42 | remotes::install_deps(dependencies = TRUE) 43 | remotes::install_cran("covr") 44 | shell: Rscript {0} 45 | 46 | - name: Test coverage 47 | run: covr::codecov() 48 | shell: Rscript {0} 49 | -------------------------------------------------------------------------------- /R/cumulate.R: -------------------------------------------------------------------------------- 1 | #' Compute cumulative projections 2 | #' 3 | #' \code{cumulate} is an S3 generic to compute cumulative numbers defined in the 4 | #' package \code{incidence}. The method for \code{projections} objects turns 5 | #' predicted incidences into cumulative incidences over time. 6 | #' 7 | #' 8 | #' @author Thibaut Jombart \email{thibautjombart@@gmail.com} 9 | #' 10 | #' @seealso The \code{\link{project}} function to generate the 11 | #' \code{projections} objects. 12 | #' 13 | #' @param x A \code{projections} object. 14 | #' 15 | #' @examples 16 | #' 17 | #' if (require(distcrete) && 18 | #' require(incidence)) { 19 | #' 20 | #' ## simulate basic epicurve 21 | #' dat <- c(0, 2, 2, 3, 3, 5, 5, 5, 6, 6, 6, 6) 22 | #' i <- incidence(dat) 23 | #' 24 | #' 25 | #' ## example with a function for SI 26 | #' si <- distcrete("gamma", interval = 1L, 27 | #' shape = 1.5, 28 | #' scale = 2, w = 0) 29 | #' set.seed(1) 30 | #' pred_1 <- project(i, runif(100, 0.8, 1.9), si, n_days = 30) 31 | #' plot_1 <- plot(pred_1) 32 | #' 33 | #' ## cumulative predictions 34 | #' pred_1_cum <- cumulate(pred_1) 35 | #' pred_1_cum 36 | #' plot(pred_1_cum) 37 | #' } 38 | #' 39 | #' 40 | #' @importFrom incidence cumulate 41 | #' @export 42 | #' @aliases cumulate.projections 43 | #' 44 | cumulate.projections <- function(x) { 45 | if (isTRUE(attr(x, "cumulative"))) { 46 | stop("x already contains cumulative incidence") 47 | } 48 | out <- x 49 | out[] <- apply(out[], 2, cumsum) 50 | attr(out, "cumulative") <- TRUE 51 | out 52 | } 53 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: 4 | - main 5 | - master 6 | 7 | name: pkgdown 8 | 9 | jobs: 10 | pkgdown: 11 | runs-on: macOS-latest 12 | env: 13 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 14 | steps: 15 | - uses: actions/checkout@v2 16 | 17 | - uses: r-lib/actions/setup-r@v1 18 | 19 | - uses: r-lib/actions/setup-pandoc@v1 20 | 21 | - name: Query dependencies 22 | run: | 23 | install.packages('remotes') 24 | saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) 25 | writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") 26 | shell: Rscript {0} 27 | 28 | - name: Cache R packages 29 | uses: actions/cache@v2 30 | with: 31 | path: ${{ env.R_LIBS_USER }} 32 | key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} 33 | restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- 34 | 35 | - name: Install dependencies 36 | run: | 37 | remotes::install_deps(dependencies = TRUE) 38 | install.packages("pkgdown", type = "binary") 39 | shell: Rscript {0} 40 | 41 | - name: Install package 42 | run: R CMD INSTALL . 43 | 44 | - name: Deploy package 45 | run: | 46 | git config --local user.email "actions@github.com" 47 | git config --local user.name "GitHub Actions" 48 | Rscript -e 'pkgdown::deploy_to_branch(new_process = FALSE)' 49 | -------------------------------------------------------------------------------- /man/merge_add_projections.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/merge_add_projections.R 3 | \name{merge_add_projections} 4 | \alias{merge_add_projections} 5 | \alias{+.projections} 6 | \title{Add data of different projections objects} 7 | \usage{ 8 | merge_add_projections(x) 9 | 10 | \method{+}{projections}(a, b) 11 | } 12 | \arguments{ 13 | \item{x}{A \code{list} of \code{projections} objects to be added.} 14 | 15 | \item{a}{A \code{projections} object.} 16 | 17 | \item{b}{A \code{projections} object.} 18 | } 19 | \description{ 20 | This function adds counts from several \code{projections} objects, making sure 21 | that they all use the same dates, adding rows of '0' where 22 | needed. Simulations (columns) are recycled when needed if some objects have 23 | less simulations than others. The same operation is implemented by the \code{+} 24 | operator. 25 | } 26 | \examples{ 27 | 28 | if (require(incidence)) { 29 | 30 | ## make toy data and projections 31 | set.seed(1) 32 | i <- incidence::incidence(as.Date('2020-01-01') + 33 | sample(1:20, 50, replace = TRUE)) 34 | si <- c(0.2, 0.5, 0.2, 0.1) 35 | 36 | x_1 <- project(x = i[1:10], 37 | si = si, 38 | R = 3.5, 39 | n_sim = 200, 40 | n_days = 5) 41 | 42 | x_2 <- project(x = i[11:20], 43 | si = si, 44 | R = 1.8, 45 | n_sim = 300, 46 | n_days = 10 47 | ) 48 | 49 | ## check simulations 50 | x_1 # first type 51 | x_2 # other simulations 52 | y <- x_1 + x_2 # add simulations 53 | plot(y) 54 | 55 | } 56 | } 57 | \author{ 58 | Thibaut Jombart 59 | } 60 | -------------------------------------------------------------------------------- /R/conversion.R: -------------------------------------------------------------------------------- 1 | #' Conversion of projections objects 2 | #' 3 | #' These functions convert \code{projections} objects into other classes. 4 | #' 5 | #' @rdname conversions 6 | #' 7 | #' @author Thibaut Jombart \email{thibautjombart@@gmail.com} 8 | #' 9 | #' @importFrom stats as.ts 10 | #' 11 | #' @export 12 | #' 13 | #' @param x An \code{projections} object, or an object to be converted as 14 | #' \code{projections} (see details). 15 | #' 16 | #' @param ... Further arguments passed to other functions (no used). 17 | #' 18 | #' @param long A logical indicating if the output data.frame should be 'long', 19 | #' i.e. where a single column containing 'groups' is added in case of data 20 | #' computed on several groups. 21 | #' 22 | #' 23 | #' @export 24 | #' 25 | #' 26 | #' @seealso the \code{\link{project}} function to generate the 'projections' objects. 27 | #' 28 | #' 29 | 30 | 31 | as.matrix.projections <- function(x, ...) { 32 | out <- x 33 | class(out) <- oldClass(out)[-1] # first class will be projections 34 | attr(out, "dates") <- NULL 35 | attr(out, "cumulative") <- NULL 36 | rownames(out) <- as.character(get_dates(x)) 37 | 38 | out 39 | } 40 | 41 | 42 | 43 | 44 | #' @export 45 | #' @rdname conversions 46 | 47 | as.data.frame.projections <- function(x, ..., long = FALSE){ 48 | if (!long) { 49 | colnames(x) <- paste("sim", seq_len(ncol(x)), sep = "_") 50 | out <- cbind.data.frame(dates = attr(x, "dates"), as.matrix(x)) 51 | } else { 52 | out <- data.frame(date = rep(attr(x, "dates"), ncol(x)), 53 | incidence = as.vector(x), 54 | sim = rep(seq_len(ncol(x)), each = nrow(x))) 55 | } 56 | 57 | row.names(out) <- NULL 58 | 59 | out 60 | } 61 | -------------------------------------------------------------------------------- /man/summary.projections.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/summary.R 3 | \name{summary.projections} 4 | \alias{summary.projections} 5 | \title{Summary for projections objects} 6 | \usage{ 7 | \method{summary}{projections}( 8 | object, 9 | quantiles = c(0.025, 0.25, 0.5, 0.75, 0.975), 10 | mean = TRUE, 11 | sd = TRUE, 12 | min = TRUE, 13 | max = TRUE, 14 | ... 15 | ) 16 | } 17 | \arguments{ 18 | \item{object}{A \code{projections} object to summarise} 19 | 20 | \item{quantiles}{A \code{numeric} vector indicating which quantiles should be 21 | computed; ignored if \code{FALSE} or of length 0} 22 | 23 | \item{mean}{a \code{logical} indicating of the mean should be computed} 24 | 25 | \item{sd}{a \code{logical} indicating of the standard deviation should be computed} 26 | 27 | \item{min}{a \code{logical} indicating of the minimum should be computed} 28 | 29 | \item{max}{a \code{logical} indicating of the maximum should be computed} 30 | 31 | \item{...}{only preesnt for compatibility with the generic} 32 | } 33 | \description{ 34 | This method summarises predicted epidemic trajectories contained in a 35 | \code{projections} object by days, deriving the mean, standard deviation, and 36 | user-specified quantiles for each day. 37 | } 38 | \examples{ 39 | if (require(incidence)) { 40 | i <- incidence::incidence(as.Date('2020-01-23')) 41 | si <- c(0.2, 0.5, 0.2, 0.1) 42 | R0 <- 2 43 | 44 | p <- project(x = i, 45 | si = si, 46 | R = R0, 47 | n_sim = 2, 48 | R_fix_within = TRUE, 49 | n_days = 10, 50 | model = "poisson" 51 | ) 52 | summary(p) 53 | 54 | } 55 | } 56 | \author{ 57 | Thibaut Jombart 58 | } 59 | -------------------------------------------------------------------------------- /R/internals.R: -------------------------------------------------------------------------------- 1 | 2 | ## Internal functions (not exported) 3 | 4 | assert_reporting <- function(x) { 5 | if (!is.numeric(x)) stop("reporting is not numeric") 6 | if (!all(is.finite(x))) stop("reporting is not a finite value") 7 | if (any(x <= 0)) stop("reporting <= 0") 8 | if (any(x > 1)) stop("reporting > 1") 9 | } 10 | 11 | 12 | assert_R <- function(x) { 13 | if (is.list(x)) { 14 | x <- unlist(x) 15 | } 16 | if (!is.numeric(x)) stop("R is not numeric") 17 | if (!all(is.finite(x))) stop("R is not a finite value") 18 | if (any(x < 0)) stop(sprintf("R < 0 (value: %.2f)", x[x<0])) 19 | } 20 | 21 | 22 | 23 | ## A fix for the nonesensical behaviour of `sample` when first argument is of 24 | ## length 1. 25 | 26 | sample_ <- function(x, ...) { 27 | x[sample.int(length(x), ...)] 28 | } 29 | 30 | 31 | 32 | 33 | 34 | ## Define colors for quantiles 35 | quantile_pal <- grDevices::colorRampPalette( 36 | c("#b3c6ff", "#d147a3", "#993366"), bias = 2) 37 | 38 | color_quantiles <- function(x, palette = quantile_pal) { 39 | labels <- as.character(unique(x)) 40 | dist_from_median <- 50 - abs(50-as.numeric(sub("%", "", labels))) 41 | out <- palette(51)[dist_from_median + 1] 42 | names(out) <- labels 43 | out 44 | } 45 | 46 | 47 | 48 | 49 | ## Function making colors transparent 50 | 51 | transp <- function(col, alpha = .5){ 52 | res <- apply(grDevices::col2rgb(col), 2, 53 | function(c) 54 | grDevices::rgb(c[1]/255, c[2]/255, c[3]/255, alpha)) 55 | return(res) 56 | } 57 | 58 | 59 | 60 | ## Implement isTRUE and isFALSE to avoid dep on R 3.5.0 61 | 62 | isFALSE <- function(x) { 63 | is.logical(x) && length(x) == 1L && !is.na(x) && !x 64 | } 65 | 66 | isTRUE <- function(x) { 67 | is.logical(x) && length(x) == 1L && !is.na(x) && x 68 | } 69 | -------------------------------------------------------------------------------- /docs/bootstrap-toc.css: -------------------------------------------------------------------------------- 1 | /*! 2 | * Bootstrap Table of Contents v0.4.1 (http://afeld.github.io/bootstrap-toc/) 3 | * Copyright 2015 Aidan Feldman 4 | * Licensed under MIT (https://github.com/afeld/bootstrap-toc/blob/gh-pages/LICENSE.md) */ 5 | 6 | /* modified from https://github.com/twbs/bootstrap/blob/94b4076dd2efba9af71f0b18d4ee4b163aa9e0dd/docs/assets/css/src/docs.css#L548-L601 */ 7 | 8 | /* All levels of nav */ 9 | nav[data-toggle='toc'] .nav > li > a { 10 | display: block; 11 | padding: 4px 20px; 12 | font-size: 13px; 13 | font-weight: 500; 14 | color: #767676; 15 | } 16 | nav[data-toggle='toc'] .nav > li > a:hover, 17 | nav[data-toggle='toc'] .nav > li > a:focus { 18 | padding-left: 19px; 19 | color: #563d7c; 20 | text-decoration: none; 21 | background-color: transparent; 22 | border-left: 1px solid #563d7c; 23 | } 24 | nav[data-toggle='toc'] .nav > .active > a, 25 | nav[data-toggle='toc'] .nav > .active:hover > a, 26 | nav[data-toggle='toc'] .nav > .active:focus > a { 27 | padding-left: 18px; 28 | font-weight: bold; 29 | color: #563d7c; 30 | background-color: transparent; 31 | border-left: 2px solid #563d7c; 32 | } 33 | 34 | /* Nav: second level (shown on .active) */ 35 | nav[data-toggle='toc'] .nav .nav { 36 | display: none; /* Hide by default, but at >768px, show it */ 37 | padding-bottom: 10px; 38 | } 39 | nav[data-toggle='toc'] .nav .nav > li > a { 40 | padding-top: 1px; 41 | padding-bottom: 1px; 42 | padding-left: 30px; 43 | font-size: 12px; 44 | font-weight: normal; 45 | } 46 | nav[data-toggle='toc'] .nav .nav > li > a:hover, 47 | nav[data-toggle='toc'] .nav .nav > li > a:focus { 48 | padding-left: 29px; 49 | } 50 | nav[data-toggle='toc'] .nav .nav > .active > a, 51 | nav[data-toggle='toc'] .nav .nav > .active:hover > a, 52 | nav[data-toggle='toc'] .nav .nav > .active:focus > a { 53 | padding-left: 28px; 54 | font-weight: 500; 55 | } 56 | 57 | /* from https://github.com/twbs/bootstrap/blob/e38f066d8c203c3e032da0ff23cd2d6098ee2dd6/docs/assets/css/src/docs.css#L631-L634 */ 58 | nav[data-toggle='toc'] .nav > .active > ul { 59 | display: block; 60 | } 61 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: projections 2 | Title: Project Future Case Incidence 3 | Version: 0.6.1 4 | Authors@R: 5 | c(person(given = "Thibaut", 6 | family = "Jombart", 7 | role = c("aut", "cre"), 8 | email = "thibautjombart@gmail.com"), 9 | person(given = "Pierre", 10 | family = "Nouvellet", 11 | role = "aut", 12 | email = "p.nouvellet@imperial.ac.uk"), 13 | person(given = "Sangeeta", 14 | family = "Bhatia", 15 | role = "ctb", 16 | email = "sangeetabhatia03@gmail.com"), 17 | person(given = "Zhian N.", 18 | family = "Kamvar", 19 | role = "ctb", 20 | email = "zkamvar@gmail.com"), 21 | person(given = "Tim", 22 | family = "Taylor", 23 | role = "ctb", 24 | email = "tim.taylor@hiddenelephants.co.uk"), 25 | person(given = "Stephane", 26 | family = "Ghozzi", 27 | role = "ctb", 28 | email = "stephane.ghozzi@mailbox.org")) 29 | Description: Provides functions and graphics for projecting daily incidence based on past incidence, and estimates of the serial interval and reproduction number. Projections are based on a branching process using a Poisson-distributed number of new cases per day, similar to the model used for estimating R in 'EpiEstim' or in 'earlyR', and described by Nouvellet et al. (2017) . The package provides the S3 class 'projections' which extends 'matrix', with accessors and additional helpers for handling, subsetting, merging, or adding these objects, as well as dedicated printing and plotting methods. 30 | Depends: R (>= 3.5.0) 31 | License: MIT + file LICENSE 32 | Encoding: UTF-8 33 | Suggests: 34 | testthat, 35 | roxygen2, 36 | knitr, 37 | rmarkdown, 38 | outbreaks, 39 | magrittr, 40 | distcrete, 41 | svglite, 42 | EpiEstim 43 | Imports: 44 | stats, 45 | utils, 46 | incidence (>= 1.4.1), 47 | ggplot2, 48 | methods 49 | RoxygenNote: 7.3.2 50 | Roxygen: list(markdown = TRUE) 51 | URL: https://www.repidemicsconsortium.org/projections/ 52 | BugReports: https://github.com/reconhub/projections/issues 53 | Config/testthat/edition: 3 54 | -------------------------------------------------------------------------------- /docs/docsearch.js: -------------------------------------------------------------------------------- 1 | $(function() { 2 | 3 | // register a handler to move the focus to the search bar 4 | // upon pressing shift + "/" (i.e. "?") 5 | $(document).on('keydown', function(e) { 6 | if (e.shiftKey && e.keyCode == 191) { 7 | e.preventDefault(); 8 | $("#search-input").focus(); 9 | } 10 | }); 11 | 12 | $(document).ready(function() { 13 | // do keyword highlighting 14 | /* modified from https://jsfiddle.net/julmot/bL6bb5oo/ */ 15 | var mark = function() { 16 | 17 | var referrer = document.URL ; 18 | var paramKey = "q" ; 19 | 20 | if (referrer.indexOf("?") !== -1) { 21 | var qs = referrer.substr(referrer.indexOf('?') + 1); 22 | var qs_noanchor = qs.split('#')[0]; 23 | var qsa = qs_noanchor.split('&'); 24 | var keyword = ""; 25 | 26 | for (var i = 0; i < qsa.length; i++) { 27 | var currentParam = qsa[i].split('='); 28 | 29 | if (currentParam.length !== 2) { 30 | continue; 31 | } 32 | 33 | if (currentParam[0] == paramKey) { 34 | keyword = decodeURIComponent(currentParam[1].replace(/\+/g, "%20")); 35 | } 36 | } 37 | 38 | if (keyword !== "") { 39 | $(".contents").unmark({ 40 | done: function() { 41 | $(".contents").mark(keyword); 42 | } 43 | }); 44 | } 45 | } 46 | }; 47 | 48 | mark(); 49 | }); 50 | }); 51 | 52 | /* Search term highlighting ------------------------------*/ 53 | 54 | function matchedWords(hit) { 55 | var words = []; 56 | 57 | var hierarchy = hit._highlightResult.hierarchy; 58 | // loop to fetch from lvl0, lvl1, etc. 59 | for (var idx in hierarchy) { 60 | words = words.concat(hierarchy[idx].matchedWords); 61 | } 62 | 63 | var content = hit._highlightResult.content; 64 | if (content) { 65 | words = words.concat(content.matchedWords); 66 | } 67 | 68 | // return unique words 69 | var words_uniq = [...new Set(words)]; 70 | return words_uniq; 71 | } 72 | 73 | function updateHitURL(hit) { 74 | 75 | var words = matchedWords(hit); 76 | var url = ""; 77 | 78 | if (hit.anchor) { 79 | url = hit.url_without_anchor + '?q=' + escape(words.join(" ")) + '#' + hit.anchor; 80 | } else { 81 | url = hit.url + '?q=' + escape(words.join(" ")); 82 | } 83 | 84 | return url; 85 | } 86 | -------------------------------------------------------------------------------- /tests/testthat/test-build_projections.R: -------------------------------------------------------------------------------- 1 | test_that("Test round trip", { 2 | skip_on_cran() 3 | 4 | ## simulate basic epicurve 5 | dat <- c(0, 2, 2, 3, 3, 5, 5, 5, 6, 6, 6, 6) 6 | i <- incidence::incidence(dat) 7 | 8 | 9 | ## example with a function for SI 10 | si <- distcrete::distcrete("gamma", interval = 1L, 11 | shape = 1.5, 12 | scale = 2, w = 0) 13 | 14 | set.seed(1) 15 | pred_1 <- project(i, runif(100, 0.8, 1.9), si, n_days = 30) 16 | colnames(pred_1) <- paste("sim", 1:ncol(pred_1), sep = "_") 17 | 18 | df <- as.data.frame(pred_1) 19 | new_pred <- build_projections(df[, -1], df[, 1]) 20 | expect_identical(pred_1, new_pred) 21 | 22 | }) 23 | 24 | 25 | 26 | test_that("Test dates default", { 27 | skip_on_cran() 28 | 29 | ## simulate basic epicurve 30 | dat <- c(0, 2, 2, 3, 3, 5, 5, 5, 6, 6, 6, 6) 31 | i <- incidence::incidence(dat) 32 | 33 | 34 | ## example with a function for SI 35 | si <- distcrete::distcrete("gamma", interval = 1L, 36 | shape = 1.5, 37 | scale = 2, w = 0) 38 | 39 | set.seed(1) 40 | x <- project(i, runif(100, 0.8, 1.9), si, n_days = 30) 41 | 42 | df <- as.data.frame(x) 43 | new_x <- build_projections(df[, -1]) 44 | expect_equal(seq_along(get_dates(x)) - 1L, get_dates(new_x)) 45 | }) 46 | 47 | 48 | 49 | test_that("Test errors", { 50 | skip_on_cran() 51 | 52 | expect_error( 53 | new_projections(matrix(1:10, ncol = 2), dates = 1:10, cumulative = FALSE), 54 | "Number of dates (10) does not match number of rows (5)", 55 | fixed = TRUE) 56 | 57 | expect_error( 58 | build_projections(matrix(1:10, ncol = 2), dates = 1:10), 59 | "Number of dates (10) does not match number of rows (5)", 60 | fixed = TRUE) 61 | 62 | }) 63 | 64 | 65 | 66 | 67 | 68 | test_that("Test ordering", { 69 | skip_on_cran() 70 | 71 | mat <- matrix(round(rnorm(100, 10)), ncol = 20) 72 | dates <- Sys.Date() + c(5, 1, 3, 2, 4) 73 | 74 | ## test ordering 75 | x <- build_projections(mat, dates) 76 | expect_identical(get_dates(x), sort(dates)) 77 | expect_equal(as.vector(mat[order(dates), ]), as.vector(x)) 78 | 79 | ## test no ordering 80 | x <- build_projections(mat, dates, order_dates = FALSE) 81 | expect_identical(get_dates(x), dates) 82 | expect_equal(as.vector(mat), as.vector(x)) 83 | 84 | }) 85 | 86 | -------------------------------------------------------------------------------- /R/compute_relative_infectivity.R: -------------------------------------------------------------------------------- 1 | 2 | #' Calculate the relative infectivity of infectious individuals 3 | #' 4 | #' This function calculates the relative infectivity of infectious indiviuals at 5 | #' time \eqn{t+1}, generated by cases with onset at time 1, 2, ..., t. The 6 | #' relative infectivity of an individual on a given day is defined as the 7 | #' probability that new infections generated by this individual show symptoms on 8 | #' that day, and is defined by the serial interval distribution. The function 9 | #' sums these values across all infected individuals (see details for more 10 | #' information). Calculations use matrices where independent simulations are 11 | #' stored as separate columns. 12 | #' 13 | #' @param w a `numeric` containing numbers representing the PMF of the serial 14 | #' interval, starting at day 1, i.e. one day after symptom onset; the vector 15 | #' should always be at least as long as the largest value of `t` allowed 16 | #' 17 | #' @param cases a `matrix` of `integers` with `t` rows (each row is a date) and 18 | #' `n_sim` columns (each column is a separate simulation) indicating number of 19 | #' cases on a given day, in a given simulation 20 | #' 21 | #' @param t an `integer` indicating the simulation step: incidence will then be 22 | #' computed for `t+1` taking into account past cases and R from time point `1` 23 | #' until `t` 24 | #' 25 | #' @seealso `compute_force_infection` does a similar 26 | #' thing, but also factors in the reproduction numbers of all individuals, 27 | #' resulting in an estimate of average number of new cases at `t+1`. 28 | #' 29 | #' @author Thibaut Jombart, with inputs from Anne Cori and Pierre Nouvellet 30 | #' 31 | #' @details 32 | #' 33 | #' The relative infectivity for \eqn{i=1,...n} individuals at time \eqn{t+1} is 34 | #' defined as: 35 | #' 36 | #' \deqn{ \sum_{i = 1}^n w(t - t_i) } 37 | #' 38 | #' where \eqn{w(.)} is the PMF of the serial interval distribution and \eqn{t_i} is the 39 | #' date of onset of case *i*. 40 | #' 41 | #' This is equivalent to: 42 | #' 43 | #' \deqn{ 44 | #' \sum_{s=1}^t y_s w(s - t_i) 45 | #' } 46 | #' 47 | #' where \eqn{y_s} is the number of new cases at time *s*. This latter 48 | #' formulation is the one used in the function. 49 | #' 50 | #' @noRd 51 | 52 | compute_relative_infectivity <- function(w, cases, t) { 53 | rev_w <- rev(w) 54 | ws <- utils::tail(rev_w, t) 55 | cases <- cases[seq_len(t), , drop = FALSE] 56 | out <- ws %*% cases 57 | out 58 | } 59 | -------------------------------------------------------------------------------- /R/compute_force_infection.R: -------------------------------------------------------------------------------- 1 | 2 | #' Calculate force of infection 3 | #' 4 | #' This function calculates the force of infection at time t+1, generated by 5 | #' cases with onset at time 1, 2, ..., t, with reproduction numbers R_1, R_2, 6 | #' ..., R_t. Calculations use matrices where independent simulations are stored 7 | #' as separate columns. 8 | #' 9 | #' @param w a `numeric` containing numbers representing the PMF of the serial 10 | #' interval, starting at day 1, i.e. one day after symptom onset; the vector 11 | #' should always be at least as long as the largest value of `t` allowed 12 | #' 13 | #' @param cases a `matrix` of `integers` with `t` rows (each row is a date) and 14 | #' `n_sim` columns (each column is a separate simulation) indicating number of 15 | #' cases on a given day, in a given simulation 16 | #' 17 | #' @param R a `matrix` of `numeric` with `t` rows (each row is a date) and 18 | #' `n_sim` columns (each column is a separate simulation) indicating the 19 | #' reproduction number on a given day, in a given simulation 20 | #' 21 | #' @param t an `integer` indicating the simulation step: incidence will then be 22 | #' computed for `t+1` taking into account past cases and R from time point `1` 23 | #' until `t` 24 | #' 25 | #' @param instantaneous_R a boolean specifying whether to assume `R` is the case 26 | #' reproduction number (`instantaneous_R = FALSE`), or the 27 | #' instantaneous reproduction number (`instantaneous_R = TRUE`). 28 | #' If `instantaneous_R = FALSE` then values of `R` at time `t` will govern the 29 | #' mean number of secondary cases of all cases infected at time `t`, 30 | #' even if those secondary cases appear after `t`. In other words, `R` 31 | #' will characterise onwards transmission from infectors depending on their 32 | #' date of infection. 33 | #' If `instantaneous_R = TRUE` then values of `R` at time `t` will govern the 34 | #' mean number of secondary cases made at time `t` by all cases infected 35 | #' before `t`. In other words, `R` will characterise onwards transmission at 36 | #' a given time. 37 | #' 38 | #' @noRd 39 | 40 | compute_force_infection <- function(w, cases, R, t, instantaneous_R) { 41 | rev_w <- rev(w) 42 | ws <- utils::tail(rev_w, t) 43 | 44 | cases <- cases[seq_len(t), , drop = FALSE] 45 | R <- R[seq_len(t), , drop = FALSE] 46 | 47 | if(!instantaneous_R) { 48 | lambda <- ws %*% (cases * R) 49 | } else { 50 | lambda <- (ws %*% cases) * R[t,] 51 | } 52 | as.vector(lambda) 53 | } 54 | -------------------------------------------------------------------------------- /R/subset.R: -------------------------------------------------------------------------------- 1 | #' Subsetting 'projections' objects 2 | #' 3 | #' Two functions can be used to subset projections objects. The operator "[" can 4 | #' be used as for matrices, using the syntax \code{x[i,j]} where 'i' is a subset 5 | #' of dates, and 'j' is a subset of simulations. 6 | #' 7 | #' @author Thibaut Jombart \email{thibautjombart@@gmail.com} 8 | #' 9 | #' 10 | #' @rdname subset 11 | #' 12 | #' @aliases "subset.projections" "[.projections" 13 | #' 14 | #' @seealso The \code{\link{project}} function to generate the 'projections' 15 | #' objects. 16 | #' 17 | #' @param x An projections object, generated by the function 18 | #' \code{\link{project}}. 19 | #' 20 | #' @param from The starting date; data strictly before this date are discarded. 21 | #' 22 | #' @param to The ending date; data strictly after this date are discarded. 23 | #' 24 | #' @param sim (optional) The simulations to retained, indicated as subsets of 25 | #' the columns of x. 26 | #' 27 | #' @param ... Further arguments passed to other methods (not used). 28 | #' 29 | 30 | 31 | 32 | #' @export 33 | #' @param i a subset of dates to retain 34 | #' @param j a subset of groups to retain 35 | 36 | "[.projections" <- function(x, i, j){ 37 | if (missing(i)) { 38 | i <- TRUE 39 | } 40 | 41 | if (missing(j)) { 42 | j <- TRUE 43 | } 44 | 45 | ## we first subset the incidence matrix and then handle the dates; procedure 46 | ## is not totally straightforward and needs to work for different types of 47 | ## dates: numeric, integer, Date, etc. 48 | 49 | out <- as.matrix(x)[i, j, drop = FALSE] 50 | 51 | old_dates <- get_dates(x) 52 | names(old_dates) <- as.character(old_dates) 53 | new_dates_chr <- rownames(out) 54 | new_dates <- old_dates[new_dates_chr] 55 | new_dates <- unname(new_dates) 56 | 57 | cumulative <- attr(x, "cumulative") 58 | 59 | new_projections(out, new_dates, cumulative) 60 | } 61 | 62 | 63 | 64 | #' @export 65 | #' @rdname subset 66 | subset.projections <- function(x, ..., from = NULL, to = NULL, 67 | sim = TRUE){ 68 | 69 | ## We need to make sure the comparison with dates is going to work. As for the 70 | ## [ operator, 'from' and 'to' are assumed to be expressed in the same way as 71 | ## the attr(x, "dates"). 72 | 73 | dates <- attr(x, "dates") 74 | 75 | if (is.null(from)) { 76 | from <- min(dates, na.rm = TRUE) 77 | } 78 | 79 | if (is.null(to)) { 80 | to <- max(dates, na.rm = TRUE) 81 | } 82 | 83 | to.keep <- dates >= from & dates <= to 84 | 85 | if (sum(to.keep) < 1) { 86 | stop("No data retained.") 87 | } 88 | x[to.keep, sim] 89 | } 90 | -------------------------------------------------------------------------------- /R/build_projections.R: -------------------------------------------------------------------------------- 1 | #' @importFrom methods is 2 | NULL 3 | 4 | new_projections <- function(x, dates, cumulative, ..., class = character()) { 5 | 6 | stopifnot(is.array(x) || is.matrix(x)) 7 | stopifnot(is(dates, "Date") || is.numeric(dates)) 8 | stopifnot(is.logical(cumulative)) 9 | 10 | if (length(dates) != nrow(x)) { 11 | stop(sprintf("Number of dates (%d) does not match number of rows (%d)", 12 | length(dates), nrow(x)) 13 | ) 14 | } 15 | 16 | x <- as.matrix(x) 17 | rownames(x) <- as.character(dates) 18 | 19 | structure(x, 20 | ..., 21 | dates = dates, 22 | cumulative = cumulative, 23 | class = c(class, "projections", class(x))) 24 | } 25 | 26 | 27 | 28 | #' Constructor for projections objects 29 | #' 30 | #' This function builds a valid \code{projections} object from some input 31 | #' simulations and dates. 32 | #' 33 | #' @author Thibaut Jombart \email{thibautjombart@gmail.com} 34 | #' 35 | #' 36 | #' @export 37 | #' 38 | #' @param x A \code{matrix} of simulated incidence stored as integers, where 39 | #' rows correspond to dates and columns to simulations. 40 | #' 41 | #' @param dates A vector of dates containing one value per row in \code{x}; 42 | #' acceptable formats are: \code{integer}, \code{Date}, and \code{POSIXct}; if 43 | #' NULL, the time steps will be counted, with the first dates corresponding to 44 | #' 0. 45 | #' 46 | #' @param cumulative A logical indicating if data represent cumulative 47 | #' incidence; defaults to \code{FALSE}. 48 | #' 49 | #' @param order_dates A logical indicating whether the dates should be ordered, 50 | #' from the oldest to the most recent one; `TRUE` by default. 51 | #' 52 | #' 53 | #' @export 54 | #' 55 | #' 56 | #' @seealso the \code{\link{project}} function to generate the 'projections' 57 | #' objects. 58 | #' 59 | #' 60 | build_projections <- function(x, dates = NULL, cumulative = FALSE, 61 | order_dates = TRUE) { 62 | x <- as.matrix(x) # todo - this allows dataframes to be used. This is 63 | # tested for but not documented. 64 | 65 | if (is.null(dates)) { 66 | dates <- seq_len(nrow(x)) - 1L 67 | } 68 | if (length(dates) != nrow(x)) { 69 | stop( 70 | sprintf( 71 | "Number of dates (%d) does not match number of rows (%d)", 72 | length(dates), nrow(x)) 73 | ) 74 | } 75 | 76 | ## reorder dates 77 | if (order_dates) { 78 | idx <- order(dates) 79 | dates <- sort(dates) 80 | x <- x[idx, , drop = FALSE] 81 | } 82 | 83 | new_projections(x, dates, cumulative) 84 | } 85 | -------------------------------------------------------------------------------- /R/summary.R: -------------------------------------------------------------------------------- 1 | 2 | #' Summary for projections objects 3 | #' 4 | #' This method summarises predicted epidemic trajectories contained in a 5 | #' `projections` object by days, deriving the mean, standard deviation, and 6 | #' user-specified quantiles for each day. 7 | #' 8 | #' @author Thibaut Jombart 9 | #' 10 | #' @export 11 | #' 12 | #' @aliases summary.projections 13 | #' 14 | #' @param object A `projections` object to summarise 15 | #' 16 | #' @param quantiles A `numeric` vector indicating which quantiles should be 17 | #' computed; ignored if `FALSE` or of length 0 18 | #' 19 | #' @param mean a `logical` indicating of the mean should be computed 20 | #' 21 | #' @param sd a `logical` indicating of the standard deviation should be computed 22 | #' 23 | #' @param min a `logical` indicating of the minimum should be computed 24 | #' 25 | #' @param max a `logical` indicating of the maximum should be computed 26 | #' 27 | #' @param ... only preesnt for compatibility with the generic 28 | #' 29 | #' @examples 30 | #' if (require(incidence)) { 31 | #' i <- incidence::incidence(as.Date('2020-01-23')) 32 | #' si <- c(0.2, 0.5, 0.2, 0.1) 33 | #' R0 <- 2 34 | #' 35 | #' p <- project(x = i, 36 | #' si = si, 37 | #' R = R0, 38 | #' n_sim = 2, 39 | #' R_fix_within = TRUE, 40 | #' n_days = 10, 41 | #' model = "poisson" 42 | #' ) 43 | #' summary(p) 44 | #' 45 | #' } 46 | 47 | summary.projections <- function(object, 48 | quantiles = c(0.025, 0.25, 0.5, 0.75, 0.975), 49 | mean = TRUE, 50 | sd = TRUE, 51 | min = TRUE, 52 | max = TRUE, 53 | ...) { 54 | 55 | ## This auxiliary function will calculate summaries for a single day 56 | f_summary <- function(x, mean, sd, min, max, quantiles) { 57 | x <- as.vector(x) 58 | out <- list() 59 | if (mean) { 60 | out$mean <- mean(x, na.rm = TRUE) 61 | } 62 | if (sd) { 63 | out$sd <- sd(x, na.rm = TRUE) 64 | } 65 | if (min) { 66 | out$min <- min(x, na.rm = TRUE) 67 | } 68 | if (max) { 69 | out$max <- max(x, na.rm = TRUE) 70 | } 71 | if (!isFALSE(quantiles) & length(quantiles)) { 72 | out$quantiles <- stats::quantile(x, 73 | quantiles, 74 | na.rm = TRUE) 75 | } 76 | do.call(c, out) 77 | } 78 | 79 | out <- apply(object, 1, f_summary, 80 | mean = mean, 81 | sd = sd, 82 | min = min, 83 | max = max, 84 | quantiles = quantiles 85 | ) 86 | out <- cbind.data.frame(dates = get_dates(object), 87 | as.data.frame(t(out))) 88 | rownames(out) <- NULL 89 | out 90 | } 91 | 92 | -------------------------------------------------------------------------------- /tests/testthat/test-subset.R: -------------------------------------------------------------------------------- 1 | test_that("Test subsetting with numeric dates inputs", { 2 | skip_on_cran() 3 | 4 | ## simulate basic epicurve 5 | dat <- c(0, 2, 2, 3, 3, 5, 5, 5, 6, 6, 6, 6) 6 | i <- incidence::incidence(dat) 7 | 8 | 9 | ## example with a function for SI 10 | si <- distcrete::distcrete("gamma", interval = 1L, 11 | shape = 1.5, 12 | scale = 2, w = 0) 13 | 14 | x <- project(i, runif(100, 0.8, 1.9), si, n_days = 30) 15 | 16 | subset_1 <- subset(x, from = 15, to = 20, sim = 1:10) 17 | ref_1 <- x[get_dates(x) %in% 15:20, 1:10] 18 | expect_identical(ref_1, subset_1) 19 | 20 | subset_2 <- subset(x, from = 15, sim = c(TRUE, FALSE)) 21 | ref_2 <- x[get_dates(x) >= 15, c(TRUE, FALSE)] 22 | expect_identical(ref_2, subset_2) 23 | 24 | subset_3 <- subset(x, to = 15, sim = c(TRUE, FALSE)) 25 | ref_3 <- x[get_dates(x) <= 15, c(TRUE, FALSE)] 26 | expect_identical(ref_3, subset_3) 27 | 28 | expect_identical(x[], x) 29 | expect_identical(as.vector(subset_1), 30 | unname(unlist(as.data.frame(x)[get_dates(x) %in% 15:20, 2:11]))) 31 | 32 | expect_error(subset(x, from = 1, to = 0), "No data retained.") 33 | 34 | }) 35 | 36 | 37 | 38 | 39 | 40 | test_that("Test subsetting with Date inputs", { 41 | skip_on_cran() 42 | 43 | ## simulate basic epicurve 44 | day <- as.Date("1982-01-01") 45 | dat <- day + c(0, 2, 2, 3, 3, 5, 5, 5, 6, 6, 6, 6) 46 | i <- incidence::incidence(dat) 47 | 48 | 49 | ## example with a function for SI 50 | si <- distcrete::distcrete("gamma", interval = 1L, 51 | shape = 1.5, 52 | scale = 2, w = 0) 53 | 54 | x <- project(i, runif(100, 0.8, 1.9), si, n_days = 30) 55 | 56 | subset_1 <- subset(x, from = day + 15, to = day + 20, sim = 1:10) 57 | ref_1 <- x[get_dates(x) %in% (day + 15:20), 1:10] 58 | expect_identical(ref_1, subset_1) 59 | 60 | subset_2 <- subset(x, from = day + 15, sim = c(TRUE, FALSE)) 61 | ref_2 <- x[get_dates(x) >= (day + 15), c(TRUE, FALSE)] 62 | expect_identical(ref_2, subset_2) 63 | 64 | subset_3 <- subset(x, to = day + 15, sim = 3:10) 65 | ref_3 <- x[get_dates(x) <= (day + 15), 3:10] 66 | expect_identical(ref_3, subset_3) 67 | 68 | }) 69 | 70 | 71 | 72 | 73 | 74 | test_that("Test [ operator handles dates and content", { 75 | skip_on_cran() 76 | 77 | ## test with numeric dates 78 | dates <- 0:9 79 | x_mat <- matrix(1:30, ncol = 3) 80 | x <- build_projections(x_mat, dates = dates) 81 | sub_x <- x[4:2, 2:3] 82 | expect_identical(as.vector(x_mat[4:2, 2:3]), as.vector(sub_x)) 83 | expect_identical(dates[4:2], get_dates(sub_x)) 84 | 85 | ## test with Date 86 | dates <- 0:9 + Sys.Date() 87 | x_mat <- matrix(1:30, ncol = 3) 88 | x <- build_projections(x_mat, dates = dates) 89 | sub_x <- x[4:2, 2:3] 90 | expect_identical(as.vector(sub_x), as.vector(x_mat[4:2, 2:3])) 91 | expect_identical(dates[4:2], get_dates(sub_x)) 92 | 93 | }) 94 | -------------------------------------------------------------------------------- /R/merge_projections.R: -------------------------------------------------------------------------------- 1 | #' Merge a list of projections objects 2 | #' 3 | #' This function merges `projections` objects, binding them by columns, making 4 | #' sure that they all use the same dates, adding rows of '0' where needed. 5 | #' 6 | #' @author Thibaut Jombart 7 | #' 8 | #' @param x A `list` of `projections` objects to be merged. 9 | #' 10 | #' @export 11 | #' 12 | #' @examples 13 | #' 14 | #' ## generate toy data 15 | #' dates <- Sys.Date() + c(0, 0, 2, 5, 6, 6, 7) 16 | #' i <- incidence::incidence(dates) 17 | #' si <- c(0.2, 0.5, 0.2, 0.1) 18 | #' R0 <- 3.5 19 | #' 20 | #' ## make several projections objects 21 | #' x <- lapply(1:10, 22 | #' function(j) 23 | #' project(x = i, 24 | #' si = si, 25 | #' R = R0, 26 | #' n_sim = 2 * j, 27 | #' R_fix_within = TRUE, 28 | #' n_days = j, 29 | #' model = "poisson" 30 | #' )) 31 | #' ## see all dimensions 32 | #' lapply(x, dim) 33 | #' merge_projections(x) 34 | 35 | merge_projections <- function(x) { 36 | 37 | ## check that inputs are all okay 38 | if (!is.list(x)) { 39 | msg <- sprintf("x is not a `list` but a %s", 40 | class(x)[1]) 41 | stop(msg) 42 | } 43 | 44 | is_projections <- vapply(x, 45 | function(e) inherits(e, "projections"), 46 | logical(1)) 47 | if (!all(is_projections)) { 48 | msg <- "some input objects are not `projections` objects" 49 | stop(msg) 50 | } 51 | 52 | if (!length(x)) { 53 | msg <- "x is an empty `list`" 54 | stop(msg) 55 | } 56 | 57 | ## note: Reduce(function(...) merge(..., all = TRUE), proj) would work here 58 | ## but take a loooot of time; `dplyr::full_join` is worse; we do the merge 59 | ## manually instead 60 | 61 | ## Strategy is: 62 | 63 | ## 1. convert all objects to `data.frame` 64 | 65 | ## 2. finding all dates and making a vector of unique dates; we also store 66 | ## it as a data.frame for merging 67 | 68 | ## 3. merge this date data.frame to all other data.frames, so they all have 69 | ## the same temporal references 70 | 71 | ## 4. cbind all obtained data.frames, excluding the dates column, using 72 | ## do.call for computer efficiency; replace all NAs by 0 73 | 74 | ## 5. build a new `projections` object 75 | 76 | 77 | ## step 1 78 | list_df <- lapply(x, as.data.frame) 79 | 80 | 81 | ## step 2 82 | all_dates <- Reduce(c, lapply(list_df, function(e) e$dates)) 83 | all_dates <- sort(unique(all_dates)) # sorting is important!! 84 | all_dates_df <- data.frame(dates = all_dates) 85 | 86 | ## step 3 87 | list_df_complete <- lapply(list_df, 88 | function(e) merge(all_dates_df, e, all = TRUE)) 89 | 90 | ## step 4 91 | out_matrix <- do.call(cbind, lapply(list_df_complete, function(e) e[, -1])) 92 | out_matrix[is.na(out_matrix)] <- 0 93 | colnames(out_matrix) <- paste("sim", seq_len(ncol(out_matrix)), sep = "_") 94 | 95 | # step 5 96 | out <- build_projections(out_matrix, all_dates) 97 | out 98 | } 99 | -------------------------------------------------------------------------------- /tests/testthat/test-summary.R: -------------------------------------------------------------------------------- 1 | test_that("Testing default summary", { 2 | i <- incidence::incidence(as.Date('2020-01-23')) 3 | si <- c(0.2, 0.5, 0.2, 0.1) 4 | R0 <- 2 5 | 6 | p <- project(x = i, 7 | si = si, 8 | R = R0, 9 | n_sim = 2, 10 | R_fix_within = TRUE, 11 | n_days = 10, 12 | model = "poisson" 13 | ) 14 | 15 | s <- summary(p) 16 | 17 | expect_identical(get_dates(p), s$dates) 18 | expect_equal(as.vector(apply(p, 1, median)), s$`quantiles.50%`) 19 | expect_equal(as.vector(apply(p, 1, mean)), s$mean) 20 | expect_equal(as.vector(apply(p, 1, sd)), s$sd) 21 | expect_equal(as.vector(apply(p, 1, min)), s$min) 22 | expect_equal(as.vector(apply(p, 1, max)), s$max) 23 | expect_identical(as.vector(apply(p, 1, quantile, 0.025)), 24 | s$`quantiles.2.5%`) 25 | expect_identical(as.vector(apply(p, 1, quantile, 0.975)), 26 | s$`quantiles.97.5%`) 27 | expect_identical(as.vector(apply(p, 1, quantile, 0.25)), 28 | s$`quantiles.25%`) 29 | expect_identical(as.vector(apply(p, 1, quantile, 0.75)), 30 | s$`quantiles.75%`) 31 | 32 | }) 33 | 34 | 35 | 36 | 37 | 38 | test_that("Testing summary on/off", { 39 | i <- incidence::incidence(as.Date('2020-01-23')) 40 | si <- c(0.2, 0.5, 0.2, 0.1) 41 | R0 <- 2 42 | 43 | p <- project(x = i, 44 | si = si, 45 | R = R0, 46 | n_sim = 2, 47 | R_fix_within = TRUE, 48 | n_days = 10, 49 | model = "poisson" 50 | ) 51 | 52 | ## no min/max/mean/sd 53 | s_quantiles_only <- summary(p, min = FALSE, max = FALSE, mean = FALSE, sd = FALSE) 54 | expect_identical(get_dates(p), s_quantiles_only$dates) 55 | expect_null(s_quantiles_only$mean) 56 | expect_null(s_quantiles_only$sd) 57 | expect_null(s_quantiles_only$min) 58 | expect_null(s_quantiles_only$max) 59 | expect_equal(as.vector(apply(p, 1, median)), s_quantiles_only$`quantiles.50%`) 60 | expect_identical(as.vector(apply(p, 1, quantile, 0.025)), 61 | s_quantiles_only$`quantiles.2.5%`) 62 | expect_identical(as.vector(apply(p, 1, quantile, 0.975)), 63 | s_quantiles_only$`quantiles.97.5%`) 64 | expect_identical(as.vector(apply(p, 1, quantile, 0.25)), 65 | s_quantiles_only$`quantiles.25%`) 66 | expect_identical(as.vector(apply(p, 1, quantile, 0.75)), 67 | s_quantiles_only$`quantiles.75%`) 68 | 69 | ## no quantiles 70 | s_no_quantiles <- summary(p, quantiles = FALSE) 71 | expect_identical(get_dates(p), s_no_quantiles$dates) 72 | expect_equal(as.vector(apply(p, 1, mean)), s_no_quantiles$mean) 73 | expect_equal(as.vector(apply(p, 1, sd)), s_no_quantiles$sd) 74 | expect_equal(as.vector(apply(p, 1, min)), s_no_quantiles$min) 75 | expect_equal(as.vector(apply(p, 1, max)), s_no_quantiles$max) 76 | 77 | expect_identical(c("dates", "mean", "sd", "min", "max"), names(s_no_quantiles)) 78 | expect_identical(s_no_quantiles, summary(p, quantiles = NULL)) 79 | expect_identical(s_no_quantiles, summary(p, quantiles = numeric(0))) 80 | 81 | 82 | ## different set of quantiles 83 | s_other_quantiles <- summary(p, quantiles = c(0.4, 0.7)) 84 | expect_identical(as.vector(apply(p, 1, quantile, 0.4)), 85 | s_other_quantiles$`quantiles.40%`) 86 | expect_identical(as.vector(apply(p, 1, quantile, 0.7)), 87 | s_other_quantiles$`quantiles.70%`) 88 | 89 | }) 90 | -------------------------------------------------------------------------------- /docs/pkgdown.js: -------------------------------------------------------------------------------- 1 | /* http://gregfranko.com/blog/jquery-best-practices/ */ 2 | (function($) { 3 | $(function() { 4 | 5 | $('.navbar-fixed-top').headroom(); 6 | 7 | $('body').css('padding-top', $('.navbar').height() + 10); 8 | $(window).resize(function(){ 9 | $('body').css('padding-top', $('.navbar').height() + 10); 10 | }); 11 | 12 | $('[data-toggle="tooltip"]').tooltip(); 13 | 14 | var cur_path = paths(location.pathname); 15 | var links = $("#navbar ul li a"); 16 | var max_length = -1; 17 | var pos = -1; 18 | for (var i = 0; i < links.length; i++) { 19 | if (links[i].getAttribute("href") === "#") 20 | continue; 21 | // Ignore external links 22 | if (links[i].host !== location.host) 23 | continue; 24 | 25 | var nav_path = paths(links[i].pathname); 26 | 27 | var length = prefix_length(nav_path, cur_path); 28 | if (length > max_length) { 29 | max_length = length; 30 | pos = i; 31 | } 32 | } 33 | 34 | // Add class to parent
  • , and enclosing
  • if in dropdown 35 | if (pos >= 0) { 36 | var menu_anchor = $(links[pos]); 37 | menu_anchor.parent().addClass("active"); 38 | menu_anchor.closest("li.dropdown").addClass("active"); 39 | } 40 | }); 41 | 42 | function paths(pathname) { 43 | var pieces = pathname.split("/"); 44 | pieces.shift(); // always starts with / 45 | 46 | var end = pieces[pieces.length - 1]; 47 | if (end === "index.html" || end === "") 48 | pieces.pop(); 49 | return(pieces); 50 | } 51 | 52 | // Returns -1 if not found 53 | function prefix_length(needle, haystack) { 54 | if (needle.length > haystack.length) 55 | return(-1); 56 | 57 | // Special case for length-0 haystack, since for loop won't run 58 | if (haystack.length === 0) { 59 | return(needle.length === 0 ? 0 : -1); 60 | } 61 | 62 | for (var i = 0; i < haystack.length; i++) { 63 | if (needle[i] != haystack[i]) 64 | return(i); 65 | } 66 | 67 | return(haystack.length); 68 | } 69 | 70 | /* Clipboard --------------------------*/ 71 | 72 | function changeTooltipMessage(element, msg) { 73 | var tooltipOriginalTitle=element.getAttribute('data-original-title'); 74 | element.setAttribute('data-original-title', msg); 75 | $(element).tooltip('show'); 76 | element.setAttribute('data-original-title', tooltipOriginalTitle); 77 | } 78 | 79 | if(ClipboardJS.isSupported()) { 80 | $(document).ready(function() { 81 | var copyButton = ""; 82 | 83 | $(".examples, div.sourceCode").addClass("hasCopyButton"); 84 | 85 | // Insert copy buttons: 86 | $(copyButton).prependTo(".hasCopyButton"); 87 | 88 | // Initialize tooltips: 89 | $('.btn-copy-ex').tooltip({container: 'body'}); 90 | 91 | // Initialize clipboard: 92 | var clipboardBtnCopies = new ClipboardJS('[data-clipboard-copy]', { 93 | text: function(trigger) { 94 | return trigger.parentNode.textContent; 95 | } 96 | }); 97 | 98 | clipboardBtnCopies.on('success', function(e) { 99 | changeTooltipMessage(e.trigger, 'Copied!'); 100 | e.clearSelection(); 101 | }); 102 | 103 | clipboardBtnCopies.on('error', function() { 104 | changeTooltipMessage(e.trigger,'Press Ctrl+C or Command+C to copy'); 105 | }); 106 | }); 107 | } 108 | })(window.jQuery || window.$) 109 | -------------------------------------------------------------------------------- /tests/testthat/test-merge_add_projections.R: -------------------------------------------------------------------------------- 1 | test_that("Merging works", { 2 | 3 | set.seed(1) 4 | i <- incidence::incidence(as.Date('2020-01-01') + sample(1:30, 10)) 5 | si <- c(0.2, 0.5, 0.2, 0.1) 6 | 7 | x_1 <- project(x = i[1:10], 8 | si = si, 9 | R = 2, 10 | n_sim = 1000, 11 | R_fix_within = TRUE, 12 | n_days = 10, 13 | model = "poisson" 14 | )[1:3, ] 15 | 16 | x_2 <- project(x = i, 17 | si = si, 18 | R = 1.5, 19 | n_sim = 100, 20 | R_fix_within = TRUE, 21 | n_days = 20, 22 | model = "poisson" 23 | ) 24 | 25 | x_3 <- project(x = i, 26 | si = si, 27 | R = 3.4, 28 | n_sim = 200, 29 | R_fix_within = TRUE, 30 | n_days = 8, 31 | model = "poisson" 32 | ) 33 | 34 | ## test adding these 3 simulations 35 | list_x <- list(x_1, x_2, x_3) 36 | x <- merge_add_projections(list_x) 37 | 38 | 39 | ## check date range is correct: output should start at first date of all 40 | ## inputs, end of last dates of all inputs 41 | 42 | first_date <- min(Reduce("c", lapply(list_x, function(e) min(get_dates(e))))) 43 | last_date <- max(Reduce("c", lapply(list_x, function(e) max(get_dates(e))))) 44 | expect_equal(min(get_dates(x)), first_date) 45 | expect_equal(max(get_dates(x)), last_date) 46 | 47 | 48 | ## check dimensions: output should have as many sims as the largest input 49 | 50 | n_sims <- max(sapply(list_x, ncol)) 51 | expect_equal(ncol(x), n_sims) 52 | 53 | 54 | ## check values 55 | x <- merge_add_projections(list(x_2[-c(1:3), ], x_2[c(1:3), ])) 56 | expect_equal(as.vector(x), as.vector(x_2)) 57 | 58 | x <- merge_add_projections(list(x_2, x_2[c(1:3), ])) 59 | expect_equal(as.vector(x[1:3, ]), as.vector(x_2[1:3, ] * 2)) 60 | expect_equal(as.vector(x[-(1:3), ]), as.vector(x_2[-(1:3), ])) 61 | 62 | 63 | ## check operator version 64 | expect_identical(x + x, x * 2) 65 | expect_identical(x[-1, ] + x[1, ], x) 66 | 67 | ## check date continuity 68 | y <- x[1,] + x[nrow(x),] 69 | expected_dates <- seq(from = min(get_dates(x)), to = max(get_dates(x)), by = 1L) 70 | expect_identical(get_dates(y), expected_dates) 71 | 72 | }) 73 | 74 | 75 | 76 | 77 | 78 | test_that("Errors are issued as they should", { 79 | 80 | msg <- "x is not a `list` but a character" 81 | expect_error(merge_add_projections(letters), msg) 82 | 83 | msg <- "some input objects are not `projections` objects" 84 | expect_error(merge_add_projections(list(letters)), msg) 85 | 86 | msg <- "x is an empty `list`" 87 | expect_error(merge_add_projections(list()), msg) 88 | 89 | }) 90 | 91 | 92 | 93 | 94 | 95 | test_that("+ operator works with numeric right-hand operator", { 96 | 97 | set.seed(1) 98 | i <- incidence::incidence(as.Date('2020-01-01') + sample(1:30, 10)) 99 | si <- c(0.2, 0.5, 0.2, 0.1) 100 | 101 | x <- project(x = i[1:10], 102 | si = si, 103 | R = 2, 104 | n_sim = 1000, 105 | R_fix_within = TRUE, 106 | n_days = 10, 107 | model = "poisson" 108 | )[1:3, ] 109 | 110 | ## test with a scalar integer 111 | x_plus <- x + 2L 112 | expect_identical(as.matrix(x) + 2L, as.matrix(x_plus)) 113 | expect_identical(class(x), class(x_plus)) 114 | 115 | ## test with a with a numeric vector 116 | x_plus <- x + 10:13 117 | expect_identical(as.matrix(x) + 10:13, as.matrix(x_plus)) 118 | expect_identical(class(x), class(x_plus)) 119 | 120 | ## test with a with a decimal numbers 121 | b <- 10:13 + 1.1 122 | x_plus <- x + b 123 | expect_identical(as.matrix(x) + b, as.matrix(x_plus)) 124 | expect_identical(class(x), class(x_plus)) 125 | 126 | }) 127 | -------------------------------------------------------------------------------- /tests/testthat/test-plots.R: -------------------------------------------------------------------------------- 1 | save_svg <- function(plot) { 2 | path <- tempfile(fileext = ".svg") 3 | ggplot2::ggsave(path, plot = plot) 4 | path 5 | } 6 | 7 | expect_snapshot_plot <- function(code, name) { 8 | # Other packages might affect results 9 | skip_if_not_installed("svglite") 10 | path <- save_svg(code) 11 | expect_snapshot_file(path, paste0(name, ".svg")) 12 | } 13 | 14 | test_that("Test against reference results", { 15 | skip_on_ci() 16 | 17 | ## simulate basic epicurve 18 | dat <- c(0, 2, 2, 3, 3, 5, 5, 5, 6, 6, 6, 6) 19 | i <- incidence::incidence(dat) 20 | 21 | 22 | ## example with a function for SI 23 | si <- distcrete::distcrete("gamma", interval = 1L, 24 | shape = 1.5, 25 | scale = 2, w = 0) 26 | 27 | set.seed(1) 28 | pred_1 <- project(i, runif(100, 0.8, 1.9), si, n_days = 30) 29 | plot_1 <- plot(pred_1) 30 | 31 | expect_snapshot_plot(plot_1, "basic-example-plot") 32 | 33 | ## using simulated ebola data 34 | 35 | si <- distcrete::distcrete( 36 | "gamma", 37 | interval = 1L, 38 | shape = 2.4, 39 | scale = 4.7, 40 | w = 0.5) 41 | 42 | i <- incidence::incidence(outbreaks::ebola_sim$linelist$date_of_onset) 43 | 44 | ## add projections after the first 100 days, over 60 days 45 | set.seed(1) 46 | proj <- project(x = i[1:100], R = 1.4, si = si, n_days = 60) 47 | 48 | ## plotting projections 49 | plot_2 <- plot(proj) 50 | expect_snapshot_plot(plot_2, "evd-proj") 51 | 52 | plot_3 <- plot(proj, boxplots = TRUE, outliers = FALSE) 53 | expect_snapshot_plot(plot_3, "evd-proj-box-no-outliers") 54 | 55 | plot_4 <- plot(proj, ribbon = FALSE) 56 | expect_snapshot_plot(plot_4, "evd-proj-no-ribbon") 57 | 58 | plot_5 <- plot(proj, boxplots = FALSE, linetype = 2, linesize = 3) 59 | expect_snapshot_plot(plot_5, "evd-proj-no-box-custom-lines") 60 | 61 | plot_6 <- plot(proj, boxplots = TRUE, boxplots_color = "red") 62 | expect_snapshot_plot(plot_6, "evd-proj-red-box") 63 | 64 | plot_7 <- plot(proj, quantiles = FALSE, ribbon = FALSE, boxplots = TRUE) 65 | expect_snapshot_plot(plot_7, "evd-proj-box-only") 66 | 67 | plot_8 <- plot(proj, quantiles = FALSE) 68 | expect_snapshot_plot(plot_8, "evd-proj-ribbon-only") 69 | 70 | plot_9 <- plot(proj, ribbon_color = "red", quantiles = FALSE) 71 | expect_snapshot_plot(plot_9, "evd-proj-red-ribbon") 72 | 73 | plot_10 <- plot( 74 | proj, 75 | ribbon_color = "red", 76 | ribbon_alpha = 1, 77 | quantiles = FALSE, 78 | ribbon_quantiles = c(.4, .6) 79 | ) 80 | expect_snapshot_plot(plot_10, "evd-proj-full-red-ribbon-narrow-range") 81 | 82 | 83 | ## adding projections to incidence::incidence plot 84 | plot_11 <- plot(i) %>% add_projections(proj) 85 | expect_snapshot_plot(plot_11, "evd-proj-with-incidence-incidence") 86 | 87 | plot_12 <- plot(i) %>% add_projections(proj, boxplots = TRUE) 88 | expect_snapshot_plot(plot_12, "evd-proj-with-incidence-incidence-no-box") 89 | 90 | plot_13 <- 91 | plot(i) %>% 92 | add_projections(proj, quantiles = FALSE, ribbon = FALSE, boxplots = TRUE) 93 | expect_snapshot_plot(plot_13, "evd-proj-with-incidence-incidence-box-only") 94 | 95 | 96 | ## same, custom colors and quantiles 97 | quantiles <- c(.001, .01, 0.05, .1, .2, .3, .4, .5) 98 | pal <- colorRampPalette(c("#b3c6ff", "#00e64d", "#cc0066")) 99 | plot_14 <- plot(i[1:200]) %>% 100 | add_projections(proj, quantiles, palette = pal) + 101 | ggplot2::scale_x_date(date_labels = "%b %Y") 102 | expect_snapshot_plot(plot_14, "evd-proj-with-incidence-incidence-and-custom") 103 | 104 | }) 105 | 106 | test_that("Plotting issues expected errors", { 107 | skip_on_cran() 108 | 109 | 110 | ## simulate basic epicurve 111 | dat <- c(0, 2, 2, 3, 3, 5, 5, 5, 6, 6, 6, 6) 112 | i <- incidence::incidence(dat) 113 | p <- plot(i) 114 | 115 | ## example with a function for SI 116 | expect_error(add_projections(p, "toto"), 117 | "`x` must be a 'projections' object but is a `character`", 118 | fixed = TRUE) 119 | }) 120 | -------------------------------------------------------------------------------- /R/merge_add_projections.R: -------------------------------------------------------------------------------- 1 | #' Add data of different projections objects 2 | #' 3 | #' This function adds counts from several `projections` objects, making sure 4 | #' that they all use the same dates, adding rows of '0' where 5 | #' needed. Simulations (columns) are recycled when needed if some objects have 6 | #' less simulations than others. The same operation is implemented by the `+` 7 | #' operator. 8 | #' 9 | #' @author Thibaut Jombart 10 | #' 11 | #' @param x A `list` of `projections` objects to be added. 12 | #' 13 | #' @param a A `projections` object. 14 | #' 15 | #' @param b A `projections` object. 16 | #' 17 | #' @export 18 | #' 19 | #' @examples 20 | #' 21 | #' if (require(incidence)) { 22 | #' 23 | #' ## make toy data and projections 24 | #' set.seed(1) 25 | #' i <- incidence::incidence(as.Date('2020-01-01') + 26 | #' sample(1:20, 50, replace = TRUE)) 27 | #' si <- c(0.2, 0.5, 0.2, 0.1) 28 | #' 29 | #' x_1 <- project(x = i[1:10], 30 | #' si = si, 31 | #' R = 3.5, 32 | #' n_sim = 200, 33 | #' n_days = 5) 34 | #' 35 | #' x_2 <- project(x = i[11:20], 36 | #' si = si, 37 | #' R = 1.8, 38 | #' n_sim = 300, 39 | #' n_days = 10 40 | #' ) 41 | #' 42 | #' ## check simulations 43 | #' x_1 # first type 44 | #' x_2 # other simulations 45 | #' y <- x_1 + x_2 # add simulations 46 | #' plot(y) 47 | #' 48 | #' } 49 | 50 | 51 | merge_add_projections <- function(x) { 52 | 53 | ## check that inputs are all okay 54 | if (!is.list(x)) { 55 | msg <- sprintf("x is not a `list` but a %s", 56 | class(x)[1]) 57 | stop(msg) 58 | } 59 | 60 | is_projections <- vapply(x, 61 | function(e) inherits(e, "projections"), 62 | logical(1)) 63 | if (!all(is_projections)) { 64 | msg <- "some input objects are not `projections` objects" 65 | stop(msg) 66 | } 67 | 68 | if (!length(x)) { 69 | msg <- "x is an empty `list`" 70 | stop(msg) 71 | } 72 | 73 | 74 | ## note: Reduce(function(...) merge(..., all = TRUE), proj) would work here 75 | ## but take a loooot of time; `dplyr::full_join` is worse; we do the merge 76 | ## manually instead 77 | 78 | ## Strategy is: 79 | 80 | ## 1. convert all objects to `data.frame` 81 | 82 | ## 2. finding all dates and making a vector of unique dates; we also store 83 | ## it as a data.frame for merging 84 | 85 | ## 3. merge this date data.frame to all other data.frames, so they all have 86 | ## the same temporal references 87 | 88 | ## 4. replace all NAs by 0 89 | 90 | ## 5. recycle matrices with less simulations 91 | 92 | ## 6. add data from the different data.frame 93 | 94 | ## 7. build a new `projections` object 95 | 96 | 97 | ## step 1 98 | list_df <- lapply(x, as.data.frame) 99 | 100 | 101 | ## step 2 102 | all_dates <- Reduce(c, lapply(list_df, function(e) e$dates)) 103 | all_dates <- unique(all_dates) 104 | all_dates <- seq(from = min(all_dates), to = max(all_dates), by = 1L) 105 | all_dates_df <- data.frame(dates = all_dates) 106 | 107 | ## step 3 108 | list_df_complete <- lapply(list_df, 109 | function(e) merge(all_dates_df, e, all = TRUE)) 110 | 111 | ## step 4-5 112 | list_matrices <- lapply(list_df_complete, 113 | function(e) as.matrix(e[, -1], drop = FALSE)) 114 | n_sims <- max(vapply(list_matrices, ncol, integer(1))) 115 | 116 | for (i in seq_along(list_matrices)) { 117 | ## step 4 118 | list_matrices[[i]][is.na(list_matrices[[i]])] <- 0 119 | 120 | ## step 5 121 | current_n_col <- ncol(list_matrices[[i]]) 122 | idx_col <- rep(seq_len(current_n_col), length.out = n_sims) 123 | list_matrices[[i]] <- list_matrices[[i]][, idx_col, drop = FALSE] 124 | } 125 | 126 | ## step 5 127 | out_matrix <- Reduce("+", list_matrices) 128 | 129 | out <- build_projections(out_matrix, all_dates) 130 | out 131 | } 132 | 133 | 134 | 135 | #' @export 136 | #' @rdname merge_add_projections 137 | `+.projections` <- function(a, b) { 138 | if (inherits(b, "projections")) { 139 | merge_add_projections(list(a, b)) 140 | } else { 141 | old_class <- class(a) 142 | out <- unclass(a) + b 143 | class(out) <- old_class 144 | out 145 | } 146 | } 147 | 148 | -------------------------------------------------------------------------------- /man/plot.projections.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot.projections.R 3 | \name{plot.projections} 4 | \alias{plot.projections} 5 | \alias{add_projections} 6 | \title{Plot projections objects} 7 | \usage{ 8 | \method{plot}{projections}(x, ylab = NULL, title = NULL, ...) 9 | 10 | add_projections( 11 | p, 12 | x, 13 | quantiles = c(0.01, 0.05, 0.1, 0.5), 14 | ribbon = TRUE, 15 | boxplots = FALSE, 16 | palette = quantile_pal, 17 | quantiles_alpha = 1, 18 | linetype = 1, 19 | linesize = 0.5, 20 | ribbon_quantiles = NULL, 21 | ribbon_color = NULL, 22 | ribbon_alpha = 0.3, 23 | boxplots_color = "#47476b", 24 | boxplots_fill = "grey", 25 | boxplots_alpha = 0.8, 26 | outliers = TRUE 27 | ) 28 | } 29 | \arguments{ 30 | \item{x}{A \code{projections} object.} 31 | 32 | \item{ylab}{An optional label for the y-axis. If missing will default to 33 | "predicted incidence" or, if cumulative, "predicted cumulative incidence"} 34 | 35 | \item{title}{An optional title.} 36 | 37 | \item{...}{Further arguments to be passed to \code{add_projections}.} 38 | 39 | \item{p}{A previous incidence plot to which projections should be added.} 40 | 41 | \item{quantiles}{A vector of quantiles to plot, automatically completed to be 42 | symmetric around the median.} 43 | 44 | \item{ribbon}{A logical indicating if a ribbon should be drawn; defaults to 45 | \code{TRUE}.} 46 | 47 | \item{boxplots}{A logical indicating if boxplots should be drawn.} 48 | 49 | \item{palette}{A color palette to be used for plotting the quantile lines; 50 | defaults to \code{quantile_pal}.} 51 | 52 | \item{quantiles_alpha}{A number used to control the transparency of the 53 | quantile lines, from 0 (full transparency) to 1 (full opacity); defaults to 54 | 1.} 55 | 56 | \item{linetype}{An integer indicating the type of line used for plotting the 57 | quantiles; defaults to 1 for a plain line.} 58 | 59 | \item{linesize}{An integer indicating the size of line used for plotting the 60 | quantiles; defaults to 0.5.} 61 | 62 | \item{ribbon_quantiles}{A vector of 2 quantiles to be used to determine the 63 | limits of the ribbon; if NULL (default); uses the most extreme quantiles if 64 | available; if quantiles are not provided, the daily range will be used.} 65 | 66 | \item{ribbon_color}{Any valid color, used for the ribbon.} 67 | 68 | \item{ribbon_alpha}{A number used to control the transparency of the 69 | ribbon, from 0 (full transparency) to 1 (full opacity); defaults to 0.3.} 70 | 71 | \item{boxplots_color}{Any valid color, used for the boxplot.} 72 | 73 | \item{boxplots_fill}{Any valid color, used for filling the boxplot.} 74 | 75 | \item{boxplots_alpha}{A number used to control the transparency of the 76 | boxplots, from 0 (full transparency) to 1 (full opacity); defaults to 0.8.} 77 | 78 | \item{outliers}{A logical indicating if outliers should be displayed 79 | alongside the boxplots; defaults to \code{TRUE}.} 80 | } 81 | \description{ 82 | The \code{plot} method of \code{projections} objects (output by the function 83 | \code{\link{project}}) shows quantiles of predicted incidence over time. The 84 | function \code{add_projections} can be used to add a similar plot to an 85 | existing \code{incidence} plot. This latter function is piping friendly (see 86 | examples). 87 | } 88 | \examples{ 89 | 90 | if (require(outbreaks) && 91 | require(distcrete) && 92 | require(incidence) && 93 | require(magrittr)) { 94 | 95 | si <- distcrete("gamma", 96 | interval = 1L, 97 | shape = 2.4, 98 | scale = 4.7, 99 | w = 0.5) 100 | 101 | i <- incidence(ebola_sim$linelist$date_of_onset) 102 | plot(i) 103 | 104 | ## add projections after the first 100 days, over 60 days 105 | set.seed(1) 106 | proj <- project(x = i[1:100], R = 1.4, si = si, n_days = 60) 107 | 108 | ## plotting projections: different options 109 | plot(proj) 110 | plot(proj, quantiles = c(.025, .5)) # 95\% CI 111 | plot(proj, ribbon_color = "red", quantiles = FALSE) # range 112 | plot(proj, ribbon_color = "red", quantiles = FALSE, 113 | ribbon_quantiles = c(.025, .5)) 114 | plot(proj, boxplots = TRUE, quantiles = FALSE, ribbon = FALSE) 115 | plot(proj, boxplots = TRUE, quantiles = FALSE, outliers = FALSE) 116 | plot(proj, linetype = 3) 117 | 118 | ## adding them to incidence plot 119 | plot(i) \%>\% add_projections(proj) 120 | plot(i[1:160]) \%>\% add_projections(proj) 121 | plot(i[1:160]) \%>\% add_projections(proj, boxplots = FALSE) 122 | plot(i[1:160]) \%>\% 123 | add_projections(proj, boxplots_alpha = .3, boxplots_color = "red") 124 | 125 | ## same, with customised quantiles and colors 126 | quantiles <- c(.001, .01, 0.05, .1, .2, .3, .4, .5) 127 | pal <- colorRampPalette(c("#b3c6ff", "#00e64d", "#cc0066")) 128 | plot(i[1:200]) \%>\% 129 | add_projections(proj, quantiles, palette = pal) 130 | 131 | } 132 | 133 | } 134 | \seealso{ 135 | \code{\link{project}} to generate projections 136 | } 137 | \author{ 138 | Thibaut Jombart \email{thibautjombart@gmail.com} 139 | } 140 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # projections 0.6.1 2 | 3 | ## Fixes and improvements 4 | 5 | - fixed tests of dates due failing due to changes in `as.Date()` 6 | - fixed example in the manpage of `summary.projection` 7 | 8 | 9 | 10 | # projections 0.6.0 11 | 12 | ## Fixes and improvements 13 | 14 | - fixed over-dispersion parameter in NegBin model 15 | - improved support for NegBin and Rt models 16 | 17 | 18 | # projections 0.5.4 19 | 20 | ## Fixes and improvements 21 | 22 | - add option to use instantaneous R rather than the default case R in project 23 | 24 | 25 | # projections 0.5.3 26 | 27 | ## Fixes and improvements 28 | 29 | - harmonise si definition with EpiEstim. 30 | 31 | 32 | # projections 0.5.2 33 | 34 | ## Fixes and improvements 35 | 36 | - now using 3rd edition of testthat for checks. 37 | 38 | 39 | # projections 0.5.1 40 | 41 | ## Fixes and improvements 42 | 43 | - now using the new default random number generator in tests 44 | 45 | - updated tests to pass check with R 4.0.2; this includes re-generation of most 46 | reference objects, which were manually inspected and validated against old 47 | references 48 | 49 | 50 | # projections 0.5.0 51 | 52 | ## New functions 53 | 54 | - new function `merge_projections` permits to join different sets of 55 | simulations, adapting the respective time windows accordingly 56 | 57 | - new function `merge_add_projections` permits to add simulated case incidence 58 | from different sets of simulations, adapting the respective time windows 59 | accordingly; if objects contain different numbers of simulations, the shortest 60 | ones are recycled as needed; also implemented as the operator `+` 61 | 62 | - new function `summary` will summarise `projections` objects by day, using a 63 | range of pre-defined statistics (mean, sd, min, max, and user-defined 64 | quantiles) 65 | 66 | ## Fixes and improvements 67 | 68 | - bug fix for the use of time-varying R in `project` 69 | 70 | - bug fix for `as.data.frame(..., long = TRUE)` 71 | 72 | - more consistent handling of inputs for the serial interval; if provided as a 73 | vector, `si` now starts at a delay of 1 day, rather than 0 and assuming the 74 | first entry is 0; for `distcrete` inputs, the mass for `si$d(0)` is now 75 | ignored, and the rest of the distribution is rescaled accorindly to ensure the 76 | PMF sums to 1 77 | 78 | - (*documentation*) more realistic serial interval distribution used for the Ebola 79 | examples 80 | 81 | - (*internal*) the force of infection is now calculated by the new internal 82 | function `compute_force_infection` 83 | 84 | - (*testing*) revised sets of tests relying less on comparison to references, 85 | but testing for meaningful output properties instead 86 | 87 | - (*testing*) 100% coverage 88 | 89 | 90 | # projections 0.4.1 91 | 92 | - `project()` will can now take single dates or single projections as inputs. 93 | (@acori, @zkamvar, #18). 94 | 95 | # projections 0.4.0 96 | 97 | - `project` can now use time-varying R by specifying `time_change`, a vector of 98 | dates at which R changes, and providing a `vector` or a `list` of values for 99 | `R` instead of a vector, in which case it needs to have `length(time_change) + 100 | 1` components, each of which is a vector of R values. 101 | 102 | # projections 0.3.2 103 | 104 | - A bug in `project()` where R was being resampled recursively was fixed 105 | (#11, @jarvisc1; #12, @zkamvar) 106 | 107 | # projections 0.3.1 108 | 109 | - `get_dates()` now inherits the generic `get_dates()` from incidence 110 | 111 | # projections 0.3.0 112 | 113 | ## New features 114 | 115 | This is a big release! Plenty of new features have been added, including: 116 | 117 | - `projections` can now be subsetted like matrices using `x[i,j]`, or using the 118 | function `subset` 119 | 120 | - new function `cumulate` to compute cumulative incidence for `projections` 121 | objects, akin to the similar function in the `incidence` package 122 | 123 | - much improved graphics; `plot` now call upons `add_projections`, which 124 | implements many options for plotting projections, including quantiles lines, 125 | ribbon, and boxplots; `add_projections` can also be used to add such plots to 126 | an existing `incidence` plot 127 | 128 | - `build_projections` can be used to build a `projections` object from an input 129 | matrix and optional dates 130 | 131 | 132 | 133 | # projections 0.1.1 134 | 135 | ## New features 136 | 137 | - `project` can now use a Negative Binomial model as an alternative to the 138 | original Poisson model to account for over-dispersion in new cases / 139 | super-spreading. 140 | 141 | 142 | ## Bug fixes 143 | 144 | Fixed the calls to `sample`, which has a rather irrational behaviour when 145 | passing a first argument of length 1 (i.e. not bootstrapping from the vector). 146 | 147 | 148 | 149 | 150 | # projections 0.0.1 151 | 152 | First release of the package! 153 | 154 | 155 | ## New features 156 | 157 | - `project`: a function generating projections from an existing *incidence* 158 | object, a serial interval distribution, and a set of plausible reproduction 159 | numbers ($R$); returns a `projections` object. 160 | 161 | - `plot`/`print`: plotting and printing methods for `projections` objects. 162 | 163 | - `get_dates`: accessors for `projections` objects. 164 | 165 | - `as.data.frame`: conversion from `projections` objects to `data.frame`. 166 | 167 | -------------------------------------------------------------------------------- /docs/bootstrap-toc.js: -------------------------------------------------------------------------------- 1 | /*! 2 | * Bootstrap Table of Contents v0.4.1 (http://afeld.github.io/bootstrap-toc/) 3 | * Copyright 2015 Aidan Feldman 4 | * Licensed under MIT (https://github.com/afeld/bootstrap-toc/blob/gh-pages/LICENSE.md) */ 5 | (function() { 6 | 'use strict'; 7 | 8 | window.Toc = { 9 | helpers: { 10 | // return all matching elements in the set, or their descendants 11 | findOrFilter: function($el, selector) { 12 | // http://danielnouri.org/notes/2011/03/14/a-jquery-find-that-also-finds-the-root-element/ 13 | // http://stackoverflow.com/a/12731439/358804 14 | var $descendants = $el.find(selector); 15 | return $el.filter(selector).add($descendants).filter(':not([data-toc-skip])'); 16 | }, 17 | 18 | generateUniqueIdBase: function(el) { 19 | var text = $(el).text(); 20 | var anchor = text.trim().toLowerCase().replace(/[^A-Za-z0-9]+/g, '-'); 21 | return anchor || el.tagName.toLowerCase(); 22 | }, 23 | 24 | generateUniqueId: function(el) { 25 | var anchorBase = this.generateUniqueIdBase(el); 26 | for (var i = 0; ; i++) { 27 | var anchor = anchorBase; 28 | if (i > 0) { 29 | // add suffix 30 | anchor += '-' + i; 31 | } 32 | // check if ID already exists 33 | if (!document.getElementById(anchor)) { 34 | return anchor; 35 | } 36 | } 37 | }, 38 | 39 | generateAnchor: function(el) { 40 | if (el.id) { 41 | return el.id; 42 | } else { 43 | var anchor = this.generateUniqueId(el); 44 | el.id = anchor; 45 | return anchor; 46 | } 47 | }, 48 | 49 | createNavList: function() { 50 | return $(''); 51 | }, 52 | 53 | createChildNavList: function($parent) { 54 | var $childList = this.createNavList(); 55 | $parent.append($childList); 56 | return $childList; 57 | }, 58 | 59 | generateNavEl: function(anchor, text) { 60 | var $a = $(''); 61 | $a.attr('href', '#' + anchor); 62 | $a.text(text); 63 | var $li = $('
  • '); 64 | $li.append($a); 65 | return $li; 66 | }, 67 | 68 | generateNavItem: function(headingEl) { 69 | var anchor = this.generateAnchor(headingEl); 70 | var $heading = $(headingEl); 71 | var text = $heading.data('toc-text') || $heading.text(); 72 | return this.generateNavEl(anchor, text); 73 | }, 74 | 75 | // Find the first heading level (`

    `, then `

    `, etc.) that has more than one element. Defaults to 1 (for `

    `). 76 | getTopLevel: function($scope) { 77 | for (var i = 1; i <= 6; i++) { 78 | var $headings = this.findOrFilter($scope, 'h' + i); 79 | if ($headings.length > 1) { 80 | return i; 81 | } 82 | } 83 | 84 | return 1; 85 | }, 86 | 87 | // returns the elements for the top level, and the next below it 88 | getHeadings: function($scope, topLevel) { 89 | var topSelector = 'h' + topLevel; 90 | 91 | var secondaryLevel = topLevel + 1; 92 | var secondarySelector = 'h' + secondaryLevel; 93 | 94 | return this.findOrFilter($scope, topSelector + ',' + secondarySelector); 95 | }, 96 | 97 | getNavLevel: function(el) { 98 | return parseInt(el.tagName.charAt(1), 10); 99 | }, 100 | 101 | populateNav: function($topContext, topLevel, $headings) { 102 | var $context = $topContext; 103 | var $prevNav; 104 | 105 | var helpers = this; 106 | $headings.each(function(i, el) { 107 | var $newNav = helpers.generateNavItem(el); 108 | var navLevel = helpers.getNavLevel(el); 109 | 110 | // determine the proper $context 111 | if (navLevel === topLevel) { 112 | // use top level 113 | $context = $topContext; 114 | } else if ($prevNav && $context === $topContext) { 115 | // create a new level of the tree and switch to it 116 | $context = helpers.createChildNavList($prevNav); 117 | } // else use the current $context 118 | 119 | $context.append($newNav); 120 | 121 | $prevNav = $newNav; 122 | }); 123 | }, 124 | 125 | parseOps: function(arg) { 126 | var opts; 127 | if (arg.jquery) { 128 | opts = { 129 | $nav: arg 130 | }; 131 | } else { 132 | opts = arg; 133 | } 134 | opts.$scope = opts.$scope || $(document.body); 135 | return opts; 136 | } 137 | }, 138 | 139 | // accepts a jQuery object, or an options object 140 | init: function(opts) { 141 | opts = this.helpers.parseOps(opts); 142 | 143 | // ensure that the data attribute is in place for styling 144 | opts.$nav.attr('data-toggle', 'toc'); 145 | 146 | var $topContext = this.helpers.createChildNavList(opts.$nav); 147 | var topLevel = this.helpers.getTopLevel(opts.$scope); 148 | var $headings = this.helpers.getHeadings(opts.$scope, topLevel); 149 | this.helpers.populateNav($topContext, topLevel, $headings); 150 | } 151 | }; 152 | 153 | $(function() { 154 | $('nav[data-toggle="toc"]').each(function(i, el) { 155 | var $nav = $(el); 156 | Toc.init($nav); 157 | }); 158 | }); 159 | })(); 160 | -------------------------------------------------------------------------------- /docs/LICENSE-text.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | License • projections 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 55 | 56 | 57 | 58 | 59 | 60 | 61 |
    62 |
    63 | 105 | 106 | 107 | 108 |
    109 | 110 |
    111 |
    112 |
    113 |

    License

    114 |
    115 | 116 | 
    YEAR: 2017
117 | COPYRIGHT HOLDER: Thibaut Jombart
118 |
    119 | 120 |
    121 | 122 | 127 | 128 |
    129 | 130 | 131 | 132 |
    133 |
    134 |

    Developed by Thibaut Jombart, Pierre Nouvellet.

    135 |
    136 | 137 |
    138 |

    Site built with pkgdown 1.5.1.

    139 |
    140 | 141 |
    142 |
    143 | 144 | 145 | 146 | 147 | 148 | 149 | 150 | 151 | -------------------------------------------------------------------------------- /docs/404.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Page not found (404) • projections 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 55 | 56 | 57 | 58 | 59 | 60 | 61 |
    62 |
    63 | 105 | 106 | 107 | 108 |
    109 | 110 |
    111 |
    112 |
    113 |

    Page not found (404)

    114 |
    115 | 116 | Content not found. Please use links in the navbar. 117 | 118 |
    119 | 120 | 125 | 126 |
    127 | 128 | 129 | 130 |
    131 |
    132 |

    Developed by Thibaut Jombart, Pierre Nouvellet.

    133 |
    134 | 135 |
    136 |

    Site built with pkgdown 1.5.1.

    137 |
    138 | 139 |
    140 |
    141 | 142 | 143 | 144 | 145 | 146 | 147 | 148 | 149 | -------------------------------------------------------------------------------- /docs/authors.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Authors • projections 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 55 | 56 | 57 | 58 | 59 | 60 | 61 |
    62 |
    63 | 105 | 106 | 107 | 108 |
    109 | 110 |
    111 |
    112 |
    113 |

    Authors

    114 |
    115 | 116 |
      117 |
    • 118 |

      Thibaut Jombart. Author, maintainer. 119 |

      120 |
      • 121 |
    • 122 |

      Pierre Nouvellet. Author. 123 |

      124 |
      • 125 |
    • 126 |

      Sangeeta Bhatia. Contributor. 127 |

      128 |
      • 129 |
    • 130 |

      Zhian N. Kamvar. Contributor. 131 |

      132 |
      • 133 |
    • 134 |

      Tim Taylor. Contributor. 135 |

      136 |
      • 137 |
    • 138 |

      Stephane Ghozzi. Contributor. 139 |

      140 |
      • 141 |
    142 | 143 |
    144 | 145 |
    146 | 147 | 148 | 149 |
    150 |
    151 |

    Developed by Thibaut Jombart, Pierre Nouvellet.

    152 |
    153 | 154 |
    155 |

    Site built with pkgdown 1.5.1.

    156 |
    157 | 158 |
    159 |
    160 | 161 | 162 | 163 | 164 | 165 | 166 | 167 | 168 | -------------------------------------------------------------------------------- /man/project.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/project.R 3 | \name{project} 4 | \alias{project} 5 | \title{Project future incidence} 6 | \usage{ 7 | project( 8 | x, 9 | R, 10 | si, 11 | n_sim = 100, 12 | n_days = 7, 13 | R_fix_within = FALSE, 14 | model = c("poisson", "negbin"), 15 | size = 0.03, 16 | time_change = NULL, 17 | instantaneous_R = FALSE 18 | ) 19 | } 20 | \arguments{ 21 | \item{x}{An \code{incidence} object containing daily incidence; other time 22 | intervals will trigger an error.} 23 | 24 | \item{R}{A vector of numbers representing plausible reproduction numbers; for 25 | instance, these can be samples from a posterior distribution using the 26 | \code{earlyR} or \code{EpiEstim} packages. If \code{time_change} is provided, then it must 27 | be a \code{vector} (for fixed values of R per time window) or a \code{list} of 28 | vectors (for separate distributions of R per time window), with one element 29 | more than the number of dates in \code{time_change}.} 30 | 31 | \item{si}{A function computing the serial interval, or a \code{numeric} vector 32 | providing its mass function, starting a day 1, so that \code{si[i]} is the PMF 33 | for serial interval of \code{i}. The model implicitly assumes that \code{si[0] = 0}. 34 | For functions, we strongly recommend using the RECON package 35 | \code{distcrete} to obtain such distribution (see example).} 36 | 37 | \item{n_sim}{The number of epicurves to simulate. Defaults to 100.} 38 | 39 | \item{n_days}{The number of days to run simulations for. Defaults to 14.} 40 | 41 | \item{R_fix_within}{A logical indicating if R should be fixed within 42 | simulations (but still varying across simulations). If \code{FALSE}, R is 43 | drawn for every simulation and every time step. Fixing values within 44 | simulations favours more extreme predictions (see details)} 45 | 46 | \item{model}{Distribution to be used for projections. Must be one of 47 | "poisson" or "negbin" (negative binomial process). Defaults to poisson} 48 | 49 | \item{size}{size parameter of negative binomial distribition. Ignored if 50 | model is poisson} 51 | 52 | \item{time_change}{an optional vector of times at which the simulations 53 | should use a different sample of reproduction numbers, provided in days 54 | into the simulation (so that day '1' is the first day after the input 55 | \code{incidence} object); if provided, \code{n} dates in \code{time_change} will produce 56 | \code{n+1} time windows, in which case \code{R} should be a list of vectors of \code{n+1} 57 | \code{R} values, one per each time window.} 58 | 59 | \item{instantaneous_R}{a boolean specifying whether to assume \code{R} is the case 60 | reproduction number (\code{instantaneous_R = FALSE}, the default), or the 61 | instantaneous reproduction number (\code{instantaneous_R = TRUE}). 62 | If \code{instantaneous_R = FALSE} then values of \code{R} at time \code{t} will govern the 63 | mean number of secondary cases of all cases infected at time \code{t}, 64 | even if those secondary cases appear after \code{t}. In other words, \code{R} 65 | will characterise onwards transmission from infectors depending on their 66 | date of infection. 67 | If \code{instantaneous_R = TRUE} then values of \code{R} at time \code{t} will govern the 68 | mean number of secondary cases made at time \code{t} by all cases infected 69 | before \code{t}. In other words, \code{R} will characterise onwards transmission at 70 | a given time.} 71 | } 72 | \description{ 73 | This function simulates future incidence based on past incidence data, a 74 | selection of plausible reproduction numbers (R), and the distribution of the 75 | serial interval (time from primary onset to secondary onset). 76 | } 77 | \details{ 78 | The decision to fix R values within simulations 79 | (\code{R_fix_within}) reflects two alternative views of the uncertainty 80 | associated with R. When drawing R values at random from the provided 81 | sample, (\code{R_fix_within} set to \code{FALSE}), it is assumed that R 82 | varies naturally, and can be treated as a random variable with a given 83 | distribution. When fixing values within simulations (\code{R_fix_within} 84 | set to \code{TRUE}), R is treated as a fixed parameter, and the uncertainty 85 | is merely a consequence of the estimation of R. In other words, the first 86 | view is rather Bayesian, while the second is more frequentist. 87 | } 88 | \examples{ 89 | 90 | ## example using simulated Ebola outbreak 91 | if (require(outbreaks) && 92 | require(distcrete) && 93 | require(incidence) && 94 | require(magrittr)) { 95 | 96 | si <- distcrete("gamma", interval = 1L, 97 | shape = 2.4, 98 | scale = 4.7, 99 | w = 0.5) 100 | 101 | i <- incidence(ebola_sim$linelist$date_of_onset) 102 | plot(i) 103 | 104 | 105 | ## projections after the first 100 days, over 60 days, fixed R to 2.1 106 | 107 | set.seed(1) 108 | proj_1 <- project(x = i[1:100], R = 2.1, si = si, n_days = 60) 109 | plot(proj_1) 110 | 111 | ## add projections to incidence plot 112 | plot(i[1:160]) \%>\% add_projections(proj_1) 113 | 114 | 115 | ## projections after the first 100 days, over 60 days, 116 | ## using a sample of R 117 | 118 | set.seed(1) 119 | R <- rnorm(100, 1.8, 0.2) 120 | hist(R, col = "grey", border = "white", main = "Distribution of R") 121 | proj_2 <- project(x = i[1:100], R = R, si = si, n_days = 60) 122 | 123 | ## add projections to incidence plot 124 | plot(i[1:160]) \%>\% add_projections(proj_2) 125 | 126 | 127 | ## same with R constant per simulation (more variability) 128 | 129 | set.seed(1) 130 | proj_3 <- project(x = i[1:100], R = R, si = si, n_days = 60, 131 | R_fix_within = TRUE) 132 | 133 | ## add projections to incidence plot 134 | plot(i[1:160]) \%>\% add_projections(proj_3) 135 | 136 | 137 | ## time-varying R, 2 periods, R is 2.1 then 0.5 138 | set.seed(1) 139 | proj_4 <- project(i, 140 | R = c(2.1, 0.5), 141 | si = si, 142 | n_days = 60, 143 | time_change = 40, 144 | n_sim = 100) 145 | plot(proj_4) 146 | 147 | 148 | ## time-varying R, 2 periods, separate distributions of R for each period 149 | set.seed(1) 150 | R_period_1 <- runif(100, min = 1.1, max = 3) 151 | R_period_2 <- runif(100, min = 0.6, max = .9) 152 | 153 | proj_5 <- project(i, 154 | R = list(R_period_1, R_period_2), 155 | si = si, 156 | n_days = 60, 157 | time_change = 20, 158 | n_sim = 100) 159 | plot(proj_5) 160 | 161 | } 162 | 163 | } 164 | \author{ 165 | Pierre Nouvellet (original model), Thibaut Jombart (bulk of the 166 | code), Sangeeta Bhatia (Negative Binomial model), Stephane Ghozzi (bug fixes 167 | time varying R) 168 | } 169 | -------------------------------------------------------------------------------- /docs/reference/print.projections.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Print method for projections objects — print.projections • projections 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 56 | 57 | 58 | 59 | 60 | 61 | 62 |
    63 |
    64 | 106 | 107 | 108 | 109 |
    110 | 111 |
    112 |
    113 |
    114 |

    Print method for projections objects

    115 | Source: R/print.projections.R 116 | 117 |
    118 | 119 |
    120 |

    This method prints the content of projections objects.

    121 |
    122 | 123 | 
    # S3 method for projections
124 | print(x, ...)
    125 | 126 |

    Arguments

    127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 137 | 138 |
    x

    A projections object.

    ...

    further parameters to be passed to other methods (currently not 136 | used)

    139 | 140 | 141 |
    142 | 147 |
    148 | 149 | 150 |
    151 |
    152 |

    Developed by Thibaut Jombart, Pierre Nouvellet.

    153 |
    154 | 155 |
    156 |

    Site built with pkgdown 1.5.1.

    157 |
    158 | 159 |
    160 |
    161 | 162 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | -------------------------------------------------------------------------------- /docs/CONDUCT.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Contributor Code of Conduct • projections 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 55 | 56 | 57 | 58 | 59 | 60 | 61 |
    62 |
    63 | 105 | 106 | 107 | 108 |
    109 | 110 |
    111 |
    112 |
    113 |

    Contributor Code of Conduct

    114 |
    115 | 116 |
    117 | 118 |

    As contributors and maintainers of this project, we pledge to respect all people who contribute through reporting issues, posting feature requests, updating documentation, submitting pull requests or patches, and other activities.

    119 |

    We are committed to making participation in this project a harassment-free experience for everyone, regardless of level of experience, gender, gender identity and expression, sexual orientation, disability, personal appearance, body size, race, ethnicity, age, or religion.

    120 |

    Examples of unacceptable behavior by participants include the use of sexual language or imagery, derogatory comments or personal attacks, trolling, public or private harassment, insults, or other unprofessional conduct.

    121 |

    Project maintainers have the right and responsibility to remove, edit, or reject comments, commits, code, wiki edits, issues, and other contributions that are not aligned to this Code of Conduct. Project maintainers who do not follow the Code of Conduct may be removed from the project team.

    122 |

    Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by opening an issue or contacting one or more of the project maintainers.

    123 |

    This Code of Conduct is adapted from the Contributor Covenant (http:contributor-covenant.org), version 1.0.0, available at http://contributor-covenant.org/version/1/0/0/

    124 |
    125 | 126 |
    127 | 128 | 133 | 134 |
    135 | 136 | 137 | 138 |
    139 |
    140 |

    Developed by Thibaut Jombart, Pierre Nouvellet.

    141 |
    142 | 143 |
    144 |

    Site built with pkgdown 1.5.1.

    145 |
    146 | 147 |
    148 |
    149 | 150 | 151 | 152 | 153 | 154 | 155 | 156 | 157 | -------------------------------------------------------------------------------- /docs/reference/conversions.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Conversion of projections objects — as.matrix.projections • projections 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 56 | 57 | 58 | 59 | 60 | 61 | 62 |
    63 |
    64 | 106 | 107 | 108 | 109 |
    110 | 111 |
    112 |
    113 |
    114 |

    Conversion of projections objects

    115 | Source: R/conversion.R 116 | 117 |
    118 | 119 |
    120 |

    These functions convert projections objects into other classes.

    121 |
    122 | 123 | 
    # S3 method for projections
124 | as.matrix(x, ...)
125 | 
126 | # S3 method for projections
127 | as.data.frame(x, ..., long = FALSE)
    128 | 129 |

    Arguments

    130 | 131 | 132 | 133 | 134 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 146 | 147 |
    x

    An projections object, or an object to be converted as 135 | projections (see details).

    ...

    Further arguments passed to other functions (no used).

    long

    A logical indicating if the output data.frame should be 'long', 144 | i.e. where a single column containing 'groups' is added in case of data 145 | computed on several groups.

    148 | 149 |

    See also

    150 | 151 |

    the project function to generate the 'projections' objects.

    152 | 153 |
    154 | 159 |
    160 | 161 | 162 |
    163 |
    164 |

    Developed by Thibaut Jombart, Pierre Nouvellet.

    165 |
    166 | 167 |
    168 |

    Site built with pkgdown 1.5.1.

    169 |
    170 | 171 |
    172 |
    173 | 174 | 175 | 176 | 177 | 178 | 179 | 180 | 181 | -------------------------------------------------------------------------------- /docs/reference/build_projections.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Constructor for projections objects — build_projections • projections 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 57 | 58 | 59 | 60 | 61 | 62 | 63 |
    64 |
    65 | 107 | 108 | 109 | 110 |
    111 | 112 |
    113 |
    114 |
    115 |

    Constructor for projections objects

    116 | Source: R/build_projections.R 117 | 118 |
    119 | 120 |
    121 |

    This function builds a valid projections object from some input 122 | simulations and dates.

    123 |
    124 | 125 | 
    build_projections(x, dates = NULL, cumulative = FALSE, order_dates = TRUE)
    126 | 127 |

    Arguments

    128 | 129 | 130 | 131 | 132 | 134 | 135 | 136 | 137 | 141 | 142 | 143 | 144 | 146 | 147 | 148 | 149 | 151 | 152 |
    x

    A matrix of simulated incidence stored as integers, where 133 | rows correspond to dates and columns to simulations.

    dates

    A vector of dates containing one value per row in x; 138 | acceptable formats are: integer, Date, and POSIXct; if 139 | NULL, the time steps will be counted, with the first dates corresponding to 140 | 0.

    cumulative

    A logical indicating if data represent cumulative 145 | incidence; defaults to FALSE.

    order_dates

    A logical indicating whether the dates should be ordered, 150 | from the oldest to the most recent one; `TRUE` by default.

    153 | 154 |

    See also

    155 | 156 |

    the project function to generate the 'projections' 157 | objects.

    158 | 159 |
    160 | 165 |
    166 | 167 | 168 |
    169 |
    170 |

    Developed by Thibaut Jombart, Pierre Nouvellet.

    171 |
    172 | 173 |
    174 |

    Site built with pkgdown 1.5.1.

    175 |
    176 | 177 |
    178 |
    179 | 180 | 181 | 182 | 183 | 184 | 185 | 186 | 187 | -------------------------------------------------------------------------------- /docs/reference/subset.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Subsetting 'projections' objects — [.projections • projections 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 58 | 59 | 60 | 61 | 62 | 63 | 64 |
    65 |
    66 | 108 | 109 | 110 | 111 |
    112 | 113 |
    114 |
    115 |
    116 |

    Subsetting 'projections' objects

    117 | Source: R/subset.R 118 | 119 |
    120 | 121 |
    122 |

    Two functions can be used to subset projections objects. The operator "[" can 123 | be used as for matrices, using the syntax x[i,j] where 'i' is a subset 124 | of dates, and 'j' is a subset of simulations.

    125 |
    126 | 127 | 
    # S3 method for projections
128 | [(x, i, j)
129 | 
130 | # S3 method for projections
131 | subset(x, ..., from = NULL, to = NULL, sim = TRUE)
    132 | 133 |

    Arguments

    134 | 135 | 136 | 137 | 138 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | 148 | 149 | 150 | 151 | 152 | 153 | 154 | 155 | 156 | 157 | 158 | 159 | 160 | 161 | 162 | 163 | 165 | 166 |
    x

    An projections object, generated by the function 139 | project.

    i

    a subset of dates to retain

    j

    a subset of groups to retain

    ...

    Further arguments passed to other methods (not used).

    from

    The starting date; data strictly before this date are discarded.

    to

    The ending date; data strictly after this date are discarded.

    sim

    (optional) The simulations to retained, indicated as subsets of 164 | the columns of x.

    167 | 168 |

    See also

    169 | 170 |

    The project function to generate the 'projections' 171 | objects.

    172 | 173 |
    174 | 179 |
    180 | 181 | 182 |
    183 |
    184 |

    Developed by Thibaut Jombart, Pierre Nouvellet.

    185 |
    186 | 187 |
    188 |

    Site built with pkgdown 1.5.1.

    189 |
    190 | 191 |
    192 |
    193 | 194 | 195 | 196 | 197 | 198 | 199 | 200 | 201 | -------------------------------------------------------------------------------- /docs/pkgdown.css: -------------------------------------------------------------------------------- 1 | /* Sticky footer */ 2 | 3 | /** 4 | * Basic idea: https://philipwalton.github.io/solved-by-flexbox/demos/sticky-footer/ 5 | * Details: https://github.com/philipwalton/solved-by-flexbox/blob/master/assets/css/components/site.css 6 | * 7 | * .Site -> body > .container 8 | * .Site-content -> body > .container .row 9 | * .footer -> footer 10 | * 11 | * Key idea seems to be to ensure that .container and __all its parents__ 12 | * have height set to 100% 13 | * 14 | */ 15 | 16 | html, body { 17 | height: 100%; 18 | } 19 | 20 | body { 21 | position: relative; 22 | } 23 | 24 | body > .container { 25 | display: flex; 26 | height: 100%; 27 | flex-direction: column; 28 | } 29 | 30 | body > .container .row { 31 | flex: 1 0 auto; 32 | } 33 | 34 | footer { 35 | margin-top: 45px; 36 | padding: 35px 0 36px; 37 | border-top: 1px solid #e5e5e5; 38 | color: #666; 39 | display: flex; 40 | flex-shrink: 0; 41 | } 42 | footer p { 43 | margin-bottom: 0; 44 | } 45 | footer div { 46 | flex: 1; 47 | } 48 | footer .pkgdown { 49 | text-align: right; 50 | } 51 | footer p { 52 | margin-bottom: 0; 53 | } 54 | 55 | img.icon { 56 | float: right; 57 | } 58 | 59 | img { 60 | max-width: 100%; 61 | } 62 | 63 | /* Fix bug in bootstrap (only seen in firefox) */ 64 | summary { 65 | display: list-item; 66 | } 67 | 68 | /* Typographic tweaking ---------------------------------*/ 69 | 70 | .contents .page-header { 71 | margin-top: calc(-60px + 1em); 72 | } 73 | 74 | dd { 75 | margin-left: 3em; 76 | } 77 | 78 | /* Section anchors ---------------------------------*/ 79 | 80 | a.anchor { 81 | margin-left: -30px; 82 | display:inline-block; 83 | width: 30px; 84 | height: 30px; 85 | visibility: hidden; 86 | 87 | background-image: url(./link.svg); 88 | background-repeat: no-repeat; 89 | background-size: 20px 20px; 90 | background-position: center center; 91 | } 92 | 93 | .hasAnchor:hover a.anchor { 94 | visibility: visible; 95 | } 96 | 97 | @media (max-width: 767px) { 98 | .hasAnchor:hover a.anchor { 99 | visibility: hidden; 100 | } 101 | } 102 | 103 | 104 | /* Fixes for fixed navbar --------------------------*/ 105 | 106 | .contents h1, .contents h2, .contents h3, .contents h4 { 107 | padding-top: 60px; 108 | margin-top: -40px; 109 | } 110 | 111 | /* Navbar submenu --------------------------*/ 112 | 113 | .dropdown-submenu { 114 | position: relative; 115 | } 116 | 117 | .dropdown-submenu>.dropdown-menu { 118 | top: 0; 119 | left: 100%; 120 | margin-top: -6px; 121 | margin-left: -1px; 122 | border-radius: 0 6px 6px 6px; 123 | } 124 | 125 | .dropdown-submenu:hover>.dropdown-menu { 126 | display: block; 127 | } 128 | 129 | .dropdown-submenu>a:after { 130 | display: block; 131 | content: " "; 132 | float: right; 133 | width: 0; 134 | height: 0; 135 | border-color: transparent; 136 | border-style: solid; 137 | border-width: 5px 0 5px 5px; 138 | border-left-color: #cccccc; 139 | margin-top: 5px; 140 | margin-right: -10px; 141 | } 142 | 143 | .dropdown-submenu:hover>a:after { 144 | border-left-color: #ffffff; 145 | } 146 | 147 | .dropdown-submenu.pull-left { 148 | float: none; 149 | } 150 | 151 | .dropdown-submenu.pull-left>.dropdown-menu { 152 | left: -100%; 153 | margin-left: 10px; 154 | border-radius: 6px 0 6px 6px; 155 | } 156 | 157 | /* Sidebar --------------------------*/ 158 | 159 | #pkgdown-sidebar { 160 | margin-top: 30px; 161 | position: -webkit-sticky; 162 | position: sticky; 163 | top: 70px; 164 | } 165 | 166 | #pkgdown-sidebar h2 { 167 | font-size: 1.5em; 168 | margin-top: 1em; 169 | } 170 | 171 | #pkgdown-sidebar h2:first-child { 172 | margin-top: 0; 173 | } 174 | 175 | #pkgdown-sidebar .list-unstyled li { 176 | margin-bottom: 0.5em; 177 | } 178 | 179 | /* bootstrap-toc tweaks ------------------------------------------------------*/ 180 | 181 | /* All levels of nav */ 182 | 183 | nav[data-toggle='toc'] .nav > li > a { 184 | padding: 4px 20px 4px 6px; 185 | font-size: 1.5rem; 186 | font-weight: 400; 187 | color: inherit; 188 | } 189 | 190 | nav[data-toggle='toc'] .nav > li > a:hover, 191 | nav[data-toggle='toc'] .nav > li > a:focus { 192 | padding-left: 5px; 193 | color: inherit; 194 | border-left: 1px solid #878787; 195 | } 196 | 197 | nav[data-toggle='toc'] .nav > .active > a, 198 | nav[data-toggle='toc'] .nav > .active:hover > a, 199 | nav[data-toggle='toc'] .nav > .active:focus > a { 200 | padding-left: 5px; 201 | font-size: 1.5rem; 202 | font-weight: 400; 203 | color: inherit; 204 | border-left: 2px solid #878787; 205 | } 206 | 207 | /* Nav: second level (shown on .active) */ 208 | 209 | nav[data-toggle='toc'] .nav .nav { 210 | display: none; /* Hide by default, but at >768px, show it */ 211 | padding-bottom: 10px; 212 | } 213 | 214 | nav[data-toggle='toc'] .nav .nav > li > a { 215 | padding-left: 16px; 216 | font-size: 1.35rem; 217 | } 218 | 219 | nav[data-toggle='toc'] .nav .nav > li > a:hover, 220 | nav[data-toggle='toc'] .nav .nav > li > a:focus { 221 | padding-left: 15px; 222 | } 223 | 224 | nav[data-toggle='toc'] .nav .nav > .active > a, 225 | nav[data-toggle='toc'] .nav .nav > .active:hover > a, 226 | nav[data-toggle='toc'] .nav .nav > .active:focus > a { 227 | padding-left: 15px; 228 | font-weight: 500; 229 | font-size: 1.35rem; 230 | } 231 | 232 | /* orcid ------------------------------------------------------------------- */ 233 | 234 | .orcid { 235 | font-size: 16px; 236 | color: #A6CE39; 237 | /* margins are required by official ORCID trademark and display guidelines */ 238 | margin-left:4px; 239 | margin-right:4px; 240 | vertical-align: middle; 241 | } 242 | 243 | /* Reference index & topics ----------------------------------------------- */ 244 | 245 | .ref-index th {font-weight: normal;} 246 | 247 | .ref-index td {vertical-align: top;} 248 | .ref-index .icon {width: 40px;} 249 | .ref-index .alias {width: 40%;} 250 | .ref-index-icons .alias {width: calc(40% - 40px);} 251 | .ref-index .title {width: 60%;} 252 | 253 | .ref-arguments th {text-align: right; padding-right: 10px;} 254 | .ref-arguments th, .ref-arguments td {vertical-align: top;} 255 | .ref-arguments .name {width: 20%;} 256 | .ref-arguments .desc {width: 80%;} 257 | 258 | /* Nice scrolling for wide elements --------------------------------------- */ 259 | 260 | table { 261 | display: block; 262 | overflow: auto; 263 | } 264 | 265 | /* Syntax highlighting ---------------------------------------------------- */ 266 | 267 | pre { 268 | word-wrap: normal; 269 | word-break: normal; 270 | border: 1px solid #eee; 271 | } 272 | 273 | pre, code { 274 | background-color: #f8f8f8; 275 | color: #333; 276 | } 277 | 278 | pre code { 279 | overflow: auto; 280 | word-wrap: normal; 281 | white-space: pre; 282 | } 283 | 284 | pre .img { 285 | margin: 5px 0; 286 | } 287 | 288 | pre .img img { 289 | background-color: #fff; 290 | display: block; 291 | height: auto; 292 | } 293 | 294 | code a, pre a { 295 | color: #375f84; 296 | } 297 | 298 | a.sourceLine:hover { 299 | text-decoration: none; 300 | } 301 | 302 | .fl {color: #1514b5;} 303 | .fu {color: #000000;} /* function */ 304 | .ch,.st {color: #036a07;} /* string */ 305 | .kw {color: #264D66;} /* keyword */ 306 | .co {color: #888888;} /* comment */ 307 | 308 | .message { color: black; font-weight: bolder;} 309 | .error { color: orange; font-weight: bolder;} 310 | .warning { color: #6A0366; font-weight: bolder;} 311 | 312 | /* Clipboard --------------------------*/ 313 | 314 | .hasCopyButton { 315 | position: relative; 316 | } 317 | 318 | .btn-copy-ex { 319 | position: absolute; 320 | right: 0; 321 | top: 0; 322 | visibility: hidden; 323 | } 324 | 325 | .hasCopyButton:hover button.btn-copy-ex { 326 | visibility: visible; 327 | } 328 | 329 | /* headroom.js ------------------------ */ 330 | 331 | .headroom { 332 | will-change: transform; 333 | transition: transform 200ms linear; 334 | } 335 | .headroom--pinned { 336 | transform: translateY(0%); 337 | } 338 | .headroom--unpinned { 339 | transform: translateY(-100%); 340 | } 341 | 342 | /* mark.js ----------------------------*/ 343 | 344 | mark { 345 | background-color: rgba(255, 255, 51, 0.5); 346 | border-bottom: 2px solid rgba(255, 153, 51, 0.3); 347 | padding: 1px; 348 | } 349 | 350 | /* vertical spacing after htmlwidgets */ 351 | .html-widget { 352 | margin-bottom: 10px; 353 | } 354 | 355 | /* fontawesome ------------------------ */ 356 | 357 | .fab { 358 | font-family: "Font Awesome 5 Brands" !important; 359 | } 360 | 361 | /* don't display links in code chunks when printing */ 362 | /* source: https://stackoverflow.com/a/10781533 */ 363 | @media print { 364 | code a:link:after, code a:visited:after { 365 | content: ""; 366 | } 367 | } 368 | -------------------------------------------------------------------------------- /docs/reference/summary.projections.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Summary for projections objects — summary.projections • projections 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 58 | 59 | 60 | 61 | 62 | 63 | 64 |
    65 |
    66 | 108 | 109 | 110 | 111 |
    112 | 113 |
    114 |
    115 |
    116 |

    Summary for projections objects

    117 | Source: R/summary.R 118 | 119 |
    120 | 121 |
    122 |

    This method summarises predicted epidemic trajectories contained in a 123 | `projections` object by days, deriving the mean, standard deviation, and 124 | user-specified quantiles for each day.

    125 |
    126 | 127 | 
    # S3 method for projections
128 | summary(
129 |   object,
130 |   quantiles = c(0.025, 0.25, 0.5, 0.75, 0.975),
131 |   mean = TRUE,
132 |   sd = TRUE,
133 |   min = TRUE,
134 |   max = TRUE,
135 |   ...
136 | )
    137 | 138 |

    Arguments

    139 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | 149 | 150 | 151 | 152 | 153 | 154 | 155 | 156 | 157 | 158 | 159 | 160 | 161 | 162 | 163 | 164 | 165 | 166 | 167 | 168 | 181 | 182 |
    object

    A `projections` object to summarise

    quantiles

    A `numeric` vector indicating which quantiles should be 148 | computed; ignored if `FALSE` or of length 0

    mean

    a `logical` indicating of the mean should be computed

    sd

    a `logical` indicating of the standard deviation should be computed

    min

    a `logical` indicating of the minimum should be computed

    max

    a `logical` indicating of the maximum should be computed

    ...

    only preesnt for compatibility with the generic

    169 |

    if (require(incidence)) 170 | i <- incidence::incidence(as.Date('2020-01-23')) 171 | si <- c(0.2, 0.5, 0.2, 0.1) 172 | R0 <- 2 p <- project(x = i, 173 | si = si, 174 | R = R0, 175 | n_sim = 2, 176 | R_fix_within = TRUE, 177 | n_days = 10, 178 | model = "poisson" 179 | ) 180 | summary(p)

    183 | 184 | 185 |
    186 | 191 |
    192 | 193 | 194 |
    195 |
    196 |

    Developed by Thibaut Jombart, Pierre Nouvellet.

    197 |
    198 | 199 |
    200 |

    Site built with pkgdown 1.5.1.

    201 |
    202 | 203 |
    204 |
    205 | 206 | 207 | 208 | 209 | 210 | 211 | 212 | 213 | -------------------------------------------------------------------------------- /docs/reference/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Function reference • projections 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 55 | 56 | 57 | 58 | 59 | 60 | 61 |
    62 |
    63 | 105 | 106 | 107 | 108 |
    109 | 110 |
    111 |
    112 |
    113 |

    Reference

    114 |
    115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 141 | 142 | 143 | 144 | 147 | 148 | 149 | 150 | 153 | 154 | 155 | 156 | 159 | 160 | 161 | 162 | 165 | 166 | 167 | 168 | 171 | 172 | 173 | 174 | 177 | 178 | 179 | 180 | 183 | 184 | 185 | 186 | 189 | 190 | 191 | 192 | 195 | 196 | 197 | 198 | 201 | 202 | 203 | 204 |
    127 |

    All functions

    128 |

    129 |
    139 |

    build_projections()

    140 |

    Constructor for projections objects

    145 |

    as.matrix(<projections>) as.data.frame(<projections>)

    146 |

    Conversion of projections objects

    151 |

    cumulate(<projections>)

    152 |

    Compute cumulative projections

    157 |

    merge_add_projections() `+`(<projections>)

    158 |

    Add data of different projections objects

    163 |

    merge_projections()

    164 |

    Merge a list of projections objects

    169 |

    plot(<projections>) add_projections()

    170 |

    Plot projections objects

    175 |

    print(<projections>)

    176 |

    Print method for projections objects

    181 |

    project()

    182 |

    Project future incidence

    187 |

    get_dates(<projections>)

    188 |

    Access content projections objects

    193 |

    `[`(<projections>) subset(<projections>)

    194 |

    Subsetting 'projections' objects

    199 |

    summary(<projections>)

    200 |

    Summary for projections objects

    205 |
    206 | 207 | 212 |
    213 | 214 | 215 |
    216 |
    217 |

    Developed by Thibaut Jombart, Pierre Nouvellet.

    218 |
    219 | 220 |
    221 |

    Site built with pkgdown 1.5.1.

    222 |
    223 | 224 |
    225 |
    226 | 227 | 228 | 229 | 230 | 231 | 232 | 233 | 234 | -------------------------------------------------------------------------------- /R/plot.projections.R: -------------------------------------------------------------------------------- 1 | #' Plot projections objects 2 | #' 3 | #' The \code{plot} method of \code{projections} objects (output by the function 4 | #' \code{\link{project}}) shows quantiles of predicted incidence over time. The 5 | #' function \code{add_projections} can be used to add a similar plot to an 6 | #' existing \code{incidence} plot. This latter function is piping friendly (see 7 | #' examples). 8 | #' 9 | #' @seealso \code{\link{project}} to generate projections 10 | #' 11 | #' @author Thibaut Jombart \email{thibautjombart@@gmail.com} 12 | #' 13 | #' @export 14 | #' @importFrom graphics plot 15 | #' 16 | #' @aliases plot.projections 17 | #' 18 | #' @param x A \code{projections} object. 19 | #' 20 | #' @param ylab An optional label for the y-axis. If missing will default to 21 | #' "predicted incidence" or, if cumulative, "predicted cumulative incidence" 22 | #' 23 | #' @param title An optional title. 24 | #' 25 | #' @param quantiles A vector of quantiles to plot, automatically completed to be 26 | #' symmetric around the median. 27 | #' 28 | #' @param palette A color palette to be used for plotting the quantile lines; 29 | #' defaults to \code{quantile_pal}. 30 | #' 31 | #' @param ribbon A logical indicating if a ribbon should be drawn; defaults to 32 | #' \code{TRUE}. 33 | #' 34 | #' @param ribbon_color Any valid color, used for the ribbon. 35 | #' 36 | #' @param ribbon_alpha A number used to control the transparency of the 37 | #' ribbon, from 0 (full transparency) to 1 (full opacity); defaults to 0.3. 38 | #' 39 | #' @param ribbon_quantiles A vector of 2 quantiles to be used to determine the 40 | #' limits of the ribbon; if NULL (default); uses the most extreme quantiles if 41 | #' available; if quantiles are not provided, the daily range will be used. 42 | #' 43 | #' @param boxplots A logical indicating if boxplots should be drawn. 44 | #' 45 | #' @param linetype An integer indicating the type of line used for plotting the 46 | #' quantiles; defaults to 1 for a plain line. 47 | #' 48 | #' @param linesize An integer indicating the size of line used for plotting the 49 | #' quantiles; defaults to 0.5. 50 | #' 51 | #' @param boxplots_color Any valid color, used for the boxplot. 52 | #' 53 | #' @param boxplots_fill Any valid color, used for filling the boxplot. 54 | #' 55 | #' @param boxplots_alpha A number used to control the transparency of the 56 | #' boxplots, from 0 (full transparency) to 1 (full opacity); defaults to 0.8. 57 | #' 58 | #' @param quantiles_alpha A number used to control the transparency of the 59 | #' quantile lines, from 0 (full transparency) to 1 (full opacity); defaults to 60 | #' 1. 61 | #' 62 | #' @param outliers A logical indicating if outliers should be displayed 63 | #' alongside the boxplots; defaults to \code{TRUE}. 64 | #' 65 | #' @param ... Further arguments to be passed to \code{add_projections}. 66 | #' 67 | #' @examples 68 | #' 69 | #' if (require(outbreaks) && 70 | #' require(distcrete) && 71 | #' require(incidence) && 72 | #' require(magrittr)) { 73 | #' 74 | #' si <- distcrete("gamma", 75 | #' interval = 1L, 76 | #' shape = 2.4, 77 | #' scale = 4.7, 78 | #' w = 0.5) 79 | #' 80 | #' i <- incidence(ebola_sim$linelist$date_of_onset) 81 | #' plot(i) 82 | #' 83 | #' ## add projections after the first 100 days, over 60 days 84 | #' set.seed(1) 85 | #' proj <- project(x = i[1:100], R = 1.4, si = si, n_days = 60) 86 | #' 87 | #' ## plotting projections: different options 88 | #' plot(proj) 89 | #' plot(proj, quantiles = c(.025, .5)) # 95% CI 90 | #' plot(proj, ribbon_color = "red", quantiles = FALSE) # range 91 | #' plot(proj, ribbon_color = "red", quantiles = FALSE, 92 | #' ribbon_quantiles = c(.025, .5)) 93 | #' plot(proj, boxplots = TRUE, quantiles = FALSE, ribbon = FALSE) 94 | #' plot(proj, boxplots = TRUE, quantiles = FALSE, outliers = FALSE) 95 | #' plot(proj, linetype = 3) 96 | #' 97 | #' ## adding them to incidence plot 98 | #' plot(i) %>% add_projections(proj) 99 | #' plot(i[1:160]) %>% add_projections(proj) 100 | #' plot(i[1:160]) %>% add_projections(proj, boxplots = FALSE) 101 | #' plot(i[1:160]) %>% 102 | #' add_projections(proj, boxplots_alpha = .3, boxplots_color = "red") 103 | #' 104 | #' ## same, with customised quantiles and colors 105 | #' quantiles <- c(.001, .01, 0.05, .1, .2, .3, .4, .5) 106 | #' pal <- colorRampPalette(c("#b3c6ff", "#00e64d", "#cc0066")) 107 | #' plot(i[1:200]) %>% 108 | #' add_projections(proj, quantiles, palette = pal) 109 | #' 110 | #' } 111 | #' 112 | 113 | plot.projections <- function(x, ylab = NULL, title = NULL, ...) { 114 | empty <- ggplot2::ggplot() 115 | out <- add_projections(empty, x, ...) 116 | if (is.null(ylab)) { 117 | ylab <- ifelse(isTRUE(attr(x, "cumulative")), 118 | "Predicted cumulative incidence", 119 | "Predicted incidence") 120 | } 121 | 122 | if (is.null(title)) { 123 | title <- ggplot2::waiver() 124 | } 125 | 126 | out <- out + ggplot2::labs(x = "", y = ylab, title = title) 127 | out 128 | } 129 | 130 | 131 | 132 | 133 | 134 | 135 | ## This function will take an existing 'incidence' plot object ('p') and add 136 | ## lines from an 'projections' object ('x'), as returned by projections::project 137 | 138 | #' @export 139 | #' @rdname plot.projections 140 | #' @param p A previous incidence plot to which projections should be added. 141 | add_projections <- function(p, x, quantiles = c(0.01, 0.05, 0.1, 0.5), 142 | ribbon = TRUE, boxplots = FALSE, 143 | palette = quantile_pal, 144 | quantiles_alpha = 1, 145 | linetype = 1, linesize = 0.5, 146 | ribbon_quantiles = NULL, 147 | ribbon_color = NULL, ribbon_alpha = 0.3, 148 | boxplots_color = "#47476b", 149 | boxplots_fill = "grey", 150 | boxplots_alpha = 0.8, 151 | outliers = TRUE) { 152 | 153 | if (!inherits(x, "projections")) { 154 | msg <- sprintf( 155 | "`x` must be a 'projections' object but is a `%s`", 156 | paste(class(x), collapse = ", ")) 157 | stop(msg) 158 | } 159 | 160 | ## Strategy: we start off the provided plot, which may well be empty 161 | ## (i.e. output of ggplot2::ggplot()), and add layers depending on what the 162 | ## user wants. Currently available layers include: 163 | 164 | ## - quantiles 165 | ## - boxplots 166 | ## - ribbon 167 | 168 | out <- p 169 | dates <- get_dates(x) 170 | 171 | if (!is.null(quantiles) && !isFALSE(quantiles) && !all(is.na(quantiles))) { 172 | quantiles <- sort(unique(c(quantiles, 1 - quantiles))) 173 | quantiles <- quantiles[quantiles >= 0 & quantiles <= 1] 174 | } 175 | 176 | 177 | ## This is the part handling the ribbon 178 | 179 | if (isTRUE(ribbon)) { 180 | ## find the ymin and ymax for ribbon 181 | if (is.null(ribbon_quantiles)) { 182 | if (is.null(quantiles) || isFALSE(quantiles) || all(is.na(quantiles))) { 183 | ribbon_quantiles <- c(0, 1) 184 | } else { 185 | ribbon_quantiles <- range(quantiles) 186 | } 187 | } 188 | stats <- t(apply(x, 1, stats::quantile, ribbon_quantiles)) 189 | df <- cbind.data.frame(dates, stats) 190 | names(df) <- c("dates", "ymin", "ymax") 191 | 192 | ## find colors; use the quantile's by default 193 | if (is.null(ribbon_color)) { 194 | ribbon_color <- color_quantiles(ribbon_quantiles, palette)[1] 195 | } 196 | ribbon_color <- transp(ribbon_color, ribbon_alpha) 197 | 198 | out <- out + 199 | ggplot2::geom_ribbon( 200 | data = df, 201 | ggplot2::aes(x = .data[["dates"]], 202 | ymin = .data[["ymin"]], 203 | ymax = .data[["ymax"]]), 204 | fill = ribbon_color) 205 | } 206 | 207 | 208 | ## This is the part handling the boxplots 209 | 210 | if (isTRUE(boxplots)) { 211 | df <- as.data.frame(x, long = TRUE) 212 | out <- suppressMessages( 213 | out + 214 | ggplot2::geom_boxplot( 215 | data = df, 216 | ggplot2::aes(x = .data[["date"]], 217 | y = .data[["incidence"]], 218 | group = .data[["date"]]), 219 | color = transp(boxplots_color, boxplots_alpha), 220 | fill = transp(boxplots_fill, boxplots_alpha), 221 | outlier.size = 0.5, 222 | outlier.color = ifelse(outliers, boxplots_color, "transparent") 223 | ) 224 | ) 225 | } 226 | 227 | 228 | ## This is the part handling the quantile lines 229 | 230 | if (isFALSE(quantiles)) { 231 | quantiles <- NULL 232 | } 233 | if (!is.null(quantiles)) { 234 | stats <- t(apply(x, 1, stats::quantile, quantiles)) 235 | quantiles <- rep(colnames(stats), each = nrow(stats)) 236 | quantiles <- factor(quantiles, levels = unique(quantiles)) 237 | df <- cbind.data.frame(dates = rep(dates, ncol(stats)), 238 | quantile = quantiles, 239 | value = as.vector(stats), 240 | stringsAsFactors = FALSE) 241 | 242 | colors <- color_quantiles(df$quantile, palette) 243 | colors <- transp(colors, quantiles_alpha) 244 | 245 | out <- suppressMessages( 246 | out + 247 | ggplot2::geom_line( 248 | data = df, 249 | ggplot2::aes(x = .data[["dates"]], 250 | y = .data[["value"]], 251 | color = .data[["quantile"]]), 252 | linetype = linetype, 253 | linewidth = linesize 254 | ) + 255 | ggplot2::scale_color_manual(values = colors) 256 | ) 257 | } 258 | 259 | ## We need to update the x scale, depending on the type of the dates 260 | 261 | if (inherits(dates, c("Date", "POSIXct"))) { 262 | out <- out + ggplot2::scale_x_date() 263 | } else { 264 | out <- out + ggplot2::scale_x_continuous() 265 | } 266 | 267 | out 268 | } 269 | 270 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/plots/evd-proj-red-ribbon.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 0 57 | 25 58 | 50 59 | 75 60 | 100 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | Jul 15 72 | Aug 01 73 | Aug 15 74 | Sep 01 75 | Sep 15 76 | Predicted incidence 77 | 78 | 79 | --------------------------------------------------------------------------------