From 90c87b7aa809a04019fe61ebfc8c3cf8d716f182 Mon Sep 17 00:00:00 2001 From: Sam Abbott Date: Thu, 27 Apr 2023 11:48:11 +0100 Subject: [PATCH 01/19] update linting defaults --- .lintr | 41 ++++++++++++----------------------------- 1 file changed, 12 insertions(+), 29 deletions(-) diff --git a/.lintr b/.lintr index 7dcf09100..4d74f9d75 100644 --- a/.lintr +++ b/.lintr @@ -1,31 +1,14 @@ -linters: with_defaults( - line_length_linter = line_length_linter(120) +linters: linters_with_tags( + tags = NULL, # include all linters + implicit_integer_linter = NULL, + extraction_operator_linter = NULL, + undesirable_function_linter = NULL, + function_argument_linter = NULL, + indentation_linter = NULL, + object_name_linter = NULL, + cyclocomp_linter(25L) ) -exclusions: list( - "inst/dev/load-stan-functions.R", - "inst/dev/recover-synthetic.R", - "inst/dev/test-secondary.R", - "inst/pkg-structure/generate-pkgstructure-report.R", - "R/stanmodels.R", - "tests/spelling.R", - "tests/testthat.R", - "tests/testthat/test-calc_CrI.R", - "tests/testthat/test-calc_CrIs.R", - "tests/testthat/test-calc_summary_measures.R", - "tests/testthat/test-calc_summary_stats.R", - "tests/testthat/test-create_future-rt.R", - "tests/testthat/test-create_stan_args.R", - "tests/testthat/test-epinow.R", - "tests/testthat/test-estimate_infections.R", - "tests/testthat/test-extract_CrIs.R", - "tests/testthat/test-get_dist.R", - "tests/testthat/test-set_dt_single_thread.R", - "tests/testthat/test-match_output_arguments.R", - "tests/testthat/test-regional_epinow.R", - "tests/testthat/test-regional_runtimes.R", - "tests/testthat/test-setup_future.R", - "tests/testthat/test-simulate_infections.R", - "tests/testthat/test-stan-infections.R", - "tests/testthat/test-stan-rt.R", - "tests/testthat/test-stan-secondary.R" +exclusions: c( + list.files("tests", recursive = TRUE, full.names = TRUE), + list.files("inst", recursive = TRUE, full.names = TRUE) ) From d08355589e1302c56f5b7f10a1873f7aab05f37c Mon Sep 17 00:00:00 2001 From: Sam Abbott Date: Thu, 27 Apr 2023 11:51:54 +0100 Subject: [PATCH 02/19] move to linting only changed files --- .../workflows/lint-only-changed-files.yaml | 47 +++++++++++++++++++ .github/workflows/lint.yaml | 36 -------------- 2 files changed, 47 insertions(+), 36 deletions(-) create mode 100644 .github/workflows/lint-only-changed-files.yaml delete mode 100644 .github/workflows/lint.yaml diff --git a/.github/workflows/lint-only-changed-files.yaml b/.github/workflows/lint-only-changed-files.yaml new file mode 100644 index 000000000..496b70a9d --- /dev/null +++ b/.github/workflows/lint-only-changed-files.yaml @@ -0,0 +1,47 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + pull_request: + branches: + - main + workflow_dispatch: + +name: lint-changed-files + +jobs: + lint-changed-files: + runs-on: ubuntu-latest + if: "! contains(github.event.head_commit.message, '[ci skip]')" + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + steps: + - uses: actions/checkout@v3 + + - uses: r-lib/actions/setup-r@v2 + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: | + any::gh + any::lintr + any::purrr + needs: check + + - name: Add lintr options + run: | + cat('\noptions(lintr.linter_file = ".lintr")\n', file = "~/.Rprofile", append = TRUE) + shell: Rscript {0} + + - name: Install package + run: R CMD INSTALL . + + - name: Extract and lint files changed by this PR + run: | + files <- gh::gh("GET https://api.github.com/repos/${{ github.repository }}/pulls/${{ github.event.pull_request.number }}/files") + changed_files <- purrr::map_chr(files, "filename") + all_files <- list.files(recursive = TRUE) + exclusions_list <- as.list(setdiff(all_files, changed_files)) + lintr::lint_package(exclusions = exclusions_list) + shell: Rscript {0} + env: + LINTR_ERROR_ON_LINT: true \ No newline at end of file diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml deleted file mode 100644 index 4f9e54081..000000000 --- a/.github/workflows/lint.yaml +++ /dev/null @@ -1,36 +0,0 @@ -on: - push: - branches: - - main - - master - - develop - pull_request: - branches: - - main - - master - - develop - workflow_dispatch: - -name: lint - -jobs: - lint: - runs-on: ubuntu-latest - if: "! contains(github.event.head_commit.message, '[ci skip]')" - env: - GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} - steps: - - uses: actions/checkout@v2 - - - uses: r-lib/actions/setup-r@v2 - with: - use-public-rspm: true - - - uses: r-lib/actions/setup-r-dependencies@v2 - with: - extra-packages: any::lintr - needs: lint - - - name: Lint - run: lintr::lint_package() - shell: Rscript {0} \ No newline at end of file From d568287a9846a9c77411073f6c2e8f23e9a6761d Mon Sep 17 00:00:00 2001 From: Sam Abbott Date: Thu, 27 Apr 2023 11:53:56 +0100 Subject: [PATCH 03/19] updated news + dev version and added an action to render the readme --- .github/workflows/render-readme.yaml | 38 ++++++++++++++++++++++++++++ DESCRIPTION | 2 +- NEWS.md | 5 +++- 3 files changed, 43 insertions(+), 2 deletions(-) create mode 100644 .github/workflows/render-readme.yaml diff --git a/.github/workflows/render-readme.yaml b/.github/workflows/render-readme.yaml new file mode 100644 index 000000000..87f415a87 --- /dev/null +++ b/.github/workflows/render-readme.yaml @@ -0,0 +1,38 @@ +on: + workflow_dispatch: + push: + paths: + - 'README.Rmd' + +jobs: + render-readme: + runs-on: macos-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + steps: + - name: Checkout repos + uses: actions/checkout@v2 + + - name: Setup R + uses: r-lib/actions/setup-r@v2 + + - name: Setup pandoc + uses: r-lib/actions/setup-pandoc@v2 + + - name: Install dependencies + uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::rmarkdown, local::. + + - name: Compile the readme + run: | + rmarkdown::render("README.Rmd") + shell: Rscript {0} + + - name: Commit files + run: | + git config --local user.email "action@github.com" + git config --local user.name "GitHub Action" + git add README.md man/figures/ + git diff-index --quiet HEAD || git commit -m "Automatic readme update" + git push origin || echo "No changes to push" diff --git a/DESCRIPTION b/DESCRIPTION index 50463edf1..83b39ccde 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Type: Package Package: EpiNow2 Title: Estimate Real-Time Case Counts and Time-Varying Epidemiological Parameters -Version: 1.3.6.1000 +Version: 1.3.6.2000 Authors@R: c(person(given = "Sam", family = "Abbott", diff --git a/NEWS.md b/NEWS.md index 302df64c4..16267c7c1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,10 +1,13 @@ -# EpiNow2 1.3.6.1000 +# EpiNow2 1.3.6.2000 This release is in development. For a stable release install 1.3.5 from CRAN. ## Package * Model description has been expanded to include more detail. +* Moved to a GitHub Action to only lint changed files. +* Linted the package with a wider range of default linters. +* Added a GitHub Action to build the README when it is altered. # EpiNow2 1.3.5 From a32118d005f82e309160ff7e6791acef3cc570f3 Mon Sep 17 00:00:00 2001 From: Sam Abbott Date: Thu, 27 Apr 2023 11:57:29 +0100 Subject: [PATCH 04/19] update install instructions --- README.Rmd | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/README.Rmd b/README.Rmd index 08fbb51b9..b661a0cc1 100644 --- a/README.Rmd +++ b/README.Rmd @@ -46,19 +46,19 @@ A simple example of using the package to estimate a national Rt for Covid-19 can ## Installation -Install the stable version of the package: +Install the released version of the package: ```{r, eval = FALSE} install.packages("EpiNow2") ``` -Install the stable development version of the package with: +Install the development version of the package with: ```{r, eval = FALSE} install.packages("EpiNow2", repos = "https://epiforecasts.r-universe.dev") ``` -Install the unstable development version of the package with (few users should need to do this): +Alternatively, install the development version of the package with (few users should need to do this): ```{r, eval = FALSE} remotes::install_github("epiforecasts/EpiNow2") From ed2859a657950af0c6756462d42043d0d0b98a26 Mon Sep 17 00:00:00 2001 From: Sam Abbott Date: Thu, 27 Apr 2023 12:00:47 +0100 Subject: [PATCH 05/19] use NULL vs c() --- R/summarise.R | 6 +++--- R/utilities.R | 18 ++++++++++-------- tests/testthat/test-delays.R | 2 +- tests/testthat/test-epinow.R | 2 +- 4 files changed, 15 insertions(+), 13 deletions(-) diff --git a/R/summarise.R b/R/summarise.R index 6e5a74efb..f77814019 100644 --- a/R/summarise.R +++ b/R/summarise.R @@ -555,7 +555,7 @@ regional_runtimes <- function(regional_output = NULL, #' calc_CrI(samples) #' # add 90% credible interval grouped by type #' calc_CrI(samples, summarise_by = "type") -calc_CrI <- function(samples, summarise_by = c(), CrI = 0.9) { +calc_CrI <- function(samples, summarise_by = NULL, CrI = 0.9) { samples <- data.table::setDT(samples) CrI_half <- CrI / 2 lower_CrI <- 0.5 - CrI_half @@ -589,7 +589,7 @@ calc_CrI <- function(samples, summarise_by = c(), CrI = 0.9) { #' calc_CrIs(samples) #' # add 90% credible interval grouped by type #' calc_CrIs(samples, summarise_by = "type") -calc_CrIs <- function(samples, summarise_by = c(), CrIs = c(0.2, 0.5, 0.9)) { +calc_CrIs <- function(samples, summarise_by = NULL, CrIs = c(0.2, 0.5, 0.9)) { CrIs <- CrIs[order(CrIs)] with_CrIs <- purrr::map(CrIs, ~ calc_CrI( samples = samples, @@ -642,7 +642,7 @@ extract_CrIs <- function(summarised) { #' calc_summary_stats(samples) #' # by type #' calc_summary_stats(samples, summarise_by = "type") -calc_summary_stats <- function(samples, summarise_by = c()) { +calc_summary_stats <- function(samples, summarise_by = NULL) { samples <- data.table::setDT(samples) sum_stats <- data.table::copy(samples)[, .( diff --git a/R/utilities.R b/R/utilities.R index a7533b74c..8a270dffc 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -178,8 +178,8 @@ allocate_empty <- function(data, params, n = 0) { #' of futile.logger for details. Supported options are "info" and "debug" #' @return A logical vector of named output arguments #' @importFrom futile.logger flog.info flog.debug -match_output_arguments <- function(input_args = c(), - supported_args = c(), +match_output_arguments <- function(input_args = NULL, + supported_args = NULL, logger = NULL, level = "info") { if (level %in% "info") { @@ -403,13 +403,15 @@ globalVariables( "bottom", "cases", "confidence", "confirm", "country_code", "crps", "cum_cases", "Date", "date_confirm", "date_confirmation", "date_onset", "date_onset_sample", "date_onset_symptoms", "date_onset.x", "date_onset.y", - "date_report", "day", "doubling_time", "effect", "Effective reproduction no.", - "estimates", "Expected change in daily cases", "fit_meas", "goodness_of_fit", + "date_report", "day", "doubling_time", "effect", + "Effective reproduction no.", "estimates", + "Expected change in daily cases", "fit_meas", "goodness_of_fit", "gt_sample", "import_status", "imported", "index", "latest", "little_r", - "lower", "max_time", "mean_R", "Mean(R)", "metric", "mid_lower", "mid_upper", - "min_time", "model", "modifier", "n", "New", "confirmed cases by infection date", - "overall_little_r", "params", "prob_control", "provnum_ne", "R0_range", - "region", "region_code", "report_delay", "results_dir", "rt", "rt_type", + "lower", "max_time", "mean_R", "Mean(R)", "metric", "mid_lower", + "mid_upper", "min_time", "model", "modifier", "n", "New", + "confirmed cases by infection date", "overall_little_r", "params", + "prob_control", "provnum_ne", "R0_range", "region", "region_code", + "report_delay", "results_dir", "rt", "rt_type", "sample_R", "sampled_r", "sd_R", "sd_rt", "Std(R)", "t_end", "t_start", "target_date", "time", "time_varying_r", "top", "total", "type", "upper", "value", "var", "vars", "viridis_palette", "window", ".", "%>%", diff --git a/tests/testthat/test-delays.R b/tests/testthat/test-delays.R index 8cb6c9fdc..d9f4dfdbe 100644 --- a/tests/testthat/test-delays.R +++ b/tests/testthat/test-delays.R @@ -1,7 +1,7 @@ test_stan_data <- function(generation_time = generation_time_opts(), delays = delay_opts(), truncation = trunc_opts(), - params = c()) { + params = NULL) { data <- create_stan_data( reported_cases = example_confirmed, generation_time = generation_time, diff --git a/tests/testthat/test-epinow.R b/tests/testthat/test-epinow.R index 9d26a873f..ac720cb8f 100644 --- a/tests/testthat/test-epinow.R +++ b/tests/testthat/test-epinow.R @@ -64,7 +64,7 @@ test_that("epinow can produce partial output as specified", { cores = 1, chains = 2, control = list(adapt_delta = 0.8) ), - output = c(), + output = NULL, logs = NULL, verbose = FALSE )) expect_equal(names(out), c("estimates", "estimated_reported_cases", "summary")) From 59b38946ec3d9ff02c56ae9239eb419305f2561d Mon Sep 17 00:00:00 2001 From: Sam Abbott Date: Thu, 27 Apr 2023 13:12:28 +0100 Subject: [PATCH 06/19] further linting and doc update --- .lintr | 3 +- NAMESPACE | 14 +- R/create.R | 77 ++++++---- R/epinow.R | 11 +- R/estimate_infections.R | 2 +- R/estimate_secondary.R | 8 +- R/estimate_truncation.R | 2 +- R/extract.R | 4 +- R/get.R | 12 +- R/plot.R | 4 +- R/regional_epinow.R | 4 +- R/report.R | 86 +++++++---- R/simulate_infections.R | 10 +- R/stanmodels.R | 2 +- R/summarise.R | 183 ++++++++++++++++------- R/utilities.R | 54 ++++--- man/R_to_growth.Rd | 9 +- man/calc_CrI.Rd | 9 +- man/calc_CrIs.Rd | 6 +- man/calc_summary_measures.Rd | 7 +- man/calc_summary_stats.Rd | 9 +- man/clean_nowcasts.Rd | 8 +- man/create_future_rt.Rd | 14 +- man/create_initial_conditions.Rd | 7 +- man/create_obs_model.Rd | 7 +- man/create_stan_args.Rd | 19 ++- man/epinow.Rd | 11 +- man/estimate_infections.Rd | 5 +- man/estimate_secondary.Rd | 4 +- man/expose_stan_fns.Rd | 9 +- man/get_regional_results.Rd | 8 +- man/growth_to_R.Rd | 11 +- man/make_conf.Rd | 2 +- man/map_prob_change.Rd | 3 +- man/match_output_arguments.Rd | 4 +- man/plot_estimates.Rd | 4 +- man/regional_epinow.Rd | 9 +- man/regional_runtimes.Rd | 8 +- man/regional_summary.Rd | 8 +- man/report_cases.Rd | 11 +- man/report_plots.Rd | 26 ++-- man/report_summary.Rd | 10 +- man/rt_opts.Rd | 11 +- man/run_region.Rd | 5 +- man/simulate_infections.Rd | 4 +- man/summarise_key_measures.Rd | 12 +- man/summary.epinow.Rd | 4 +- man/summary.estimate_infections.Rd | 11 +- man/update_secondary_args.Rd | 3 +- tests/testthat/test-estimate_secondary.R | 2 +- tests/testthat/test-report_cases.R | 8 +- 51 files changed, 497 insertions(+), 267 deletions(-) diff --git a/.lintr b/.lintr index 4d74f9d75..7bedc8fa5 100644 --- a/.lintr +++ b/.lintr @@ -10,5 +10,6 @@ linters: linters_with_tags( ) exclusions: c( list.files("tests", recursive = TRUE, full.names = TRUE), - list.files("inst", recursive = TRUE, full.names = TRUE) + list.files("inst", recursive = TRUE, full.names = TRUE), + "R/stanmodels.R" ) diff --git a/NAMESPACE b/NAMESPACE index ba4559ebd..f09aea3ab 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -158,6 +158,13 @@ importFrom(ggplot2,theme) importFrom(ggplot2,theme_bw) importFrom(lifecycle,deprecate_soft) importFrom(lifecycle,deprecate_warn) +importFrom(lifecycle,rgamma) +importFrom(lifecycle,rlnorm) +importFrom(lifecycle,rnorm) +importFrom(lifecycle,rpois) +importFrom(lifecycle,runif) +importFrom(lifecycle,sd) +importFrom(lifecycle,var) importFrom(lubridate,days) importFrom(lubridate,wday) importFrom(patchwork,plot_layout) @@ -197,13 +204,6 @@ importFrom(stats,plnorm) importFrom(stats,quantile) importFrom(stats,quasipoisson) importFrom(stats,rexp) -importFrom(stats,rgamma) -importFrom(stats,rlnorm) -importFrom(stats,rnorm) -importFrom(stats,rpois) -importFrom(stats,runif) -importFrom(stats,sd) -importFrom(stats,var) importFrom(truncnorm,rtruncnorm) importFrom(utils,capture.output) importFrom(utils,tail) diff --git a/R/create.R b/R/create.R index b7c88e246..0a96bc71c 100644 --- a/R/create.R +++ b/R/create.R @@ -90,22 +90,25 @@ create_shifted_cases <- function(reported_cases, shift, ) ][ , - confirm := runner::mean_run(confirm, k = smoothing_window, lag = -floor(smoothing_window / 2)) + confirm := runner::mean_run( + confirm, k = smoothing_window, lag = -floor(smoothing_window / 2) + ) ][ , confirm := data.table::fifelse(confirm == 0, 1, confirm) ] ## Forecast trend on reported cases using the last week of data - final_week <- data.table::data.table(confirm = shifted_reported_cases[1:(.N - horizon - shift)][max(1, .N - 6):.N]$confirm)[ - , - t := 1:.N + final_week <- data.table::data.table( + confirm = shifted_reported_cases[1:(.N - horizon - shift)][ + max(1, .N - 6):.N]$confirm)[, + t := seq_len(.N) ] lm_model <- stats::lm(log(confirm) ~ t, data = final_week) ## Estimate unreported future infections using a log linear model shifted_reported_cases <- shifted_reported_cases[ , - t := 1:.N + t := seq_len(.N) ][ , t := t - (.N - horizon - shift - 6) @@ -127,12 +130,19 @@ create_shifted_cases <- function(reported_cases, shift, #' Construct the Required Future Rt assumption #' #' @description `r lifecycle::badge("stable")` -#' Converts the `future` argument from `rt_opts()` into arguments that can be passed to `stan`. -#' @param future A character string or integer. This argument indicates how to set future Rt values. Supported -#' options are to project using the Rt model ("project"), to use the latest estimate based on partial data ("latest"), -#' to use the latest estimate based on data that is over 50% complete ("estimate"). If an integer is supplied then the Rt estimate -#' from this many days into the future (or past if negative) past will be used forwards in time. +#' Converts the `future` argument from `rt_opts()` into arguments that can be +#' passed to `stan`. +#' +#' @param future A character string or integer. This argument indicates how to +#' set future Rt values. Supported options are to project using the Rt model +#' ("project"), to use the latest estimate based on partial data ("latest"), +#' to use the latest estimate based on data that is over 50% complete +#' ("estimate"). If an integer is supplied then the Rt estimate from this many +#' days into the future (or past if negative) past will be used forwards in +#' time. +#' #' @param delay Numeric mean delay +#' #' @return A list containing a logical called fixed and an integer called from #' @author Sam Abbott create_future_rt <- function(future = "latest", delay = 0) { @@ -333,7 +343,8 @@ create_gp_data <- function(gp = gp_opts(), data) { #' Create Observation Model Settings #' #' @description `r lifecycle::badge("stable")` -#' Takes the output of `obs_opts()` and converts it into a list understood by `stan`. +#' Takes the output of `obs_opts()` and converts it into a list understood +#' by `stan`. #' @param obs A list of options as generated by `obs_opts()` defining the #' observation model. Defaults to `obs_opts()`. #' @param dates A vector of dates used to calculate the day of the week. @@ -351,7 +362,9 @@ create_gp_data <- function(gp = gp_opts(), data) { #' create_obs_model(obs_opts(family = "poisson"), dates = dates) #' #' # Applying a observation scaling to the data -#' create_obs_model(obs_opts(scale = list(mean = 0.4, sd = 0.01)), dates = dates) +#' create_obs_model( +#' obs_opts(scale = list(mean = 0.4, sd = 0.01)), dates = dates +#' ) #' #' # Apply a custom week week length #' create_obs_model(obs_opts(week_length = 3), dates = dates) @@ -362,7 +375,7 @@ create_obs_model <- function(obs = obs_opts(), dates) { phi_sd = obs$phi[2], week_effect = ifelse(obs$week_effect, obs$week_length, 1), obs_weight = obs$weight, - obs_scale = ifelse(length(obs$scale) != 0, 1, 0), + obs_scale = as.numeric(length(obs$scale) != 0), likelihood = as.numeric(obs$likelihood), return_likelihood = as.numeric(obs$return_likelihood) ) @@ -477,7 +490,8 @@ create_stan_data <- function(reported_cases, generation_time, ) ) - # rescale mean shifted prior for back calculation if observation scaling is used + # rescale mean shifted prior for back calculation if observation scaling is + # used if (data$obs_scale == 1) { data$shifted_cases <- data$shifted_cases / data$obs_scale_mean data$prior_infections <- log(exp(data$prior_infections) / data$obs_scale_mean) @@ -487,9 +501,10 @@ create_stan_data <- function(reported_cases, generation_time, #' Create Initial Conditions Generating Function #' @description `r lifecycle::badge("stable")` -#' Uses the output of `create_stan_data` to create a function which can be used to -#' sample from the prior distributions (or as close as possible) for parameters. Used -#' in order to initialise each `stan` chain within a range of plausible values. +#' Uses the output of `create_stan_data` to create a function which can be used +#' to sample from the prior distributions (or as close as possible) for +#' parameters. Used in order to initialise each `stan` chain within a range of +#' plausible values. #' @param data A list of data as produced by `create_stan_data.` #' @return An initial condition generating function #' @importFrom purrr map2_dbl @@ -542,7 +557,9 @@ create_initial_conditions <- function(data) { out$rho ) ) - out$alpha <- array(truncnorm::rtruncnorm(1, a = 0, mean = 0, sd = data$alpha_sd)) + out$alpha <- array( + truncnorm::rtruncnorm(1, a = 0, mean = 0, sd = data$alpha_sd) + ) } if (data$model_type == 1) { out$rep_phi <- array( @@ -597,15 +614,23 @@ create_initial_conditions <- function(data) { #' Create a List of Stan Arguments #' #' @description `r lifecycle::badge("stable")` -#' Generates a list of arguments as required by `rstan::sampling` or `rstan::vb` by combining the required options, -#' with data, and type of initialisation. Initialisation defaults to random but it is expected that `create_initial_conditions` -#' will be used. -#' @param stan A list of stan options as generated by `stan_opts()`. Defaults to `stan_opts()`. Can be used to override -#' `data`, `init`, and `verbose` settings if desired. +#' Generates a list of arguments as required by `rstan::sampling` or +#' `rstan::vb` by combining the required options, with data, and type of +#' initialisation. Initialisation defaults to random but it is expected that +#' `create_initial_conditions` will be used. +#' +#' @param stan A list of stan options as generated by `stan_opts()`. Defaults +#' to `stan_opts()`. Can be used to override `data`, `init`, and `verbose` +#' settings if desired. +#' #' @param data A list of stan data as created by `create_stan_data` -#' @param init Initial conditions passed to `rstan`. Defaults to "random" but can also be a function ( -#' as supplied by `create_intitial_conditions`). -#' @param verbose Logical, defaults to `FALSE`. Should verbose progress messages be returned. +#' +#' @param init Initial conditions passed to `rstan`. Defaults to "random" but +#' can also be a function (as supplied by `create_intitial_conditions`). +#' +#' @param verbose Logical, defaults to `FALSE`. Should verbose progress +#' messages be returned. +#' #' @return A list of stan arguments #' @author Sam Abbott #' @export diff --git a/R/epinow.R b/R/epinow.R index 1b8fd99e5..4b48713e8 100644 --- a/R/epinow.R +++ b/R/epinow.R @@ -4,7 +4,7 @@ #' This function wraps the functionality of `estimate_infections()` and #' `forecast_infections()` in order to estimate Rt and cases by date of #' infection, forecast into these infections into the future. It also contains -#' additional functionality to convert forecasts to date of report and produc +#' additional functionality to convert forecasts to date of report and produce #' summary output useful for reporting results and interpreting them. See #' [here](https://gist.github.com/seabbs/163d0f195892cde685c70473e1f5e867) for #' an example of using `epinow` to estimate Rt for Covid-19 in a country from @@ -41,7 +41,9 @@ #' options(mc.cores = ifelse(interactive(), 4, 1)) #' # construct example distributions #' generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") -#' incubation_period <- get_incubation_period(disease = "SARS-CoV-2", source = "lauer") +#' incubation_period <- get_incubation_period( +#' disease = "SARS-CoV-2", source = "lauer" +#' ) #' reporting_delay <- list( #' mean = convert_to_logmean(2, 1), #' mean_sd = 0.1, @@ -91,8 +93,9 @@ epinow <- function(reported_cases, return_output <- TRUE } - if (is.null(CrIs) | length(CrIs) == 0 | !is.numeric(CrIs)) { - futile.logger::flog.fatal("At least one credible interval must be specified", + if (is.null(CrIs) || length(CrIs) == 0 || !is.numeric(CrIs)) { + futile.logger::flog.fatal( + "At least one credible interval must be specified", name = "EpiNow2.epinow" ) stop("At least one credible interval must be specified") diff --git a/R/estimate_infections.R b/R/estimate_infections.R index 12a07c9f2..27d8abb9e 100644 --- a/R/estimate_infections.R +++ b/R/estimate_infections.R @@ -339,7 +339,7 @@ estimate_infections <- function(reported_cases, out$prior_infections <- shifted_cases[ , .( - parameter = "prior_infections", time = 1:.N, + parameter = "prior_infections", time = seq_len(.N), date, value = confirm, sample = 1 ) ] diff --git a/R/estimate_secondary.R b/R/estimate_secondary.R index 654b7e846..093381a5c 100644 --- a/R/estimate_secondary.R +++ b/R/estimate_secondary.R @@ -88,7 +88,7 @@ #' plot(inc, primary = TRUE) #' #' # forecast future secondary cases from primary -#' inc_preds <- forecast_secondary(inc, cases[61:.N][, value := primary]) +#' inc_preds <- forecast_secondary(inc, cases[6seq_len(.N)][, value := primary]) #' plot(inc_preds, new_obs = cases, from = "2020-05-01") #' #' #### Prevalence data example #### @@ -115,7 +115,7 @@ #' plot(prev, primary = TRUE) #' #' # forecast future secondary cases from primary -#' prev_preds <- forecast_secondary(prev, cases[101:.N][, value := primary]) +#' prev_preds <- forecast_secondary(prev, cases[10seq_len(.N)][, value := primary]) #' plot(prev_preds, new_obs = cases, from = "2020-06-01") #' #' options(old_opts) @@ -471,7 +471,7 @@ simulate_secondary <- function(data, type = "incidence", family = "poisson", family <- match.arg(family, choices = c("none", "poisson", "negbin")) data <- data.table::as.data.table(data) data <- data.table::copy(data) - data <- data[, index := 1:.N] + data <- data[, index := seq_len(.N)] # apply scaling data <- data[, scaled := scaling * primary] # add convolution @@ -591,7 +591,7 @@ forecast_secondary <- function(estimate, primary <- primary[date > max(estimate$predictions$date, na.rm = TRUE)] primary <- primary[, .(date, sample, value)] if (!is.null(samples)) { - primary <- primary[sample(1:.N, samples, replace = TRUE)] + primary <- primary[sample(seq_len(.N), samples, replace = TRUE)] } } ## rename to avoid conflict with estimate diff --git a/R/estimate_truncation.R b/R/estimate_truncation.R index 6de2e74af..363ed0e5d 100644 --- a/R/estimate_truncation.R +++ b/R/estimate_truncation.R @@ -205,7 +205,7 @@ estimate_truncation <- function(obs, max_truncation, trunc_max = 10, var_names = TRUE ) recon_obs <- recon_obs[, id := variable][, variable := NULL] - recon_obs <- recon_obs[, dataset := 1:.N][ + recon_obs <- recon_obs[, dataset := seq_len(.N)][ , dataset := dataset %% data$obs_sets ][ diff --git a/R/extract.R b/R/extract.R index d47f3e984..95efb9061 100644 --- a/R/extract.R +++ b/R/extract.R @@ -23,13 +23,13 @@ extract_parameter <- function(param, samples, dates) { ) ) ) - param_df <- param_df[, time := 1:.N] + param_df <- param_df[, time := seq_len(.N)] param_df <- data.table::melt(param_df, id.vars = "time", variable.name = "var" ) - param_df <- param_df[, var := NULL][, sample := 1:.N, by = .(time)] + param_df <- param_df[, var := NULL][, sample := seq_len(.N), by = .(time)] param_df <- param_df[, date := dates, by = .(sample)] param_df <- param_df[, .( parameter = param, time, date, diff --git a/R/get.R b/R/get.R index d0ea80899..092365ead 100644 --- a/R/get.R +++ b/R/get.R @@ -72,8 +72,12 @@ get_raw_result <- function(file, region, date, #' @examples #' \donttest{ #' # construct example distributions -#' generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") -#' incubation_period <- get_incubation_period(disease = "SARS-CoV-2", source = "lauer") +#' generation_time <- get_generation_time( +#' disease = "SARS-CoV-2", source = "ganyani" +#' ) +#' incubation_period <- get_incubation_period( +#' disease = "SARS-CoV-2", source = "lauer" +#' ) #' reporting_delay <- estimate_delay(rlnorm(100, log(6), 1), max_value = 10) #' #' # example case vector @@ -138,7 +142,9 @@ get_regional_results <- function(regional_output, result_dir = results_dir, date = date )[[1]]) - summarised <- data.table::rbindlist(summarised, idcol = "region", fill = TRUE) + summarised <- data.table::rbindlist( + summarised, idcol = "region", fill = TRUE + ) out$summarised <- summarised return(out) } diff --git a/R/plot.R b/R/plot.R index 0b3748fe4..9b4579082 100644 --- a/R/plot.R +++ b/R/plot.R @@ -64,7 +64,9 @@ plot_CrIs <- function(plot, CrIs, alpha, linewidth) { #' #' # set up example delays #' generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") -#' incubation_period <- get_incubation_period(disease = "SARS-CoV-2", source = "lauer") +#' incubation_period <- get_incubation_period( +#' disease = "SARS-CoV-2", source = "lauer" +#' ) #' reporting_delay <- estimate_delay(rlnorm(100, log(6), 1), max_value = 10) #' #' # run model diff --git a/R/regional_epinow.R b/R/regional_epinow.R index f5dccf41e..80e059153 100644 --- a/R/regional_epinow.R +++ b/R/regional_epinow.R @@ -44,7 +44,9 @@ #' #' # construct example distributions #' generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") -#' incubation_period <- get_incubation_period(disease = "SARS-CoV-2", source = "lauer") +#' incubation_period <- get_incubation_period( +#' disease = "SARS-CoV-2", source = "lauer" +#' ) #' reporting_delay <- list( #' mean = convert_to_logmean(2, 1), #' mean_sd = 0.1, diff --git a/R/report.R b/R/report.R index 6edbbc22d..db9f9e059 100644 --- a/R/report.R +++ b/R/report.R @@ -5,7 +5,8 @@ #' Likely to be removed/replaced in later releases by functionality drawing on #' the `stan` implementation. #' -#' @param case_estimates A data.table of case estimates with the following variables: date, sample, cases +#' @param case_estimates A data.table of case estimates with the following +#' variables: date, sample, cases #' #' @param case_forecast A data.table of case forecasts with the following #' variables: date, sample, cases. If not supplied the default is not to @@ -32,8 +33,12 @@ #' cases <- example_confirmed[1:40] #' #' # set up example delays -#' generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") -#' incubation_period <- get_incubation_period(disease = "SARS-CoV-2", source = "lauer") +#' generation_time <- get_generation_time( +#' disease = "SARS-CoV-2", source = "ganyani" +#' ) +#' incubation_period <- get_incubation_period( +#' disease = "SARS-CoV-2", source = "lauer" +#' ) #' reporting_delay <- list( #' mean = convert_to_logmean(2, 1), mean_sd = 0.1, #' sd = convert_to_logsd(2, 1), sd_sd = 0.1, max = 10 @@ -78,7 +83,9 @@ report_cases <- function(case_estimates, effect = rep(1, 7), day = 1:7 ) - reporting_effect <- reporting_effect[, .(sample = unlist(sample)), by = .(effect, day)] + reporting_effect <- reporting_effect[, + .(sample = unlist(sample)), by = .(effect, day) + ] } # filter and sum nowcast to use only upscaled cases by date of infection infections <- data.table::copy(case_estimates) @@ -109,7 +116,8 @@ report_cases <- function(case_estimates, # bind all samples together out$samples <- report # summarise samples - out$summarised <- calc_summary_measures(report[, value := cases][, cases := NULL], + out$summarised <- calc_summary_measures( + report[, value := cases][, cases := NULL], summarise_by = c("date"), order_by = c("date"), CrIs = CrIs @@ -117,17 +125,21 @@ report_cases <- function(case_estimates, return(out) } - #' Provide Summary Statistics for Estimated Infections and Rt #' @description `r lifecycle::badge("questioning")` -#' Creates a snapshot summary of estimates. May be removed in later releases as S3 methods are -#' enhanced. -#' @param summarised_estimates A data.table of summarised estimates containing the following variables: -#' variable, median, bottom, and top. It should contain the following estimates: R, infections, and r -#' (rate of growth). +#' Creates a snapshot summary of estimates. May be removed in later releases as +#' S3 methods are enhanced. +#' +#' @param summarised_estimates A data.table of summarised estimates containing +#' the following variables: variable, median, bottom, and top. It should +#' contain the following estimates: R, infections, and r (rate of growth). +#' #' @param rt_samples A data.table containing Rt samples with the following variables: sample and value. +#' #' @param return_numeric Should numeric summary information be returned. +#' #' @inheritParams setup_target_folder +#' #' @return A data.table containing formatted and numeric summary measures #' @export #' @importFrom data.table data.table setDT @@ -151,24 +163,26 @@ report_summary <- function(summarised_estimates, ] # extract latest R estimate - R_latest <- summarised_estimates[variable == "R"][, variable := NULL][ - , + R_latest <- summarised_estimates[variable == "R"][, + variable := NULL][, purrr::map(.SD, ~ signif(., 2)) ] # estimate probability of control - prob_control <- rt_samples[, .(prob_control = sum(value <= 1) / .N)]$prob_control + prob_control <- rt_samples[, + .(prob_control = sum(value <= 1) / .N) + ]$prob_control prob_control <- signif(prob_control, 2) # extract current cases - current_cases <- summarised_estimates[variable == "infections"][, variable := NULL][ - , + current_cases <- summarised_estimates[variable == "infections"][, + variable := NULL][, purrr::map(.SD, ~ signif(as.integer(.)), 2) ] # get individual estimates - r_latest <- summarised_estimates[variable == "growth_rate"][, variable := NULL][ - , + r_latest <- summarised_estimates[variable == "growth_rate"][, + variable := NULL][, purrr::map(.SD, ~ signif(., 2)) ] @@ -222,25 +236,32 @@ report_summary <- function(summarised_estimates, #' Report plots #' #' @description `r lifecycle::badge("questioning")` -#' Returns key summary plots for estimates. May be depreciated in later releases as current S3 methods -#' are enhanced. +#' Returns key summary plots for estimates. May be depreciated in later +#' releases as current S3 methods are enhanced. +#' #' @param summarised_estimates A data.table of summarised estimates containing #' the following variables: variable, median, bottom, and top. #' #' It should also contain the following estimates: R, infections, #' reported_cases_rt, and r (rate of growth). +#' #' @param ... Additional arguments passed to `plot_estimates()`. +#' #' @importFrom ggplot2 ggsave theme labs scale_x_date theme_bw #' @importFrom patchwork plot_layout #' @importFrom data.table setDT #' @inheritParams setup_target_folder #' @inheritParams epinow #' @inheritParams plot_estimates -#' @return A named list of `ggplot2` objects, `list(infections, reports, R, growth_rate, summary)`, -#' which correspond to a summary combination (last item) and for the leading items -#' @seealso [plot_estimates()] of `summarised_estimates[variable == "infections"]`, -#' `summarised_estimates[variable == "reported_cases"]`, `summarised_estimates[variable == "R"]`, -#' and `summarised_estimates[variable == "growth_rate"]`, respectively. +#' @return A named list of `ggplot2` objects, `list(infections, reports, R, +#' growth_rate, summary)`, which correspond to a summary combination (last +#' item) and for the leading items. +#' +#' @seealso [plot_estimates()] of +#' `summarised_estimates[variable == "infections"]`, +#' `summarised_estimates[variable == "reported_cases"]`, +#' `summarised_estimates[variable == "R"]`, and +#' `summarised_estimates[variable == "growth_rate"]`, respectively. #' @export #' @examples #' \donttest{ @@ -248,8 +269,12 @@ report_summary <- function(summarised_estimates, #' cases <- example_confirmed[1:40] #' #' # set up example delays -#' generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") -#' incubation_period <- get_incubation_period(disease = "SARS-CoV-2", source = "lauer") +#' generation_time <- get_generation_time( +#' disease = "SARS-CoV-2", source = "ganyani" +#' ) +#' incubation_period <- get_incubation_period( +#' disease = "SARS-CoV-2", source = "lauer" +#' ) #' reporting_delay <- bootstrapped_dist_fit(rlnorm(100, log(6), 1), max_value = 30) #' #' # run model @@ -334,7 +359,7 @@ report_plots <- function(summarised_estimates, reported, ) ) - # organise output + # Organise output plots <- list( infections = infections, reports = reports, @@ -355,7 +380,10 @@ report_plots <- function(summarised_estimates, reported, R = "reff_plot.png", growth_rate = "growth_rate_plot.png", summary = "summary_plot.png" )) - mapply(ggplot2::ggsave, filename = pths, plot = plots, width = wd, height = ht, dpi = dpi) + mapply( + ggplot2::ggsave, filename = pths, plot = plots, + width = wd, height = ht, dpi = dpi + ) })) } return(plots) diff --git a/R/simulate_infections.R b/R/simulate_infections.R index c775d2da5..386f26bbd 100644 --- a/R/simulate_infections.R +++ b/R/simulate_infections.R @@ -46,7 +46,9 @@ #' # set up example generation time #' generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") #' # set delays between infection and case report -#' incubation_period <- get_incubation_period(disease = "SARS-CoV-2", source = "lauer") +#' incubation_period <- get_incubation_period( +#' disease = "SARS-CoV-2", source = "lauer" +#' ) #' reporting_delay <- list( #' mean = convert_to_logmean(2, 1), mean_sd = 0.1, #' sd = convert_to_logsd(2, 1), sd_sd = 0.1, max = 15 @@ -219,7 +221,9 @@ simulate_infections <- function(estimates, if (!is.null(batch_size)) { batch_no <- ceiling(samples / batch_size) nstarts <- seq(1, by = batch_size, length.out = batch_no) - nends <- c(seq(batch_size, by = batch_size, length.out = batch_no - 1), samples) + nends <- c( + seq(batch_size, by = batch_size, length.out = batch_no - 1), samples + ) batches <- transpose(list(nstarts, nends)) } else { batches <- list(list(1, samples)) @@ -261,7 +265,7 @@ simulate_infections <- function(estimates, start_date = min(estimates$observations$date), CrIs = extract_CrIs(estimates$summarised) / 100 ) - format_out$samples <- format_out$samples[, sample := 1:.N, + format_out$samples <- format_out$samples[, sample := seq_len(.N), by = c("variable", "time", "date", "strat") ] diff --git a/R/stanmodels.R b/R/stanmodels.R index 120f51678..6fcdd36a3 100644 --- a/R/stanmodels.R +++ b/R/stanmodels.R @@ -17,7 +17,7 @@ Rcpp::loadModule("stan_fit4tune_inv_gamma_mod", what = TRUE) # instantiate each stanmodel object stanmodels <- sapply(stanmodels, function(model_name) { # create C++ code for stan model - stan_file <- if(dir.exists("stan")) "stan" else file.path("inst", "stan") + stan_file <- if (dir.exists("stan")) "stan" else file.path("inst", "stan") stan_file <- file.path(stan_file, paste0(model_name, ".stan")) stanfit <- rstan::stanc_builder(stan_file, allow_undefined = TRUE, diff --git a/R/summarise.R b/R/summarise.R index f77814019..c26407631 100644 --- a/R/summarise.R +++ b/R/summarise.R @@ -27,11 +27,17 @@ summarise_results <- function(regions, if (is.null(results_dir)) { if (is.null(summaries)) { - stop("Either a results directory or a list of summary data frames must be supplied") + stop( + "Either a results directory or a list of summary data frames must be", + " supplied" + ) } } else { if (!is.null(summaries)) { - stop("Both a results directory and a list of summary data frames have been supplied.") + stop( + "Both a results directory and a list of summary data frames have been", + " supplied." + ) } } @@ -77,7 +83,10 @@ summarise_results <- function(regions, numeric_estimates <- data.table::merge.data.table(numeric_estimates, estimates[measure %in% "Expected change in daily cases"][ , - .(region, `Expected change in daily cases` = estimate, prob_control = numeric_estimate) + .(region, + `Expected change in daily cases` = estimate, + prob_control = numeric_estimate + ) ], by = "region", all.x = TRUE ) @@ -86,7 +95,9 @@ summarise_results <- function(regions, data.table::setorderv(numeric_estimates, cols = "median", order = -1)$region ) - numeric_estimates <- numeric_estimates[, region := factor(region, levels = high_inc_regions)] + numeric_estimates <- numeric_estimates[, + region := factor(region, levels = high_inc_regions) + ] # clean up joined estimate table and munge into a presentation format estimates <- estimates[, numeric_estimate := NULL][ @@ -100,9 +111,13 @@ summarise_results <- function(regions, )) ] - estimates <- data.table::dcast(estimates, region ~ ..., value.var = "estimate") + estimates <- data.table::dcast( + estimates, region ~ ..., value.var = "estimate" + ) estimates <- estimates[, (region_scale) := region][, region := NULL] - estimates <- estimates[, c(region_scale, colnames(estimates)[-ncol(estimates)]), with = FALSE] + estimates <- estimates[, + c(region_scale, colnames(estimates)[-ncol(estimates)]), with = FALSE + ] out <- list(estimates, numeric_estimates, high_inc_regions) names(out) <- c("table", "data", "regions_by_inc") @@ -143,8 +158,12 @@ summarise_results <- function(regions, #' @examples #' \donttest{ #' # example delays -#' generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") -#' incubation_period <- get_incubation_period(disease = "SARS-CoV-2", source = "lauer") +#' generation_time <- get_generation_time( +#' disease = "SARS-CoV-2", source = "ganyani" +#' ) +#' incubation_period <- get_incubation_period( +#' disease = "SARS-CoV-2", source = "lauer" +#' ) #' reporting_delay <- estimate_delay(rlnorm(100, log(6), 1), max_value = 30) #' #' # example case vector from EpiSoon @@ -181,7 +200,9 @@ regional_summary <- function(regional_output = NULL, ...) { reported_cases <- data.table::setDT(reported_cases) if (is.null(summary_dir)) { - futile.logger::flog.info("No summary directory specified so returning summary output") + futile.logger::flog.info( + "No summary directory specified so returning summary output" + ) return_output <- TRUE } else { futile.logger::flog.info("Saving summary to : %s", summary_dir) @@ -262,14 +283,18 @@ regional_summary <- function(regional_output = NULL, summarised_results$data <- force_factor(summarised_results$data) if (!is.null(summary_dir)) { - data.table::fwrite(summarised_results$table, file.path(summary_dir, "summary_table.csv")) - data.table::fwrite(summarised_results$data, file.path(summary_dir, "summary_data.csv")) + data.table::fwrite( + summarised_results$table, file.path(summary_dir, "summary_table.csv") + ) + data.table::fwrite( + summarised_results$data, file.path(summary_dir, "summary_data.csv") + ) } # adaptive add a logscale to the summary plot based on range of observed cases current_inf <- summarised_results$data[metric %in% "New confirmed cases by infection date"] - uppers <- grepl("upper_", colnames(current_inf)) - lowers <- grepl("lower_", colnames(current_inf)) + uppers <- grepl("upper_", colnames(current_inf), fixed = TRUE) # nolint + lowers <- grepl("lower_", colnames(current_inf), fixed = TRUE) # nolint log_cases <- (max(current_inf[, ..uppers], na.rm = TRUE) / min(current_inf[, ..lowers], na.rm = TRUE)) > 1000 @@ -311,7 +336,9 @@ regional_summary <- function(regional_output = NULL, ) high_plots <- report_plots( - summarised_estimates = results$estimates$summarised[region %in% most_reports], + summarised_estimates = results$estimates$summarised[ + region %in% most_reports + ], reported = reported_cases[region %in% most_reports], max_plot = max_plot, ... ) @@ -377,7 +404,7 @@ regional_summary <- function(regional_output = NULL, out$reported_cases <- reported_cases out$high_plots <- high_plots - if (all_regions & plot) { + if (all_regions && plot) { out$plots <- plots } return(out) @@ -389,16 +416,25 @@ regional_summary <- function(regional_output = NULL, #' Summarise rt and cases #' #' @description `r lifecycle::badge("maturing")` -#' Produces summarised data frames of output across regions. Used internally by `regional_summary`. -#' @param regional_results A list of dataframes as produced by `get_regional_results` +#' Produces summarised data frames of output across regions. Used internally by +#' `regional_summary`. +#' +#' @param regional_results A list of dataframes as produced by +#' `get_regional_results` +#' #' @param results_dir Character string indicating the directory from which to #' extract results. +#' #' @param summary_dir Character string the directory into which to save results #' as a csv. -#' @param type Character string, the region identifier to apply (defaults to region). +#' +#' @param type Character string, the region identifier to apply (defaults to +#' region). +#' #' @inheritParams get_regional_results #' @seealso regional_summary -#' @return A list of summarised Rt, cases by date of infection and cases by date of report +#' @return A list of summarised Rt, cases by date of infection and cases by +#' date of report #' @export #' @importFrom data.table setnames fwrite setorderv summarise_key_measures <- function(regional_results = NULL, @@ -445,17 +481,19 @@ summarise_key_measures <- function(regional_results = NULL, save_variable(out$growth_rate, "growth_rate") # clean and save case estimates - out$cases_by_infection <- summarise_variable(sum_est[variable == "infections"][ - , + out$cases_by_infection <- summarise_variable( + sum_est[variable == "infections"][, variable := NULL - ], 1) + ], 1 + ) save_variable(out$cases_by_infection, "cases_by_infection") # clean and save case estimates - out$cases_by_report <- summarise_variable(sum_est[variable == "reported_cases"][ - , + out$cases_by_report <- summarise_variable( + sum_est[variable == "reported_cases"][, variable := NULL - ], 1) + ], 1 + ) save_variable(out$cases_by_report, "cases_by_report") return(out) } @@ -463,6 +501,7 @@ summarise_key_measures <- function(regional_results = NULL, #' #' @description `r lifecycle::badge("maturing")` #' Used internally by `regional_epinow` to summarise region run times. +#' #' @seealso regional_summary regional_epinow #' @inheritParams regional_summary #' @inheritParams epinow @@ -473,8 +512,12 @@ summarise_key_measures <- function(regional_results = NULL, #' @examples #' \donttest{ #' # example delays -#' generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") -#' incubation_period <- get_incubation_period(disease = "SARS-CoV-2", source = "lauer") +#' generation_time <- get_generation_time( +#' disease = "SARS-CoV-2", source = "ganyani" +#' ) +#' incubation_period <- get_incubation_period( +#' disease = "SARS-CoV-2", source = "lauer" +#' ) #' reporting_delay <- estimate_delay(rlnorm(100, log(6), 1), max_value = 15) #' #' cases <- example_confirmed[1:30] @@ -502,10 +545,14 @@ regional_runtimes <- function(regional_output = NULL, stop("Either an output should be passed in or a target folder specified") } if (is.null(target_folder)) { - futile.logger::flog.info("No target directory specified so returning timings") + futile.logger::flog.info( + "No target directory specified so returning timings" + ) return_output <- TRUE } else { - futile.logger::flog.info("Saving timings information to : %s", target_folder) + futile.logger::flog.info( + "Saving timings information to : %s", target_folder + ) } if (!is.null(regional_output)) { timings <- data.table::data.table( @@ -516,7 +563,7 @@ regional_runtimes <- function(regional_output = NULL, if (is.null(target_date)) { target_date <- "latest" } - safe_read <- purrr::safely(readRDS) + safe_read <- purrr::safely(readRDS) # nolint regions <- get_regions(target_folder) timings <- data.table::data.table( region = regions, @@ -543,9 +590,10 @@ regional_runtimes <- function(regional_output = NULL, #' Adds symmetric a credible interval based on quantiles. #' @param samples A data.table containing at least a value variable #' @param summarise_by A character vector of variables to group by. -#' @param CrI Numeric between 0 and 1. The credible interval for which to return values. -#' Defaults to 0.9. -#' @return A data.table containing the upper and lower bounds for the specified credible interval +#' @param CrI Numeric between 0 and 1. The credible interval for which to +#' return values. Defaults to 0.9. +#' @return A data.table containing the upper and lower bounds for the specified +#' credible interval. #' @export #' @importFrom data.table copy setDT #' @importFrom stats quantile @@ -576,10 +624,14 @@ calc_CrI <- function(samples, summarise_by = NULL, CrI = 0.9) { #' #' @description `r lifecycle::badge("stable")` #' Adds symmetric credible intervals based on quantiles. +#' #' @param CrIs Numeric vector of credible intervals to calculate. +#' #' @inheritParams calc_CrI -#' @return A data.table containing the `summarise_by` variables and the specified lower and upper -#' credible intervals +#' +#' @return A data.table containing the `summarise_by` variables and the +#' specified lower and upper credible intervals. +#' #' @importFrom purrr map #' @importFrom data.table rbindlist dcast #' @export @@ -599,8 +651,11 @@ calc_CrIs <- function(samples, summarise_by = NULL, CrIs = c(0.2, 0.5, 0.9)) { with_CrIs <- data.table::rbindlist(with_CrIs) scale_CrIs <- round(CrIs * 100, 1) - order_CrIs <- c(paste0("lower_", rev(scale_CrIs)), paste0("upper_", scale_CrIs)) - with_CrIs <- data.table::dcast(with_CrIs, ... ~ factor(CrI, levels = order_CrIs), + order_CrIs <- c( + paste0("lower_", rev(scale_CrIs)), paste0("upper_", scale_CrIs) + ) # nolint + with_CrIs <- data.table::dcast( + with_CrIs, ... ~ factor(CrI, levels = order_CrIs), value.var = "value" ) return(with_CrIs) @@ -621,8 +676,8 @@ calc_CrIs <- function(samples, summarise_by = NULL, CrIs = c(0.2, 0.5, 0.9)) { #' ) #' extract_CrIs(summarised) extract_CrIs <- function(summarised) { - CrIs <- grep("lower_", colnames(summarised), value = TRUE) - CrIs <- gsub("lower_", "", CrIs) + CrIs <- grep("lower_", colnames(summarised), value = TRUE, fixed = TRUE) + CrIs <- gsub("lower_", "", CrIs, fixed = TRUE) CrIs <- as.numeric(CrIs) return(CrIs) } @@ -630,9 +685,10 @@ extract_CrIs <- function(summarised) { #' Calculate Summary Statistics #' #' @description `r lifecycle::badge("stable")` -#' Calculate summary statistics from a data frame by group. Currently supports the -#' mean, median and standard deviation. -#' @return A data.table containing the upper and lower bounds for the specified credible interval +#' Calculate summary statistics from a data frame by group. Currently supports +#' the mean, median and standard deviation. +#' @return A data.table containing the upper and lower bounds for the specified +#' credible interval #' @export #' @inheritParams calc_CrI #' @importFrom data.table copy setDT @@ -658,10 +714,14 @@ calc_summary_stats <- function(samples, summarise_by = NULL) { #' Calculate All Summary Measures #' #' @description `r lifecycle::badge("stable")` -#' Calculate summary statistics and credible intervals from a data frame by group. -#' @param order_by A character vector of parameters to order by, defaults to all `summarise_by` -#' variables. +#' Calculate summary statistics and credible intervals from a data frame by +#' group. +#' +#' @param order_by A character vector of parameters to order by, defaults to +#' all `summarise_by` variables. +#' #' @return A data.table containing summary statistics by group. +#' #' @export #' @inheritParams calc_CrIs #' @importFrom data.table setorderv @@ -703,10 +763,14 @@ calc_summary_measures <- function(samples, #' @description `r lifecycle::badge("stable")` #' \code{summary} method for class "epinow". #' @param object A list of output as produced by "epinow". -#' @param output A character string of output to summarise. Defaults to "estimates" -#' but also supports "forecast", and "estimated_reported_cases". +#' +#' @param output A character string of output to summarise. Defaults to +#' "estimates" but also supports "forecast", and "estimated_reported_cases". +#' #' @inheritParams summary.estimate_infections +#' #' @param ... Pass additional summary arguments to lower level methods +#' #' @seealso summary.estimate_infections epinow #' @aliases summary #' @method summary epinow @@ -739,16 +803,23 @@ summary.epinow <- function(object, output = "estimates", #' #' @description `r lifecycle::badge("stable")` #' \code{summary} method for class "estimate_infections". +#' #' @param object A list of output as produced by "estimate_infections". -#' @param type A character vector of data types to return. Defaults to "snapshot" -#' but also supports "parameters", and "samples". "snapshot" returns a summary at -#' a given date (by default the latest date informed by data). "parameters" returns -#' summarised parameter estimates that can be further filtered using `params` to -#' show just the parameters of interest and date. "samples" similarly returns posterior +#' +#' @param type A character vector of data types to return. Defaults to +#' "snapshot" but also supports "parameters", and "samples". "snapshot" return +#' a summary at a given date (by default the latest date informed by data). +#' "parameters" returns summarised parameter estimates that can be further +#' filtered using `params` to show just the parameters of interest and date. +#' "samples" similarly returns posterior #' samples. +#' #' @param date A date in the form "yyyy-mm-dd" to inspect estimates for. +#' #' @param params A character vector of parameters to filter for. +#' #' @param ... Pass additional arguments to `report_summary` +#' #' @seealso summary estimate_infections report_summary #' @method summary estimate_infections #' @return Returns a data frame of summary output @@ -758,7 +829,9 @@ summary.estimate_infections <- function(object, type = "snapshot", choices <- c("snapshot", "parameters", "samples") type <- match.arg(type, choices, several.ok = FALSE) if (is.null(date)) { - target_date <- unique(object$summarised[type != "forecast"][date == max(date)]$date) + target_date <- unique( + object$summarised[type != "forecast"][date == max(date)]$date + ) } else { target_date <- as.Date(date) } @@ -766,7 +839,9 @@ summary.estimate_infections <- function(object, type = "snapshot", if (type %in% "snapshot") { out <- report_summary( summarised_estimates = object$summarised[date == target_date], - rt_samples = object$samples[variable == "R"][date == target_date, .(sample, value)], + rt_samples = object$samples[variable == "R"][ + date == target_date, .(sample, value) + ], ... ) } else if (type %in% c("parameters", "samples")) { diff --git a/R/utilities.R b/R/utilities.R index 8a270dffc..fd3370631 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -1,11 +1,14 @@ #' Clean Nowcasts for a Supplied Date #' #' @description `r lifecycle::badge("stable")` -#' This function removes nowcasts in the format produced by `EpiNow2` from a target -#' directory for the date supplied. +#' This function removes nowcasts in the format produced by `EpiNow2` from a +#' target directory for the date supplied. +#' #' @param date Date object. Defaults to today's date -#' @param nowcast_dir Character string giving the filepath to the nowcast results directory. Defaults -#' to the current directory. +#' +#' @param nowcast_dir Character string giving the filepath to the nowcast +#' results directory. Defaults to the current directory. +#' #' @importFrom purrr walk #' @importFrom futile.logger flog.info #' @return No return value, called for side effects @@ -38,11 +41,15 @@ clean_nowcasts <- function(date = NULL, nowcast_dir = ".") { #' #' @description `r lifecycle::badge("stable")` #' Combines a list of values into formatted credible intervals. +#' #' @param value List of value to map into a string. Requires, #' `point`, `lower`, and `upper.` -#' @param CrI Numeric, credible interval to report. Defaults to 90 +#' +#' @param CrI Numeric, credible interval to report. Defaults to 90. +#' #' @param reverse Logical, defaults to FALSE. Should the reported #' credible interval be switched. +#' #' @return A character vector formatted for reporting #' @export #' @examples @@ -66,7 +73,8 @@ make_conf <- function(value, CrI = 90, reverse = FALSE) { #' #' @description `r lifecycle::badge("stable")` #' Categorises a numeric variable into "Increasing" (< 0.05), -#' "Likely increasing" (<0.4), "Stable" (< 0.6), "Likely decreasing" (< 0.95), "Decreasing" (<= 1) +#' "Likely increasing" (<0.4), "Stable" (< 0.6), +#' "Likely decreasing" (< 0.95), "Decreasing" (<= 1) #' @param var Numeric variable to be categorised #' #' @return A character variable. @@ -96,12 +104,15 @@ map_prob_change <- function(var) { #' Convert Growth Rates to Reproduction numbers. #' #' @description `r lifecycle::badge("questioning")` -#' See [here](https://www.medrxiv.org/content/10.1101/2020.01.30.20019877v3.full.pdf) -#' for justification. Now handled internally by stan so may be removed in future updates if -#' no user demand. -#' @param r Numeric, rate of growth estimates +#' See [here](https://www.medrxiv.org/content/10.1101/2020.01.30.20019877v3.full.pdf) # nolint +#' for justification. Now handled internally by stan so may be removed in +#' future updates if no user demand. +#' @param r Numeric, rate of growth estimates. +#' #' @param gamma_mean Numeric, mean of the gamma distribution +#' #' @param gamma_sd Numeric, standard deviation of the gamma distribution +#'. #' @return Numeric vector of reproduction number estimates #' @export #' @examples @@ -115,9 +126,9 @@ growth_to_R <- function(r, gamma_mean, gamma_sd) { #' Convert Reproduction Numbers to Growth Rates #' #' @description `r lifecycle::badge("questioning")` -#' See [here](https://www.medrxiv.org/content/10.1101/2020.01.30.20019877v3.full.pdf) -#' for justification. Now handled internally by stan so may be removed in future updates if -#' no user demand. +#' See [here](https://www.medrxiv.org/content/10.1101/2020.01.30.20019877v3.full.pdf) # nolint +#' for justification. Now handled internally by stan so may be removed in +#' future updates if no user demand. #' @param R Numeric, Reproduction number estimates #' @inheritParams growth_to_R #' @return Numeric vector of reproduction number estimates @@ -221,11 +232,16 @@ match_output_arguments <- function(input_args = NULL, #' #' @description `r lifecycle::badge("stable")` #' his function exposes internal stan functions in R from a user -#' supplied list of target files. Allows for testing of stan functions in R and potentially -#' user use in R code. -#' @param files A character vector indicating the target files -#' @param target_dir A character string indicating the target directory for the file +#' supplied list of target files. Allows for testing of stan functions in R and +#' potentially user use in R code. +#' +#' @param files A character vector indicating the target files. +#' +#' @param target_dir A character string indicating the target directory for the +#' file. +#' #' @param ... Additional arguments passed to `rstan::expose_stan_functions`. +#' #' @return No return value, called for side effects #' @export #' @importFrom rstan expose_stan_functions stanc @@ -396,8 +412,8 @@ set_dt_single_thread <- function() { ) } -#' @importFrom stats glm median na.omit pexp pgamma plnorm quasipoisson rexp rgamma rlnorm rnorm rpois runif sd var -#' @importFrom lifecycle deprecate_warn +#' @importFrom stats glm median na.omit pexp pgamma plnorm quasipoisson rexp +#' @importFrom lifecycle deprecate_warn rlnorm rnorm rpois runif sd var rgamma globalVariables( c( "bottom", "cases", "confidence", "confirm", "country_code", "crps", diff --git a/man/R_to_growth.Rd b/man/R_to_growth.Rd index 49ce14084..837c01eb2 100644 --- a/man/R_to_growth.Rd +++ b/man/R_to_growth.Rd @@ -11,16 +11,17 @@ R_to_growth(R, gamma_mean, gamma_sd) \item{gamma_mean}{Numeric, mean of the gamma distribution} -\item{gamma_sd}{Numeric, standard deviation of the gamma distribution} +\item{gamma_sd}{Numeric, standard deviation of the gamma distribution +.} } \value{ Numeric vector of reproduction number estimates } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#questioning}{\figure{lifecycle-questioning.svg}{options: alt='[Questioning]'}}}{\strong{[Questioning]}} -See \href{https://www.medrxiv.org/content/10.1101/2020.01.30.20019877v3.full.pdf}{here} -for justification. Now handled internally by stan so may be removed in future updates if -no user demand. +See \href{https://www.medrxiv.org/content/10.1101/2020.01.30.20019877v3.full.pdf}{here} # nolint +for justification. Now handled internally by stan so may be removed in +future updates if no user demand. } \examples{ R_to_growth(2.18, 4, 1) diff --git a/man/calc_CrI.Rd b/man/calc_CrI.Rd index dd7407106..2019f3aeb 100644 --- a/man/calc_CrI.Rd +++ b/man/calc_CrI.Rd @@ -4,18 +4,19 @@ \alias{calc_CrI} \title{Calculate Credible Interval} \usage{ -calc_CrI(samples, summarise_by = c(), CrI = 0.9) +calc_CrI(samples, summarise_by = NULL, CrI = 0.9) } \arguments{ \item{samples}{A data.table containing at least a value variable} \item{summarise_by}{A character vector of variables to group by.} -\item{CrI}{Numeric between 0 and 1. The credible interval for which to return values. -Defaults to 0.9.} +\item{CrI}{Numeric between 0 and 1. The credible interval for which to +return values. Defaults to 0.9.} } \value{ -A data.table containing the upper and lower bounds for the specified credible interval +A data.table containing the upper and lower bounds for the specified +credible interval. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} diff --git a/man/calc_CrIs.Rd b/man/calc_CrIs.Rd index 166217d86..2a4fb4218 100644 --- a/man/calc_CrIs.Rd +++ b/man/calc_CrIs.Rd @@ -4,7 +4,7 @@ \alias{calc_CrIs} \title{Calculate Credible Intervals} \usage{ -calc_CrIs(samples, summarise_by = c(), CrIs = c(0.2, 0.5, 0.9)) +calc_CrIs(samples, summarise_by = NULL, CrIs = c(0.2, 0.5, 0.9)) } \arguments{ \item{samples}{A data.table containing at least a value variable} @@ -14,8 +14,8 @@ calc_CrIs(samples, summarise_by = c(), CrIs = c(0.2, 0.5, 0.9)) \item{CrIs}{Numeric vector of credible intervals to calculate.} } \value{ -A data.table containing the \code{summarise_by} variables and the specified lower and upper -credible intervals +A data.table containing the \code{summarise_by} variables and the +specified lower and upper credible intervals. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} diff --git a/man/calc_summary_measures.Rd b/man/calc_summary_measures.Rd index 2e8dde911..16f1397b0 100644 --- a/man/calc_summary_measures.Rd +++ b/man/calc_summary_measures.Rd @@ -16,8 +16,8 @@ calc_summary_measures( \item{summarise_by}{A character vector of variables to group by.} -\item{order_by}{A character vector of parameters to order by, defaults to all \code{summarise_by} -variables.} +\item{order_by}{A character vector of parameters to order by, defaults to +all \code{summarise_by} variables.} \item{CrIs}{Numeric vector of credible intervals to calculate.} } @@ -26,7 +26,8 @@ A data.table containing summary statistics by group. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Calculate summary statistics and credible intervals from a data frame by group. +Calculate summary statistics and credible intervals from a data frame by +group. } \examples{ samples <- data.frame(value = 1:10, type = "car") diff --git a/man/calc_summary_stats.Rd b/man/calc_summary_stats.Rd index 5aa397269..e69c15caf 100644 --- a/man/calc_summary_stats.Rd +++ b/man/calc_summary_stats.Rd @@ -4,7 +4,7 @@ \alias{calc_summary_stats} \title{Calculate Summary Statistics} \usage{ -calc_summary_stats(samples, summarise_by = c()) +calc_summary_stats(samples, summarise_by = NULL) } \arguments{ \item{samples}{A data.table containing at least a value variable} @@ -12,12 +12,13 @@ calc_summary_stats(samples, summarise_by = c()) \item{summarise_by}{A character vector of variables to group by.} } \value{ -A data.table containing the upper and lower bounds for the specified credible interval +A data.table containing the upper and lower bounds for the specified +credible interval } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Calculate summary statistics from a data frame by group. Currently supports the -mean, median and standard deviation. +Calculate summary statistics from a data frame by group. Currently supports +the mean, median and standard deviation. } \examples{ samples <- data.frame(value = 1:10, type = "car") diff --git a/man/clean_nowcasts.Rd b/man/clean_nowcasts.Rd index 98c25af5f..95903e262 100644 --- a/man/clean_nowcasts.Rd +++ b/man/clean_nowcasts.Rd @@ -9,14 +9,14 @@ clean_nowcasts(date = NULL, nowcast_dir = ".") \arguments{ \item{date}{Date object. Defaults to today's date} -\item{nowcast_dir}{Character string giving the filepath to the nowcast results directory. Defaults -to the current directory.} +\item{nowcast_dir}{Character string giving the filepath to the nowcast +results directory. Defaults to the current directory.} } \value{ No return value, called for side effects } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -This function removes nowcasts in the format produced by \code{EpiNow2} from a target -directory for the date supplied. +This function removes nowcasts in the format produced by \code{EpiNow2} from a +target directory for the date supplied. } diff --git a/man/create_future_rt.Rd b/man/create_future_rt.Rd index 0b220281e..39b3adebc 100644 --- a/man/create_future_rt.Rd +++ b/man/create_future_rt.Rd @@ -7,10 +7,13 @@ create_future_rt(future = "latest", delay = 0) } \arguments{ -\item{future}{A character string or integer. This argument indicates how to set future Rt values. Supported -options are to project using the Rt model ("project"), to use the latest estimate based on partial data ("latest"), -to use the latest estimate based on data that is over 50\% complete ("estimate"). If an integer is supplied then the Rt estimate -from this many days into the future (or past if negative) past will be used forwards in time.} +\item{future}{A character string or integer. This argument indicates how to +set future Rt values. Supported options are to project using the Rt model +("project"), to use the latest estimate based on partial data ("latest"), +to use the latest estimate based on data that is over 50\% complete +("estimate"). If an integer is supplied then the Rt estimate from this many +days into the future (or past if negative) past will be used forwards in +time.} \item{delay}{Numeric mean delay} } @@ -19,7 +22,8 @@ A list containing a logical called fixed and an integer called from } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Converts the \code{future} argument from \code{rt_opts()} into arguments that can be passed to \code{stan}. +Converts the \code{future} argument from \code{rt_opts()} into arguments that can be +passed to \code{stan}. } \author{ Sam Abbott diff --git a/man/create_initial_conditions.Rd b/man/create_initial_conditions.Rd index ad3b5b7d7..96c8ec1fb 100644 --- a/man/create_initial_conditions.Rd +++ b/man/create_initial_conditions.Rd @@ -14,7 +14,8 @@ An initial condition generating function } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Uses the output of \code{create_stan_data} to create a function which can be used to -sample from the prior distributions (or as close as possible) for parameters. Used -in order to initialise each \code{stan} chain within a range of plausible values. +Uses the output of \code{create_stan_data} to create a function which can be used +to sample from the prior distributions (or as close as possible) for +parameters. Used in order to initialise each \code{stan} chain within a range of +plausible values. } diff --git a/man/create_obs_model.Rd b/man/create_obs_model.Rd index d984a08af..335cefd24 100644 --- a/man/create_obs_model.Rd +++ b/man/create_obs_model.Rd @@ -18,7 +18,8 @@ the Observation Model } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Takes the output of \code{obs_opts()} and converts it into a list understood by \code{stan}. +Takes the output of \code{obs_opts()} and converts it into a list understood +by \code{stan}. } \examples{ dates <- seq(as.Date("2020-03-15"), by = "days", length.out = 15) @@ -29,7 +30,9 @@ create_obs_model(dates = dates) create_obs_model(obs_opts(family = "poisson"), dates = dates) # Applying a observation scaling to the data -create_obs_model(obs_opts(scale = list(mean = 0.4, sd = 0.01)), dates = dates) +create_obs_model( + obs_opts(scale = list(mean = 0.4, sd = 0.01)), dates = dates +) # Apply a custom week week length create_obs_model(obs_opts(week_length = 3), dates = dates) diff --git a/man/create_stan_args.Rd b/man/create_stan_args.Rd index 41201aaac..9d7c2583a 100644 --- a/man/create_stan_args.Rd +++ b/man/create_stan_args.Rd @@ -12,24 +12,27 @@ create_stan_args( ) } \arguments{ -\item{stan}{A list of stan options as generated by \code{stan_opts()}. Defaults to \code{stan_opts()}. Can be used to override -\code{data}, \code{init}, and \code{verbose} settings if desired.} +\item{stan}{A list of stan options as generated by \code{stan_opts()}. Defaults +to \code{stan_opts()}. Can be used to override \code{data}, \code{init}, and \code{verbose} +settings if desired.} \item{data}{A list of stan data as created by \code{create_stan_data}} -\item{init}{Initial conditions passed to \code{rstan}. Defaults to "random" but can also be a function ( -as supplied by \code{create_intitial_conditions}).} +\item{init}{Initial conditions passed to \code{rstan}. Defaults to "random" but +can also be a function (as supplied by \code{create_intitial_conditions}).} -\item{verbose}{Logical, defaults to \code{FALSE}. Should verbose progress messages be returned.} +\item{verbose}{Logical, defaults to \code{FALSE}. Should verbose progress +messages be returned.} } \value{ A list of stan arguments } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Generates a list of arguments as required by \code{rstan::sampling} or \code{rstan::vb} by combining the required options, -with data, and type of initialisation. Initialisation defaults to random but it is expected that \code{create_initial_conditions} -will be used. +Generates a list of arguments as required by \code{rstan::sampling} or +\code{rstan::vb} by combining the required options, with data, and type of +initialisation. Initialisation defaults to random but it is expected that +\code{create_initial_conditions} will be used. } \examples{ # default settings diff --git a/man/epinow.Rd b/man/epinow.Rd index c10ceccf8..92b723d3b 100644 --- a/man/epinow.Rd +++ b/man/epinow.Rd @@ -59,8 +59,9 @@ Gaussian process.} \item{obs}{A list of options as generated by \code{obs_opts()} defining the observation model. Defaults to \code{obs_opts()}.} -\item{stan}{A list of stan options as generated by \code{stan_opts()}. Defaults to \code{stan_opts()}. Can be used to override -\code{data}, \code{init}, and \code{verbose} settings if desired.} +\item{stan}{A list of stan options as generated by \code{stan_opts()}. Defaults +to \code{stan_opts()}. Can be used to override \code{data}, \code{init}, and \code{verbose} +settings if desired.} \item{horizon}{Numeric, defaults to 7. Number of days into the future to forecast.} @@ -115,7 +116,7 @@ report_cases, and report_summary. This function wraps the functionality of \code{estimate_infections()} and \code{forecast_infections()} in order to estimate Rt and cases by date of infection, forecast into these infections into the future. It also contains -additional functionality to convert forecasts to date of report and produc +additional functionality to convert forecasts to date of report and produce summary output useful for reporting results and interpreting them. See \href{https://gist.github.com/seabbs/163d0f195892cde685c70473e1f5e867}{here} for an example of using \code{epinow} to estimate Rt for Covid-19 in a country from @@ -128,7 +129,9 @@ old_opts <- options() options(mc.cores = ifelse(interactive(), 4, 1)) # construct example distributions generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") -incubation_period <- get_incubation_period(disease = "SARS-CoV-2", source = "lauer") +incubation_period <- get_incubation_period( + disease = "SARS-CoV-2", source = "lauer" +) reporting_delay <- list( mean = convert_to_logmean(2, 1), mean_sd = 0.1, diff --git a/man/estimate_infections.Rd b/man/estimate_infections.Rd index ca888bd6a..aad4a5547 100644 --- a/man/estimate_infections.Rd +++ b/man/estimate_infections.Rd @@ -54,8 +54,9 @@ Gaussian process.} \item{obs}{A list of options as generated by \code{obs_opts()} defining the observation model. Defaults to \code{obs_opts()}.} -\item{stan}{A list of stan options as generated by \code{stan_opts()}. Defaults to \code{stan_opts()}. Can be used to override -\code{data}, \code{init}, and \code{verbose} settings if desired.} +\item{stan}{A list of stan options as generated by \code{stan_opts()}. Defaults +to \code{stan_opts()}. Can be used to override \code{data}, \code{init}, and \code{verbose} +settings if desired.} \item{horizon}{Numeric, defaults to 7. Number of days into the future to forecast.} diff --git a/man/estimate_secondary.Rd b/man/estimate_secondary.Rd index 4847e366f..01965f29f 100644 --- a/man/estimate_secondary.Rd +++ b/man/estimate_secondary.Rd @@ -112,7 +112,7 @@ inc <- estimate_secondary(cases[1:60], plot(inc, primary = TRUE) # forecast future secondary cases from primary -inc_preds <- forecast_secondary(inc, cases[61:.N][, value := primary]) +inc_preds <- forecast_secondary(inc, cases[6seq_len(.N)][, value := primary]) plot(inc_preds, new_obs = cases, from = "2020-05-01") #### Prevalence data example #### @@ -139,7 +139,7 @@ prev <- estimate_secondary(cases[1:100], plot(prev, primary = TRUE) # forecast future secondary cases from primary -prev_preds <- forecast_secondary(prev, cases[101:.N][, value := primary]) +prev_preds <- forecast_secondary(prev, cases[10seq_len(.N)][, value := primary]) plot(prev_preds, new_obs = cases, from = "2020-06-01") options(old_opts) diff --git a/man/expose_stan_fns.Rd b/man/expose_stan_fns.Rd index b0fa09cc4..68cbd00c4 100644 --- a/man/expose_stan_fns.Rd +++ b/man/expose_stan_fns.Rd @@ -7,9 +7,10 @@ expose_stan_fns(files, target_dir, ...) } \arguments{ -\item{files}{A character vector indicating the target files} +\item{files}{A character vector indicating the target files.} -\item{target_dir}{A character string indicating the target directory for the file} +\item{target_dir}{A character string indicating the target directory for the +file.} \item{...}{Additional arguments passed to \code{rstan::expose_stan_functions}.} } @@ -19,6 +20,6 @@ No return value, called for side effects \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} his function exposes internal stan functions in R from a user -supplied list of target files. Allows for testing of stan functions in R and potentially -user use in R code. +supplied list of target files. Allows for testing of stan functions in R and +potentially user use in R code. } diff --git a/man/get_regional_results.Rd b/man/get_regional_results.Rd index a8a5ab4b4..e022d9e76 100644 --- a/man/get_regional_results.Rd +++ b/man/get_regional_results.Rd @@ -39,8 +39,12 @@ examples for details. \examples{ \donttest{ # construct example distributions -generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") -incubation_period <- get_incubation_period(disease = "SARS-CoV-2", source = "lauer") +generation_time <- get_generation_time( + disease = "SARS-CoV-2", source = "ganyani" +) +incubation_period <- get_incubation_period( + disease = "SARS-CoV-2", source = "lauer" +) reporting_delay <- estimate_delay(rlnorm(100, log(6), 1), max_value = 10) # example case vector diff --git a/man/growth_to_R.Rd b/man/growth_to_R.Rd index 63780fded..8403d965c 100644 --- a/man/growth_to_R.Rd +++ b/man/growth_to_R.Rd @@ -7,20 +7,21 @@ growth_to_R(r, gamma_mean, gamma_sd) } \arguments{ -\item{r}{Numeric, rate of growth estimates} +\item{r}{Numeric, rate of growth estimates.} \item{gamma_mean}{Numeric, mean of the gamma distribution} -\item{gamma_sd}{Numeric, standard deviation of the gamma distribution} +\item{gamma_sd}{Numeric, standard deviation of the gamma distribution +.} } \value{ Numeric vector of reproduction number estimates } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#questioning}{\figure{lifecycle-questioning.svg}{options: alt='[Questioning]'}}}{\strong{[Questioning]}} -See \href{https://www.medrxiv.org/content/10.1101/2020.01.30.20019877v3.full.pdf}{here} -for justification. Now handled internally by stan so may be removed in future updates if -no user demand. +See \href{https://www.medrxiv.org/content/10.1101/2020.01.30.20019877v3.full.pdf}{here} # nolint +for justification. Now handled internally by stan so may be removed in +future updates if no user demand. } \examples{ growth_to_R(0.2, 4, 1) diff --git a/man/make_conf.Rd b/man/make_conf.Rd index 87b0f9e04..7e12c98fd 100644 --- a/man/make_conf.Rd +++ b/man/make_conf.Rd @@ -10,7 +10,7 @@ make_conf(value, CrI = 90, reverse = FALSE) \item{value}{List of value to map into a string. Requires, \code{point}, \code{lower}, and \code{upper.}} -\item{CrI}{Numeric, credible interval to report. Defaults to 90} +\item{CrI}{Numeric, credible interval to report. Defaults to 90.} \item{reverse}{Logical, defaults to FALSE. Should the reported credible interval be switched.} diff --git a/man/map_prob_change.Rd b/man/map_prob_change.Rd index d9e70fbe6..db4a43105 100644 --- a/man/map_prob_change.Rd +++ b/man/map_prob_change.Rd @@ -15,7 +15,8 @@ A character variable. \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} Categorises a numeric variable into "Increasing" (< 0.05), -"Likely increasing" (<0.4), "Stable" (< 0.6), "Likely decreasing" (< 0.95), "Decreasing" (<= 1) +"Likely increasing" (<0.4), "Stable" (< 0.6), +"Likely decreasing" (< 0.95), "Decreasing" (<= 1) } \examples{ var <- seq(0.01, 1, 0.01) diff --git a/man/match_output_arguments.Rd b/man/match_output_arguments.Rd index 972cb8b54..e972111fe 100644 --- a/man/match_output_arguments.Rd +++ b/man/match_output_arguments.Rd @@ -5,8 +5,8 @@ \title{Match User Supplied Arguments with Supported Options} \usage{ match_output_arguments( - input_args = c(), - supported_args = c(), + input_args = NULL, + supported_args = NULL, logger = NULL, level = "info" ) diff --git a/man/plot_estimates.Rd b/man/plot_estimates.Rd index 37d75a960..b996c1b68 100644 --- a/man/plot_estimates.Rd +++ b/man/plot_estimates.Rd @@ -49,7 +49,9 @@ cases <- example_confirmed[1:40] # set up example delays generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") -incubation_period <- get_incubation_period(disease = "SARS-CoV-2", source = "lauer") +incubation_period <- get_incubation_period( + disease = "SARS-CoV-2", source = "lauer" +) reporting_delay <- estimate_delay(rlnorm(100, log(6), 1), max_value = 10) # run model diff --git a/man/regional_epinow.Rd b/man/regional_epinow.Rd index 8bf57a9a9..4cf13c6f8 100644 --- a/man/regional_epinow.Rd +++ b/man/regional_epinow.Rd @@ -57,8 +57,9 @@ Gaussian process.} \item{obs}{A list of options as generated by \code{obs_opts()} defining the observation model. Defaults to \code{obs_opts()}.} -\item{stan}{A list of stan options as generated by \code{stan_opts()}. Defaults to \code{stan_opts()}. Can be used to override -\code{data}, \code{init}, and \code{verbose} settings if desired.} +\item{stan}{A list of stan options as generated by \code{stan_opts()}. Defaults +to \code{stan_opts()}. Can be used to override \code{data}, \code{init}, and \code{verbose} +settings if desired.} \item{horizon}{Numeric, defaults to 7. Number of days into the future to forecast.} @@ -119,7 +120,9 @@ options(mc.cores = ifelse(interactive(), 4, 1)) # construct example distributions generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") -incubation_period <- get_incubation_period(disease = "SARS-CoV-2", source = "lauer") +incubation_period <- get_incubation_period( + disease = "SARS-CoV-2", source = "lauer" +) reporting_delay <- list( mean = convert_to_logmean(2, 1), mean_sd = 0.1, diff --git a/man/regional_runtimes.Rd b/man/regional_runtimes.Rd index dbdfd6acb..c97774d0e 100644 --- a/man/regional_runtimes.Rd +++ b/man/regional_runtimes.Rd @@ -34,8 +34,12 @@ Used internally by \code{regional_epinow} to summarise region run times. \examples{ \donttest{ # example delays -generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") -incubation_period <- get_incubation_period(disease = "SARS-CoV-2", source = "lauer") +generation_time <- get_generation_time( + disease = "SARS-CoV-2", source = "ganyani" +) +incubation_period <- get_incubation_period( + disease = "SARS-CoV-2", source = "lauer" +) reporting_delay <- estimate_delay(rlnorm(100, log(6), 1), max_value = 15) cases <- example_confirmed[1:30] diff --git a/man/regional_summary.Rd b/man/regional_summary.Rd index a3c2d096a..1e7ae3ef1 100644 --- a/man/regional_summary.Rd +++ b/man/regional_summary.Rd @@ -61,8 +61,12 @@ externally. \examples{ \donttest{ # example delays -generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") -incubation_period <- get_incubation_period(disease = "SARS-CoV-2", source = "lauer") +generation_time <- get_generation_time( + disease = "SARS-CoV-2", source = "ganyani" +) +incubation_period <- get_incubation_period( + disease = "SARS-CoV-2", source = "lauer" +) reporting_delay <- estimate_delay(rlnorm(100, log(6), 1), max_value = 30) # example case vector from EpiSoon diff --git a/man/report_cases.Rd b/man/report_cases.Rd index ae500fb9d..7d4169a23 100644 --- a/man/report_cases.Rd +++ b/man/report_cases.Rd @@ -14,7 +14,8 @@ report_cases( ) } \arguments{ -\item{case_estimates}{A data.table of case estimates with the following variables: date, sample, cases} +\item{case_estimates}{A data.table of case estimates with the following +variables: date, sample, cases} \item{case_forecast}{A data.table of case forecasts with the following variables: date, sample, cases. If not supplied the default is not to @@ -52,8 +53,12 @@ the \code{stan} implementation. cases <- example_confirmed[1:40] # set up example delays -generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") -incubation_period <- get_incubation_period(disease = "SARS-CoV-2", source = "lauer") +generation_time <- get_generation_time( + disease = "SARS-CoV-2", source = "ganyani" +) +incubation_period <- get_incubation_period( + disease = "SARS-CoV-2", source = "lauer" +) reporting_delay <- list( mean = convert_to_logmean(2, 1), mean_sd = 0.1, sd = convert_to_logsd(2, 1), sd_sd = 0.1, max = 10 diff --git a/man/report_plots.Rd b/man/report_plots.Rd index 7fa69f71e..4df660803 100644 --- a/man/report_plots.Rd +++ b/man/report_plots.Rd @@ -20,16 +20,13 @@ reported_cases_rt, and r (rate of growth).} \item{...}{Additional arguments passed to \code{plot_estimates()}.} } \value{ -A named list of \code{ggplot2} objects, \code{list(infections, reports, R, growth_rate, summary)}, -which correspond to a summary combination (last item) and for the leading items -@seealso \code{\link[=plot_estimates]{plot_estimates()}} of \code{summarised_estimates[variable == "infections"]}, -\code{summarised_estimates[variable == "reported_cases"]}, \code{summarised_estimates[variable == "R"]}, -and \code{summarised_estimates[variable == "growth_rate"]}, respectively. +A named list of \code{ggplot2} objects, \code{list(infections, reports, R, growth_rate, summary)}, which correspond to a summary combination (last +item) and for the leading items. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#questioning}{\figure{lifecycle-questioning.svg}{options: alt='[Questioning]'}}}{\strong{[Questioning]}} -Returns key summary plots for estimates. May be depreciated in later releases as current S3 methods -are enhanced. +Returns key summary plots for estimates. May be depreciated in later +releases as current S3 methods are enhanced. } \examples{ \donttest{ @@ -37,8 +34,12 @@ are enhanced. cases <- example_confirmed[1:40] # set up example delays -generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") -incubation_period <- get_incubation_period(disease = "SARS-CoV-2", source = "lauer") +generation_time <- get_generation_time( + disease = "SARS-CoV-2", source = "ganyani" +) +incubation_period <- get_incubation_period( + disease = "SARS-CoV-2", source = "lauer" +) reporting_delay <- bootstrapped_dist_fit(rlnorm(100, log(6), 1), max_value = 30) # run model @@ -57,3 +58,10 @@ plots <- report_plots( plots } } +\seealso{ +\code{\link[=plot_estimates]{plot_estimates()}} of +\code{summarised_estimates[variable == "infections"]}, +\code{summarised_estimates[variable == "reported_cases"]}, +\code{summarised_estimates[variable == "R"]}, and +\code{summarised_estimates[variable == "growth_rate"]}, respectively. +} diff --git a/man/report_summary.Rd b/man/report_summary.Rd index 8d238e0ae..739a445ca 100644 --- a/man/report_summary.Rd +++ b/man/report_summary.Rd @@ -12,9 +12,9 @@ report_summary( ) } \arguments{ -\item{summarised_estimates}{A data.table of summarised estimates containing the following variables: -variable, median, bottom, and top. It should contain the following estimates: R, infections, and r -(rate of growth).} +\item{summarised_estimates}{A data.table of summarised estimates containing +the following variables: variable, median, bottom, and top. It should +contain the following estimates: R, infections, and r (rate of growth).} \item{rt_samples}{A data.table containing Rt samples with the following variables: sample and value.} @@ -27,6 +27,6 @@ A data.table containing formatted and numeric summary measures } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#questioning}{\figure{lifecycle-questioning.svg}{options: alt='[Questioning]'}}}{\strong{[Questioning]}} -Creates a snapshot summary of estimates. May be removed in later releases as S3 methods are -enhanced. +Creates a snapshot summary of estimates. May be removed in later releases as +S3 methods are enhanced. } diff --git a/man/rt_opts.Rd b/man/rt_opts.Rd index 477393ad1..8fa465e2c 100644 --- a/man/rt_opts.Rd +++ b/man/rt_opts.Rd @@ -33,10 +33,13 @@ are fit jointly with a global non-parametric effect and so represent a conservative estimate of break point changes (alter this by setting \code{gp = NULL}).} -\item{future}{A character string or integer. This argument indicates how to set future Rt values. Supported -options are to project using the Rt model ("project"), to use the latest estimate based on partial data ("latest"), -to use the latest estimate based on data that is over 50\% complete ("estimate"). If an integer is supplied then the Rt estimate -from this many days into the future (or past if negative) past will be used forwards in time.} +\item{future}{A character string or integer. This argument indicates how to +set future Rt values. Supported options are to project using the Rt model +("project"), to use the latest estimate based on partial data ("latest"), +to use the latest estimate based on data that is over 50\% complete +("estimate"). If an integer is supplied then the Rt estimate from this many +days into the future (or past if negative) past will be used forwards in +time.} \item{gp_on}{Character string, defaulting to "R_t-1". Indicates how the Gaussian process, if in use, should be applied to Rt. Currently supported diff --git a/man/run_region.Rd b/man/run_region.Rd index 2b744e110..3c23c0ba1 100644 --- a/man/run_region.Rd +++ b/man/run_region.Rd @@ -57,8 +57,9 @@ Gaussian process.} \item{obs}{A list of options as generated by \code{obs_opts()} defining the observation model. Defaults to \code{obs_opts()}.} -\item{stan}{A list of stan options as generated by \code{stan_opts()}. Defaults to \code{stan_opts()}. Can be used to override -\code{data}, \code{init}, and \code{verbose} settings if desired.} +\item{stan}{A list of stan options as generated by \code{stan_opts()}. Defaults +to \code{stan_opts()}. Can be used to override \code{data}, \code{init}, and \code{verbose} +settings if desired.} \item{horizon}{Numeric, defaults to 7. Number of days into the future to forecast.} diff --git a/man/simulate_infections.Rd b/man/simulate_infections.Rd index 9c7dd7b2c..23444f428 100644 --- a/man/simulate_infections.Rd +++ b/man/simulate_infections.Rd @@ -58,7 +58,9 @@ reported_cases <- example_confirmed[1:50] # set up example generation time generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") # set delays between infection and case report -incubation_period <- get_incubation_period(disease = "SARS-CoV-2", source = "lauer") +incubation_period <- get_incubation_period( + disease = "SARS-CoV-2", source = "lauer" +) reporting_delay <- list( mean = convert_to_logmean(2, 1), mean_sd = 0.1, sd = convert_to_logsd(2, 1), sd_sd = 0.1, max = 15 diff --git a/man/summarise_key_measures.Rd b/man/summarise_key_measures.Rd index 543e40024..771e04fe2 100644 --- a/man/summarise_key_measures.Rd +++ b/man/summarise_key_measures.Rd @@ -13,7 +13,8 @@ summarise_key_measures( ) } \arguments{ -\item{regional_results}{A list of dataframes as produced by \code{get_regional_results}} +\item{regional_results}{A list of dataframes as produced by +\code{get_regional_results}} \item{results_dir}{Character string indicating the directory from which to extract results.} @@ -21,18 +22,21 @@ extract results.} \item{summary_dir}{Character string the directory into which to save results as a csv.} -\item{type}{Character string, the region identifier to apply (defaults to region).} +\item{type}{Character string, the region identifier to apply (defaults to +region).} \item{date}{A Character string (in the format "yyyy-mm-dd") indicating the date to extract data for. Defaults to "latest" which finds the latest results available.} } \value{ -A list of summarised Rt, cases by date of infection and cases by date of report +A list of summarised Rt, cases by date of infection and cases by +date of report } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#maturing}{\figure{lifecycle-maturing.svg}{options: alt='[Maturing]'}}}{\strong{[Maturing]}} -Produces summarised data frames of output across regions. Used internally by \code{regional_summary}. +Produces summarised data frames of output across regions. Used internally by +\code{regional_summary}. } \seealso{ regional_summary diff --git a/man/summary.epinow.Rd b/man/summary.epinow.Rd index 573d8b76d..7fced965c 100644 --- a/man/summary.epinow.Rd +++ b/man/summary.epinow.Rd @@ -10,8 +10,8 @@ \arguments{ \item{object}{A list of output as produced by "epinow".} -\item{output}{A character string of output to summarise. Defaults to "estimates" -but also supports "forecast", and "estimated_reported_cases".} +\item{output}{A character string of output to summarise. Defaults to +"estimates" but also supports "forecast", and "estimated_reported_cases".} \item{date}{A date in the form "yyyy-mm-dd" to inspect estimates for.} diff --git a/man/summary.estimate_infections.Rd b/man/summary.estimate_infections.Rd index 9e7dc1868..71940df28 100644 --- a/man/summary.estimate_infections.Rd +++ b/man/summary.estimate_infections.Rd @@ -9,11 +9,12 @@ \arguments{ \item{object}{A list of output as produced by "estimate_infections".} -\item{type}{A character vector of data types to return. Defaults to "snapshot" -but also supports "parameters", and "samples". "snapshot" returns a summary at -a given date (by default the latest date informed by data). "parameters" returns -summarised parameter estimates that can be further filtered using \code{params} to -show just the parameters of interest and date. "samples" similarly returns posterior +\item{type}{A character vector of data types to return. Defaults to +"snapshot" but also supports "parameters", and "samples". "snapshot" return +a summary at a given date (by default the latest date informed by data). +"parameters" returns summarised parameter estimates that can be further +filtered using \code{params} to show just the parameters of interest and date. +"samples" similarly returns posterior samples.} \item{date}{A date in the form "yyyy-mm-dd" to inspect estimates for.} diff --git a/man/update_secondary_args.Rd b/man/update_secondary_args.Rd index b3553c7b7..232c29928 100644 --- a/man/update_secondary_args.Rd +++ b/man/update_secondary_args.Rd @@ -17,7 +17,8 @@ fraction ("frac_obs"), the mean delay ("delay_mean"), and standard deviation of the delay ("delay_sd"). The \code{data.frame} should have the following variables: \code{variable}, \code{mean}, and \code{sd}.} -\item{verbose}{Logical, defaults to \code{FALSE}. Should verbose progress messages be returned.} +\item{verbose}{Logical, defaults to \code{FALSE}. Should verbose progress +messages be returned.} } \value{ A list as produced by \code{create_stan_data()}. diff --git a/tests/testthat/test-estimate_secondary.R b/tests/testthat/test-estimate_secondary.R index 88c11245c..c142d4abb 100644 --- a/tests/testthat/test-estimate_secondary.R +++ b/tests/testthat/test-estimate_secondary.R @@ -97,7 +97,7 @@ test_that("estimate_secondary can recover simulated parameters", { test_that("forecast_secondary can return values from simulated data and plot them", { - inc_preds <- forecast_secondary(inc, cases[61:.N][, value := primary]) + inc_preds <- forecast_secondary(inc, cases[6seq_len(.N)][, value := primary]) expect_equal(names(inc_preds), c("samples", "forecast", "predictions")) # validation plot of observations vs estimates expect_error(plot(inc_preds, new_obs = cases, from = "2020-05-01"), NA) diff --git a/tests/testthat/test-report_cases.R b/tests/testthat/test-report_cases.R index 737f8ee47..5c0318d16 100644 --- a/tests/testthat/test-report_cases.R +++ b/tests/testthat/test-report_cases.R @@ -3,8 +3,12 @@ test_that("report_cases can simulate infections forward", { cases <- example_confirmed[1:10] # set up example delays - generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") - incubation_period <- get_incubation_period(disease = "SARS-CoV-2", source = "lauer") + generation_time <- get_generation_time( + disease = "SARS-CoV-2", source = "ganyani" + ) + incubation_period <- get_incubation_period( + disease = "SARS-CoV-2", source = "lauer" + ) reporting_delay <- list( mean = convert_to_logmean(2, 1), mean_sd = 0.1, sd = convert_to_logsd(2, 1), sd_sd = 0.1, max = 5 From f4b170f08395733579089c9f4e239b0bab11992e Mon Sep 17 00:00:00 2001 From: Sam Abbott Date: Thu, 27 Apr 2023 13:36:50 +0100 Subject: [PATCH 07/19] additional linting changes - mostly linewidths --- NAMESPACE | 14 +-- R/estimate_infections.R | 13 ++- R/regional_epinow.R | 132 ++++++++++++++++++--------- R/report.R | 9 +- R/setup.R | 90 +++++++++++------- R/simulate_infections.R | 17 ++-- R/summarise.R | 41 ++++++--- R/utilities.R | 40 ++++---- man/clean_regions.Rd | 12 ++- man/epinow.Rd | 8 +- man/estimate_infections.Rd | 3 +- man/get_regions_with_most_reports.Rd | 3 +- man/match_output_arguments.Rd | 13 +-- man/process_region.Rd | 4 +- man/regional_epinow.Rd | 76 +++++++++------ man/regional_summary.Rd | 10 +- man/report_summary.Rd | 3 +- man/run_region.Rd | 30 +++--- man/setup_default_logging.Rd | 12 +-- man/setup_future.Rd | 20 ++-- man/setup_logging.Rd | 29 +++--- man/simulate_infections.Rd | 10 +- man/summarise_results.Rd | 15 +-- 23 files changed, 371 insertions(+), 233 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index f09aea3ab..ba4559ebd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -158,13 +158,6 @@ importFrom(ggplot2,theme) importFrom(ggplot2,theme_bw) importFrom(lifecycle,deprecate_soft) importFrom(lifecycle,deprecate_warn) -importFrom(lifecycle,rgamma) -importFrom(lifecycle,rlnorm) -importFrom(lifecycle,rnorm) -importFrom(lifecycle,rpois) -importFrom(lifecycle,runif) -importFrom(lifecycle,sd) -importFrom(lifecycle,var) importFrom(lubridate,days) importFrom(lubridate,wday) importFrom(patchwork,plot_layout) @@ -204,6 +197,13 @@ importFrom(stats,plnorm) importFrom(stats,quantile) importFrom(stats,quasipoisson) importFrom(stats,rexp) +importFrom(stats,rgamma) +importFrom(stats,rlnorm) +importFrom(stats,rnorm) +importFrom(stats,rpois) +importFrom(stats,runif) +importFrom(stats,sd) +importFrom(stats,var) importFrom(truncnorm,rtruncnorm) importFrom(utils,capture.output) importFrom(utils,tail) diff --git a/R/estimate_infections.R b/R/estimate_infections.R index 27d8abb9e..591d6fbf3 100644 --- a/R/estimate_infections.R +++ b/R/estimate_infections.R @@ -87,7 +87,8 @@ #' # summary plot #' plot(def) #' -#' # decreasing the accuracy of the approximate Gaussian to speed up computation. +#' # decreasing the accuracy of the approximate Gaussian to speed up +#' #computation. #' # These settings are an area of active research. See ?gp_opts for details. #' agp <- estimate_infections(reported_cases, #' generation_time = generation_time, @@ -588,7 +589,8 @@ fit_model_with_vb <- function(args, future = FALSE, id = "stan") { args$method <- NULL futile.logger::flog.debug( paste0( - "%s: Running in approximate mode for ", args$iter, " iterations (with ", args$trials, " attempts). Extracting ", + "%s: Running in approximate mode for ", args$iter, + " iterations (with ", args$trials, " attempts). Extracting ", args$output_samples, " approximate posterior samples for ", args$data$t, " time steps of which ", args$data$horizon, " are a forecast" ), @@ -685,11 +687,12 @@ format_fit <- function(posterior_samples, horizon, shift, burn_in, start_date, # remove burn in period if specified if (burn_in > 0) { - futile.logger::flog.info("burn_in is depreciated as of EpiNow2 1.3.0 - if using - this feature please contact the developers", + futile.logger::flog.info( + "burn_in is depreciated as of EpiNow2 1.3.0 - if using this feature", + " please contact the developers", name = "EpiNow2.epinow.estimate_infections" ) - format_out$samples <- + format_out$samples <- format_out$samples[is.na(date) | date >= (start_date + lubridate::days(burn_in))] } diff --git a/R/regional_epinow.R b/R/regional_epinow.R index 80e059153..c1c08b870 100644 --- a/R/regional_epinow.R +++ b/R/regional_epinow.R @@ -1,34 +1,56 @@ #' Real-time Rt Estimation, Forecasting and Reporting by Region #' #' @description `r lifecycle::badge("maturing")` -#' Efficiently runs `epinow()` across multiple regions in an efficient manner and conducts basic data checks and -#' cleaning such as removing regions with fewer than `non_zero_points` as these are unlikely to produce reasonable -#' results whilst consuming significant resources. See the documentation for `epinow` for further information. +#' Efficiently runs `epinow()` across multiple regions in an efficient manner +#' and conducts basic data checks and cleaning such as removing regions with +#' fewer than `non_zero_points` as these are unlikely to produce reasonable +#' results whilst consuming significant resources. See the documentation for +#' `epinow` for further information. #' -#' By default all arguments supporting input from `_opts()` functions are shared across regions (including delays, -#' truncation, Rt settings, stan settings, and gaussian process settings). Region specific settings are supported -#' by passing a named list of `_opts()` calls (with an entry per region) to the relevant argument. A helper function -#' (`opts_list`) is available to facilitate building this list. +#' By default all arguments supporting input from `_opts()` functions are +#' shared across regions (including delays, truncation, Rt settings, stan +#' settings, and gaussian process settings). Region specific settings are +#' supported by passing a named list of `_opts()` calls (with an entry per +#' region) to the relevant argument. A helper function (`opts_list`) is +#' available to facilitate building this list. +#' +#' Regions can be estimated in parallel using the `{future}` package (see +#' `setup_future`). The progress of producing estimates across multiple regions +#' is tracked using the `progressr` package. Modify this behaviour using +#' progressr::handlers and enable it in batch by setting +#' `R_PROGRESSR_ENABLE=TRUE` as an environment variable. +#' +#' @param reported_cases A data frame of confirmed cases (confirm) by date +#' (date), and region (`region`). +#' +#' @param non_zero_points Numeric, the minimum number of time points with +#' non-zero cases in a region required for that region to be evaluated. +#' Defaults to 7. +#' +#' @param output A character vector of optional output to return. Supported +#' options are the individual regional estimates ("regions"), samples +#' ("samples"), plots ("plots"), copying the individual region dated folder into +#' a latest folder (if `target_folder` is not null, set using "latest"), the +#' stan fit of the underlying model ("fit"), and an overall summary across +#' regions ("summary"). The default is to return samples and plots alongside +#' summarised estimates and summary statistics. If `target_folder` is not NULL +#' then the default is also to copy all results into a latest folder. +#' +#' @param summary_args A list of arguments passed to `regional_summary`. See +#' the `regional_summary` documentation for details. +#' +#' @param verbose Logical defaults to FALSE. Outputs verbose progress messages +#' to the console from `epinow`. +#' +#' @param ... Pass additional arguments to `epinow`. See the documentation for +#' `epinow` for details. #' -#' Regions can be estimated in parallel using the `{future}` package (see `setup_future`). The progress of producing -#' estimates across multiple regions is tracked using the `progressr` package. Modify this behaviour using -#' progressr::handlers and enable it in batch by setting `R_PROGRESSR_ENABLE=TRUE` as an environment variable. -#' @param reported_cases A data frame of confirmed cases (confirm) by date (date), and region (`region`). -#' @param non_zero_points Numeric, the minimum number of time points with non-zero cases in a region required for -#' that region to be evaluated. Defaults to 7. -#' @param output A character vector of optional output to return. Supported options are the individual regional estimates -#' ("regions"), samples ("samples"), plots ("plots"), copying the individual region dated folder into -#' a latest folder (if `target_folder` is not null, set using "latest"), the stan fit of the underlying model ("fit"), and an -#' overall summary across regions ("summary"). The default is to return samples and plots alongside summarised estimates and -#' summary statistics. If `target_folder` is not NULL then the default is also to copy all results into a latest folder. -#' @param summary_args A list of arguments passed to `regional_summary`. See the `regional_summary` documentation for details. -#' @param verbose Logical defaults to FALSE. Outputs verbose progress messages to the console from `epinow`. -#' @param ... Pass additional arguments to `epinow`. See the documentation for `epinow` for details. #' @inheritParams epinow #' @inheritParams regional_summary #' @return A list of output stratified at the top level into regional output and across region output summary output #' @export -#' @seealso epinow estimate_infections forecast_infections setup_future regional_summary +#' @seealso epinow estimate_infections forecast_infections +#' @seealso setup_future regional_summary #' @importFrom future.apply future_lapply #' @importFrom data.table as.data.table setDT copy setorder #' @importFrom purrr safely map compact keep @@ -43,7 +65,9 @@ #' options(mc.cores = ifelse(interactive(), 4, 1)) #' #' # construct example distributions -#' generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") +#' generation_time <- get_generation_time( +#' disease = "SARS-CoV-2", source = "ganyani" +#' ) #' incubation_period <- get_incubation_period( #' disease = "SARS-CoV-2", source = "lauer" #' ) @@ -137,9 +161,13 @@ regional_epinow <- function(reported_cases, mirror_epinow = verbose ) - futile.logger::flog.info("Reporting estimates using data up to: %s", target_date) + futile.logger::flog.info( + "Reporting estimates using data up to: %s", target_date + ) if (is.null(target_folder)) { - futile.logger::flog.info("No target directory specified so returning output") + futile.logger::flog.info( + "No target directory specified so returning output" + ) return_output <- TRUE } else { futile.logger::flog.info("Saving estimates to : %s", target_folder) @@ -150,7 +178,10 @@ regional_epinow <- function(reported_cases, regions <- unique(reported_cases$region) # run regions (make parallel using future::plan) - futile.logger::flog.trace("calling future apply to process each region through the run_region function") + futile.logger::flog.trace( + "calling future apply to process each region through the run_region", + " function" + ) progressr::with_progress({ progress_fn <- progressr::progressor(along = regions) @@ -210,7 +241,9 @@ regional_epinow <- function(reported_cases, ) if (!is.null(summary_out[[2]])) { - futile.logger::flog.info("Errors caught whilst generating summary statistics: ") + futile.logger::flog.info( + "Errors caught whilst generating summary statistics: " + ) futile.logger::flog.info(toString(summary_out[[2]])) } summary_out <- summary_out[[1]] @@ -241,8 +274,9 @@ regional_epinow <- function(reported_cases, #' Clean Regions #' #' @description `r lifecycle::badge("stable")` -#' Removes regions with insufficient time points, and provides logging information on the -#' input. +#' Removes regions with insufficient time points, and provides logging +#' information on the input. +#' #' @seealso regional_epinow #' @inheritParams regional_epinow #' @importFrom data.table copy setDT @@ -251,7 +285,8 @@ regional_epinow <- function(reported_cases, clean_regions <- function(reported_cases, non_zero_points) { reported_cases <- data.table::setDT(reported_cases) # check for regions more than required time points with cases - eval_regions <- data.table::copy(reported_cases)[, .(confirm = confirm > 0), by = c("region", "date")][, + eval_regions <- data.table::copy(reported_cases)[, + .(confirm = confirm > 0), by = c("region", "date")][, .(confirm = sum(confirm, na.rm = TRUE)), by = "region" ][confirm >= non_zero_points]$region @@ -272,10 +307,10 @@ clean_regions <- function(reported_cases, non_zero_points) { } else { futile.logger::flog.info( "Producing estimates for: %s", - paste(eval_regions, collapse = ", ") + toString(eval_regions) ) message <- ifelse(length(orig_regions) == 0, "none", - paste(orig_regions, collapse = ", ") + toString(orig_regions) ) futile.logger::flog.info( "Regions excluded: %s", @@ -291,13 +326,16 @@ clean_regions <- function(reported_cases, non_zero_points) { #' #' @description `r lifecycle::badge("maturing")` #' Internal function that handles calling `epinow`. Future work will extend this -#' function to better handle `stan` logs and allow the user to modify settings between -#' regions. +#' function to better handle `stan` logs and allow the user to modify settings +#' between regions. +#' #' @param target_region Character string indicating the region being evaluated -#' @param progress_fn Function as returned by `progressr::progressor`. Allows the use of a -#' progress bar. +#' @param progress_fn Function as returned by `progressr::progressor`. Allows +#' the use of a progress bar. +#' #' @param complete_logger Character string indicating the logger to output #' the completion of estimation to. +#' #' @inheritParams regional_epinow #' @importFrom futile.logger flog.trace flog.warn #' @importFrom purrr quietly @@ -331,7 +369,8 @@ run_region <- function(target_region, if (!is.null(target_folder)) { target_folder <- file.path(target_folder, target_region) } - futile.logger::flog.trace("filtering data for target region %s", target_region, + futile.logger::flog.trace( + "filtering data for target region %s", target_region, name = "EpiNow2.epinow" ) regional_cases <- reported_cases[region %in% target_region][, region := NULL] @@ -377,11 +416,14 @@ run_region <- function(target_region, #' Process regional estimate #' #' @description `r lifecycle::badge("maturing")` -#' Internal function that removes output that is not required, and returns logging -#' information. +#' Internal function that removes output that is not required, and returns +#' logging information. #' @param out List of output returned by `epinow` +#' #' @param timing Output from `Sys.time` +#' #' @param return_timing Logical, should runtime be returned +#' #' @inheritParams regional_epinow #' @inheritParams run_region #' @seealso regional_epinow @@ -400,7 +442,7 @@ process_region <- function(out, target_region, timing, out$estimated_reported_cases$plots <- NULL } - if (!is.null(out[["summary"]])) { # if it failed a warning would have been output above + if (!is.null(out[["summary"]])) { futile.logger::flog.info("Completed estimates for: %s", target_region, name = complete_logger ) @@ -414,7 +456,9 @@ process_region <- function(out, target_region, timing, #' Internal function that processes the output from multiple `epinow` runs, adds #' summary logging information. #' @param regional_out A list of output from multiple runs of `regional_epinow` +#' #' @param regions A character vector identifying the regions that have been run +#' #' @importFrom purrr keep map compact #' @importFrom futile.logger flog.trace flog.info #' @seealso regional_epinow epinow @@ -424,7 +468,9 @@ process_regions <- function(regional_out, regions) { names(regional_out) <- regions problems <- purrr::keep(regional_out, ~ !is.null(.$error)) futile.logger::flog.info("Completed regional estimates") - futile.logger::flog.info("Regions with estimates: %s", (length(regions) - length(problems))) + futile.logger::flog.info( + "Regions with estimates: %s", (length(regions) - length(problems)) + ) futile.logger::flog.info("Regions with runtime errors: %s", length(problems)) for (location in names(problems)) { # output timeout / error @@ -433,6 +479,8 @@ process_regions <- function(regional_out, regions) { name = "EpiNow2.epinow" ) } - sucessful_regional_out <- purrr::keep(purrr::compact(regional_out), ~ is.finite(.$timing)) + sucessful_regional_out <- purrr::keep( + purrr::compact(regional_out), ~ is.finite(.$timing) + ) return(list(all = regional_out, successful = sucessful_regional_out)) } diff --git a/R/report.R b/R/report.R index db9f9e059..0554e2381 100644 --- a/R/report.R +++ b/R/report.R @@ -118,8 +118,8 @@ report_cases <- function(case_estimates, # summarise samples out$summarised <- calc_summary_measures( report[, value := cases][, cases := NULL], - summarise_by = c("date"), - order_by = c("date"), + summarise_by = "date", + order_by = "date", CrIs = CrIs ) return(out) @@ -129,12 +129,13 @@ report_cases <- function(case_estimates, #' @description `r lifecycle::badge("questioning")` #' Creates a snapshot summary of estimates. May be removed in later releases as #' S3 methods are enhanced. -#' +#' #' @param summarised_estimates A data.table of summarised estimates containing #' the following variables: variable, median, bottom, and top. It should #' contain the following estimates: R, infections, and r (rate of growth). #' -#' @param rt_samples A data.table containing Rt samples with the following variables: sample and value. +#' @param rt_samples A data.table containing Rt samples with the following +#' variables: sample and value. #' #' @param return_numeric Should numeric summary information be returned. #' diff --git a/R/setup.R b/R/setup.R index ec4aaa92f..0e27ad413 100644 --- a/R/setup.R +++ b/R/setup.R @@ -2,20 +2,29 @@ #' #' @description `r lifecycle::badge("questioning")` #' Sets up `futile.logger` logging, which is integrated into `EpiNow2`. See the -#' documentation for `futile.logger` for full details. By default `EpiNow2` prints all logs at -#' the "INFO" level and returns them to the console. Usage of logging is currently being explored -#' as the current setup cannot log stan errors or progress. -#' @param threshold Character string indicating the logging level see (?futile.logger -#' for details of the available options). Defaults to "INFO". -#' @param file Character string indicating the path to save logs to. By default logs will be -#' written to the console. -#' @param mirror_to_console Logical, defaults to `FALSE`. If saving logs to a file should they -#' also be duplicated in the console. -#' @param name Character string defaulting to EpiNow2. This indicates the name of the logger to setup. -#' The default logger for EpiNow2 is called EpiNow2. Nested options include: Epinow2.epinow which controls -#' all logging for `epinow` and nested functions, EpiNow2.epinow.estimate_infections (logging in -#' `estimate_infections`), and EpiNow2.epinow.estimate_infections.fit (logging in fitting functions). -#' @importFrom futile.logger flog.threshold flog.appender appender.tee appender.file flog.info +#' documentation for `futile.logger` for full details. By default `EpiNow2` +#' prints all logs at the "INFO" level and returns them to the console. Usage +#' of logging is currently being explored as the current setup cannot log stan +#' errors or progress. +#' +#' @param threshold Character string indicating the logging level see +#' (?futile.logger for details of the available options). Defaults to "INFO". +#' +#' @param file Character string indicating the path to save logs to. By default +#' logs will be written to the console. +#' +#' @param mirror_to_console Logical, defaults to `FALSE`. If saving logs to a +#' file should they also be duplicated in the console. +#' +#' @param name Character string defaulting to EpiNow2. This indicates the name +#' of the logger to setup. The default logger for EpiNow2 is called EpiNow2. +#' Nested options include: Epinow2.epinow which controls all logging for +#' `epinow` and nested functions, EpiNow2.epinow.estimate_infections (logging in +#' `estimate_infections`), and EpiNow2.epinow.estimate_infections.fit (logging +#' in fitting functions). +#' +#' @importFrom futile.logger flog.threshold flog.appender appender.tee +#' @importFrom futile.logger appender.file flog.info #' @return Nothing #' @export setup_logging <- function(threshold = "INFO", file = NULL, @@ -32,10 +41,14 @@ setup_logging <- function(threshold = "INFO", file = NULL, if (!is.null(file)) { if (mirror_to_console) { message(sprintf("Writing %s logs to the console and: %s", name, file)) - futile.logger::flog.appender(futile.logger::appender.tee(file), name = name) + futile.logger::flog.appender( + futile.logger::appender.tee(file), name = name + ) } else { message(sprintf("Writing %s logs to: %s", name, file)) - futile.logger::flog.appender(futile.logger::appender.file(file), name = name) + futile.logger::flog.appender( + futile.logger::appender.file(file), name = name + ) } } else { message(sprintf("Writing %s logs to the console", name)) @@ -47,15 +60,18 @@ setup_logging <- function(threshold = "INFO", file = NULL, #' Setup Default Logging #' #' @description `r lifecycle::badge("questioning")` -#' Sets up default logging. Usage of logging is currently being explored as the current setup -#' cannot log stan errors or progress. +#' Sets up default logging. Usage of logging is currently being explored as the +#' current setup cannot log stan errors or progress. +#' #' @param logs Character path indicating the target folder in which to store log -#' information. Defaults to the temporary directory if not specified. Default logging -#' can be disabled if `logs` is set to NULL. If specifying a custom logging setup then -#' the code for `setup_default_logging` and the `setup_logging` function are a sensible -#' place to start. +#' information. Defaults to the temporary directory if not specified. Default +#' logging can be disabled if `logs` is set to NULL. If specifying a custom +#' logging setup then the code for `setup_default_logging` and the +#' `setup_logging` function are a sensible place to start. +#' #' @param mirror_epinow Logical, defaults to FALSE. Should internal logging be #' returned from `epinow` to the console. +#' #' @inheritParams setup_target_folder #' @return No return value, called for side effects #' @export @@ -97,26 +113,31 @@ setup_default_logging <- function(logs = tempdir(check = TRUE), #' Set up Future Backend #' @description `r lifecycle::badge("stable")` #' A utility function that aims to streamline the set up -#' of the required future backend with sensible defaults for most users of `regional_epinow`. -#' More advanced users are recommended to setup their own `future` backend based on their -#' available resources. -#' @param strategies A vector length 1 to 2 of strategies to pass to `future::plan`. Nesting -#' of parallelisation is from the top level down. The default is to set up nesting parallelisation -#' with both using `future::multisession` (`future::multicore` will likely be a faster option on +#' of the required future backend with sensible defaults for most users of +#' `regional_epinow`. More advanced users are recommended to setup their own +#' `future` backend based on their available resources. +#' +#' @param strategies A vector length 1 to 2 of strategies to pass to +#' `future::plan`. Nesting of parallelisation is from the top level down. +#' The default is to set up nesting parallelisation with both using +#' `future::multisession` (`future::multicore` will likely be a faster option on #' supported platforms). For single level parallelisation use a single strategy #' or `future::plan` directly. See `?future::plan` for options. +#' #' @param min_cores_per_worker Numeric, the minimum number of cores per worker. #' Defaults to 4 which assumes 4 MCMC chains are in use per region. +#' #' @inheritParams regional_epinow #' @importFrom futile.logger flog.error flog.info flog.debug #' @importFrom future availableCores plan tweak #' @export #' @return Numeric number of cores to use per worker. If greater than 1 pass to -#' `stan_args = list(cores = "output from setup future")` or use `future = TRUE`. If only a single strategy is -#' used then nothing is returned. -setup_future <- function(reported_cases, strategies = c("multisession", "multisession"), +#' `stan_args = list(cores = "output from setup future")` or use +#' `future = TRUE`. If only a single strategy is used then nothing is returned. +setup_future <- function(reported_cases, + strategies = c("multisession", "multisession"), min_cores_per_worker = 4) { - if (length(strategies) > 2 | length(strategies) == 0) { + if (length(strategies) > 2 || length(strategies) == 0) { futile.logger::flog.error("1 or 2 strategies should be used") stop("1 or 2 strategies should be used") } @@ -138,7 +159,9 @@ setup_future <- function(reported_cases, strategies = c("multisession", "multise return(invisible(NULL)) } else { jobs <- length(unique(reported_cases$region)) - workers <- min(ceiling(future::availableCores() / min_cores_per_worker), jobs) + workers <- min( + ceiling(future::availableCores() / min_cores_per_worker), jobs + ) cores_per_worker <- max(1, round(future::availableCores() / workers, 0)) futile.logger::flog.info( @@ -170,7 +193,6 @@ setup_dt <- function(reported_cases) { return(reported_cases) } - #' Setup Target Folder for Saving #' #' @description `r lifecycle::badge("stable")` diff --git a/R/simulate_infections.R b/R/simulate_infections.R index 386f26bbd..692f24dc5 100644 --- a/R/simulate_infections.R +++ b/R/simulate_infections.R @@ -1,9 +1,12 @@ -#' Simulate infections using a given trajectory of the time-varying reproduction number +#' Simulate infections using a given trajectory of the time-varying +#' reproduction number #' #' @description `r lifecycle::badge("stable")` -#' This function simulates infections using an existing fit to observed cases but with a modified -#' time-varying reproduction number. This can be used to explore forecast models or past counterfactuals. -#' Simulations can be run in parallel using `future::plan`. +#' This function simulates infections using an existing fit to observed cases +#' but with a modified time-varying reproduction number. This can be used to +#' explore forecast models or past counterfactuals. Simulations can be run in +#' parallel using `future::plan`. +#' #' @param estimates The \code{estimates} element of an \code{epinow} run that #' has been done with output = "fit", or the result of #' \code{estimate_infections} with \code{return_fit} set to TRUE. @@ -145,7 +148,9 @@ simulate_infections <- function(estimates, # sample from posterior if samples != posterior posterior_sample <- dim(draws$obs_reports)[1] if (posterior_sample < samples) { - posterior_samples <- sample(1:posterior_sample, samples, replace = TRUE) + posterior_samples <- sample( + 1:posterior_sample, samples, replace = TRUE + ) # nolint R_draws <- draws$R draws <- map(draws, ~ as.matrix(.[posterior_samples, ])) draws$R <- R_draws @@ -158,7 +163,7 @@ simulate_infections <- function(estimates, if (obs_time != dim(draws$R)[2]) { horizon <- dim(draws$R)[2] - time + horizon + shift - horizon <- ifelse(horizon < 0, 0, horizon) + horizon <- ifelse(horizon < 0, 0, horizon) # nolint time <- dim(draws$R)[2] + shift obs_time <- time - shift starting_day <- estimates$args$day_of_week[1] diff --git a/R/summarise.R b/R/summarise.R index c26407631..43f0db73c 100644 --- a/R/summarise.R +++ b/R/summarise.R @@ -1,17 +1,24 @@ #' Summarise Real-time Results #' #' @description `r lifecycle::badge("questioning")` -#' Used internally by `regional_summary` to produce a summary table of results. May be streamlined in later -#' releases. -#' @param regions An character string containing the list of regions to extract results for -#' (must all have results for the same target date). +#' Used internally by `regional_summary` to produce a summary table of results. +#' May be streamlined in later releases. +#' +#' @param regions An character string containing the list of regions to extract +#' results for (must all have results for the same target date). +#' #' @param summaries A list of summary data frames as output by `epinow` -#' @param results_dir An optional character string indicating the location of the results directory to extract results -#' from. +#' +#' @param results_dir An optional character string indicating the location of +#' the results directory to extract results from. +#' #' @param target_date A character string indicating the target date to extract #' results for. All regions must have results #' for this date. -#' @param region_scale A character string indicating the name to give the regions being summarised. +#' +#' @param region_scale A character string indicating the name to give the +#' regions being summarised. +#' #' @importFrom purrr safely map_chr map_dbl map_chr #' @importFrom data.table setorderv melt merge.data.table dcast #' @return A list of summary data @@ -52,9 +59,11 @@ summarise_results <- function(regions, ) } - load_data <- purrr::safely(get_result) + load_data <- purrr::safely(get_result) # nolint - estimates <- purrr::map(regions, ~ load_data(file = "summary.rds", region = .)[[1]]) + estimates <- purrr::map( + regions, ~ load_data(file = "summary.rds", region = .)[[1]] + ) names(estimates) <- regions } else { estimates <- summaries @@ -107,7 +116,7 @@ summarise_results <- function(regions, "Expected change in daily cases", "Effective reproduction no.", "Rate of growth", - "Doubling/halving time (days)" + "Doubling/halving time (days)" # nolint )) ] @@ -208,7 +217,7 @@ regional_summary <- function(regional_output = NULL, futile.logger::flog.info("Saving summary to : %s", summary_dir) } - if (!is.null(results_dir) & !is.null(regional_output)) { + if (!is.null(results_dir) && !is.null(regional_output)) { stop("Only one of results_dir and regional_output should be specified") } @@ -243,7 +252,9 @@ regional_summary <- function(regional_output = NULL, dir.create(summary_dir, recursive = TRUE) } saveRDS(latest_date, file.path(summary_dir, "latest_date.rds")) - data.table::fwrite(reported_cases, file.path(summary_dir, "reported_cases.csv")) + data.table::fwrite( + reported_cases, file.path(summary_dir, "reported_cases.csv") + ) } if (!is.null(regional_output)) { @@ -324,7 +335,7 @@ regional_summary <- function(regional_output = NULL, } save_ggplot(summary_plot, "summary_plot.png", width = ifelse(length(regions) > 60, - ifelse(length(regions) > 120, 36, 24), + ifelse(length(regions) > 120, 36, 24), # nolint 12 ) ) @@ -359,7 +370,7 @@ regional_summary <- function(regional_output = NULL, if (all_regions) { plots_per_row <- ifelse(length(regions) > 60, ifelse(length(regions) > 120, 8, 5), 3 - ) + ) # nolint plots <- report_plots( summarised_estimates = results$estimates$summarised, @@ -541,7 +552,7 @@ regional_runtimes <- function(regional_output = NULL, target_folder = NULL, target_date = NULL, return_output = FALSE) { - if (is.null(target_folder) & is.null(regional_output)) { + if (is.null(target_folder) && is.null(regional_output)) { stop("Either an output should be passed in or a target folder specified") } if (is.null(target_folder)) { diff --git a/R/utilities.R b/R/utilities.R index fd3370631..58430e73a 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -1,7 +1,7 @@ #' Clean Nowcasts for a Supplied Date #' #' @description `r lifecycle::badge("stable")` -#' This function removes nowcasts in the format produced by `EpiNow2` from a +#' This function removes nowcasts in the format produced by `EpiNow2` from a #' target directory for the date supplied. #' #' @param date Date object. Defaults to today's date @@ -93,7 +93,7 @@ map_prob_change <- function(var) { ) ) ) - ) + ) # nolint var <- factor(var, levels = c( "Increasing", "Likely increasing", "Stable", "Likely decreasing", "Decreasing" @@ -179,14 +179,20 @@ allocate_empty <- function(data, params, n = 0) { #' Match User Supplied Arguments with Supported Options #' #' @description `r lifecycle::badge("stable")` -#' Match user supplied arguments with supported options and return a logical list for -#' internal usage +#' Match user supplied arguments with supported options and return a logical +#' list for internal usage. +#' #' @param input_args A character vector of input arguments (can be partial). +#' #' @param supported_args A character vector of supported output arguments. -#' @param logger A character vector indicating the logger to target messages at. Defaults -#' to no logging. -#' @param level Character string defaulting to "info". Logging level see documentation -#' of futile.logger for details. Supported options are "info" and "debug" +#' +#' @param logger A character vector indicating the logger to target messages +#' at. Defaults to no logging. +#' +#' @param level Character string defaulting to "info". Logging level see +#' documentation of futile.logger for details. Supported options are "info" and +#' "debug". +#' #' @return A logical vector of named output arguments #' @importFrom futile.logger flog.info flog.debug match_output_arguments <- function(input_args = NULL, @@ -204,7 +210,7 @@ match_output_arguments <- function(input_args = NULL, # get arguments supplied and linked to supported args found_args <- lapply(input_args, function(arg) { - supported_args[grepl(arg, supported_args)] + grep(arg, supported_args, value = TRUE) }) found_args <- unlist(found_args) found_args <- unique(found_args) @@ -213,7 +219,7 @@ match_output_arguments <- function(input_args = NULL, if (!is.null(logger)) { if (length(found_args) > 0) { flog_fn("Producing following optional outputs: %s", - paste(found_args, collapse = ", "), + toString(found_args), name = logger ) } else { @@ -412,8 +418,9 @@ set_dt_single_thread <- function() { ) } -#' @importFrom stats glm median na.omit pexp pgamma plnorm quasipoisson rexp -#' @importFrom lifecycle deprecate_warn rlnorm rnorm rpois runif sd var rgamma +#' @importFrom stats glm median na.omit pexp pgamma plnorm quasipoisson rexp +#' @importFrom lifecycle deprecate_warn +#' @importFrom stats rlnorm rnorm rpois runif sd var rgamma globalVariables( c( "bottom", "cases", "confidence", "confirm", "country_code", "crps", @@ -433,9 +440,10 @@ globalVariables( "value", "var", "vars", "viridis_palette", "window", ".", "%>%", "New confirmed cases by infection date", "Data", "R", "reference", ".SD", "day_of_week", "forecast_type", "measure", "numeric_estimate", - "point", "strat", "estimate", "breakpoint", "variable", "value.V1", "central_lower", "central_upper", - "mean_sd", "sd_sd", "average_7", "..lowers", "..upper_CrI", "..uppers", "timing", - "dataset", "last_confirm", "report_date", "secondary", "id", - "conv", "meanlog", "primary", "scaled", "scaling", "sdlog" + "point", "strat", "estimate", "breakpoint", "variable", "value.V1", + "central_lower", "central_upper", "mean_sd", "sd_sd", "average_7", + "..lowers", "..upper_CrI", "..uppers", "timing", "dataset", "last_confirm", + "report_date", "secondary", "id", "conv", "meanlog", "primary", "scaled", + "scaling", "sdlog" ) ) diff --git a/man/clean_regions.Rd b/man/clean_regions.Rd index b9f3bd813..83cd513a6 100644 --- a/man/clean_regions.Rd +++ b/man/clean_regions.Rd @@ -7,18 +7,20 @@ clean_regions(reported_cases, non_zero_points) } \arguments{ -\item{reported_cases}{A data frame of confirmed cases (confirm) by date (date), and region (\code{region}).} +\item{reported_cases}{A data frame of confirmed cases (confirm) by date +(date), and region (\code{region}).} -\item{non_zero_points}{Numeric, the minimum number of time points with non-zero cases in a region required for -that region to be evaluated. Defaults to 7.} +\item{non_zero_points}{Numeric, the minimum number of time points with +non-zero cases in a region required for that region to be evaluated. +Defaults to 7.} } \value{ A dataframe of cleaned regional data } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Removes regions with insufficient time points, and provides logging information on the -input. +Removes regions with insufficient time points, and provides logging +information on the input. } \seealso{ regional_epinow diff --git a/man/epinow.Rd b/man/epinow.Rd index 92b723d3b..3a4575c14 100644 --- a/man/epinow.Rd +++ b/man/epinow.Rd @@ -93,10 +93,10 @@ return all options.} \item{target_date}{Date, defaults to maximum found in the data if not specified.} \item{logs}{Character path indicating the target folder in which to store log -information. Defaults to the temporary directory if not specified. Default logging -can be disabled if \code{logs} is set to NULL. If specifying a custom logging setup then -the code for \code{setup_default_logging} and the \code{setup_logging} function are a sensible -place to start.} +information. Defaults to the temporary directory if not specified. Default +logging can be disabled if \code{logs} is set to NULL. If specifying a custom +logging setup then the code for \code{setup_default_logging} and the +\code{setup_logging} function are a sensible place to start.} \item{id}{A character string used to assign logging information on error. Used by \code{regional_epinow} to assign errors to regions. Alter the default to diff --git a/man/estimate_infections.Rd b/man/estimate_infections.Rd index aad4a5547..67ee235c0 100644 --- a/man/estimate_infections.Rd +++ b/man/estimate_infections.Rd @@ -136,7 +136,8 @@ summary(def) # summary plot plot(def) -# decreasing the accuracy of the approximate Gaussian to speed up computation. +# decreasing the accuracy of the approximate Gaussian to speed up +#computation. # These settings are an area of active research. See ?gp_opts for details. agp <- estimate_infections(reported_cases, generation_time = generation_time, diff --git a/man/get_regions_with_most_reports.Rd b/man/get_regions_with_most_reports.Rd index 7404208cb..e3cec779b 100644 --- a/man/get_regions_with_most_reports.Rd +++ b/man/get_regions_with_most_reports.Rd @@ -7,7 +7,8 @@ get_regions_with_most_reports(reported_cases, time_window = 7, no_regions = 6) } \arguments{ -\item{reported_cases}{A data frame of confirmed cases (confirm) by date (date), and region (\code{region}).} +\item{reported_cases}{A data frame of confirmed cases (confirm) by date +(date), and region (\code{region}).} \item{time_window}{Numeric, number of days to include from latest date in data. Defaults to 7 days.} diff --git a/man/match_output_arguments.Rd b/man/match_output_arguments.Rd index e972111fe..47123aa69 100644 --- a/man/match_output_arguments.Rd +++ b/man/match_output_arguments.Rd @@ -16,17 +16,18 @@ match_output_arguments( \item{supported_args}{A character vector of supported output arguments.} -\item{logger}{A character vector indicating the logger to target messages at. Defaults -to no logging.} +\item{logger}{A character vector indicating the logger to target messages +at. Defaults to no logging.} -\item{level}{Character string defaulting to "info". Logging level see documentation -of futile.logger for details. Supported options are "info" and "debug"} +\item{level}{Character string defaulting to "info". Logging level see +documentation of futile.logger for details. Supported options are "info" and +"debug".} } \value{ A logical vector of named output arguments } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Match user supplied arguments with supported options and return a logical list for -internal usage +Match user supplied arguments with supported options and return a logical +list for internal usage. } diff --git a/man/process_region.Rd b/man/process_region.Rd index aa6925067..3b7a5dbe6 100644 --- a/man/process_region.Rd +++ b/man/process_region.Rd @@ -33,8 +33,8 @@ A list of processed output } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#maturing}{\figure{lifecycle-maturing.svg}{options: alt='[Maturing]'}}}{\strong{[Maturing]}} -Internal function that removes output that is not required, and returns logging -information. +Internal function that removes output that is not required, and returns +logging information. } \seealso{ regional_epinow diff --git a/man/regional_epinow.Rd b/man/regional_epinow.Rd index 4cf13c6f8..8ebcd8414 100644 --- a/man/regional_epinow.Rd +++ b/man/regional_epinow.Rd @@ -28,7 +28,8 @@ regional_epinow( ) } \arguments{ -\item{reported_cases}{A data frame of confirmed cases (confirm) by date (date), and region (\code{region}).} +\item{reported_cases}{A data frame of confirmed cases (confirm) by date +(date), and region (\code{region}).} \item{generation_time}{A call to \code{generation_time_opts()} defining the generation time distribution used. For backwards compatibility a list of @@ -70,47 +71,60 @@ forecast.} \item{target_date}{Date, defaults to maximum found in the data if not specified.} -\item{non_zero_points}{Numeric, the minimum number of time points with non-zero cases in a region required for -that region to be evaluated. Defaults to 7.} +\item{non_zero_points}{Numeric, the minimum number of time points with +non-zero cases in a region required for that region to be evaluated. +Defaults to 7.} -\item{output}{A character vector of optional output to return. Supported options are the individual regional estimates -("regions"), samples ("samples"), plots ("plots"), copying the individual region dated folder into -a latest folder (if \code{target_folder} is not null, set using "latest"), the stan fit of the underlying model ("fit"), and an -overall summary across regions ("summary"). The default is to return samples and plots alongside summarised estimates and -summary statistics. If \code{target_folder} is not NULL then the default is also to copy all results into a latest folder.} +\item{output}{A character vector of optional output to return. Supported +options are the individual regional estimates ("regions"), samples +("samples"), plots ("plots"), copying the individual region dated folder into +a latest folder (if \code{target_folder} is not null, set using "latest"), the +stan fit of the underlying model ("fit"), and an overall summary across +regions ("summary"). The default is to return samples and plots alongside +summarised estimates and summary statistics. If \code{target_folder} is not NULL +then the default is also to copy all results into a latest folder.} \item{return_output}{Logical, defaults to FALSE. Should output be returned, this automatically updates to TRUE if no directory for saving is specified.} -\item{summary_args}{A list of arguments passed to \code{regional_summary}. See the \code{regional_summary} documentation for details.} +\item{summary_args}{A list of arguments passed to \code{regional_summary}. See +the \code{regional_summary} documentation for details.} -\item{verbose}{Logical defaults to FALSE. Outputs verbose progress messages to the console from \code{epinow}.} +\item{verbose}{Logical defaults to FALSE. Outputs verbose progress messages +to the console from \code{epinow}.} \item{logs}{Character path indicating the target folder in which to store log -information. Defaults to the temporary directory if not specified. Default logging -can be disabled if \code{logs} is set to NULL. If specifying a custom logging setup then -the code for \code{setup_default_logging} and the \code{setup_logging} function are a sensible -place to start.} +information. Defaults to the temporary directory if not specified. Default +logging can be disabled if \code{logs} is set to NULL. If specifying a custom +logging setup then the code for \code{setup_default_logging} and the +\code{setup_logging} function are a sensible place to start.} -\item{...}{Pass additional arguments to \code{epinow}. See the documentation for \code{epinow} for details.} +\item{...}{Pass additional arguments to \code{epinow}. See the documentation for +\code{epinow} for details.} } \value{ A list of output stratified at the top level into regional output and across region output summary output } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#maturing}{\figure{lifecycle-maturing.svg}{options: alt='[Maturing]'}}}{\strong{[Maturing]}} -Efficiently runs \code{epinow()} across multiple regions in an efficient manner and conducts basic data checks and -cleaning such as removing regions with fewer than \code{non_zero_points} as these are unlikely to produce reasonable -results whilst consuming significant resources. See the documentation for \code{epinow} for further information. - -By default all arguments supporting input from \verb{_opts()} functions are shared across regions (including delays, -truncation, Rt settings, stan settings, and gaussian process settings). Region specific settings are supported -by passing a named list of \verb{_opts()} calls (with an entry per region) to the relevant argument. A helper function -(\code{opts_list}) is available to facilitate building this list. - -Regions can be estimated in parallel using the \code{{future}} package (see \code{setup_future}). The progress of producing -estimates across multiple regions is tracked using the \code{progressr} package. Modify this behaviour using -progressr::handlers and enable it in batch by setting \code{R_PROGRESSR_ENABLE=TRUE} as an environment variable. +Efficiently runs \code{epinow()} across multiple regions in an efficient manner +and conducts basic data checks and cleaning such as removing regions with +fewer than \code{non_zero_points} as these are unlikely to produce reasonable +results whilst consuming significant resources. See the documentation for +\code{epinow} for further information. + +By default all arguments supporting input from \verb{_opts()} functions are +shared across regions (including delays, truncation, Rt settings, stan +settings, and gaussian process settings). Region specific settings are +supported by passing a named list of \verb{_opts()} calls (with an entry per +region) to the relevant argument. A helper function (\code{opts_list}) is +available to facilitate building this list. + +Regions can be estimated in parallel using the \code{{future}} package (see +\code{setup_future}). The progress of producing estimates across multiple regions +is tracked using the \code{progressr} package. Modify this behaviour using +progressr::handlers and enable it in batch by setting +\code{R_PROGRESSR_ENABLE=TRUE} as an environment variable. } \examples{ \donttest{ @@ -119,7 +133,9 @@ old_opts <- options() options(mc.cores = ifelse(interactive(), 4, 1)) # construct example distributions -generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") +generation_time <- get_generation_time( + disease = "SARS-CoV-2", source = "ganyani" +) incubation_period <- get_incubation_period( disease = "SARS-CoV-2", source = "lauer" ) @@ -172,5 +188,7 @@ options(old_opts) } } \seealso{ -epinow estimate_infections forecast_infections setup_future regional_summary +epinow estimate_infections forecast_infections + +setup_future regional_summary } diff --git a/man/regional_summary.Rd b/man/regional_summary.Rd index 1e7ae3ef1..a4a7bcfed 100644 --- a/man/regional_summary.Rd +++ b/man/regional_summary.Rd @@ -22,10 +22,11 @@ regional_summary( \item{regional_output}{A list of output as produced by \code{regional_epinow} and stored in the \code{regional} list.} -\item{reported_cases}{A data frame of confirmed cases (confirm) by date (date), and region (\code{region}).} +\item{reported_cases}{A data frame of confirmed cases (confirm) by date +(date), and region (\code{region}).} -\item{results_dir}{An optional character string indicating the location of the results directory to extract results -from.} +\item{results_dir}{An optional character string indicating the location of +the results directory to extract results from.} \item{summary_dir}{A character string giving the directory in which to store summary of results.} @@ -34,7 +35,8 @@ in which to store summary of results.} extract results (in the format "yyyy-mm-dd"). Defaults to latest available estimates.} -\item{region_scale}{A character string indicating the name to give the regions being summarised.} +\item{region_scale}{A character string indicating the name to give the +regions being summarised.} \item{all_regions}{Logical, defaults to \code{TRUE}. Should summary plots for all regions be returned rather than just regions of interest.} diff --git a/man/report_summary.Rd b/man/report_summary.Rd index 739a445ca..848f9d5ba 100644 --- a/man/report_summary.Rd +++ b/man/report_summary.Rd @@ -16,7 +16,8 @@ report_summary( the following variables: variable, median, bottom, and top. It should contain the following estimates: R, infections, and r (rate of growth).} -\item{rt_samples}{A data.table containing Rt samples with the following variables: sample and value.} +\item{rt_samples}{A data.table containing Rt samples with the following +variables: sample and value.} \item{target_folder}{Character string specifying where to save results (will create if not present).} diff --git a/man/run_region.Rd b/man/run_region.Rd index 3c23c0ba1..832a25019 100644 --- a/man/run_region.Rd +++ b/man/run_region.Rd @@ -66,7 +66,8 @@ forecast.} \item{CrIs}{Numeric vector of credible intervals to calculate.} -\item{reported_cases}{A data frame of confirmed cases (confirm) by date (date), and region (\code{region}).} +\item{reported_cases}{A data frame of confirmed cases (confirm) by date +(date), and region (\code{region}).} \item{target_folder}{Character string specifying where to save results (will create if not present).} @@ -75,21 +76,26 @@ forecast.} \item{return_output}{Logical, defaults to FALSE. Should output be returned, this automatically updates to TRUE if no directory for saving is specified.} -\item{output}{A character vector of optional output to return. Supported options are the individual regional estimates -("regions"), samples ("samples"), plots ("plots"), copying the individual region dated folder into -a latest folder (if \code{target_folder} is not null, set using "latest"), the stan fit of the underlying model ("fit"), and an -overall summary across regions ("summary"). The default is to return samples and plots alongside summarised estimates and -summary statistics. If \code{target_folder} is not NULL then the default is also to copy all results into a latest folder.} +\item{output}{A character vector of optional output to return. Supported +options are the individual regional estimates ("regions"), samples +("samples"), plots ("plots"), copying the individual region dated folder into +a latest folder (if \code{target_folder} is not null, set using "latest"), the +stan fit of the underlying model ("fit"), and an overall summary across +regions ("summary"). The default is to return samples and plots alongside +summarised estimates and summary statistics. If \code{target_folder} is not NULL +then the default is also to copy all results into a latest folder.} \item{complete_logger}{Character string indicating the logger to output the completion of estimation to.} -\item{verbose}{Logical defaults to FALSE. Outputs verbose progress messages to the console from \code{epinow}.} +\item{verbose}{Logical defaults to FALSE. Outputs verbose progress messages +to the console from \code{epinow}.} -\item{progress_fn}{Function as returned by \code{progressr::progressor}. Allows the use of a -progress bar.} +\item{progress_fn}{Function as returned by \code{progressr::progressor}. Allows +the use of a progress bar.} -\item{...}{Pass additional arguments to \code{epinow}. See the documentation for \code{epinow} for details.} +\item{...}{Pass additional arguments to \code{epinow}. See the documentation for +\code{epinow} for details.} } \value{ A list of processed output as produced by \code{process_region} @@ -97,8 +103,8 @@ A list of processed output as produced by \code{process_region} \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#maturing}{\figure{lifecycle-maturing.svg}{options: alt='[Maturing]'}}}{\strong{[Maturing]}} Internal function that handles calling \code{epinow}. Future work will extend this -function to better handle \code{stan} logs and allow the user to modify settings between -regions. +function to better handle \code{stan} logs and allow the user to modify settings +between regions. } \seealso{ regional_epinow diff --git a/man/setup_default_logging.Rd b/man/setup_default_logging.Rd index 212db63ac..0b0fb885b 100644 --- a/man/setup_default_logging.Rd +++ b/man/setup_default_logging.Rd @@ -12,10 +12,10 @@ setup_default_logging( } \arguments{ \item{logs}{Character path indicating the target folder in which to store log -information. Defaults to the temporary directory if not specified. Default logging -can be disabled if \code{logs} is set to NULL. If specifying a custom logging setup then -the code for \code{setup_default_logging} and the \code{setup_logging} function are a sensible -place to start.} +information. Defaults to the temporary directory if not specified. Default +logging can be disabled if \code{logs} is set to NULL. If specifying a custom +logging setup then the code for \code{setup_default_logging} and the +\code{setup_logging} function are a sensible place to start.} \item{mirror_epinow}{Logical, defaults to FALSE. Should internal logging be returned from \code{epinow} to the console.} @@ -27,8 +27,8 @@ No return value, called for side effects } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#questioning}{\figure{lifecycle-questioning.svg}{options: alt='[Questioning]'}}}{\strong{[Questioning]}} -Sets up default logging. Usage of logging is currently being explored as the current setup -cannot log stan errors or progress. +Sets up default logging. Usage of logging is currently being explored as the +current setup cannot log stan errors or progress. } \examples{ setup_default_logging() diff --git a/man/setup_future.Rd b/man/setup_future.Rd index 71acb1712..648a05a98 100644 --- a/man/setup_future.Rd +++ b/man/setup_future.Rd @@ -11,11 +11,13 @@ setup_future( ) } \arguments{ -\item{reported_cases}{A data frame of confirmed cases (confirm) by date (date), and region (\code{region}).} +\item{reported_cases}{A data frame of confirmed cases (confirm) by date +(date), and region (\code{region}).} -\item{strategies}{A vector length 1 to 2 of strategies to pass to \code{future::plan}. Nesting -of parallelisation is from the top level down. The default is to set up nesting parallelisation -with both using \code{future::multisession} (\code{future::multicore} will likely be a faster option on +\item{strategies}{A vector length 1 to 2 of strategies to pass to +\code{future::plan}. Nesting of parallelisation is from the top level down. +The default is to set up nesting parallelisation with both using +\code{future::multisession} (\code{future::multicore} will likely be a faster option on supported platforms). For single level parallelisation use a single strategy or \code{future::plan} directly. See \code{?future::plan} for options.} @@ -24,13 +26,13 @@ Defaults to 4 which assumes 4 MCMC chains are in use per region.} } \value{ Numeric number of cores to use per worker. If greater than 1 pass to -\code{stan_args = list(cores = "output from setup future")} or use \code{future = TRUE}. If only a single strategy is -used then nothing is returned. +\code{stan_args = list(cores = "output from setup future")} or use +\code{future = TRUE}. If only a single strategy is used then nothing is returned. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} A utility function that aims to streamline the set up -of the required future backend with sensible defaults for most users of \code{regional_epinow}. -More advanced users are recommended to setup their own \code{future} backend based on their -available resources. +of the required future backend with sensible defaults for most users of +\code{regional_epinow}. More advanced users are recommended to setup their own +\code{future} backend based on their available resources. } diff --git a/man/setup_logging.Rd b/man/setup_logging.Rd index f059d6be9..8fa3d6537 100644 --- a/man/setup_logging.Rd +++ b/man/setup_logging.Rd @@ -12,19 +12,21 @@ setup_logging( ) } \arguments{ -\item{threshold}{Character string indicating the logging level see (?futile.logger -for details of the available options). Defaults to "INFO".} +\item{threshold}{Character string indicating the logging level see +(?futile.logger for details of the available options). Defaults to "INFO".} -\item{file}{Character string indicating the path to save logs to. By default logs will be -written to the console.} +\item{file}{Character string indicating the path to save logs to. By default +logs will be written to the console.} -\item{mirror_to_console}{Logical, defaults to \code{FALSE}. If saving logs to a file should they -also be duplicated in the console.} +\item{mirror_to_console}{Logical, defaults to \code{FALSE}. If saving logs to a +file should they also be duplicated in the console.} -\item{name}{Character string defaulting to EpiNow2. This indicates the name of the logger to setup. -The default logger for EpiNow2 is called EpiNow2. Nested options include: Epinow2.epinow which controls -all logging for \code{epinow} and nested functions, EpiNow2.epinow.estimate_infections (logging in -\code{estimate_infections}), and EpiNow2.epinow.estimate_infections.fit (logging in fitting functions).} +\item{name}{Character string defaulting to EpiNow2. This indicates the name +of the logger to setup. The default logger for EpiNow2 is called EpiNow2. +Nested options include: Epinow2.epinow which controls all logging for +\code{epinow} and nested functions, EpiNow2.epinow.estimate_infections (logging in +\code{estimate_infections}), and EpiNow2.epinow.estimate_infections.fit (logging +in fitting functions).} } \value{ Nothing @@ -32,7 +34,8 @@ Nothing \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#questioning}{\figure{lifecycle-questioning.svg}{options: alt='[Questioning]'}}}{\strong{[Questioning]}} Sets up \code{futile.logger} logging, which is integrated into \code{EpiNow2}. See the -documentation for \code{futile.logger} for full details. By default \code{EpiNow2} prints all logs at -the "INFO" level and returns them to the console. Usage of logging is currently being explored -as the current setup cannot log stan errors or progress. +documentation for \code{futile.logger} for full details. By default \code{EpiNow2} +prints all logs at the "INFO" level and returns them to the console. Usage +of logging is currently being explored as the current setup cannot log stan +errors or progress. } diff --git a/man/simulate_infections.Rd b/man/simulate_infections.Rd index 23444f428..16119954b 100644 --- a/man/simulate_infections.Rd +++ b/man/simulate_infections.Rd @@ -2,7 +2,8 @@ % Please edit documentation in R/simulate_infections.R \name{simulate_infections} \alias{simulate_infections} -\title{Simulate infections using a given trajectory of the time-varying reproduction number} +\title{Simulate infections using a given trajectory of the time-varying +reproduction number} \usage{ simulate_infections( estimates, @@ -42,9 +43,10 @@ results from the specified scenario rather than fitting. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -This function simulates infections using an existing fit to observed cases but with a modified -time-varying reproduction number. This can be used to explore forecast models or past counterfactuals. -Simulations can be run in parallel using \code{future::plan}. +This function simulates infections using an existing fit to observed cases +but with a modified time-varying reproduction number. This can be used to +explore forecast models or past counterfactuals. Simulations can be run in +parallel using \code{future::plan}. } \examples{ \donttest{ diff --git a/man/summarise_results.Rd b/man/summarise_results.Rd index 78e3af79e..1db5c29c9 100644 --- a/man/summarise_results.Rd +++ b/man/summarise_results.Rd @@ -13,25 +13,26 @@ summarise_results( ) } \arguments{ -\item{regions}{An character string containing the list of regions to extract results for -(must all have results for the same target date).} +\item{regions}{An character string containing the list of regions to extract +results for (must all have results for the same target date).} \item{summaries}{A list of summary data frames as output by \code{epinow}} -\item{results_dir}{An optional character string indicating the location of the results directory to extract results -from.} +\item{results_dir}{An optional character string indicating the location of +the results directory to extract results from.} \item{target_date}{A character string indicating the target date to extract results for. All regions must have results for this date.} -\item{region_scale}{A character string indicating the name to give the regions being summarised.} +\item{region_scale}{A character string indicating the name to give the +regions being summarised.} } \value{ A list of summary data } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#questioning}{\figure{lifecycle-questioning.svg}{options: alt='[Questioning]'}}}{\strong{[Questioning]}} -Used internally by \code{regional_summary} to produce a summary table of results. May be streamlined in later -releases. +Used internally by \code{regional_summary} to produce a summary table of results. +May be streamlined in later releases. } From bfd76c99039118640b6d6c44bed47b738a54c3e5 Mon Sep 17 00:00:00 2001 From: Sam Abbott Date: Thu, 27 Apr 2023 13:47:01 +0100 Subject: [PATCH 08/19] more linting - focus on || and && --- R/adjust.R | 4 +++- R/create.R | 27 ++++++++++++++++++--------- R/summarise.R | 8 ++++++-- R/utilities.R | 4 +++- man/adjust_infection_to_report.Rd | 4 +++- man/create_clean_reported_cases.Rd | 6 +++--- man/create_rt_data.Rd | 3 ++- 7 files changed, 38 insertions(+), 18 deletions(-) diff --git a/R/adjust.R b/R/adjust.R index 4450aa47a..673d54326 100644 --- a/R/adjust.R +++ b/R/adjust.R @@ -42,7 +42,9 @@ #' ) #' #' # simple mapping -#' report <- adjust_infection_to_report(cases, delay_defs = list(incubation_def, delay_def)) +#' report <- adjust_infection_to_report( +#' cases, delay_defs = list(incubation_def, delay_def) +#' ) #' print(report) #' #' # mapping with a weekly reporting effect diff --git a/R/create.R b/R/create.R index 0a96bc71c..1727cb19c 100644 --- a/R/create.R +++ b/R/create.R @@ -1,15 +1,18 @@ #' Create Clean Reported Cases #' @description `r lifecycle::badge("stable")` -#' Cleans a data frame of reported cases by replacing missing dates with 0 cases and applies an optional -#' threshold at which point 0 cases are replaced with a moving average of observed cases. See `zero_threshold` -#' for details. +#' Cleans a data frame of reported cases by replacing missing dates with 0 +#' cases and applies an optional threshold at which point 0 cases are replaced +#' with a moving average of observed cases. See `zero_threshold` for details. +#' #' @param filter_leading_zeros Logical, defaults to TRUE. Should zeros at the #' start of the time series be filtered out. +#' #' @param zero_threshold `r lifecycle::badge("experimental")` Numeric defaults #' to Inf. Indicates if detected zero cases are meaningful by using a threshold #' number of cases based on the 7 day average. If the average is above this #' threshold then the zero is replaced with the backwards looking rolling #' average. If set to infinity then no changes are made. +#' #' @inheritParams estimate_infections #' @importFrom data.table copy merge.data.table setorder setDT frollsum #' @return A cleaned data frame of reported cases @@ -122,7 +125,9 @@ create_shifted_cases <- function(reported_cases, shift, ][, t := NULL] ## Drop median generation interval initial values - shifted_reported_cases <- shifted_reported_cases[, confirm := ceiling(confirm)] + shifted_reported_cases <- shifted_reported_cases[, + confirm := ceiling(confirm) + ] shifted_reported_cases <- shifted_reported_cases[-(1:smoothing_window)] return(shifted_reported_cases) } @@ -175,8 +180,12 @@ create_future_rt <- function(future = "latest", delay = 0) { #' @param rt A list of options as generated by `rt_opts()` defining Rt estimation. #' Defaults to `rt_opts()`. Set to `NULL` to switch to using back calculation #' rather than generating infections using Rt. -#' @param breakpoints An integer vector (binary) indicating the location of breakpoints. +#' +#' @param breakpoints An integer vector (binary) indicating the location of +#' breakpoints. +#' #' @param horizon Numeric, forecast horizon. +#' #' @seealso rt_settings #' @return A list of settings defining the time-varying reproduction number #' @inheritParams create_future_rt @@ -217,20 +226,20 @@ create_rt_data <- function(rt = rt_opts(), breakpoints = NULL, } } # check breakpoints - if (is.null(breakpoints) | sum(breakpoints) == 0) { + if (is.null(breakpoints) || sum(breakpoints) == 0) { rt$use_breakpoints <- FALSE } # map settings to underlying gp stan requirements rt_data <- list( r_mean = rt$prior$mean, r_sd = rt$prior$sd, - estimate_r = ifelse(rt$use_rt, 1, 0), + estimate_r = as.numeric(rt$use_rt), bp_n = ifelse(rt$use_breakpoints, sum(breakpoints, na.rm = TRUE), 0), breakpoints = breakpoints, - future_fixed = ifelse(future_rt$fixed, 1, 0), + future_fixed = as.numeric(future_rt$fixed), fixed_from = future_rt$from, pop = rt$pop, - stationary = ifelse(rt$gp_on %in% "R0", 1, 0), + stationary = as.numeric(rt$gp_on %in% "R0"), future_time = horizon - future_rt$from ) return(rt_data) diff --git a/R/summarise.R b/R/summarise.R index 43f0db73c..0b6309a1d 100644 --- a/R/summarise.R +++ b/R/summarise.R @@ -368,9 +368,11 @@ regional_summary <- function(regional_output = NULL, } if (all_regions) { + # nolint start plots_per_row <- ifelse(length(regions) > 60, ifelse(length(regions) > 120, 8, 5), 3 - ) # nolint + ) + # nolint end plots <- report_plots( summarised_estimates = results$estimates$summarised, @@ -662,9 +664,11 @@ calc_CrIs <- function(samples, summarise_by = NULL, CrIs = c(0.2, 0.5, 0.9)) { with_CrIs <- data.table::rbindlist(with_CrIs) scale_CrIs <- round(CrIs * 100, 1) + # nolint start order_CrIs <- c( paste0("lower_", rev(scale_CrIs)), paste0("upper_", scale_CrIs) - ) # nolint + ) + # nolint emd with_CrIs <- data.table::dcast( with_CrIs, ... ~ factor(CrI, levels = order_CrIs), value.var = "value" diff --git a/R/utilities.R b/R/utilities.R index 58430e73a..102fb97cb 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -85,6 +85,7 @@ make_conf <- function(value, CrI = 90, reverse = FALSE) { #' #' map_prob_change(var) map_prob_change <- function(var) { + # nolint start var <- ifelse(var < 0.05, "Increasing", ifelse(var < 0.4, "Likely increasing", ifelse(var < 0.6, "Stable", @@ -93,7 +94,8 @@ map_prob_change <- function(var) { ) ) ) - ) # nolint + ) + # nolint end var <- factor(var, levels = c( "Increasing", "Likely increasing", "Stable", "Likely decreasing", "Decreasing" diff --git a/man/adjust_infection_to_report.Rd b/man/adjust_infection_to_report.Rd index 34dac96c0..8fe936316 100644 --- a/man/adjust_infection_to_report.Rd +++ b/man/adjust_infection_to_report.Rd @@ -61,7 +61,9 @@ incubation_def <- lognorm_dist_def( ) # simple mapping -report <- adjust_infection_to_report(cases, delay_defs = list(incubation_def, delay_def)) +report <- adjust_infection_to_report( + cases, delay_defs = list(incubation_def, delay_def) +) print(report) # mapping with a weekly reporting effect diff --git a/man/create_clean_reported_cases.Rd b/man/create_clean_reported_cases.Rd index 60d163b86..245090fa3 100644 --- a/man/create_clean_reported_cases.Rd +++ b/man/create_clean_reported_cases.Rd @@ -32,9 +32,9 @@ A cleaned data frame of reported cases } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Cleans a data frame of reported cases by replacing missing dates with 0 cases and applies an optional -threshold at which point 0 cases are replaced with a moving average of observed cases. See \code{zero_threshold} -for details. +Cleans a data frame of reported cases by replacing missing dates with 0 +cases and applies an optional threshold at which point 0 cases are replaced +with a moving average of observed cases. See \code{zero_threshold} for details. } \author{ Sam Abbott diff --git a/man/create_rt_data.Rd b/man/create_rt_data.Rd index aa0a389ec..56207914b 100644 --- a/man/create_rt_data.Rd +++ b/man/create_rt_data.Rd @@ -11,7 +11,8 @@ create_rt_data(rt = rt_opts(), breakpoints = NULL, delay = 0, horizon = 0) Defaults to \code{rt_opts()}. Set to \code{NULL} to switch to using back calculation rather than generating infections using Rt.} -\item{breakpoints}{An integer vector (binary) indicating the location of breakpoints.} +\item{breakpoints}{An integer vector (binary) indicating the location of +breakpoints.} \item{delay}{Numeric mean delay} From fc3df6f6db86eaec73a4b3c966a05e5909648abb Mon Sep 17 00:00:00 2001 From: Sam Abbott Date: Thu, 27 Apr 2023 13:51:11 +0100 Subject: [PATCH 09/19] catch more | usage --- R/create.R | 3 ++- R/estimate_infections.R | 2 +- R/summarise.R | 2 +- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/R/create.R b/R/create.R index 1727cb19c..a35d22e0a 100644 --- a/R/create.R +++ b/R/create.R @@ -468,7 +468,8 @@ create_stan_data <- function(reported_cases, generation_time, t = 1:min(7, length(cases)) ) data$prior_infections <- log(mean(first_week$confirm, na.rm = TRUE)) - data$prior_infections <- ifelse(is.na(data$prior_infections) | is.null(data$prior_infections), + data$prior_infections <- ifelse( + is.na(data$prior_infections) || is.null(data$prior_infections), 0, data$prior_infections ) if (is.null(data$gt_weight)) { diff --git a/R/estimate_infections.R b/R/estimate_infections.R index 591d6fbf3..e466a8964 100644 --- a/R/estimate_infections.R +++ b/R/estimate_infections.R @@ -693,7 +693,7 @@ format_fit <- function(posterior_samples, horizon, shift, burn_in, start_date, name = "EpiNow2.epinow.estimate_infections" ) format_out$samples <- - format_out$samples[is.na(date) | + format_out$samples[is.na(date) || date >= (start_date + lubridate::days(burn_in))] } diff --git a/R/summarise.R b/R/summarise.R index 0b6309a1d..434313f33 100644 --- a/R/summarise.R +++ b/R/summarise.R @@ -668,7 +668,7 @@ calc_CrIs <- function(samples, summarise_by = NULL, CrIs = c(0.2, 0.5, 0.9)) { order_CrIs <- c( paste0("lower_", rev(scale_CrIs)), paste0("upper_", scale_CrIs) ) - # nolint emd + # nolint end with_CrIs <- data.table::dcast( with_CrIs, ... ~ factor(CrI, levels = order_CrIs), value.var = "value" From 04059f5905f6072f1013ec9a74d9406ca85dbca5 Mon Sep 17 00:00:00 2001 From: Sam Abbott Date: Thu, 27 Apr 2023 14:02:03 +0100 Subject: [PATCH 10/19] lint create --- R/create.R | 54 ++++++++++++++++++++++++++++++--------------- R/epinow.R | 9 +++++--- R/opts.R | 2 +- R/regional_epinow.R | 6 ++--- R/setup.R | 4 ++-- 5 files changed, 48 insertions(+), 27 deletions(-) diff --git a/R/create.R b/R/create.R index a35d22e0a..d38a2f66a 100644 --- a/R/create.R +++ b/R/create.R @@ -23,11 +23,13 @@ create_clean_reported_cases <- function(reported_cases, horizon, filter_leading_zeros = TRUE, zero_threshold = Inf) { reported_cases <- data.table::setDT(reported_cases) - reported_cases_grid <- data.table::copy(reported_cases)[, .(date = seq(min(date), max(date) + horizon, by = "days"))] + reported_cases_grid <- data.table::copy(reported_cases)[, + .(date = seq(min(date), max(date) + horizon, by = "days")) + ] reported_cases <- data.table::merge.data.table( reported_cases, reported_cases_grid, - by = c("date"), all.y = TRUE + by = "date", all.y = TRUE ) if (is.null(reported_cases$breakpoint)) { @@ -57,7 +59,7 @@ create_clean_reported_cases <- function(reported_cases, horizon, confirm := as.integer(average_7) ][ , - c("average_7") := NULL + "average_7" := NULL ] } return(reported_cases) @@ -66,13 +68,18 @@ create_clean_reported_cases <- function(reported_cases, horizon, #' Create Delay Shifted Cases #' #' @description `r lifecycle::badge("stable")` -#' This functions creates a data frame of reported cases that has been smoothed using -#' a centred partial rolling average (with a period set by `smoothing_window`) and shifted back in time -#' by some delay. It is used by `estimate_infections` to generate the mean shifted prior -#' on which the back calculation method (see `backcalc_opts()`) is based. +#' +#' This functions creates a data frame of reported cases that has been smoothed +#' using a centred partial rolling average (with a period set by +#' `smoothing_window`) and shifted back in time by some delay. It is used by +#' `estimate_infections` to generate the mean shifted prior on which the back +#' calculation method (see `backcalc_opts()`) is based. +#' #' @param smoothing_window Numeric, the rolling average smoothing window #' to apply. Must be odd in order to be defined as a centred average. +#' #' @param shift Numeric, mean delay shift to apply. +#' #' @inheritParams estimate_infections #' @inheritParams create_stan_data #' @importFrom data.table copy shift frollmean fifelse .N @@ -177,9 +184,9 @@ create_future_rt <- function(future = "latest", delay = 0) { #' @description `r lifecycle::badge("stable")` #' Takes the output from `rt_opts()` and converts it into a list understood by #' `stan`. -#' @param rt A list of options as generated by `rt_opts()` defining Rt estimation. -#' Defaults to `rt_opts()`. Set to `NULL` to switch to using back calculation -#' rather than generating infections using Rt. +#' @param rt A list of options as generated by `rt_opts()` defining Rt +#' estimation. Defaults to `rt_opts()`. Set to `NULL` to switch to using back +#' calculation rather than generating infections using Rt. #' #' @param breakpoints An integer vector (binary) indicating the location of #' breakpoints. @@ -247,9 +254,12 @@ create_rt_data <- function(rt = rt_opts(), breakpoints = NULL, #' Create Back Calculation Data #' #' @description `r lifecycle::badge("stable")` -#' Takes the output of `backcalc_opts()` and converts it into a list understood by `stan`. -#' @param backcalc A list of options as generated by `backcalc_opts()` to define the -#' back calculation. Defaults to `backcalc_opts()`. +#' Takes the output of `backcalc_opts()` and converts it into a list understood +#' by `stan`. +#' +#' @param backcalc A list of options as generated by `backcalc_opts()` to +#' define the back calculation. Defaults to `backcalc_opts()`. +#' #' @seealso backcalc_opts #' @return A list of settings defining the Gaussian process #' @export @@ -273,11 +283,13 @@ create_rt_data <- function(rt = rt_opts(), breakpoints = NULL, create_backcalc_data <- function(backcalc = backcalc_opts) { data <- list( rt_half_window = as.integer((backcalc$rt_window - 1) / 2), + # nolint start backcalc_prior = ifelse(backcalc$prior == "none", 0, ifelse(backcalc$prior == "reports", 1, ifelse(backcalc$prior == "infections", 2, 0) ) ) + # nolint end ) return(data) } @@ -332,7 +344,7 @@ create_gp_data <- function(gp = gp_opts(), data) { # map settings to underlying gp stan requirements gp_data <- list( - fixed = ifelse(fixed, 1, 0), + fixed = as.numeric(fixed), M = M, L = gp$boundary_scale, ls_meanlog = convert_to_logmean(gp$ls_mean, gp$ls_sd), @@ -340,9 +352,11 @@ create_gp_data <- function(gp = gp_opts(), data) { ls_min = gp$ls_min, ls_max = data$t - data$seeding_time - data$horizon, alpha_sd = gp$alpha_sd, + # nolint start gp_type = ifelse(gp$kernel == "se", 0, ifelse(gp$kernel == "matern", 1, 0) ) + # nolint end ) gp_data <- c(data, gp_data) @@ -379,7 +393,7 @@ create_gp_data <- function(gp = gp_opts(), data) { #' create_obs_model(obs_opts(week_length = 3), dates = dates) create_obs_model <- function(obs = obs_opts(), dates) { data <- list( - model_type = ifelse(obs$family %in% "poisson", 0, 1), + model_type = as.numeric(obs$family %in% "poisson"), phi_mean = obs$phi[1], phi_sd = obs$phi[2], week_effect = ifelse(obs$week_effect, obs$week_length, 1), @@ -464,8 +478,8 @@ create_stan_data <- function(reported_cases, generation_time, ) # initial estimate of growth first_week <- data.table::data.table( - confirm = cases[1:min(7, length(cases))], - t = 1:min(7, length(cases)) + confirm = cases[seq_len(min(7, length(cases)))], + t = seq_len(min(7, length(cases))) ) data$prior_infections <- log(mean(first_week$confirm, na.rm = TRUE)) data$prior_infections <- ifelse( @@ -562,11 +576,13 @@ create_initial_conditions <- function(data) { meanlog = data$ls_meanlog, sdlog = ifelse(data$ls_sdlog > 0, data$ls_sdlog * 0.1, 0.01) )) + # nolint start out$rho <- ifelse(out$rho > data$ls_max, data$ls_max - 0.001, ifelse(out$rho < data$ls_min, data$ls_min + 0.001, out$rho ) ) + # nolint end out$alpha <- array( truncnorm::rtruncnorm(1, a = 0, mean = 0, sd = data$alpha_sd) ) @@ -614,7 +630,9 @@ create_initial_conditions <- function(data) { )) } if (data$week_effect > 0) { - out$day_of_week_simplex <- array(rep(1 / data$week_effect, data$week_effect)) + out$day_of_week_simplex <- array( + rep(1 / data$week_effect, data$week_effect) + ) } return(out) } diff --git a/R/epinow.R b/R/epinow.R index 4b48713e8..d9124330a 100644 --- a/R/epinow.R +++ b/R/epinow.R @@ -25,7 +25,8 @@ #' report_cases, and report_summary. #' @author Sam Abbott #' @export -#' @seealso estimate_infections simulate_infections forecast_infections regional_epinow +#' @seealso estimate_infections simulate_infections forecast_infections +#' @seealso regional_epinow #' @inheritParams setup_target_folder #' @inheritParams estimate_infections #' @inheritParams setup_default_logging @@ -40,7 +41,9 @@ #' old_opts <- options() #' options(mc.cores = ifelse(interactive(), 4, 1)) #' # construct example distributions -#' generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") +#' generation_time <- get_generation_time( +#' disease = "SARS-CoV-2", source = "ganyani" +#' ) #' incubation_period <- get_incubation_period( #' disease = "SARS-CoV-2", source = "lauer" #' ) @@ -252,7 +255,7 @@ epinow <- function(reported_cases, out$trace <- rlang::trace_back() } - if (!is.null(target_folder) & !is.null(out$error)) { + if (!is.null(target_folder) && !is.null(out$error)) { saveRDS(out$error, paste0(target_folder, "/error.rds")) saveRDS(out$trace, paste0(target_folder, "/trace.rds")) } diff --git a/R/opts.R b/R/opts.R index 59376949e..dfd09800b 100644 --- a/R/opts.R +++ b/R/opts.R @@ -465,7 +465,7 @@ obs_opts <- function(family = "negbin", scale = list(), likelihood = TRUE, return_likelihood = FALSE) { - if (length(phi) != 2 | !is.numeric(phi)) { + if (length(phi) != 2 || !is.numeric(phi)) { stop("phi be numeric and of length two") } obs <- list( diff --git a/R/regional_epinow.R b/R/regional_epinow.R index c1c08b870..90ca98265 100644 --- a/R/regional_epinow.R +++ b/R/regional_epinow.R @@ -200,7 +200,7 @@ regional_epinow <- function(reported_cases, target_folder = target_folder, target_date = target_date, output = output, - return_output = output["summary"] | return_output, + return_output = output["summary"]|| return_output, complete_logger = ifelse(length(regions) > 10, "EpiNow2.epinow", "EpiNow2" @@ -432,13 +432,13 @@ run_region <- function(target_region, process_region <- function(out, target_region, timing, return_output = TRUE, return_timing = TRUE, complete_logger = "EpiNow2.epinow") { - if (!is.null(out[["estimates"]]) & !return_output) { + if (!is.null(out[["estimates"]]) && !return_output) { out$estimates$samples <- NULL } if (!is.null(out[["estimated_reported_cases"]]) & !return_output) { out$estimated_reported_cases$samples <- NULL } - if (!is.null(out[["plots"]]) & !return_output) { + if (!is.null(out[["plots"]]) && !return_output) { out$estimated_reported_cases$plots <- NULL } diff --git a/R/setup.R b/R/setup.R index 0e27ad413..4ba868de6 100644 --- a/R/setup.R +++ b/R/setup.R @@ -65,8 +65,8 @@ setup_logging <- function(threshold = "INFO", file = NULL, #' #' @param logs Character path indicating the target folder in which to store log #' information. Defaults to the temporary directory if not specified. Default -#' logging can be disabled if `logs` is set to NULL. If specifying a custom -#' logging setup then the code for `setup_default_logging` and the +#' logging can be disabled if `logs` is set to NULL. If specifying a custom +#' logging setup then the code for `setup_default_logging` and the #' `setup_logging` function are a sensible place to start. #' #' @param mirror_epinow Logical, defaults to FALSE. Should internal logging be From 5b3c9d8cb9e8daf75bb76612c68f74ee21f1c15d Mon Sep 17 00:00:00 2001 From: Sam Abbott Date: Thu, 27 Apr 2023 14:50:35 +0100 Subject: [PATCH 11/19] more linting --- R/estimate_secondary.R | 12 ++-- R/extract.R | 28 +++++--- R/get.R | 14 ++-- R/opts.R | 15 ++-- R/plot.R | 120 ++++++++++++++++++++++---------- man/create_backcalc_data.Rd | 7 +- man/create_rt_data.Rd | 6 +- man/create_shifted_cases.Rd | 10 +-- man/create_stan_data.Rd | 10 +-- man/epinow.Rd | 18 +++-- man/estimate_infections.Rd | 10 +-- man/gp_opts.Rd | 3 +- man/plot.epinow.Rd | 6 +- man/plot.estimate_infections.Rd | 6 +- man/plot_CrIs.Rd | 4 +- man/plot_estimates.Rd | 32 +++++---- man/plot_summary.Rd | 13 ++-- man/regional_epinow.Rd | 10 +-- man/regional_summary.Rd | 5 +- man/report_plots.Rd | 3 +- man/run_region.Rd | 10 +-- 21 files changed, 212 insertions(+), 130 deletions(-) diff --git a/R/estimate_secondary.R b/R/estimate_secondary.R index 093381a5c..61b9843c0 100644 --- a/R/estimate_secondary.R +++ b/R/estimate_secondary.R @@ -300,14 +300,14 @@ update_secondary_args <- function(data, priors, verbose = TRUE) { ) } # replace scaling if present in the prior - scale <- priors[grepl("frac_obs", variable)] + scale <- priors[grepl("frac_obs", variable, fixed = TRUE)] if (nrow(scale) > 0) { data$obs_scale_mean <- as.array(signif(scale$mean, 3)) data$obs_scale_sd <- as.array(signif(scale$sd, 3)) } # replace delay parameters if present - delay_mean <- priors[grepl("delay_mean", variable)] - delay_sd <- priors[grepl("delay_sd", variable)] + delay_mean <- priors[grepl("delay_mean", variable, fixed = TRUE)] + delay_sd <- priors[grepl("delay_sd", variable, fixed = TRUE)] if (nrow(delay_mean) > 0) { if (is.null(data$delay_mean_mean)) { warning( @@ -319,7 +319,7 @@ update_secondary_args <- function(data, priors, verbose = TRUE) { data$delay_sd_mean <- as.array(signif(delay_sd$mean, 3)) data$delay_sd_sd <- as.array(signif(delay_sd$sd, 3)) } - phi <- priors[grepl("rep_phi", variable)] + phi <- priors[grepl("rep_phi", variable, fixed = TRUE)] if (nrow(phi) > 0) { data$phi_mean <- signif(phi$mean, 3) data$phi_sd <- signif(phi$sd, 3) @@ -575,7 +575,7 @@ forecast_secondary <- function(estimate, all_dates = FALSE, CrIs = c(0.2, 0.5, 0.9)) { ## deal with input if data frame - if (any(class(primary) %in% "data.frame")) { + if (inherits(primary, "data.frame")) { primary <- data.table::as.data.table(primary) if (is.null(primary$sample)) { if (is.null(samples)) { @@ -586,7 +586,7 @@ forecast_secondary <- function(estimate, } primary <- primary[, .(date, sample, value)] } - if (any(class(primary) %in% "estimate_infections")) { + if (inherits(primary, "estimate_infections")) { primary <- data.table::as.data.table(primary$samples[variable == primary_variable]) primary <- primary[date > max(estimate$predictions$date, na.rm = TRUE)] primary <- primary[, .(date, sample, value)] diff --git a/R/extract.R b/R/extract.R index 95efb9061..0468322be 100644 --- a/R/extract.R +++ b/R/extract.R @@ -79,7 +79,8 @@ extract_static_parameter <- function(param, samples) { #' @author Sam Abbott #' @importFrom rstan extract #' @importFrom data.table data.table -extract_parameter_samples <- function(stan_fit, data, reported_dates, reported_inf_dates, +extract_parameter_samples <- function(stan_fit, data, reported_dates, + reported_inf_dates, drop_length_1 = FALSE, merge = FALSE) { # extract sample from stan object samples <- rstan::extract(stan_fit) @@ -145,17 +146,25 @@ extract_parameter_samples <- function(stan_fit, data, reported_dates, reported_i 1:data$week_effect ) out$day_of_week <- out$day_of_week[, value := value * data$week_effect] - out$day_of_week <- out$day_of_week[, strat := date][, c("time", "date") := NULL] + out$day_of_week <- out$day_of_week[, strat := date][, + c("time", "date") := NULL + ] } if (data$n_uncertain_mean_delays > 0) { - out$delay_mean <- extract_parameter("delay_mean", samples, 1:data$n_uncertain_mean_delays) + out$delay_mean <- extract_parameter( + "delay_mean", samples, 1:data$n_uncertain_mean_delays + ) out$delay_mean <- - out$delay_mean[, strat := as.character(time)][, time := NULL][, date := NULL] + out$delay_mean[, strat := as.character(time)][, time := NULL][, + date := NULL + ] } if (data$n_uncertain_sd_delays > 0) { out$delay_sd <- extract_parameter("delay_sd", samples, 1:data$n_uncertain_sd_delays) out$delay_sd <- - out$delay_sd[, strat := as.character(time)][, time := NULL][, date := NULL] + out$delay_sd[, strat := as.character(time)][, time := NULL][, + date := NULL + ] } if (data$truncation > 0) { if (data$trunc_mean_sd > 0) { @@ -179,15 +188,14 @@ extract_parameter_samples <- function(stan_fit, data, reported_dates, reported_i } if (data$model_type == 1) { out$reporting_overdispersion <- extract_static_parameter("rep_phi", samples) - out$reporting_overdispersion <- out$reporting_overdispersion[, value := value.V1][ - , + out$reporting_overdispersion <- out$reporting_overdispersion[, + value := value.V1][, value.V1 := NULL ] } if (data$obs_scale == 1) { out$fraction_observed <- extract_static_parameter("frac_obs", samples) - out$fraction_observed <- out$fraction_observed[, value := value.V1][ - , + out$fraction_observed <- out$fraction_observed[, value := value.V1][, value.V1 := NULL ] } @@ -316,7 +324,7 @@ extract_inits <- function(fit, current_inits, return(res) } # extract samples - fit_inits <- purrr::map(1:samples, init_fun) + fit_inits <- purrr::map(1:samples, init_fun) # nolint # set up sampling function exclude_vars <- exclude_list old_init_fn <- current_inits diff --git a/R/get.R b/R/get.R index 092365ead..e0fb5f081 100644 --- a/R/get.R +++ b/R/get.R @@ -123,7 +123,7 @@ get_regional_results <- function(regional_output, # find all regions regions <- get_regions(results_dir) - load_data <- purrr::safely(EpiNow2::get_raw_result) + load_data <- purrr::safely(EpiNow2::get_raw_result) # nolint # get estimates get_estimates_file <- function(samples_path, summarised_path) { @@ -170,7 +170,9 @@ get_regional_results <- function(regional_output, } # get incidence values and combine summarised <- purrr::map(regional_output, ~ .[[data]]$summarised) - summarised <- data.table::rbindlist(summarised, idcol = "region", fill = TRUE) + summarised <- data.table::rbindlist( + summarised, idcol = "region", fill = TRUE + ) out$summarised <- summarised return(out) } @@ -282,11 +284,15 @@ get_regions_with_most_reports <- function(reported_cases, no_regions = 6) { most_reports <- data.table::copy(reported_cases) most_reports <- - most_reports[, .SD[date >= (max(date, na.rm = TRUE) - lubridate::days(time_window))], + most_reports[, + .SD[date >= (max(date, na.rm = TRUE) - lubridate::days(time_window)) + ], by = "region" ] most_reports <- most_reports[, .(confirm = sum(confirm, na.rm = TRUE)), by = "region"] - most_reports <- data.table::setorderv(most_reports, cols = "confirm", order = -1) + most_reports <- data.table::setorderv( + most_reports, cols = "confirm", order = -1 + ) most_reports <- most_reports[1:no_regions][!is.na(region)]$region return(most_reports) } diff --git a/R/opts.R b/R/opts.R index dfd09800b..6b31fc05d 100644 --- a/R/opts.R +++ b/R/opts.R @@ -53,8 +53,8 @@ generation_time_opts <- function(..., disease, source, max = 15L, (!missing(disease) && !missing(source)) ## from included distributions if (type_options > 1) { stop( - "Generation time should be given either as distributional options ", - "or as disease/source, but not both." + "Generation time should be given either as distributional options", + " or as disease/source, but not both." # nolint ) } @@ -63,13 +63,13 @@ generation_time_opts <- function(..., disease, source, max = 15L, dot_options <- dot_options[[1]] } - if (!missing(disease) && !missing(source)) { ## generation time provided as disease/source + if (!missing(disease) && !missing(source)) { dist <- get_generation_time( disease = disease, source = source, max_value = max ) dist$fixed <- fixed gt <- do.call(dist_spec, dist) - } else { ## generation time provided as distributional parameters or not at all + } else { ## make gamma default for backwards compatibility if (!("dist" %in% names(dot_options))) { dot_options$dist <- "gamma" @@ -282,7 +282,7 @@ rt_opts <- function(prior = list(mean = 1, sd = 1), rt$use_breakpoints <- TRUE } - if (!("mean" %in% names(rt$prior) & "sd" %in% names(rt$prior))) { + if (!("mean" %in% names(rt$prior) && "sd" %in% names(rt$prior))) { stop("prior must have both a mean and sd specified") } return(rt) @@ -376,7 +376,8 @@ backcalc_opts <- function(prior = "reports", prior_window = 14, rt_window = 1) { #' proportion of basis functions. See (Riutort-Mayol et al. 2020 #' ) for advice on updating this default. #' -#' @param boundary_scale Numeric, defaults to 1.5. Boundary scale of the approximate Gaussian process. See (Riutort-Mayol et al. 2020 +#' @param boundary_scale Numeric, defaults to 1.5. Boundary scale of the +#' approximate Gaussian process. See (Riutort-Mayol et al. 2020 #' ) for advice on updating this default. #' #' @return A list of settings defining the Gaussian process @@ -410,7 +411,7 @@ gp_opts <- function(basis_prop = 0.2, ) if (gp$matern_type != 3 / 2) { - stop("only the Matern 3/2 kernel is currently supported") + stop("only the Matern 3/2 kernel is currently supported") # nolint } return(gp) } diff --git a/R/plot.R b/R/plot.R index 9b4579082..f213aa833 100644 --- a/R/plot.R +++ b/R/plot.R @@ -3,10 +3,14 @@ #' @description `r lifecycle::badge("stable")` #' Adds lineranges for user specified credible intervals #' @param plot A `ggplot2` plot -#' @param CrIs Numeric list of credible intervals present in the data. As produced -#' by `extract_CrIs` +#' +#' @param CrIs Numeric list of credible intervals present in the data. As +#' produced by `extract_CrIs` +#' #' @param alpha Numeric, overall alpha of the target line range +#' #' @param linewidth Numeric, line width of the default line range. +#' #' @return A `ggplot2` plot. plot_CrIs <- function(plot, CrIs, alpha, linewidth) { index <- 1 @@ -16,7 +20,9 @@ plot_CrIs <- function(plot, CrIs, alpha, linewidth) { top <- paste0("upper_", CrI) if (index == 1) { plot <- plot + - ggplot2::geom_ribbon(ggplot2::aes(ymin = .data[[bottom]], ymax = .data[[top]]), + ggplot2::geom_ribbon( + ggplot2::aes(ymin = .data[[bottom]], ymax = .data[[top]] + ), alpha = 0.2, linewidth = linewidth ) } else { @@ -37,23 +43,38 @@ plot_CrIs <- function(plot, CrIs, alpha, linewidth) { #' Plot Estimates #' #' @description `r lifecycle::badge("questioning")` -#' Allows users to plot the output from `estimate_infections` easily. In future releases it -#' may be depreciated in favour of increasing the functionality of the S3 plot methods. -#' @param estimate A data.table of estimates containing the following variables: date, type -#' (must contain "estimate", "estimate based on partial data" and optionally "forecast"), -#' @param reported A data.table of reported cases with the following variables: date, confirm. -#' @param ylab Character string, defaulting to "Cases". Title for the plot y axis. -#' @param hline Numeric, if supplied gives the horizontal intercept for a indicator line. -#' @param obs_as_col Logical, defaults to `TRUE`. Should observed data, if supplied, be plotted using columns or -#' as points (linked using a line). -#' @param max_plot Numeric, defaults to 10. A multiplicative upper bound on the number of cases shown on the plot. Based -#' on the maximum number of reported cases. +#' Allows users to plot the output from `estimate_infections` easily. In future +#' releases it may be depreciated in favour of increasing the functionality of +#' the S3 plot methods. +#' +#' @param estimate A data.table of estimates containing the following +#' variables: date, type (must contain "estimate", "estimate based on partial +#' data" and optionally "forecast"). +#' +#' @param reported A data.table of reported cases with the following variables: +#' date, confirm. +#' +#' @param ylab Character string, defaulting to "Cases". Title for the plot y +#' axis. +#' +#' @param hline Numeric, if supplied gives the horizontal intercept for a +#' indicator line. +#' +#' @param obs_as_col Logical, defaults to `TRUE`. Should observed data, if +#' supplied, be plotted using columns or as points (linked using a line). +#' +#' @param max_plot Numeric, defaults to 10. A multiplicative upper bound on the\ +#' number of cases shown on the plot. Based on the maximum number of reported +#' cases. +#' #' @param estimate_type Character vector indicating the type of data to plot. #' Default to all types with supported options being: "Estimate", "Estimate #' based on partial data", and "Forecast". +#' #' @return A `ggplot2` object #' @export -#' @importFrom ggplot2 ggplot aes geom_col geom_line geom_point geom_vline geom_hline geom_ribbon scale_y_continuous theme_bw +#' @importFrom ggplot2 ggplot aes geom_col geom_line geom_point geom_vline +#' @importFrom ggplot2 geom_hline geom_ribbon scale_y_continuous theme_bw #' @importFrom scales comma #' @importFrom data.table setDT fifelse copy as.data.table #' @importFrom purrr map @@ -63,7 +84,9 @@ plot_CrIs <- function(plot, CrIs, alpha, linewidth) { #' cases <- example_confirmed[1:40] #' #' # set up example delays -#' generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") +#' generation_time <- get_generation_time( +#' disease = "SARS-CoV-2", source = "ganyani" +#' ) #' incubation_period <- get_incubation_period( #' disease = "SARS-CoV-2", source = "lauer" #' ) @@ -128,10 +151,10 @@ plot_estimates <- function(estimate, reported, ylab = "Cases", hline, estimate <- estimate[type %in% estimate_type] } # scale plot values based on reported cases - if (!missing(reported) & !is.na(max_plot)) { + if (!missing(reported) && !is.na(max_plot)) { sd_cols <- c( - grep("lower_", colnames(estimate), value = TRUE), - grep("upper_", colnames(estimate), value = TRUE) + grep("lower_", colnames(estimate), value = TRUE, fixed = TRUE), + grep("upper_", colnames(estimate), value = TRUE, fixed = TRUE) ) cols <- setdiff(colnames(reported), c("date", "confirm", "breakpoint")) @@ -142,21 +165,22 @@ plot_estimates <- function(estimate, reported, ylab = "Cases", hline, ] estimate <- estimate[max_cases_to_plot, on = cols] } else { - max_cases_to_plot <- round(max(reported$confirm, na.rm = TRUE) * max_plot, 0) + max_cases_to_plot <- round( + max(reported$confirm, na.rm = TRUE) * max_plot, 0 + ) estimate <- estimate[, max := max_cases_to_plot] } estimate <- estimate[, lapply(.SD, function(var) { - data.table::fifelse( - var > max, - max, var - ) + pmin(var, max) }), by = setdiff(colnames(estimate), sd_cols), .SDcols = sd_cols ] } # initialise plot - plot <- ggplot2::ggplot(estimate, ggplot2::aes(x = date, col = type, fill = type)) + plot <- ggplot2::ggplot( + estimate, ggplot2::aes(x = date, col = type, fill = type) + ) # add in reported data if present (either as column or as a line) if (!missing(reported)) { @@ -187,7 +211,9 @@ plot_estimates <- function(estimate, reported, ylab = "Cases", hline, # plot estimates plot <- plot + ggplot2::geom_vline( - xintercept = orig_estimate[type == "Estimate based on partial data"][date == max(date)]$date, + xintercept = orig_estimate[ + type == "Estimate based on partial data"][date == max(date) + ]$date, linetype = 2 ) @@ -220,12 +246,22 @@ plot_estimates <- function(estimate, reported, ylab = "Cases", hline, #' Plot a Summary of the Latest Results #' #' @description `r lifecycle::badge("questioning")` -#' Used to return a summary plot across regions (using results generated by `summarise_results`). +#' Used to return a summary plot across regions (using results generated by +#' `summarise_results`). +#' #' May be depreciated in later releases in favour of enhanced S3 methods. -#' @param summary_results A data.table as returned by `summarise_results` (the `data` object). -#' @param x_lab A character string giving the label for the x axis, defaults to region. -#' @param log_cases Logical, should cases be shown on a logged scale. Defaults to `FALSE` +#' +#' @param summary_results A data.table as returned by `summarise_results` (the +#' `data` object). +#' +#' @param x_lab A character string giving the label for the x axis, defaults to +#' region. +#' +#' @param log_cases Logical, should cases be shown on a logged scale. Defaults +#' to `FALSE`. +#' #' @param max_cases Numeric, no default. The maximum number of cases to plot. +#' #' @return A `ggplot2` object #' @export #' @importFrom ggplot2 ggplot aes geom_linerange geom_hline facet_wrap theme guides labs expand_limits guide_legend element_blank scale_color_manual .data coord_cartesian scale_y_continuous theme_bw @@ -277,9 +313,11 @@ plot_summary <- function(summary_results, } # check max_cases - upper_CrI <- paste0("upper_", max_CrI) - max_upper <- max(summary_results[metric %in% "New confirmed cases by infection date"][, ..upper_CrI], - na.rm = TRUE + upper_CrI <- paste0("upper_", max_CrI) # nolint + max_upper <- max( + summary_results[ + metric %in% "New confirmed cases by infection date"][, ..upper_CrI], + na.rm = TRUE ) max_cases <- min( c( @@ -290,7 +328,9 @@ plot_summary <- function(summary_results, ) # cases plot cases_plot <- - inner_plot(summary_results[metric %in% "New confirmed cases by infection date"]) + + inner_plot( + summary_results[metric %in% "New confirmed cases by infection date"] + ) + ggplot2::labs(x = x_lab, y = "") + ggplot2::expand_limits(y = 0) + ggplot2::theme( @@ -317,7 +357,7 @@ plot_summary <- function(summary_results, # rt plot rt_data <- summary_results[metric %in% "Effective reproduction no."] - uppers <- grepl("upper_", colnames(rt_data)) + uppers <- grepl("upper_", colnames(rt_data), fixed = TRUE) # nolint max_rt <- max(data.table::copy(rt_data)[, ..uppers], na.rm = TRUE) rt_plot <- inner_plot(rt_data) + @@ -337,11 +377,15 @@ plot_summary <- function(summary_results, #' #' @description `r lifecycle::badge("maturing")` #' `plot` method for class "estimate_infections". +#' #' @param x A list of output as produced by `estimate_infections` -#' @param type A character vector indicating the name of plots to return. Defaults -#' to "summary" with supported options being "infections", "reports", "R", "growth_rate", -#' "summary", "all". +#' +#' @param type A character vector indicating the name of plots to return. +#' Defaults to "summary" with supported options being "infections", "reports", +#' "R", "growth_rate", "summary", "all". +#' #' @param ... Pass additional arguments to report_plots +#' #' @seealso plot report_plots estimate_infections #' @aliases plot #' @method plot estimate_infections diff --git a/man/create_backcalc_data.Rd b/man/create_backcalc_data.Rd index 0af85812b..d5118d2bf 100644 --- a/man/create_backcalc_data.Rd +++ b/man/create_backcalc_data.Rd @@ -7,15 +7,16 @@ create_backcalc_data(backcalc = backcalc_opts) } \arguments{ -\item{backcalc}{A list of options as generated by \code{backcalc_opts()} to define the -back calculation. Defaults to \code{backcalc_opts()}.} +\item{backcalc}{A list of options as generated by \code{backcalc_opts()} to +define the back calculation. Defaults to \code{backcalc_opts()}.} } \value{ A list of settings defining the Gaussian process } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Takes the output of \code{backcalc_opts()} and converts it into a list understood by \code{stan}. +Takes the output of \code{backcalc_opts()} and converts it into a list understood +by \code{stan}. } \examples{ # define input data required diff --git a/man/create_rt_data.Rd b/man/create_rt_data.Rd index 56207914b..1b73f5618 100644 --- a/man/create_rt_data.Rd +++ b/man/create_rt_data.Rd @@ -7,9 +7,9 @@ create_rt_data(rt = rt_opts(), breakpoints = NULL, delay = 0, horizon = 0) } \arguments{ -\item{rt}{A list of options as generated by \code{rt_opts()} defining Rt estimation. -Defaults to \code{rt_opts()}. Set to \code{NULL} to switch to using back calculation -rather than generating infections using Rt.} +\item{rt}{A list of options as generated by \code{rt_opts()} defining Rt +estimation. Defaults to \code{rt_opts()}. Set to \code{NULL} to switch to using back +calculation rather than generating infections using Rt.} \item{breakpoints}{An integer vector (binary) indicating the location of breakpoints.} diff --git a/man/create_shifted_cases.Rd b/man/create_shifted_cases.Rd index 23f77693a..4ea38de13 100644 --- a/man/create_shifted_cases.Rd +++ b/man/create_shifted_cases.Rd @@ -23,10 +23,12 @@ A data frame for shifted reported cases } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -This functions creates a data frame of reported cases that has been smoothed using -a centred partial rolling average (with a period set by \code{smoothing_window}) and shifted back in time -by some delay. It is used by \code{estimate_infections} to generate the mean shifted prior -on which the back calculation method (see \code{backcalc_opts()}) is based. + +This functions creates a data frame of reported cases that has been smoothed +using a centred partial rolling average (with a period set by +\code{smoothing_window}) and shifted back in time by some delay. It is used by +\code{estimate_infections} to generate the mean shifted prior on which the back +calculation method (see \code{backcalc_opts()}) is based. } \examples{ create_shifted_cases(example_confirmed, 7, 14, 7) diff --git a/man/create_stan_data.Rd b/man/create_stan_data.Rd index 3d37e0179..d92916691 100644 --- a/man/create_stan_data.Rd +++ b/man/create_stan_data.Rd @@ -25,9 +25,9 @@ create_stan_data( generation time distribution used. For backwards compatibility a list of summary parameters can also be passed.} -\item{rt}{A list of options as generated by \code{rt_opts()} defining Rt estimation. -Defaults to \code{rt_opts()}. Set to \code{NULL} to switch to using back calculation -rather than generating infections using Rt.} +\item{rt}{A list of options as generated by \code{rt_opts()} defining Rt +estimation. Defaults to \code{rt_opts()}. Set to \code{NULL} to switch to using back +calculation rather than generating infections using Rt.} \item{gp}{A list of options as generated by \code{gp_opts()} to define the Gaussian process. Defaults to \code{gp_opts()}.Set to NULL to disable the @@ -42,8 +42,8 @@ details.} \item{horizon}{Numeric, forecast horizon.} -\item{backcalc}{A list of options as generated by \code{backcalc_opts()} to define the -back calculation. Defaults to \code{backcalc_opts()}.} +\item{backcalc}{A list of options as generated by \code{backcalc_opts()} to +define the back calculation. Defaults to \code{backcalc_opts()}.} \item{shifted_cases}{A dataframe of delay shifted cases} diff --git a/man/epinow.Rd b/man/epinow.Rd index 3a4575c14..c543261a7 100644 --- a/man/epinow.Rd +++ b/man/epinow.Rd @@ -45,12 +45,12 @@ generated by \code{trunc_opts()} defining the truncation of observed data. Defaults to \code{trunc_opts()}. See \code{estimate_truncation()} for an approach to estimating truncation from data.} -\item{rt}{A list of options as generated by \code{rt_opts()} defining Rt estimation. -Defaults to \code{rt_opts()}. Set to \code{NULL} to switch to using back calculation -rather than generating infections using Rt.} +\item{rt}{A list of options as generated by \code{rt_opts()} defining Rt +estimation. Defaults to \code{rt_opts()}. Set to \code{NULL} to switch to using back +calculation rather than generating infections using Rt.} -\item{backcalc}{A list of options as generated by \code{backcalc_opts()} to define the -back calculation. Defaults to \code{backcalc_opts()}.} +\item{backcalc}{A list of options as generated by \code{backcalc_opts()} to +define the back calculation. Defaults to \code{backcalc_opts()}.} \item{gp}{A list of options as generated by \code{gp_opts()} to define the Gaussian process. Defaults to \code{gp_opts()}.Set to NULL to disable the @@ -128,7 +128,9 @@ the ECDC data source. old_opts <- options() options(mc.cores = ifelse(interactive(), 4, 1)) # construct example distributions -generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") +generation_time <- get_generation_time( + disease = "SARS-CoV-2", source = "ganyani" +) incubation_period <- get_incubation_period( disease = "SARS-CoV-2", source = "lauer" ) @@ -161,7 +163,9 @@ options(old_opts) } } \seealso{ -estimate_infections simulate_infections forecast_infections regional_epinow +estimate_infections simulate_infections forecast_infections + +regional_epinow } \author{ Sam Abbott diff --git a/man/estimate_infections.Rd b/man/estimate_infections.Rd index 67ee235c0..beb9e168e 100644 --- a/man/estimate_infections.Rd +++ b/man/estimate_infections.Rd @@ -40,12 +40,12 @@ generated by \code{trunc_opts()} defining the truncation of observed data. Defaults to \code{trunc_opts()}. See \code{estimate_truncation()} for an approach to estimating truncation from data.} -\item{rt}{A list of options as generated by \code{rt_opts()} defining Rt estimation. -Defaults to \code{rt_opts()}. Set to \code{NULL} to switch to using back calculation -rather than generating infections using Rt.} +\item{rt}{A list of options as generated by \code{rt_opts()} defining Rt +estimation. Defaults to \code{rt_opts()}. Set to \code{NULL} to switch to using back +calculation rather than generating infections using Rt.} -\item{backcalc}{A list of options as generated by \code{backcalc_opts()} to define the -back calculation. Defaults to \code{backcalc_opts()}.} +\item{backcalc}{A list of options as generated by \code{backcalc_opts()} to +define the back calculation. Defaults to \code{backcalc_opts()}.} \item{gp}{A list of options as generated by \code{gp_opts()} to define the Gaussian process. Defaults to \code{gp_opts()}.Set to NULL to disable the diff --git a/man/gp_opts.Rd b/man/gp_opts.Rd index 59abea3d1..cae2325b1 100644 --- a/man/gp_opts.Rd +++ b/man/gp_opts.Rd @@ -24,7 +24,8 @@ effect). In general smaller posterior length scales require a higher proportion of basis functions. See (Riutort-Mayol et al. 2020 \url{https://arxiv.org/abs/2004.11408}) for advice on updating this default.} -\item{boundary_scale}{Numeric, defaults to 1.5. Boundary scale of the approximate Gaussian process. See (Riutort-Mayol et al. 2020 +\item{boundary_scale}{Numeric, defaults to 1.5. Boundary scale of the +approximate Gaussian process. See (Riutort-Mayol et al. 2020 \url{https://arxiv.org/abs/2004.11408}) for advice on updating this default.} \item{ls_mean}{Numeric, defaults to 21 days. The mean of the lognormal diff --git a/man/plot.epinow.Rd b/man/plot.epinow.Rd index 62254ad58..472b6dba6 100644 --- a/man/plot.epinow.Rd +++ b/man/plot.epinow.Rd @@ -9,9 +9,9 @@ \arguments{ \item{x}{A list of output as produced by \code{epinow}} -\item{type}{A character vector indicating the name of plots to return. Defaults -to "summary" with supported options being "infections", "reports", "R", "growth_rate", -"summary", "all".} +\item{type}{A character vector indicating the name of plots to return. +Defaults to "summary" with supported options being "infections", "reports", +"R", "growth_rate", "summary", "all".} \item{...}{Pass additional arguments to report_plots} } diff --git a/man/plot.estimate_infections.Rd b/man/plot.estimate_infections.Rd index 20058e9c4..6f396bb44 100644 --- a/man/plot.estimate_infections.Rd +++ b/man/plot.estimate_infections.Rd @@ -10,9 +10,9 @@ \arguments{ \item{x}{A list of output as produced by \code{estimate_infections}} -\item{type}{A character vector indicating the name of plots to return. Defaults -to "summary" with supported options being "infections", "reports", "R", "growth_rate", -"summary", "all".} +\item{type}{A character vector indicating the name of plots to return. +Defaults to "summary" with supported options being "infections", "reports", +"R", "growth_rate", "summary", "all".} \item{...}{Pass additional arguments to report_plots} } diff --git a/man/plot_CrIs.Rd b/man/plot_CrIs.Rd index 3878febb1..ce18d436f 100644 --- a/man/plot_CrIs.Rd +++ b/man/plot_CrIs.Rd @@ -9,8 +9,8 @@ plot_CrIs(plot, CrIs, alpha, linewidth) \arguments{ \item{plot}{A \code{ggplot2} plot} -\item{CrIs}{Numeric list of credible intervals present in the data. As produced -by \code{extract_CrIs}} +\item{CrIs}{Numeric list of credible intervals present in the data. As +produced by \code{extract_CrIs}} \item{alpha}{Numeric, overall alpha of the target line range} diff --git a/man/plot_estimates.Rd b/man/plot_estimates.Rd index b996c1b68..233ce1eb4 100644 --- a/man/plot_estimates.Rd +++ b/man/plot_estimates.Rd @@ -15,20 +15,25 @@ plot_estimates( ) } \arguments{ -\item{estimate}{A data.table of estimates containing the following variables: date, type -(must contain "estimate", "estimate based on partial data" and optionally "forecast"),} +\item{estimate}{A data.table of estimates containing the following +variables: date, type (must contain "estimate", "estimate based on partial +data" and optionally "forecast").} -\item{reported}{A data.table of reported cases with the following variables: date, confirm.} +\item{reported}{A data.table of reported cases with the following variables: +date, confirm.} -\item{ylab}{Character string, defaulting to "Cases". Title for the plot y axis.} +\item{ylab}{Character string, defaulting to "Cases". Title for the plot y +axis.} -\item{hline}{Numeric, if supplied gives the horizontal intercept for a indicator line.} +\item{hline}{Numeric, if supplied gives the horizontal intercept for a +indicator line.} -\item{obs_as_col}{Logical, defaults to \code{TRUE}. Should observed data, if supplied, be plotted using columns or -as points (linked using a line).} +\item{obs_as_col}{Logical, defaults to \code{TRUE}. Should observed data, if +supplied, be plotted using columns or as points (linked using a line).} -\item{max_plot}{Numeric, defaults to 10. A multiplicative upper bound on the number of cases shown on the plot. Based -on the maximum number of reported cases.} +\item{max_plot}{Numeric, defaults to 10. A multiplicative upper bound on the\ +number of cases shown on the plot. Based on the maximum number of reported +cases.} \item{estimate_type}{Character vector indicating the type of data to plot. Default to all types with supported options being: "Estimate", "Estimate @@ -39,8 +44,9 @@ A \code{ggplot2} object } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#questioning}{\figure{lifecycle-questioning.svg}{options: alt='[Questioning]'}}}{\strong{[Questioning]}} -Allows users to plot the output from \code{estimate_infections} easily. In future releases it -may be depreciated in favour of increasing the functionality of the S3 plot methods. +Allows users to plot the output from \code{estimate_infections} easily. In future +releases it may be depreciated in favour of increasing the functionality of +the S3 plot methods. } \examples{ \donttest{ @@ -48,7 +54,9 @@ may be depreciated in favour of increasing the functionality of the S3 plot meth cases <- example_confirmed[1:40] # set up example delays -generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") +generation_time <- get_generation_time( + disease = "SARS-CoV-2", source = "ganyani" +) incubation_period <- get_incubation_period( disease = "SARS-CoV-2", source = "lauer" ) diff --git a/man/plot_summary.Rd b/man/plot_summary.Rd index e9d638816..075fb558d 100644 --- a/man/plot_summary.Rd +++ b/man/plot_summary.Rd @@ -7,11 +7,14 @@ plot_summary(summary_results, x_lab = "Region", log_cases = FALSE, max_cases) } \arguments{ -\item{summary_results}{A data.table as returned by \code{summarise_results} (the \code{data} object).} +\item{summary_results}{A data.table as returned by \code{summarise_results} (the +\code{data} object).} -\item{x_lab}{A character string giving the label for the x axis, defaults to region.} +\item{x_lab}{A character string giving the label for the x axis, defaults to +region.} -\item{log_cases}{Logical, should cases be shown on a logged scale. Defaults to \code{FALSE}} +\item{log_cases}{Logical, should cases be shown on a logged scale. Defaults +to \code{FALSE}.} \item{max_cases}{Numeric, no default. The maximum number of cases to plot.} } @@ -20,6 +23,8 @@ A \code{ggplot2} object } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#questioning}{\figure{lifecycle-questioning.svg}{options: alt='[Questioning]'}}}{\strong{[Questioning]}} -Used to return a summary plot across regions (using results generated by \code{summarise_results}). +Used to return a summary plot across regions (using results generated by +\code{summarise_results}). + May be depreciated in later releases in favour of enhanced S3 methods. } diff --git a/man/regional_epinow.Rd b/man/regional_epinow.Rd index 8ebcd8414..4ebafa33c 100644 --- a/man/regional_epinow.Rd +++ b/man/regional_epinow.Rd @@ -44,12 +44,12 @@ generated by \code{trunc_opts()} defining the truncation of observed data. Defaults to \code{trunc_opts()}. See \code{estimate_truncation()} for an approach to estimating truncation from data.} -\item{rt}{A list of options as generated by \code{rt_opts()} defining Rt estimation. -Defaults to \code{rt_opts()}. Set to \code{NULL} to switch to using back calculation -rather than generating infections using Rt.} +\item{rt}{A list of options as generated by \code{rt_opts()} defining Rt +estimation. Defaults to \code{rt_opts()}. Set to \code{NULL} to switch to using back +calculation rather than generating infections using Rt.} -\item{backcalc}{A list of options as generated by \code{backcalc_opts()} to define the -back calculation. Defaults to \code{backcalc_opts()}.} +\item{backcalc}{A list of options as generated by \code{backcalc_opts()} to +define the back calculation. Defaults to \code{backcalc_opts()}.} \item{gp}{A list of options as generated by \code{gp_opts()} to define the Gaussian process. Defaults to \code{gp_opts()}.Set to NULL to disable the diff --git a/man/regional_summary.Rd b/man/regional_summary.Rd index a4a7bcfed..75616e034 100644 --- a/man/regional_summary.Rd +++ b/man/regional_summary.Rd @@ -47,8 +47,9 @@ this automatically updates to TRUE if no directory for saving is specified.} \item{plot}{Logical, defaults to \code{TRUE}. Should regional summary plots be produced.} -\item{max_plot}{Numeric, defaults to 10. A multiplicative upper bound on the number of cases shown on the plot. Based -on the maximum number of reported cases.} +\item{max_plot}{Numeric, defaults to 10. A multiplicative upper bound on the\ +number of cases shown on the plot. Based on the maximum number of reported +cases.} \item{...}{Additional arguments passed to \code{report_plots}.} } diff --git a/man/report_plots.Rd b/man/report_plots.Rd index 4df660803..27f7a218b 100644 --- a/man/report_plots.Rd +++ b/man/report_plots.Rd @@ -13,7 +13,8 @@ the following variables: variable, median, bottom, and top. It should also contain the following estimates: R, infections, reported_cases_rt, and r (rate of growth).} -\item{reported}{A data.table of reported cases with the following variables: date, confirm.} +\item{reported}{A data.table of reported cases with the following variables: +date, confirm.} \item{target_folder}{Character string specifying where to save results (will create if not present).} diff --git a/man/run_region.Rd b/man/run_region.Rd index 832a25019..b0b60373d 100644 --- a/man/run_region.Rd +++ b/man/run_region.Rd @@ -43,12 +43,12 @@ generated by \code{trunc_opts()} defining the truncation of observed data. Defaults to \code{trunc_opts()}. See \code{estimate_truncation()} for an approach to estimating truncation from data.} -\item{rt}{A list of options as generated by \code{rt_opts()} defining Rt estimation. -Defaults to \code{rt_opts()}. Set to \code{NULL} to switch to using back calculation -rather than generating infections using Rt.} +\item{rt}{A list of options as generated by \code{rt_opts()} defining Rt +estimation. Defaults to \code{rt_opts()}. Set to \code{NULL} to switch to using back +calculation rather than generating infections using Rt.} -\item{backcalc}{A list of options as generated by \code{backcalc_opts()} to define the -back calculation. Defaults to \code{backcalc_opts()}.} +\item{backcalc}{A list of options as generated by \code{backcalc_opts()} to +define the back calculation. Defaults to \code{backcalc_opts()}.} \item{gp}{A list of options as generated by \code{gp_opts()} to define the Gaussian process. Defaults to \code{gp_opts()}.Set to NULL to disable the From f26658e31bae6ca97e4d3f86bed382029dba7729 Mon Sep 17 00:00:00 2001 From: Sam Abbott Date: Thu, 27 Apr 2023 15:07:27 +0100 Subject: [PATCH 12/19] more linting --- R/estimate_secondary.R | 32 ++++++++++++++++++++++---------- R/opts.R | 5 +++-- R/plot.R | 9 +++++++-- R/regional_epinow.R | 11 ++++++----- 4 files changed, 38 insertions(+), 19 deletions(-) diff --git a/R/estimate_secondary.R b/R/estimate_secondary.R index 61b9843c0..c988b0ff7 100644 --- a/R/estimate_secondary.R +++ b/R/estimate_secondary.R @@ -560,7 +560,8 @@ simulate_secondary <- function(data, type = "incidence", family = "poisson", #' #' @author Sam Abbott #' @importFrom rstan extract sampling -#' @importFrom data.table rbindlist merge.data.table as.data.table setorderv setcolorder copy +#' @importFrom data.table rbindlist merge.data.table as.data.table setorderv +#' @importFrom data.table setcolorder copy #' @importFrom lubridate days wday #' @importFrom utils tail #' @importFrom purrr map @@ -582,7 +583,9 @@ forecast_secondary <- function(estimate, samples <- 1000 } primary <- primary[, .(date, sample = list(1:samples), value)] - primary <- primary[, .(sample = as.numeric(unlist(sample))), by = c("date", "value")] + primary <- primary[, + .(sample = as.numeric(unlist(sample))), by = c("date", "value") + ] } primary <- primary[, .(date, sample, value)] } @@ -609,23 +612,31 @@ forecast_secondary <- function(estimate, data <- estimate$data # combined primary from data and input primary - primary_fit <- estimate$predictions[, .(date, value = primary, sample = list(unique(updated_primary$sample)))] + primary_fit <- estimate$predictions[, + .(date, value = primary, sample = list(unique(updated_primary$sample))) + ] primary_fit <- primary_fit[date <= min(primary$date, na.rm = TRUE)] - primary_fit <- primary_fit[, .(sample = as.numeric(unlist(sample))), by = c("date", "value")] - primary_fit <- data.table::rbindlist(list(primary_fit, updated_primary), use.names = TRUE) + primary_fit <- primary_fit[, + .(sample = as.numeric(unlist(sample))), by = c("date", "value") + ] + primary_fit <- data.table::rbindlist( + list(primary_fit, updated_primary), use.names = TRUE + ) data.table::setorderv(primary_fit, c("sample", "date")) # update data with primary samples and day of week data$primary <- t( matrix(primary_fit$value, ncol = length(unique(primary_fit$sample))) ) - data$day_of_week <- add_day_of_week(unique(primary_fit$date), data$week_effect) + data$day_of_week <- add_day_of_week( + unique(primary_fit$date), data$week_effect + ) data$n <- nrow(data$primary) data$t <- ncol(data$primary) data$h <- nrow(primary[sample == min(sample)]) # extract samples for posterior of estimates - posterior_samples <- sample(1:data$n, data$n, replace = TRUE) + posterior_samples <- sample(seq_len(data$n), data$n, replace = TRUE) # nolint draws <- purrr::map(draws, ~ as.matrix(.[posterior_samples, ])) # combine with data data <- c(data, draws) @@ -655,7 +666,9 @@ forecast_secondary <- function(estimate, samples <- as.data.table(samples) colnames(samples) <- c("iterations", "sample", "time", "value") samples <- samples[, c("iterations", "time") := NULL] - samples <- samples[, date := rep(tail(dates, ifelse(all_dates, data$t, data$h)), data$n)] + samples <- samples[, + date := rep(tail(dates, ifelse(all_dates, data$t, data$h)), data$n) + ] # summarise samples summarised <- calc_summary_measures(samples, @@ -679,8 +692,7 @@ forecast_secondary <- function(estimate, data.table::setorderv(forecast_obs, "date") # add in predictions in estimate_secondary format out$predictions <- data.table::merge.data.table(summarised, - forecast_obs, - by = "date", all = TRUE + forecast_obs, by = "date", all = TRUE ) data.table::setcolorder(out$predictions, c("date", "primary", "secondary", "mean", "sd")) class(out) <- c("estimate_secondary", class(out)) diff --git a/R/opts.R b/R/opts.R index 6b31fc05d..60ccc892f 100644 --- a/R/opts.R +++ b/R/opts.R @@ -437,7 +437,8 @@ gp_opts <- function(basis_prop = 0.2, #' week or if data has a non-weekly periodicity. #' #' @param scale List, defaulting to an empty list. Should an scaling factor be -#' applied to map latent infections (convolved to date of report). If none empty a mean (`mean`) and standard deviation (`sd`) needs to be supplied +#' applied to map latent infections (convolved to date of report). If none +#' empty a mean (`mean`) and standard deviation (`sd`) needs to be supplied #' defining the normally distributed scaling factor. #' #' @param likelihood Logical, defaults to `TRUE`. Should the likelihood be @@ -686,7 +687,7 @@ stan_opts <- function(samples = 2000, init_fit = NULL, return_fit = TRUE, ...) { - backend <- match.arg(backend, choices = c("rstan")) + backend <- match.arg(backend, choices = "rstan") if (backend %in% "rstan") { opts <- rstan_opts( samples = samples, diff --git a/R/plot.R b/R/plot.R index f213aa833..d56e933b1 100644 --- a/R/plot.R +++ b/R/plot.R @@ -264,7 +264,10 @@ plot_estimates <- function(estimate, reported, ylab = "Cases", hline, #' #' @return A `ggplot2` object #' @export -#' @importFrom ggplot2 ggplot aes geom_linerange geom_hline facet_wrap theme guides labs expand_limits guide_legend element_blank scale_color_manual .data coord_cartesian scale_y_continuous theme_bw +#' @importFrom ggplot2 ggplot aes geom_linerange geom_hline facet_wrap +#' @importFrom ggplot2 theme guides labs expand_limits guide_legend +#' @importFrom ggplot2 scale_color_manual .data coord_cartesian +#' @importFrom gggplot2 theme_bw element_blank scale_y_continuous #' @importFrom scales comma #' @importFrom patchwork plot_layout #' @importFrom data.table setDT @@ -292,7 +295,9 @@ plot_summary <- function(summary_results, bottom <- paste0("lower_", CrI) top <- paste0("upper_", CrI) plot <- plot + - ggplot2::geom_linerange(ggplot2::aes(ymin = .data[[bottom]], ymax = .data[[top]]), + ggplot2::geom_linerange( + ggplot2::aes(ymin = .data[[bottom]], ymax = .data[[top]] + ), alpha = ifelse(index == 1, 0.4, alpha_per_CrI), linewidth = 4 ) diff --git a/R/regional_epinow.R b/R/regional_epinow.R index 90ca98265..9fe873c69 100644 --- a/R/regional_epinow.R +++ b/R/regional_epinow.R @@ -19,7 +19,7 @@ #' is tracked using the `progressr` package. Modify this behaviour using #' progressr::handlers and enable it in batch by setting #' `R_PROGRESSR_ENABLE=TRUE` as an environment variable. -#' +#' #' @param reported_cases A data frame of confirmed cases (confirm) by date #' (date), and region (`region`). #' @@ -38,7 +38,7 @@ #' #' @param summary_args A list of arguments passed to `regional_summary`. See #' the `regional_summary` documentation for details. -#' +#' #' @param verbose Logical defaults to FALSE. Outputs verbose progress messages #' to the console from `epinow`. #' @@ -47,7 +47,8 @@ #' #' @inheritParams epinow #' @inheritParams regional_summary -#' @return A list of output stratified at the top level into regional output and across region output summary output +#' @return A list of output stratified at the top level into regional output +#' and across region output summary output #' @export #' @seealso epinow estimate_infections forecast_infections #' @seealso setup_future regional_summary @@ -200,7 +201,7 @@ regional_epinow <- function(reported_cases, target_folder = target_folder, target_date = target_date, output = output, - return_output = output["summary"]|| return_output, + return_output = output["summary"] || return_output, complete_logger = ifelse(length(regions) > 10, "EpiNow2.epinow", "EpiNow2" @@ -435,7 +436,7 @@ process_region <- function(out, target_region, timing, if (!is.null(out[["estimates"]]) && !return_output) { out$estimates$samples <- NULL } - if (!is.null(out[["estimated_reported_cases"]]) & !return_output) { + if (!is.null(out[["estimated_reported_cases"]]) && !return_output) { out$estimated_reported_cases$samples <- NULL } if (!is.null(out[["plots"]]) && !return_output) { From 7b12be3026c5f41200daa4fab57e29101511d865 Mon Sep 17 00:00:00 2001 From: Sam Abbott Date: Thu, 27 Apr 2023 15:27:25 +0100 Subject: [PATCH 13/19] lint the world --- NAMESPACE | 4 +++- R/adjust.R | 21 ++++++++++++------- R/epinow-internal.R | 35 +++++++++++++++++++++---------- R/estimate_truncation.R | 16 ++++++++------ R/report.R | 6 ++++-- R/setup.R | 10 ++++++--- R/simulate_infections.R | 18 ++++++++++------ R/summarise.R | 4 +++- man/adjust_infection_to_report.Rd | 21 ++++++++++++------- man/copy_results_to_latest.Rd | 3 ++- man/epinow.Rd | 6 ++++-- man/estimate_truncation.Rd | 6 ++++-- man/estimates_by_report_date.Rd | 3 ++- man/obs_opts.Rd | 3 ++- man/regional_epinow.Rd | 9 +++++--- man/regional_runtimes.Rd | 3 ++- man/report_plots.Rd | 7 +++++-- man/report_summary.Rd | 3 ++- man/run_region.Rd | 6 ++++-- man/save_estimate_infections.Rd | 3 ++- man/save_input.Rd | 3 ++- man/setup_default_logging.Rd | 3 ++- man/setup_target_folder.Rd | 6 ++++-- man/simulate_infections.Rd | 8 +++++-- man/update_horizon.Rd | 3 ++- 25 files changed, 140 insertions(+), 70 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index ba4559ebd..255ebefe1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -132,10 +132,12 @@ importFrom(future,availableCores) importFrom(future,plan) importFrom(future,tweak) importFrom(future.apply,future_lapply) +importFrom(gggplot2,element_blank) +importFrom(gggplot2,scale_y_continuous) +importFrom(gggplot2,theme_bw) importFrom(ggplot2,.data) importFrom(ggplot2,aes) importFrom(ggplot2,coord_cartesian) -importFrom(ggplot2,element_blank) importFrom(ggplot2,expand_limits) importFrom(ggplot2,facet_wrap) importFrom(ggplot2,geom_col) diff --git a/R/adjust.R b/R/adjust.R index 673d54326..2b4b4ccbf 100644 --- a/R/adjust.R +++ b/R/adjust.R @@ -3,19 +3,24 @@ #' @description `r lifecycle::badge("stable")` #' Maps from cases by date of infection to date of report via date of #' onset. -#' @param infections `data.table` containing a `date` variable and a numeric `cases` variable. +#' @param infections `data.table` containing a `date` variable and a numeric +#' `cases` variable. #' -#' @param delay_defs A list of single row data.tables that each defines a delay distribution (model, parameters and maximum delay for each model). +#' @param delay_defs A list of single row data.tables that each defines a +#' delay distribution (model, parameters and maximum delay for each model). #' See `lognorm_dist_def` for an example of the structure. #' -#' @param reporting_effect A numeric vector of length 7 that allows the scaling of reported cases -#' by the day on which they report (1 = Monday, 7 = Sunday). By default no scaling occurs. +#' @param reporting_effect A numeric vector of length 7 that allows the scaling +#' of reported cases by the day on which they report (1 = Monday, 7 = Sunday). +#' By default no scaling occurs. #' -#' @param reporting_model A function that takes a single numeric vector as an argument and returns a -#' single numeric vector. Can be used to apply stochastic reporting effects. See the examples for details. +#' @param reporting_model A function that takes a single numeric vector as an +#' argument and returns a single numeric vector. Can be used to apply stochastic +#' reporting effects. See the examples for details. #' -#' @return A `data.table` containing a `date` variable (date of report) and a `cases` variable. If `return_onset = TRUE` there will be -#' a third variable `reference` which indicates what the date variable refers to. +#' @return A `data.table` containing a `date` variable (date of report) and a +#' `cases` variable. If `return_onset = TRUE` there will be a third variable +#' `reference` which indicates what the date variable refers to. #' @export #' @inheritParams sample_approx_dist #' @importFrom data.table setorder data.table data.table diff --git a/R/epinow-internal.R b/R/epinow-internal.R index d8d85fc1e..539e1ed41 100644 --- a/R/epinow-internal.R +++ b/R/epinow-internal.R @@ -10,7 +10,9 @@ #' @export update_horizon <- function(horizon, target_date, reported_cases) { if (horizon != 0) { - horizon <- horizon + as.numeric(as.Date(target_date) - max(reported_cases$date)) + horizon <- horizon + as.numeric( + as.Date(target_date) - max(reported_cases$date) + ) } return(horizon) } @@ -58,12 +60,17 @@ save_estimate_infections <- function(estimates, target_folder = NULL, samples = TRUE, return_fit = TRUE) { if (!is.null(target_folder)) { if (samples) { - saveRDS(estimates$samples, paste0(target_folder, "/estimate_samples.rds")) + saveRDS( + estimates$samples, file.path(target_folder, "estimate_samples.rds") + ) } - saveRDS(estimates$summarised, paste0(target_folder, "/summarised_estimates.rds")) + saveRDS( + estimates$summarised, + file.path(target_folder, "summarised_estimates.rds") + ) if (return_fit) { - saveRDS(estimates$fit, paste0(target_folder, "/model_fit.rds")) - saveRDS(estimates$args, paste0(target_folder, "/model_args.rds")) + saveRDS(estimates$fit, file.path(target_folder, "model_fit.rds")) + saveRDS(estimates$args, file.path(target_folder, "model_args.rds")) } } return(invisible(NULL)) @@ -88,21 +95,27 @@ estimates_by_report_date <- function(estimates, CrIs = c(0.2, 0.5, 0.9), target_folder = NULL, samples = TRUE) { estimated_reported_cases <- list() if (samples) { - estimated_reported_cases$samples <- estimates$samples[variable == "reported_cases"][ - , + estimated_reported_cases$samples <- estimates$samples[ + variable == "reported_cases"][, .(date, sample, cases = value, type = "gp_rt") ] } - estimated_reported_cases$summarised <- estimates$summarised[variable == "reported_cases"][ - , + estimated_reported_cases$summarised <- estimates$summarised[ + variable == "reported_cases"][, type := "gp_rt" ][, variable := NULL][, strat := NULL] if (!is.null(target_folder)) { if (samples) { - saveRDS(estimated_reported_cases$samples, paste0(target_folder, "/estimated_reported_cases_samples.rds")) + saveRDS( + estimated_reported_cases$samples, + file.path(target_folder, "estimated_reported_cases_samples.rds") + ) } - saveRDS(estimated_reported_cases$summarised, paste0(target_folder, "/summarised_estimated_reported_cases.rds")) + saveRDS( + estimated_reported_cases$summarised, + file.path(target_folder, "summarised_estimated_reported_cases.rds") + ) } return(estimated_reported_cases) } diff --git a/R/estimate_truncation.R b/R/estimate_truncation.R index 363ed0e5d..205d6718c 100644 --- a/R/estimate_truncation.R +++ b/R/estimate_truncation.R @@ -66,7 +66,8 @@ #' @inheritParams calc_CrIs #' @importFrom purrr map reduce map_dbl #' @importFrom rstan sampling -#' @importFrom data.table copy .N as.data.table merge.data.table setDT setcolorder +#' @importFrom data.table copy .N as.data.table merge.data.table setDT +#' @importFrom data.table setcolorder #' @examples #' # set number of cores to use #' old_opts <- options() @@ -97,7 +98,9 @@ #' cmf <- cmf / cmf[dist$max + 1] #' cmf <- rev(cmf)[-1] #' trunc_cases <- data.table::copy(cases)[1:(.N - index)] -#' trunc_cases[(.N - length(cmf) + 1):.N, confirm := as.integer(confirm * cmf)] +#' trunc_cases[ +#' (.N - length(cmf) + 1):.N, confirm := as.integer(confirm * cmf) +#' ] #' return(trunc_cases) #' } #' example_data <- purrr::map(c(20, 15, 10, 0), @@ -123,7 +126,7 @@ #' #' options(old_opts) estimate_truncation <- function(obs, max_truncation, trunc_max = 10, - trunc_dist = c("lognormal"), + trunc_dist = "lognormal", model = NULL, CrIs = c(0.2, 0.5, 0.9), verbose = TRUE, @@ -224,10 +227,10 @@ estimate_truncation <- function(obs, max_truncation, trunc_max = 10, estimates <- estimates[, lapply(.SD, as.integer)] estimates <- estimates[, index := .N - 0:(.N - 1)] if (!is.null(estimates$n_eff)) { - estimates[, c("n_eff") := NULL] + estimates[, "n_eff" := NULL] } if (!is.null(estimates$Rhat)) { - estimates[, c("Rhat") := NULL] + estimates[, "Rhat" := NULL] } target_obs <- @@ -272,7 +275,8 @@ estimate_truncation <- function(obs, max_truncation, trunc_max = 10, #' @author Sam Abbott #' @seealso plot estimate_truncation #' @method plot estimate_truncation -#' @importFrom ggplot2 ggplot aes geom_col geom_point labs scale_x_date scale_y_continuous theme theme_bw +#' @importFrom ggplot2 ggplot aes geom_col geom_point labs scale_x_date +#' @importFrom ggplot2 scale_y_continuous theme theme_bw #' @export plot.estimate_truncation <- function(x, ...) { plot <- ggplot2::ggplot(x$obs, ggplot2::aes(x = date, y = last_confirm)) + diff --git a/R/report.R b/R/report.R index 0554e2381..33279c0a5 100644 --- a/R/report.R +++ b/R/report.R @@ -205,7 +205,7 @@ report_summary <- function(summarised_estimates, "Expected change in daily cases", "Effective reproduction no.", "Rate of growth", - "Doubling/halving time (days)" + "Doubling/halving time (days)" # nolint ), estimate = c( make_conf(current_cases, max_CrI), @@ -276,7 +276,9 @@ report_summary <- function(summarised_estimates, #' incubation_period <- get_incubation_period( #' disease = "SARS-CoV-2", source = "lauer" #' ) -#' reporting_delay <- bootstrapped_dist_fit(rlnorm(100, log(6), 1), max_value = 30) +#' reporting_delay <- bootstrapped_dist_fit( +#' rlnorm(100, log(6), 1), max_value = 30 +#' ) #' #' # run model #' out <- estimate_infections(cases, diff --git a/R/setup.R b/R/setup.R index 4ba868de6..591a67a87 100644 --- a/R/setup.R +++ b/R/setup.R @@ -116,7 +116,7 @@ setup_default_logging <- function(logs = tempdir(check = TRUE), #' of the required future backend with sensible defaults for most users of #' `regional_epinow`. More advanced users are recommended to setup their own #' `future` backend based on their available resources. -#' +#' #' @param strategies A vector length 1 to 2 of strategies to pass to #' `future::plan`. Nesting of parallelisation is from the top level down. #' The default is to set up nesting parallelisation with both using @@ -197,8 +197,12 @@ setup_dt <- function(reported_cases) { #' #' @description `r lifecycle::badge("stable")` #' Sets up a folders for saving results -#' @param target_date Date, defaults to maximum found in the data if not specified. -#' @param target_folder Character string specifying where to save results (will create if not present). +#' @param target_date Date, defaults to maximum found in the data if not +#' specified. +#' +#' @param target_folder Character string specifying where to save results (will +#' create if not present). +#' #' @return A list containing the path to the dated folder and the latest folder #' @export setup_target_folder <- function(target_folder = NULL, target_date) { diff --git a/R/simulate_infections.R b/R/simulate_infections.R index 692f24dc5..b463bf78d 100644 --- a/R/simulate_infections.R +++ b/R/simulate_infections.R @@ -47,7 +47,9 @@ #' reported_cases <- example_confirmed[1:50] #' #' # set up example generation time -#' generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") +#' generation_time <- get_generation_time( +#' disease = "SARS-CoV-2", source = "ganyani" +#' ) #' # set delays between infection and case report #' incubation_period <- get_incubation_period( #' disease = "SARS-CoV-2", source = "lauer" @@ -85,7 +87,9 @@ #' #' #' # with a data.frame input of samples #' R_samples <- summary(est, type = "samples", param = "R") -#' R_samples <- R_samples[, .(date, sample, value)][sample <= 1000][date <= "2020-04-10"] +#' R_samples <- R_samples[, +#' .(date, sample, value)][sample <= 1000][date <= "2020-04-10" +#' ] #' R_samples <- R_samples[date >= "2020-04-01", value := 1.1] #' sims <- simulate_infections(est, R_samples) #' plot(sims) @@ -123,12 +127,12 @@ simulate_infections <- function(estimates, # if R is given, update trajectories in stanfit object if (!is.null(R)) { - if (any(class(R) %in% "data.frame")) { + if (inherits(R, "data.frame")) { if (is.null(R$sample)) { R <- R$value } } - if (any(class(R) %in% "data.frame")) { + if (inherits(R, "data.frame")) { R <- as.data.table(R) R <- R[, .(date, sample, value)] draws$R <- t(matrix(R$value, ncol = length(unique(R$sample)))) @@ -148,11 +152,13 @@ simulate_infections <- function(estimates, # sample from posterior if samples != posterior posterior_sample <- dim(draws$obs_reports)[1] if (posterior_sample < samples) { + # nolint start posterior_samples <- sample( - 1:posterior_sample, samples, replace = TRUE - ) # nolint + seq_len(posterior_sample), samples, replace = TRUE + ) R_draws <- draws$R draws <- map(draws, ~ as.matrix(.[posterior_samples, ])) + # nolint end draws$R <- R_draws } diff --git a/R/summarise.R b/R/summarise.R index 434313f33..b6f2e1e7d 100644 --- a/R/summarise.R +++ b/R/summarise.R @@ -303,7 +303,9 @@ regional_summary <- function(regional_output = NULL, } # adaptive add a logscale to the summary plot based on range of observed cases - current_inf <- summarised_results$data[metric %in% "New confirmed cases by infection date"] + current_inf <- summarised_results$data[ + metric %in% "New confirmed cases by infection date" + ] uppers <- grepl("upper_", colnames(current_inf), fixed = TRUE) # nolint lowers <- grepl("lower_", colnames(current_inf), fixed = TRUE) # nolint log_cases <- (max(current_inf[, ..uppers], na.rm = TRUE) / diff --git a/man/adjust_infection_to_report.Rd b/man/adjust_infection_to_report.Rd index 8fe936316..32ef09ac5 100644 --- a/man/adjust_infection_to_report.Rd +++ b/man/adjust_infection_to_report.Rd @@ -14,16 +14,20 @@ adjust_infection_to_report( ) } \arguments{ -\item{infections}{\code{data.table} containing a \code{date} variable and a numeric \code{cases} variable.} +\item{infections}{\code{data.table} containing a \code{date} variable and a numeric +\code{cases} variable.} -\item{delay_defs}{A list of single row data.tables that each defines a delay distribution (model, parameters and maximum delay for each model). +\item{delay_defs}{A list of single row data.tables that each defines a +delay distribution (model, parameters and maximum delay for each model). See \code{lognorm_dist_def} for an example of the structure.} -\item{reporting_model}{A function that takes a single numeric vector as an argument and returns a -single numeric vector. Can be used to apply stochastic reporting effects. See the examples for details.} +\item{reporting_model}{A function that takes a single numeric vector as an +argument and returns a single numeric vector. Can be used to apply stochastic +reporting effects. See the examples for details.} -\item{reporting_effect}{A numeric vector of length 7 that allows the scaling of reported cases -by the day on which they report (1 = Monday, 7 = Sunday). By default no scaling occurs.} +\item{reporting_effect}{A numeric vector of length 7 that allows the scaling +of reported cases by the day on which they report (1 = Monday, 7 = Sunday). +By default no scaling occurs.} \item{type}{Character string indicating the method to use to transform counts. Supports either "sample" which approximates sampling or "median" would shift by the median of the distribution.} @@ -32,8 +36,9 @@ which approximates sampling or "median" would shift by the median of the distrib Defaults to \code{TRUE}.} } \value{ -A \code{data.table} containing a \code{date} variable (date of report) and a \code{cases} variable. If \code{return_onset = TRUE} there will be -a third variable \code{reference} which indicates what the date variable refers to. +A \code{data.table} containing a \code{date} variable (date of report) and a +\code{cases} variable. If \code{return_onset = TRUE} there will be a third variable +\code{reference} which indicates what the date variable refers to. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} diff --git a/man/copy_results_to_latest.Rd b/man/copy_results_to_latest.Rd index d12589386..08276f220 100644 --- a/man/copy_results_to_latest.Rd +++ b/man/copy_results_to_latest.Rd @@ -7,7 +7,8 @@ copy_results_to_latest(target_folder = NULL, latest_folder = NULL) } \arguments{ -\item{target_folder}{Character string specifying where to save results (will create if not present).} +\item{target_folder}{Character string specifying where to save results (will +create if not present).} \item{latest_folder}{Character string containing the path to the latest target folder. As produced by \code{setup_target_folder}.} diff --git a/man/epinow.Rd b/man/epinow.Rd index c543261a7..6bf02eb55 100644 --- a/man/epinow.Rd +++ b/man/epinow.Rd @@ -88,9 +88,11 @@ return all options.} \item{plot_args}{A list of optional arguments passed to \code{plot.epinow()}.} -\item{target_folder}{Character string specifying where to save results (will create if not present).} +\item{target_folder}{Character string specifying where to save results (will +create if not present).} -\item{target_date}{Date, defaults to maximum found in the data if not specified.} +\item{target_date}{Date, defaults to maximum found in the data if not +specified.} \item{logs}{Character path indicating the target folder in which to store log information. Defaults to the temporary directory if not specified. Default diff --git a/man/estimate_truncation.Rd b/man/estimate_truncation.Rd index 972a3eb3b..2c813282a 100644 --- a/man/estimate_truncation.Rd +++ b/man/estimate_truncation.Rd @@ -8,7 +8,7 @@ estimate_truncation( obs, max_truncation, trunc_max = 10, - trunc_dist = c("lognormal"), + trunc_dist = "lognormal", model = NULL, CrIs = c(0.2, 0.5, 0.9), verbose = TRUE, @@ -112,7 +112,9 @@ construct_truncation <- function(index, cases, dist) { cmf <- cmf / cmf[dist$max + 1] cmf <- rev(cmf)[-1] trunc_cases <- data.table::copy(cases)[1:(.N - index)] - trunc_cases[(.N - length(cmf) + 1):.N, confirm := as.integer(confirm * cmf)] + trunc_cases[ + (.N - length(cmf) + 1):.N, confirm := as.integer(confirm * cmf) + ] return(trunc_cases) } example_data <- purrr::map(c(20, 15, 10, 0), diff --git a/man/estimates_by_report_date.Rd b/man/estimates_by_report_date.Rd index 565cab509..2b230ba95 100644 --- a/man/estimates_by_report_date.Rd +++ b/man/estimates_by_report_date.Rd @@ -16,7 +16,8 @@ estimates_by_report_date( \item{CrIs}{Numeric vector of credible intervals to calculate.} -\item{target_folder}{Character string specifying where to save results (will create if not present).} +\item{target_folder}{Character string specifying where to save results (will +create if not present).} \item{samples}{Logical, defaults to TRUE. Should samples be saved} } diff --git a/man/obs_opts.Rd b/man/obs_opts.Rd index 8a44a3f25..bce8c6edf 100644 --- a/man/obs_opts.Rd +++ b/man/obs_opts.Rd @@ -34,7 +34,8 @@ effect be used in the observation model.} week or if data has a non-weekly periodicity.} \item{scale}{List, defaulting to an empty list. Should an scaling factor be -applied to map latent infections (convolved to date of report). If none empty a mean (\code{mean}) and standard deviation (\code{sd}) needs to be supplied +applied to map latent infections (convolved to date of report). If none +empty a mean (\code{mean}) and standard deviation (\code{sd}) needs to be supplied defining the normally distributed scaling factor.} \item{likelihood}{Logical, defaults to \code{TRUE}. Should the likelihood be diff --git a/man/regional_epinow.Rd b/man/regional_epinow.Rd index 4ebafa33c..a01a2712b 100644 --- a/man/regional_epinow.Rd +++ b/man/regional_epinow.Rd @@ -67,9 +67,11 @@ forecast.} \item{CrIs}{Numeric vector of credible intervals to calculate.} -\item{target_folder}{Character string specifying where to save results (will create if not present).} +\item{target_folder}{Character string specifying where to save results (will +create if not present).} -\item{target_date}{Date, defaults to maximum found in the data if not specified.} +\item{target_date}{Date, defaults to maximum found in the data if not +specified.} \item{non_zero_points}{Numeric, the minimum number of time points with non-zero cases in a region required for that region to be evaluated. @@ -103,7 +105,8 @@ logging setup then the code for \code{setup_default_logging} and the \code{epinow} for details.} } \value{ -A list of output stratified at the top level into regional output and across region output summary output +A list of output stratified at the top level into regional output +and across region output summary output } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#maturing}{\figure{lifecycle-maturing.svg}{options: alt='[Maturing]'}}}{\strong{[Maturing]}} diff --git a/man/regional_runtimes.Rd b/man/regional_runtimes.Rd index c97774d0e..70da030c4 100644 --- a/man/regional_runtimes.Rd +++ b/man/regional_runtimes.Rd @@ -15,7 +15,8 @@ regional_runtimes( \item{regional_output}{A list of output as produced by \code{regional_epinow} and stored in the \code{regional} list.} -\item{target_folder}{Character string specifying where to save results (will create if not present).} +\item{target_folder}{Character string specifying where to save results (will +create if not present).} \item{target_date}{A character string giving the target date for which to extract results diff --git a/man/report_plots.Rd b/man/report_plots.Rd index 27f7a218b..c8cc1babf 100644 --- a/man/report_plots.Rd +++ b/man/report_plots.Rd @@ -16,7 +16,8 @@ reported_cases_rt, and r (rate of growth).} \item{reported}{A data.table of reported cases with the following variables: date, confirm.} -\item{target_folder}{Character string specifying where to save results (will create if not present).} +\item{target_folder}{Character string specifying where to save results (will +create if not present).} \item{...}{Additional arguments passed to \code{plot_estimates()}.} } @@ -41,7 +42,9 @@ generation_time <- get_generation_time( incubation_period <- get_incubation_period( disease = "SARS-CoV-2", source = "lauer" ) -reporting_delay <- bootstrapped_dist_fit(rlnorm(100, log(6), 1), max_value = 30) +reporting_delay <- bootstrapped_dist_fit( + rlnorm(100, log(6), 1), max_value = 30 +) # run model out <- estimate_infections(cases, diff --git a/man/report_summary.Rd b/man/report_summary.Rd index 848f9d5ba..b1c8bf708 100644 --- a/man/report_summary.Rd +++ b/man/report_summary.Rd @@ -19,7 +19,8 @@ contain the following estimates: R, infections, and r (rate of growth).} \item{rt_samples}{A data.table containing Rt samples with the following variables: sample and value.} -\item{target_folder}{Character string specifying where to save results (will create if not present).} +\item{target_folder}{Character string specifying where to save results (will +create if not present).} \item{return_numeric}{Should numeric summary information be returned.} } diff --git a/man/run_region.Rd b/man/run_region.Rd index b0b60373d..db2eaf318 100644 --- a/man/run_region.Rd +++ b/man/run_region.Rd @@ -69,9 +69,11 @@ forecast.} \item{reported_cases}{A data frame of confirmed cases (confirm) by date (date), and region (\code{region}).} -\item{target_folder}{Character string specifying where to save results (will create if not present).} +\item{target_folder}{Character string specifying where to save results (will +create if not present).} -\item{target_date}{Date, defaults to maximum found in the data if not specified.} +\item{target_date}{Date, defaults to maximum found in the data if not +specified.} \item{return_output}{Logical, defaults to FALSE. Should output be returned, this automatically updates to TRUE if no directory for saving is specified.} diff --git a/man/save_estimate_infections.Rd b/man/save_estimate_infections.Rd index 1237fb570..79c5ccb8e 100644 --- a/man/save_estimate_infections.Rd +++ b/man/save_estimate_infections.Rd @@ -14,7 +14,8 @@ save_estimate_infections( \arguments{ \item{estimates}{List of data frames as output by \code{estimate_infections}} -\item{target_folder}{Character string specifying where to save results (will create if not present).} +\item{target_folder}{Character string specifying where to save results (will +create if not present).} \item{samples}{Logical, defaults to TRUE. Should samples be saved} diff --git a/man/save_input.Rd b/man/save_input.Rd index 3d7cd7b33..dfe26ad2b 100644 --- a/man/save_input.Rd +++ b/man/save_input.Rd @@ -10,7 +10,8 @@ save_input(reported_cases, target_folder) \item{reported_cases}{A data frame of confirmed cases (confirm) by date (date). confirm must be integer and date must be in date format.} -\item{target_folder}{Character string specifying where to save results (will create if not present).} +\item{target_folder}{Character string specifying where to save results (will +create if not present).} } \value{ No return value, called for side effects diff --git a/man/setup_default_logging.Rd b/man/setup_default_logging.Rd index 0b0fb885b..4a32b0e20 100644 --- a/man/setup_default_logging.Rd +++ b/man/setup_default_logging.Rd @@ -20,7 +20,8 @@ logging setup then the code for \code{setup_default_logging} and the \item{mirror_epinow}{Logical, defaults to FALSE. Should internal logging be returned from \code{epinow} to the console.} -\item{target_date}{Date, defaults to maximum found in the data if not specified.} +\item{target_date}{Date, defaults to maximum found in the data if not +specified.} } \value{ No return value, called for side effects diff --git a/man/setup_target_folder.Rd b/man/setup_target_folder.Rd index f78a7d44d..0872e260d 100644 --- a/man/setup_target_folder.Rd +++ b/man/setup_target_folder.Rd @@ -7,9 +7,11 @@ setup_target_folder(target_folder = NULL, target_date) } \arguments{ -\item{target_folder}{Character string specifying where to save results (will create if not present).} +\item{target_folder}{Character string specifying where to save results (will +create if not present).} -\item{target_date}{Date, defaults to maximum found in the data if not specified.} +\item{target_date}{Date, defaults to maximum found in the data if not +specified.} } \value{ A list containing the path to the dated folder and the latest folder diff --git a/man/simulate_infections.Rd b/man/simulate_infections.Rd index 16119954b..5ba779c31 100644 --- a/man/simulate_infections.Rd +++ b/man/simulate_infections.Rd @@ -58,7 +58,9 @@ options(mc.cores = ifelse(interactive(), 4, 1)) reported_cases <- example_confirmed[1:50] # set up example generation time -generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani") +generation_time <- get_generation_time( + disease = "SARS-CoV-2", source = "ganyani" +) # set delays between infection and case report incubation_period <- get_incubation_period( disease = "SARS-CoV-2", source = "lauer" @@ -96,7 +98,9 @@ plot(sims) #' # with a data.frame input of samples R_samples <- summary(est, type = "samples", param = "R") -R_samples <- R_samples[, .(date, sample, value)][sample <= 1000][date <= "2020-04-10"] +R_samples <- R_samples[, + .(date, sample, value)][sample <= 1000][date <= "2020-04-10" +] R_samples <- R_samples[date >= "2020-04-01", value := 1.1] sims <- simulate_infections(est, R_samples) plot(sims) diff --git a/man/update_horizon.Rd b/man/update_horizon.Rd index 2e8c8302e..f2ca919c7 100644 --- a/man/update_horizon.Rd +++ b/man/update_horizon.Rd @@ -10,7 +10,8 @@ update_horizon(horizon, target_date, reported_cases) \item{horizon}{Numeric, defaults to 7. Number of days into the future to forecast.} -\item{target_date}{Date, defaults to maximum found in the data if not specified.} +\item{target_date}{Date, defaults to maximum found in the data if not +specified.} \item{reported_cases}{A data frame of confirmed cases (confirm) by date (date). confirm must be integer and date must be in date format.} From f2f10529b448c67af4504930247bc793fd00b20b Mon Sep 17 00:00:00 2001 From: Sam Date: Thu, 27 Apr 2023 15:32:16 +0100 Subject: [PATCH 14/19] update wordlist --- inst/WORDLIST | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/inst/WORDLIST b/inst/WORDLIST index 77a44238d..015ffc91b 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -16,15 +16,16 @@ Epinow Gruson Habakuk Hain +HalfNormal Hamada IO Inf Jit Kanjilal Kucharski -LN Leeuwen Lifecycle +Linted Lipsitch Lison LogNormal @@ -33,6 +34,7 @@ Matern Mayol Monkeypox NUTs +NegBinom Nowcasts ORCID PLoS @@ -50,6 +52,7 @@ Sanjat Wellcome backcalc backcalculation +centered codecov com csv @@ -57,6 +60,7 @@ dd defato discretised dist +div doi dt epidemia @@ -67,27 +71,33 @@ filepath frac github gp +intial +ldots lengthscale +leq lineranges +linters logmean lognorm logsd +lt matern mathcal mathrm mc metacran negbin +nolint nowcast nowcasting nowcasts objec obs parallisation +parameterisations parameterised pngs poisson -produc progressr rds realland @@ -95,13 +105,15 @@ rstan runtimes sd se -seealso sim +st stan stanfit testland tibbles timelimit +underreporting +varphi vb vscode warmup From 87ab4788f6c3ce5cb1c9a5073f1b9687efbf8bed Mon Sep 17 00:00:00 2001 From: Sam Date: Thu, 27 Apr 2023 15:51:06 +0100 Subject: [PATCH 15/19] linting manically whilst dreaming of future merge issues that will need to be resolved --- NAMESPACE | 4 +- R/create.R | 21 ++++---- R/data.R | 2 +- R/dist.R | 79 ++++++++++++++++++++----------- R/estimate_infections.R | 18 +++++-- R/plot.R | 2 +- README.Rmd | 2 +- data-raw/generation-time.R | 11 ++--- data-raw/incubation-period.R | 2 +- man/adjust_infection_to_report.Rd | 9 ++-- man/bootstrapped_dist_fit.Rd | 3 +- man/create_gp_data.Rd | 7 +-- man/estimate_infections.Rd | 8 +++- man/incubation_periods.Rd | 2 +- man/report_cases.Rd | 5 +- man/sample_approx_dist.Rd | 30 ++++++------ man/tune_inv_gamma.Rd | 8 ++-- 17 files changed, 127 insertions(+), 86 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 255ebefe1..ba4559ebd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -132,12 +132,10 @@ importFrom(future,availableCores) importFrom(future,plan) importFrom(future,tweak) importFrom(future.apply,future_lapply) -importFrom(gggplot2,element_blank) -importFrom(gggplot2,scale_y_continuous) -importFrom(gggplot2,theme_bw) importFrom(ggplot2,.data) importFrom(ggplot2,aes) importFrom(ggplot2,coord_cartesian) +importFrom(ggplot2,element_blank) importFrom(ggplot2,expand_limits) importFrom(ggplot2,facet_wrap) importFrom(ggplot2,geom_col) diff --git a/R/create.R b/R/create.R index d38a2f66a..5463584a2 100644 --- a/R/create.R +++ b/R/create.R @@ -35,7 +35,9 @@ create_clean_reported_cases <- function(reported_cases, horizon, if (is.null(reported_cases$breakpoint)) { reported_cases$breakpoint <- 0 } - reported_cases <- reported_cases[is.na(confirm), confirm := 0][, .(date = date, confirm, breakpoint)] + reported_cases <- reported_cases[ + is.na(confirm), confirm := 0][, .(date = date, confirm, breakpoint) + ] reported_cases <- reported_cases[is.na(breakpoint), breakpoint := 0] reported_cases <- data.table::setorder(reported_cases, date) ## Filter out 0 reported cases from the beginning of the data @@ -68,7 +70,7 @@ create_clean_reported_cases <- function(reported_cases, horizon, #' Create Delay Shifted Cases #' #' @description `r lifecycle::badge("stable")` -#' +#' #' This functions creates a data frame of reported cases that has been smoothed #' using a centred partial rolling average (with a period set by #' `smoothing_window`) and shifted back in time by some delay. It is used by @@ -144,7 +146,7 @@ create_shifted_cases <- function(reported_cases, shift, #' @description `r lifecycle::badge("stable")` #' Converts the `future` argument from `rt_opts()` into arguments that can be #' passed to `stan`. -#' +#' #' @param future A character string or integer. This argument indicates how to #' set future Rt values. Supported options are to project using the Rt model #' ("project"), to use the latest estimate based on partial data ("latest"), @@ -259,7 +261,7 @@ create_rt_data <- function(rt = rt_opts(), breakpoints = NULL, #' #' @param backcalc A list of options as generated by `backcalc_opts()` to #' define the back calculation. Defaults to `backcalc_opts()`. -#' +#' #' @seealso backcalc_opts #' @return A list of settings defining the Gaussian process #' @export @@ -296,12 +298,13 @@ create_backcalc_data <- function(backcalc = backcalc_opts) { #' Create Gaussian Process Data #' #' @description `r lifecycle::badge("stable")` -#' Takes the output of `gp_opts()` and converts it into a list understood by `stan`. +#' Takes the output of `gp_opts()` and converts it into a list understood by +#' `stan`. #' @param gp A list of options as generated by `gp_opts()` to define the #' Gaussian process. Defaults to `gp_opts()`.Set to NULL to disable the #' Gaussian process. -#' @param data A list containing the following numeric values: `t`, `seeding_time`, -#' `horizon`. +#' @param data A list containing the following numeric values: +#' `t`, `seeding_time`, `horizon`. #' @seealso gp_opts #' @return A list of settings defining the Gaussian process #' @export @@ -646,7 +649,7 @@ create_initial_conditions <- function(data) { #' `rstan::vb` by combining the required options, with data, and type of #' initialisation. Initialisation defaults to random but it is expected that #' `create_initial_conditions` will be used. -#' +#' #' @param stan A list of stan options as generated by `stan_opts()`. Defaults #' to `stan_opts()`. Can be used to override `data`, `init`, and `verbose` #' settings if desired. @@ -658,7 +661,7 @@ create_initial_conditions <- function(data) { #' #' @param verbose Logical, defaults to `FALSE`. Should verbose progress #' messages be returned. -#' +#' #' @return A list of stan arguments #' @author Sam Abbott #' @export diff --git a/R/data.R b/R/data.R index 46f8ad895..a59702d65 100644 --- a/R/data.R +++ b/R/data.R @@ -10,7 +10,7 @@ #' #' @description `r lifecycle::badge("stable")` #' Incubation period estimates. See here for details: -#' https://github.com/epiforecasts/EpiNow2/blob/main/data-raw/incubation-period.R +#' https://github.com/epiforecasts/EpiNow2/blob/main/data-raw/incubation-period.R # nolint #' @format A `data.table` of summarising the distribution "incubation_periods" diff --git a/R/dist.R b/R/dist.R index ce026d05f..b4d5502d5 100644 --- a/R/dist.R +++ b/R/dist.R @@ -302,7 +302,7 @@ gamma_dist_def <- function(shape, shape_sd, mean, mean_sd, sd, sd_sd, max_value, samples) { - if (missing(shape) & missing(scale) & !missing(mean) & !missing(sd)) { + if (missing(shape) && missing(scale) && !missing(mean) && !missing(sd)) { mean <- truncnorm::rtruncnorm(samples, a = 0, mean = mean, sd = mean_sd) sd <- truncnorm::rtruncnorm(samples, a = 0, mean = sd, sd = sd_sd) beta <- sd^2 / mean @@ -310,7 +310,9 @@ gamma_dist_def <- function(shape, shape_sd, beta <- 1 / beta } else { alpha <- truncnorm::rtruncnorm(samples, a = 0, mean = shape, sd = shape_sd) - beta <- 1 / truncnorm::rtruncnorm(samples, a = 0, mean = scale, sd = scale_sd) + beta <- 1 / truncnorm::rtruncnorm( + samples, a = 0, mean = scale, sd = scale_sd + ) } dist <- data.table::data.table( @@ -381,7 +383,9 @@ lognorm_dist_def <- function(mean, mean_sd, mean_shape } - sampled_means <- truncnorm::rtruncnorm(samples, a = 0, mean = mean, sd = mean_sd) + sampled_means <- truncnorm::rtruncnorm( + samples, a = 0, mean = mean, sd = mean_sd + ) sampled_sds <- truncnorm::rtruncnorm(samples, a = 0, mean = sd, sd = sd_sd) means <- sampled_means sds <- sampled_sds @@ -404,7 +408,8 @@ lognorm_dist_def <- function(mean, mean_sd, return(dist) } -#' Fit a Subsampled Bootstrap to Integer Values and Summarise Distribution Parameters +#' Fit a Subsampled Bootstrap to Integer Values and Summarise Distribution +#' Parameters #' #' @description `r lifecycle::badge("stable")` #' Fits an integer adjusted distribution to a subsampled bootstrap of data and @@ -553,22 +558,32 @@ estimate_delay <- function(delays, ...) { #' Approximate Sampling a Distribution using Counts #' #' @description `r lifecycle::badge("soft-deprecated")` -#' Convolves cases by a PMF function. This function will soon be removed or replaced with a -#' more robust `stan` implementation. -#' @param cases A dataframe of cases (in date order) with the following variables: -#' `date` and `cases`. +#' Convolves cases by a PMF function. This function will soon be removed or +#' replaced with a more robust `stan` implementation. +#' +#' @param cases A dataframe of cases (in date order) with the following +#' variables: `date` and `cases`. +#' #' @param max_value Numeric, maximum value to allow. Defaults to 120 days -#' @param direction Character string, defato "backwards". Direction in which to map cases. Supports -#' either "backwards" or "forwards". -#' @param dist_fn Function that takes two arguments with the first being numeric and the second being logical (and -#' defined as `dist`). Should return the probability density or a sample from the defined distribution. See +#' +#' @param direction Character string, defato "backwards". Direction in which to +#' map cases. Supports either "backwards" or "forwards". +#' +#' @param dist_fn Function that takes two arguments with the first being +#' numeric and the second being logical (and defined as `dist`). Should return +#' the probability density or a sample from the defined distribution. See #' the examples for more. -#' @param earliest_allowed_mapped A character string representing a date ("2020-01-01"). Indicates -#' the earliest allowed mapped value. -#' @param type Character string indicating the method to use to transform counts. Supports either "sample" -#' which approximates sampling or "median" would shift by the median of the distribution. -#' @param truncate_future Logical, should cases be truncated if they occur after the first date reported in the data. -#' Defaults to `TRUE`. +#' +#' @param earliest_allowed_mapped A character string representing a date +#' ("2020-01-01"). Indicates the earliest allowed mapped value. +#' +#' @param type Character string indicating the method to use to transform +#' counts. Supports either "sample" which approximates sampling or "median" +#' would shift by the median of the distribution. +#' +#' @param truncate_future Logical, should cases be truncated if they occur +#' after the first date reported in the data. Defaults to `TRUE`. +#' #' @return A `data.table` of cases by date of onset #' @export #' @importFrom purrr map_dfc @@ -694,14 +709,22 @@ sample_approx_dist <- function(cases = NULL, # filter out all zero cases until first recorded case mapped_cases <- data.table::setorder(mapped_cases, date) - mapped_cases <- mapped_cases[, cum_cases := cumsum(cases)][cum_cases != 0][, cum_cases := NULL] + mapped_cases <- mapped_cases[, + cum_cases := cumsum(cases)][cum_cases != 0][, cum_cases := NULL + ] } else if (type %in% "median") { - shift <- as.integer(median(as.integer(dist_fn(1000, dist = FALSE)), na.rm = TRUE)) + shift <- as.integer( + median(as.integer(dist_fn(1000, dist = FALSE)), na.rm = TRUE) + ) if (direction %in% "backwards") { - mapped_cases <- data.table::copy(cases)[, date := date - lubridate::days(shift)] + mapped_cases <- data.table::copy(cases)[, + date := date - lubridate::days(shift) + ] } else if (direction %in% "forwards") { - mapped_cases <- data.table::copy(cases)[, date := date + lubridate::days(shift)] + mapped_cases <- data.table::copy(cases)[, + date := date + lubridate::days(shift) + ] } } @@ -710,7 +733,7 @@ sample_approx_dist <- function(cases = NULL, } # filter out future cases - if (direction %in% "forwards" & truncate_future) { + if (direction %in% "forwards" && truncate_future) { max_date <- max(cases$date) mapped_cases <- mapped_cases[date <= max_date] } @@ -720,11 +743,12 @@ sample_approx_dist <- function(cases = NULL, #' Tune an Inverse Gamma to Achieve the Target Truncation #' #' @description `r lifecycle::badge("questioning")` -#' Allows an inverse gamma distribution to be. tuned so that less than 0.01 of its -#' probability mass function falls outside of the specified -#' bounds. This is required when using an inverse gamma prior, for example for a -#' Gaussian process. As no inverse gamma priors are currently in use and this function +#' Allows an inverse gamma distribution to be. tuned so that less than 0.01 of +#' its probability mass function falls outside of the specified bounds. This is +#' required when using an inverse gamma prior, for example for a Gaussian +#' process. As no inverse gamma priors are currently in use and this function #' has some stability issues it may be deprecated at a later date. +#' #' @param lower Numeric, defaults to 2. Lower truncation bound. #' #' @param upper Numeric, defaults to 21. Upper truncation bound. @@ -751,7 +775,6 @@ tune_inv_gamma <- function(lower = 2, upper = 21) { refresh = 0 ) - alpha <- rstan::extract(fit, "alpha") beta <- rstan::extract(fit, "beta") diff --git a/R/estimate_infections.R b/R/estimate_infections.R index e466a8964..c64aad85a 100644 --- a/R/estimate_infections.R +++ b/R/estimate_infections.R @@ -48,7 +48,8 @@ #' @inheritParams fit_model_with_nuts #' @inheritParams create_clean_reported_cases #' @inheritParams calc_CrIs -#' @importFrom data.table data.table copy merge.data.table as.data.table setorder rbindlist melt .N setDT +#' @importFrom data.table data.table copy merge.data.table as.data.table +#' @importFrom data.table setorder rbindlist melt .N setDT #' @importFrom purrr transpose #' @importFrom lubridate days #' @importFrom purrr transpose @@ -186,13 +187,17 @@ #' plot(fixed) #' #' # no delays -#' no_delay <- estimate_infections(reported_cases, generation_time = generation_time) +#' no_delay <- estimate_infections( +#' reported_cases, generation_time = generation_time +#' ) #' plot(no_delay) #' #' # break point but otherwise static Rt #' # with uncertain reporting delays #' bp_cases <- data.table::copy(reported_cases) -#' bp_cases <- bp_cases[, breakpoint := ifelse(date == as.Date("2020-03-16"), 1, 0)] +#' bp_cases <- bp_cases[, +#' breakpoint := ifelse(date == as.Date("2020-03-16"), 1, 0) +#' ] #' bkp <- estimate_infections(bp_cases, #' generation_time = generation_time, #' delays = delay_opts(incubation_period, reporting_delay), @@ -305,7 +310,7 @@ estimate_infections <- function(reported_cases, # Initialise fitting by using a previous fit or fitting to cumulative cases if (!is.null(args$init_fit)) { - if (!("stanfit" %in% class(args$init_fit))) { + if (!inherits(args$init_fit, "stanfit")) { if (args$init_fit %in% "cumulative") { args$init_fit <- init_cumulative_fit(args, warmup = 50, samples = 50, @@ -396,7 +401,8 @@ estimate_infections <- function(reported_cases, #' @author Sam Abbott init_cumulative_fit <- function(args, samples = 50, warmup = 50, id = "init", verbose = FALSE) { - futile.logger::flog.debug("%s: Fitting to cumulative data to initialise chains", id, + futile.logger::flog.debug( + "%s: Fitting to cumulative data to initialise chains", id, name = "EpiNow2.epinow.estimate_infections.fit" ) # copy main run settings and override to use only 100 iterations and a single chain @@ -672,6 +678,7 @@ format_fit <- function(posterior_samples, horizon, shift, burn_in, start_date, format_out$samples <- format_out$samples[, strat := NA] } # add type based on horizon + # nolint start format_out$samples <- format_out$samples[ , type := data.table::fifelse( @@ -684,6 +691,7 @@ format_fit <- function(posterior_samples, horizon, shift, burn_in, start_date, ) ) ] + # nolint end # remove burn in period if specified if (burn_in > 0) { diff --git a/R/plot.R b/R/plot.R index d56e933b1..874ca0946 100644 --- a/R/plot.R +++ b/R/plot.R @@ -267,7 +267,7 @@ plot_estimates <- function(estimate, reported, ylab = "Cases", hline, #' @importFrom ggplot2 ggplot aes geom_linerange geom_hline facet_wrap #' @importFrom ggplot2 theme guides labs expand_limits guide_legend #' @importFrom ggplot2 scale_color_manual .data coord_cartesian -#' @importFrom gggplot2 theme_bw element_blank scale_y_continuous +#' @importFrom ggplot2 theme_bw element_blank scale_y_continuous #' @importFrom scales comma #' @importFrom patchwork plot_layout #' @importFrom data.table setDT diff --git a/README.Rmd b/README.Rmd index b661a0cc1..816706c4c 100644 --- a/README.Rmd +++ b/README.Rmd @@ -6,7 +6,7 @@ output: github_document knitr::opts_chunk$set( collapse = TRUE, comment = "#>", - fig.path = "man/figures/", + fig.path = "man/figures/", # nolint eval = TRUE ) ``` diff --git a/data-raw/generation-time.R b/data-raw/generation-time.R index d5953ec56..3f15f7a10 100644 --- a/data-raw/generation-time.R +++ b/data-raw/generation-time.R @@ -1,13 +1,12 @@ library(data.table) -library(magrittr) -## We use the method outlined here: https://www.eurosurveillance.org/content/10.2807/1560-7917.ES.2020.25.17.2000257 +## We use the method outlined here: https://www.eurosurveillance.org/content/10.2807/1560-7917.ES.2020.25.17.2000257 # nolint ## to estimate the generation time based on the incubation time estimated -## here: https://annals.org/aim/fullarticle/2762808/incubation-period-coronavirus-disease-2019-covid-19-from-publicly-reported -## Code for this estimation process is available here: https://github.com/seabbs/COVID19 +## here: https://annals.org/aim/fullarticle/2762808/incubation-period-coronavirus-disease-2019-covid-19-from-publicly-reported # nolint +## Code for this estimation process is available here: https://github.com/seabbs/COVID19 # nolint ## We assume that a case cannot infect another case on the day of infection. ## Load raw MCMC output -gi <- data.table::setDT(readRDS("data-raw/gi.rds")) +gi <- data.table::setDT(readRDS(file.path("data-raw", "gi.rds"))) ## Check mean and standard deviation covid_generation_times_summary <- gi[, .( @@ -21,7 +20,7 @@ generation_times <- dist = "gamma", disease = "SARS-CoV-2", source = "ganyani", - url = "https://www.eurosurveillance.org/content/10.2807/1560-7917.ES.2020.25.17.2000257" + url = "https://www.eurosurveillance.org/content/10.2807/1560-7917.ES.2020.25.17.2000257" # nolint )] generation_times diff --git a/data-raw/incubation-period.R b/data-raw/incubation-period.R index 3f05e1d70..1512a5afe 100644 --- a/data-raw/incubation-period.R +++ b/data-raw/incubation-period.R @@ -7,7 +7,7 @@ incubation_periods <- data.table( dist = "lognormal", disease = "SARS-CoV-2", source = "lauer", - url = "doi.org/10.7326/M20-0504" + url = "doi.org/10.7326/M20-0504" # nolint ) usethis::use_data(incubation_periods, overwrite = TRUE) diff --git a/man/adjust_infection_to_report.Rd b/man/adjust_infection_to_report.Rd index 32ef09ac5..8fb319d8d 100644 --- a/man/adjust_infection_to_report.Rd +++ b/man/adjust_infection_to_report.Rd @@ -29,11 +29,12 @@ reporting effects. See the examples for details.} of reported cases by the day on which they report (1 = Monday, 7 = Sunday). By default no scaling occurs.} -\item{type}{Character string indicating the method to use to transform counts. Supports either "sample" -which approximates sampling or "median" would shift by the median of the distribution.} +\item{type}{Character string indicating the method to use to transform +counts. Supports either "sample" which approximates sampling or "median" +would shift by the median of the distribution.} -\item{truncate_future}{Logical, should cases be truncated if they occur after the first date reported in the data. -Defaults to \code{TRUE}.} +\item{truncate_future}{Logical, should cases be truncated if they occur +after the first date reported in the data. Defaults to \code{TRUE}.} } \value{ A \code{data.table} containing a \code{date} variable (date of report) and a diff --git a/man/bootstrapped_dist_fit.Rd b/man/bootstrapped_dist_fit.Rd index 1219f0b22..6938f2cba 100644 --- a/man/bootstrapped_dist_fit.Rd +++ b/man/bootstrapped_dist_fit.Rd @@ -2,7 +2,8 @@ % Please edit documentation in R/dist.R \name{bootstrapped_dist_fit} \alias{bootstrapped_dist_fit} -\title{Fit a Subsampled Bootstrap to Integer Values and Summarise Distribution Parameters} +\title{Fit a Subsampled Bootstrap to Integer Values and Summarise Distribution +Parameters} \usage{ bootstrapped_dist_fit( values, diff --git a/man/create_gp_data.Rd b/man/create_gp_data.Rd index ed9e61fd8..02cca9276 100644 --- a/man/create_gp_data.Rd +++ b/man/create_gp_data.Rd @@ -11,15 +11,16 @@ create_gp_data(gp = gp_opts(), data) Gaussian process. Defaults to \code{gp_opts()}.Set to NULL to disable the Gaussian process.} -\item{data}{A list containing the following numeric values: \code{t}, \code{seeding_time}, -\code{horizon}.} +\item{data}{A list containing the following numeric values: +\code{t}, \code{seeding_time}, \code{horizon}.} } \value{ A list of settings defining the Gaussian process } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Takes the output of \code{gp_opts()} and converts it into a list understood by \code{stan}. +Takes the output of \code{gp_opts()} and converts it into a list understood by +\code{stan}. } \examples{ # define input data required diff --git a/man/estimate_infections.Rd b/man/estimate_infections.Rd index beb9e168e..ddd168df2 100644 --- a/man/estimate_infections.Rd +++ b/man/estimate_infections.Rd @@ -235,13 +235,17 @@ fixed <- estimate_infections(reported_cases, plot(fixed) # no delays -no_delay <- estimate_infections(reported_cases, generation_time = generation_time) +no_delay <- estimate_infections( + reported_cases, generation_time = generation_time +) plot(no_delay) # break point but otherwise static Rt # with uncertain reporting delays bp_cases <- data.table::copy(reported_cases) -bp_cases <- bp_cases[, breakpoint := ifelse(date == as.Date("2020-03-16"), 1, 0)] +bp_cases <- bp_cases[, + breakpoint := ifelse(date == as.Date("2020-03-16"), 1, 0) +] bkp <- estimate_infections(bp_cases, generation_time = generation_time, delays = delay_opts(incubation_period, reporting_delay), diff --git a/man/incubation_periods.Rd b/man/incubation_periods.Rd index bb60bf72c..5da83205d 100644 --- a/man/incubation_periods.Rd +++ b/man/incubation_periods.Rd @@ -13,6 +13,6 @@ incubation_periods \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} Incubation period estimates. See here for details: -https://github.com/epiforecasts/EpiNow2/blob/main/data-raw/incubation-period.R +https://github.com/epiforecasts/EpiNow2/blob/main/data-raw/incubation-period.R # nolint } \keyword{datasets} diff --git a/man/report_cases.Rd b/man/report_cases.Rd index 7d4169a23..e0ba69224 100644 --- a/man/report_cases.Rd +++ b/man/report_cases.Rd @@ -25,8 +25,9 @@ incorporate forecasts.} options. See the documentation of \code{delay_opts()} and the examples below for details.} -\item{type}{Character string indicating the method to use to transform counts. Supports either "sample" -which approximates sampling or "median" would shift by the median of the distribution.} +\item{type}{Character string indicating the method to use to transform +counts. Supports either "sample" which approximates sampling or "median" +would shift by the median of the distribution.} \item{reporting_effect}{A \code{data.table} giving the weekly reporting effect with the following variables: \code{sample} (must be the same as in \code{nowcast}), diff --git a/man/sample_approx_dist.Rd b/man/sample_approx_dist.Rd index 5a94b3e45..302e6e180 100644 --- a/man/sample_approx_dist.Rd +++ b/man/sample_approx_dist.Rd @@ -15,34 +15,36 @@ sample_approx_dist( ) } \arguments{ -\item{cases}{A dataframe of cases (in date order) with the following variables: -\code{date} and \code{cases}.} +\item{cases}{A dataframe of cases (in date order) with the following +variables: \code{date} and \code{cases}.} -\item{dist_fn}{Function that takes two arguments with the first being numeric and the second being logical (and -defined as \code{dist}). Should return the probability density or a sample from the defined distribution. See +\item{dist_fn}{Function that takes two arguments with the first being +numeric and the second being logical (and defined as \code{dist}). Should return +the probability density or a sample from the defined distribution. See the examples for more.} \item{max_value}{Numeric, maximum value to allow. Defaults to 120 days} -\item{earliest_allowed_mapped}{A character string representing a date ("2020-01-01"). Indicates -the earliest allowed mapped value.} +\item{earliest_allowed_mapped}{A character string representing a date +("2020-01-01"). Indicates the earliest allowed mapped value.} -\item{direction}{Character string, defato "backwards". Direction in which to map cases. Supports -either "backwards" or "forwards".} +\item{direction}{Character string, defato "backwards". Direction in which to +map cases. Supports either "backwards" or "forwards".} -\item{type}{Character string indicating the method to use to transform counts. Supports either "sample" -which approximates sampling or "median" would shift by the median of the distribution.} +\item{type}{Character string indicating the method to use to transform +counts. Supports either "sample" which approximates sampling or "median" +would shift by the median of the distribution.} -\item{truncate_future}{Logical, should cases be truncated if they occur after the first date reported in the data. -Defaults to \code{TRUE}.} +\item{truncate_future}{Logical, should cases be truncated if they occur +after the first date reported in the data. Defaults to \code{TRUE}.} } \value{ A \code{data.table} of cases by date of onset } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#soft-deprecated}{\figure{lifecycle-soft-deprecated.svg}{options: alt='[Soft-deprecated]'}}}{\strong{[Soft-deprecated]}} -Convolves cases by a PMF function. This function will soon be removed or replaced with a -more robust \code{stan} implementation. +Convolves cases by a PMF function. This function will soon be removed or +replaced with a more robust \code{stan} implementation. } \examples{ \donttest{ diff --git a/man/tune_inv_gamma.Rd b/man/tune_inv_gamma.Rd index 417ef5fcc..1db2c38f3 100644 --- a/man/tune_inv_gamma.Rd +++ b/man/tune_inv_gamma.Rd @@ -17,10 +17,10 @@ distribution that achieves the target truncation. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#questioning}{\figure{lifecycle-questioning.svg}{options: alt='[Questioning]'}}}{\strong{[Questioning]}} -Allows an inverse gamma distribution to be. tuned so that less than 0.01 of its -probability mass function falls outside of the specified -bounds. This is required when using an inverse gamma prior, for example for a -Gaussian process. As no inverse gamma priors are currently in use and this function +Allows an inverse gamma distribution to be. tuned so that less than 0.01 of +its probability mass function falls outside of the specified bounds. This is +required when using an inverse gamma prior, for example for a Gaussian +process. As no inverse gamma priors are currently in use and this function has some stability issues it may be deprecated at a later date. } \examples{ From d573b0ddf5451a50c9cac25f6df93d790621c80d Mon Sep 17 00:00:00 2001 From: Sam Date: Thu, 27 Apr 2023 16:17:59 +0100 Subject: [PATCH 16/19] linting linting, linting in meetings, linting at lunch, linting whilst walking --- R/create.R | 6 ++++-- R/dist.R | 13 ++++++------- R/estimate_infections.R | 18 +++++++++++++----- R/extract.R | 17 ++++++++++++----- 4 files changed, 35 insertions(+), 19 deletions(-) diff --git a/R/create.R b/R/create.R index 5463584a2..7f5e8789f 100644 --- a/R/create.R +++ b/R/create.R @@ -107,7 +107,7 @@ create_shifted_cases <- function(reported_cases, shift, ) ][ , - confirm := data.table::fifelse(confirm == 0, 1, confirm) + confirm := data.table::fifelse(confirm == 0, 1, confirm) # nolint ] ## Forecast trend on reported cases using the last week of data @@ -521,7 +521,9 @@ create_stan_data <- function(reported_cases, generation_time, # used if (data$obs_scale == 1) { data$shifted_cases <- data$shifted_cases / data$obs_scale_mean - data$prior_infections <- log(exp(data$prior_infections) / data$obs_scale_mean) + data$prior_infections <- log( + exp(data$prior_infections) / data$obs_scale_mean + ) } return(data) } diff --git a/R/dist.R b/R/dist.R index b4d5502d5..35e5dd0b2 100644 --- a/R/dist.R +++ b/R/dist.R @@ -2,9 +2,11 @@ #' #' @description `r lifecycle::badge("questioning")` #' This function acts as a skeleton for a truncated distribution defined by -#' model type, maximum value and model parameters. It is designed to be used with the -#' output from `get_dist`. -#' @param n Numeric vector, number of samples to take (or days for the probability density). +#' model type, maximum value and model parameters. It is designed to be used +#' with the output from `get_dist`. +#' +#' @param n Numeric vector, number of samples to take (or days for the +#' probability density). #' #' @param dist Logical, defaults to `FALSE`. Should the probability density be #' returned rather than a number of samples. @@ -696,10 +698,7 @@ sample_approx_dist <- function(cases = NULL, case_sum <- direction_fn(rowSums(mapped_cases)) floor_case_sum <- floor(case_sum) sample_cases <- floor_case_sum + - data.table::fifelse( - (runif(seq_along(case_sum)) < (case_sum - floor_case_sum)), - 1, 0 - ) + as.numeric((runif(seq_along(case_sum)) < (case_sum - floor_case_sum))) # summarise imputed onsets and build output data.table mapped_cases <- data.table::data.table( diff --git a/R/estimate_infections.R b/R/estimate_infections.R index c64aad85a..1b5af7805 100644 --- a/R/estimate_infections.R +++ b/R/estimate_infections.R @@ -559,7 +559,10 @@ fit_model_with_nuts <- function(args, future = FALSE, max_execution_time = Inf, if (length(fit) == 0) { fit <- NULL if (is.null(fit)) { - rlang::abort("all chains failed - try inspecting the output for errors or increasing the max_execution_time") + rlang::abort( + "all chains failed - try inspecting the output for errors or", + " increasing the max_execution_time" + ) } } else { failed_chains <- chains - length(fit) @@ -597,7 +600,8 @@ fit_model_with_vb <- function(args, future = FALSE, id = "stan") { paste0( "%s: Running in approximate mode for ", args$iter, " iterations (with ", args$trials, " attempts). Extracting ", - args$output_samples, " approximate posterior samples for ", args$data$t, " time steps of which ", + args$output_samples, " approximate posterior samples for ", + args$data$t, " time steps of which ", args$data$horizon, " are a forecast" ), id, @@ -621,7 +625,7 @@ fit_model_with_vb <- function(args, future = FALSE, id = "stan") { } return(fit) } - safe_vb <- purrr::safely(fit_vb) + safe_vb <- purrr::safely(fit_vb) # nolint fit <- NULL current_trials <- 0 @@ -635,7 +639,9 @@ fit_model_with_vb <- function(args, future = FALSE, id = "stan") { if (is.null(fit)) { if (is.null(fit)) { - futile.logger::flog.error("%s: Fitting failed - try increasing stan_args$trials or inspecting the model input", + futile.logger::flog.error( + "%s: Fitting failed - try increasing stan_args$trials or inspecting", + " the model input", id, name = "EpiNow2.epinow.estimate_infections.fit" ) @@ -672,7 +678,9 @@ format_fit <- function(posterior_samples, horizon, shift, burn_in, start_date, CrIs) { format_out <- list() # bind all samples together - format_out$samples <- data.table::rbindlist(posterior_samples, fill = TRUE, idcol = "variable") + format_out$samples <- data.table::rbindlist( + posterior_samples, fill = TRUE, idcol = "variable" + ) if (is.null(format_out$samples$strat)) { format_out$samples <- format_out$samples[, strat := NA] diff --git a/R/extract.R b/R/extract.R index 0468322be..486523cd8 100644 --- a/R/extract.R +++ b/R/extract.R @@ -125,7 +125,9 @@ extract_parameter_samples <- function(stan_fit, data, reported_dates, samples, 1:data$bp_n ) - out$breakpoints <- out$breakpoints[, strat := date][, c("time", "date") := NULL] + out$breakpoints <- out$breakpoints[, + strat := date][, c("time", "date") := NULL + ] } } else { out$R <- extract_parameter( @@ -160,7 +162,9 @@ extract_parameter_samples <- function(stan_fit, data, reported_dates, ] } if (data$n_uncertain_sd_delays > 0) { - out$delay_sd <- extract_parameter("delay_sd", samples, 1:data$n_uncertain_sd_delays) + out$delay_sd <- extract_parameter( + "delay_sd", samples,seq_len(data$n_uncertain_sd_delays) + ) out$delay_sd <- out$delay_sd[, strat := as.character(time)][, time := NULL][, date := NULL @@ -170,12 +174,15 @@ extract_parameter_samples <- function(stan_fit, data, reported_dates, if (data$trunc_mean_sd > 0) { out$truncation_mean <- extract_parameter("trunc_mean", samples, 1) out$truncation_mean <- - out$truncation_mean[, strat := as.character(time)][, time := NULL][, date := NULL] + out$truncation_mean[, + strat := as.character(time)][, time := NULL][, date := NULL + ] } if (data$trunc_sd_sd > 0) { out$truncation_sd <- extract_parameter("trunc_sd", samples, 1) - out$truncation_sd <- - out$truncation_sd[, strat := as.character(time)][, time := NULL][, date := NULL] + out$truncation_sd <- out$truncation_sd[, + strat := as.character(time)][, time := NULL][, date := NULL + ] } } if (data$estimate_r && data$gt_mean_sd > 0) { From 26f5124459fed208789caf7c74e3ab008f48e762 Mon Sep 17 00:00:00 2001 From: Sam Date: Thu, 27 Apr 2023 16:26:14 +0100 Subject: [PATCH 17/19] is there any code that doesn't need to be linted? --- R/estimate_infections.R | 25 ++++++++++++++++--------- R/estimate_secondary.R | 21 +++++++++++++++------ R/estimate_truncation.R | 4 +++- R/extract.R | 2 +- R/get.R | 11 ++++++++--- R/regional_epinow.R | 7 ++++--- man/dist_skel.Rd | 7 ++++--- man/estimate_secondary.Rd | 6 ++++-- man/get_dist.Rd | 4 +++- 9 files changed, 58 insertions(+), 29 deletions(-) diff --git a/R/estimate_infections.R b/R/estimate_infections.R index 1b5af7805..6b10686d4 100644 --- a/R/estimate_infections.R +++ b/R/estimate_infections.R @@ -405,7 +405,8 @@ init_cumulative_fit <- function(args, samples = 50, warmup = 50, "%s: Fitting to cumulative data to initialise chains", id, name = "EpiNow2.epinow.estimate_infections.fit" ) - # copy main run settings and override to use only 100 iterations and a single chain + # copy main run settings and override to use only 100 iterations and a single + # chain initial_args <- list( object = args$object, data = args$data, @@ -419,8 +420,8 @@ init_cumulative_fit <- function(args, samples = 50, warmup = 50, control = list(adapt_delta = 0.9, max_treedepth = 13), refresh = ifelse(verbose, 50, -1) ) - # change observations to be cumulative in order to protect against noise and give - # an approximate fit (though for Rt constrained to be > 1) + # change observations to be cumulative in order to protect against noise and + # give an approximate fit (though for Rt constrained to be > 1) initial_args$data$cases <- cumsum(initial_args$data$cases) initial_args$data$shifted_cases <- cumsum(initial_args$data$shifted_cases) @@ -469,7 +470,8 @@ init_cumulative_fit <- function(args, samples = 50, warmup = 50, #' @importFrom rlang abort cnd_muffle #' @return A stan model object #' @author Sam Abbott -fit_model_with_nuts <- function(args, future = FALSE, max_execution_time = Inf, id = "stan") { +fit_model_with_nuts <- function(args, future = FALSE, max_execution_time = Inf, + id = "stan") { args$method <- NULL args$max_execution_time <- NULL args$future <- NULL @@ -503,14 +505,17 @@ fit_model_with_nuts <- function(args, future = FALSE, max_execution_time = Inf, onTimeout = "silent" ), warning = function(w) { - futile.logger::flog.warn("%s (chain: %s): %s - %s", id, chain, w$message, toString(w$call), + futile.logger::flog.warn( + "%s (chain: %s): %s - %s", id, chain, w$message, toString(w$call), name = "EpiNow2.epinow.estimate_infections.fit" ) rlang::cnd_muffle(w) } ), error = function(e) { - error_text <- sprintf("%s (chain: %s): %s - %s", id, chain, e$message, toString(e$call)) + error_text <- sprintf( + "%s (chain: %s): %s - %s", id, chain, e$message, toString(e$call) + ) futile.logger::flog.error(error_text, name = "EpiNow2.epinow.estimate_infections.fit" ) @@ -567,12 +572,14 @@ fit_model_with_nuts <- function(args, future = FALSE, max_execution_time = Inf, } else { failed_chains <- chains - length(fit) if (failed_chains > 0) { - futile.logger::flog.warn("%s: %s chains failed or were timed out.", id, failed_chains, + futile.logger::flog.warn( + "%s: %s chains failed or were timed out.", id, failed_chains, name = "EpiNow2.epinow.estimate_infections.fit" ) if ((chains - failed_chains) < 2) { rlang::abort( - "model fitting failed as too few chains were returned to assess convergence (2 or more required)" + "model fitting failed as too few chains were returned to assess", + " convergence (2 or more required)" ) } } @@ -629,7 +636,7 @@ fit_model_with_vb <- function(args, future = FALSE, id = "stan") { fit <- NULL current_trials <- 0 - while (current_trials <= trials & is.null(fit)) { + while (current_trials <= trials && is.null(fit)) { fit <- safe_vb(args) error <- fit[[2]] diff --git a/R/estimate_secondary.R b/R/estimate_secondary.R index c988b0ff7..c10a446b9 100644 --- a/R/estimate_secondary.R +++ b/R/estimate_secondary.R @@ -11,7 +11,7 @@ #' [here](https://gist.github.com/seabbs/4dad3958ca8d83daca8f02b143d152e6) for #' a prototype function that may be used to estimate and forecast a secondary #' observation from a primary across multiple regions and -#' [here](https://github.com/epiforecasts/covid.german.forecasts/blob/master/rt-forecast/death-from-cases.R) +#' [here](https://github.com/epiforecasts/covid.german.forecasts/blob/master/rt-forecast/death-from-cases.R) # nolint #' for an application forecasting Covid-19 deaths in Germany and Poland. #' #' @param secondary A call to `secondary_opts()` or a list containing the @@ -115,7 +115,9 @@ #' plot(prev, primary = TRUE) #' #' # forecast future secondary cases from primary -#' prev_preds <- forecast_secondary(prev, cases[10seq_len(.N)][, value := primary]) +#' prev_preds <- forecast_secondary( +#' prev, cases[10seq_len(.N)][, value := primary] +#' ) #' plot(prev_preds, new_obs = cases, from = "2020-06-01") #' #' options(old_opts) @@ -354,7 +356,8 @@ update_secondary_args <- function(data, priors, verbose = TRUE) { #' @author Sam Abbott #' @seealso plot estimate_secondary #' @method plot estimate_secondary -#' @importFrom ggplot2 ggplot aes geom_col geom_point labs scale_x_date scale_y_continuous theme theme_bw +#' @importFrom ggplot2 ggplot aes geom_col geom_point labs scale_x_date +#' @importFrom ggplot2 scale_y_continuous theme theme_bw #' @importFrom data.table as.data.table merge.data.table #' @export plot.estimate_secondary <- function(x, primary = FALSE, @@ -367,7 +370,9 @@ plot.estimate_secondary <- function(x, primary = FALSE, new_obs <- data.table::as.data.table(new_obs) new_obs <- new_obs[, .(date, secondary)] predictions <- predictions[, secondary := NULL] - predictions <- data.table::merge.data.table(predictions, new_obs, all = TRUE, by = "date") + predictions <- data.table::merge.data.table( + predictions, new_obs, all = TRUE, by = "date" + ) } if (!is.null(from)) { predictions <- predictions[date >= from] @@ -590,7 +595,9 @@ forecast_secondary <- function(estimate, primary <- primary[, .(date, sample, value)] } if (inherits(primary, "estimate_infections")) { - primary <- data.table::as.data.table(primary$samples[variable == primary_variable]) + primary <- data.table::as.data.table( + primary$samples[variable == primary_variable] + ) primary <- primary[date > max(estimate$predictions$date, na.rm = TRUE)] primary <- primary[, .(date, sample, value)] if (!is.null(samples)) { @@ -694,7 +701,9 @@ forecast_secondary <- function(estimate, out$predictions <- data.table::merge.data.table(summarised, forecast_obs, by = "date", all = TRUE ) - data.table::setcolorder(out$predictions, c("date", "primary", "secondary", "mean", "sd")) + data.table::setcolorder( + out$predictions, c("date", "primary", "secondary", "mean", "sd") + ) class(out) <- c("estimate_secondary", class(out)) return(out) } diff --git a/R/estimate_truncation.R b/R/estimate_truncation.R index 205d6718c..48cbcf220 100644 --- a/R/estimate_truncation.R +++ b/R/estimate_truncation.R @@ -296,7 +296,9 @@ plot.estimate_truncation <- function(x, ...) { plot <- plot + ggplot2::theme_bw() + - ggplot2::labs(y = "Confirmed Cases", x = "Date", col = "Type", fill = "Type") + + ggplot2::labs( + y = "Confirmed Cases", x = "Date", col = "Type", fill = "Type" + ) + ggplot2::scale_x_date(date_breaks = "day", date_labels = "%b %d") + ggplot2::scale_y_continuous(labels = scales::comma) + ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 90)) diff --git a/R/extract.R b/R/extract.R index 486523cd8..20eacb97a 100644 --- a/R/extract.R +++ b/R/extract.R @@ -163,7 +163,7 @@ extract_parameter_samples <- function(stan_fit, data, reported_dates, } if (data$n_uncertain_sd_delays > 0) { out$delay_sd <- extract_parameter( - "delay_sd", samples,seq_len(data$n_uncertain_sd_delays) + "delay_sd", samples, seq_len(data$n_uncertain_sd_delays) ) out$delay_sd <- out$delay_sd[, strat := as.character(time)][, time := NULL][, diff --git a/R/get.R b/R/get.R index e0fb5f081..9d18b4f9d 100644 --- a/R/get.R +++ b/R/get.R @@ -179,7 +179,8 @@ get_regional_results <- function(regional_output, out <- list() out$estimates <- get_estimates_data("estimates") if (forecast) { - out$estimated_reported_cases <- get_estimates_data("estimated_reported_cases") + out$estimated_reported_cases <- + get_estimates_data("estimated_reported_cases") } } return(out) @@ -208,7 +209,9 @@ get_regional_results <- function(regional_output, #' @author Sam Abbott #' @export #' @examples -#' get_dist(EpiNow2::generation_times, disease = "SARS-CoV-2", source = "ganyani") +#' get_dist( +#' EpiNow2::generation_times, disease = "SARS-CoV-2", source = "ganyani" +#' ) get_dist <- function(data, disease, source, max_value = 15, fixed = FALSE) { target_disease <- disease target_source <- source @@ -289,7 +292,9 @@ get_regions_with_most_reports <- function(reported_cases, ], by = "region" ] - most_reports <- most_reports[, .(confirm = sum(confirm, na.rm = TRUE)), by = "region"] + most_reports <- most_reports[, + .(confirm = sum(confirm, na.rm = TRUE)), by = "region" + ] most_reports <- data.table::setorderv( most_reports, cols = "confirm", order = -1 ) diff --git a/R/regional_epinow.R b/R/regional_epinow.R index 9fe873c69..882fb8d17 100644 --- a/R/regional_epinow.R +++ b/R/regional_epinow.R @@ -329,7 +329,7 @@ clean_regions <- function(reported_cases, non_zero_points) { #' Internal function that handles calling `epinow`. Future work will extend this #' function to better handle `stan` logs and allow the user to modify settings #' between regions. -#' +#' #' @param target_region Character string indicating the region being evaluated #' @param progress_fn Function as returned by `progressr::progressor`. Allows #' the use of a progress bar. @@ -376,7 +376,8 @@ run_region <- function(target_region, ) regional_cases <- reported_cases[region %in% target_region][, region := NULL] - futile.logger::flog.trace("calling epinow2::epinow to process data for %s", target_region, + futile.logger::flog.trace( + "calling epinow2::epinow to process data for %s", target_region, name = "EpiNow2.epinow" ) @@ -417,7 +418,7 @@ run_region <- function(target_region, #' Process regional estimate #' #' @description `r lifecycle::badge("maturing")` -#' Internal function that removes output that is not required, and returns +#' Internal function that removes output that is not required, and returns #' logging information. #' @param out List of output returned by `epinow` #' diff --git a/man/dist_skel.Rd b/man/dist_skel.Rd index f98d6b97a..958705908 100644 --- a/man/dist_skel.Rd +++ b/man/dist_skel.Rd @@ -7,7 +7,8 @@ dist_skel(n, dist = FALSE, cum = TRUE, model, params, max_value = 120) } \arguments{ -\item{n}{Numeric vector, number of samples to take (or days for the probability density).} +\item{n}{Numeric vector, number of samples to take (or days for the +probability density).} \item{dist}{Logical, defaults to \code{FALSE}. Should the probability density be returned rather than a number of samples.} @@ -31,8 +32,8 @@ A vector of samples or a probability distribution. \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#questioning}{\figure{lifecycle-questioning.svg}{options: alt='[Questioning]'}}}{\strong{[Questioning]}} This function acts as a skeleton for a truncated distribution defined by -model type, maximum value and model parameters. It is designed to be used with the -output from \code{get_dist}. +model type, maximum value and model parameters. It is designed to be used +with the output from \code{get_dist}. } \examples{ diff --git a/man/estimate_secondary.Rd b/man/estimate_secondary.Rd index 01965f29f..3c13058cc 100644 --- a/man/estimate_secondary.Rd +++ b/man/estimate_secondary.Rd @@ -79,7 +79,7 @@ for an example of forecasting Covid-19 deaths from Covid-19 cases. See \href{https://gist.github.com/seabbs/4dad3958ca8d83daca8f02b143d152e6}{here} for a prototype function that may be used to estimate and forecast a secondary observation from a primary across multiple regions and -\href{https://github.com/epiforecasts/covid.german.forecasts/blob/master/rt-forecast/death-from-cases.R}{here} +\href{https://github.com/epiforecasts/covid.german.forecasts/blob/master/rt-forecast/death-from-cases.R}{here} # nolint for an application forecasting Covid-19 deaths in Germany and Poland. } \examples{ @@ -139,7 +139,9 @@ prev <- estimate_secondary(cases[1:100], plot(prev, primary = TRUE) # forecast future secondary cases from primary -prev_preds <- forecast_secondary(prev, cases[10seq_len(.N)][, value := primary]) +prev_preds <- forecast_secondary( + prev, cases[10seq_len(.N)][, value := primary] +) plot(prev_preds, new_obs = cases, from = "2020-06-01") options(old_opts) diff --git a/man/get_dist.Rd b/man/get_dist.Rd index 3c6d8337c..d579a10fe 100644 --- a/man/get_dist.Rd +++ b/man/get_dist.Rd @@ -28,7 +28,9 @@ by \code{delay_opts()} and the \code{generation_time} argument of \code{epinow} \code{estimate_infections}. } \examples{ -get_dist(EpiNow2::generation_times, disease = "SARS-CoV-2", source = "ganyani") +get_dist( + EpiNow2::generation_times, disease = "SARS-CoV-2", source = "ganyani" +) } \author{ Sam Abbott From c0e971c9778a992da6178b2dbb436ec0ca2bc6e2 Mon Sep 17 00:00:00 2001 From: Sam Date: Thu, 27 Apr 2023 16:43:17 +0100 Subject: [PATCH 18/19] {pak} getting stressed out about Makevars --- .github/workflows/render-readme.yaml | 16 +++++++--------- R/estimate_infections.R | 6 ++++-- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/.github/workflows/render-readme.yaml b/.github/workflows/render-readme.yaml index 87f415a87..57bdfefa7 100644 --- a/.github/workflows/render-readme.yaml +++ b/.github/workflows/render-readme.yaml @@ -10,19 +10,17 @@ jobs: env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - name: Checkout repos - uses: actions/checkout@v2 + - uses: actions/checkout@v2 - - name: Setup R - uses: r-lib/actions/setup-r@v2 + - uses: r-lib/actions/setup-pandoc@v2 - - name: Setup pandoc - uses: r-lib/actions/setup-pandoc@v2 + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true - - name: Install dependencies - uses: r-lib/actions/setup-r-dependencies@v2 + - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::rmarkdown, local::. + extra-packages: any::pkgdown, local::. - name: Compile the readme run: | diff --git a/R/estimate_infections.R b/R/estimate_infections.R index 6b10686d4..731f88fe2 100644 --- a/R/estimate_infections.R +++ b/R/estimate_infections.R @@ -269,7 +269,9 @@ estimate_infections <- function(reported_cases, # Create mean shifted reported cases as prior reported_cases <- data.table::rbindlist(list( data.table::data.table( - date = seq(min(reported_cases$date) - delays$seeding_time - backcalc$prior_window, + date = + seq(min(reported_cases$date) - delays$seeding_time - + backcalc$prior_window, min(reported_cases$date) - 1, by = "days" ), @@ -420,7 +422,7 @@ init_cumulative_fit <- function(args, samples = 50, warmup = 50, control = list(adapt_delta = 0.9, max_treedepth = 13), refresh = ifelse(verbose, 50, -1) ) - # change observations to be cumulative in order to protect against noise and + # change observations to be cumulative in order to protect against noise and # give an approximate fit (though for Rt constrained to be > 1) initial_args$data$cases <- cumsum(initial_args$data$cases) initial_args$data$shifted_cases <- cumsum(initial_args$data$shifted_cases) From ceb6cc169afd44e74d23bd250edd3231b70a618f Mon Sep 17 00:00:00 2001 From: Sam Date: Thu, 27 Apr 2023 16:44:24 +0100 Subject: [PATCH 19/19] switch readme rendering to ubuntu --- .github/workflows/render-readme.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/render-readme.yaml b/.github/workflows/render-readme.yaml index 57bdfefa7..84896ea3b 100644 --- a/.github/workflows/render-readme.yaml +++ b/.github/workflows/render-readme.yaml @@ -6,7 +6,7 @@ on: jobs: render-readme: - runs-on: macos-latest + runs-on: ubuntu-latest env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: