diff --git a/.Rbuildignore b/.Rbuildignore index 89b14e09c..626c24f75 100755 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -10,6 +10,7 @@ ^appveyor\.yml$ ^codecov\.yml$ ^CLAUDE\.md$ +^\.claude$ ^cran-comments\.md$ ^CRAN-RELEASE$ ^\.github$ diff --git a/.github/scripts/test_installed_without.R b/.github/scripts/test_installed_without.R new file mode 100644 index 000000000..583808d45 --- /dev/null +++ b/.github/scripts/test_installed_without.R @@ -0,0 +1,91 @@ +# ==================================================================== # +# TITLE: # +# AMR: An R Package for Working with Antimicrobial Resistance Data # +# # +# SOURCE CODE: # +# https://github.com/msberends/AMR # +# # +# PLEASE CITE THIS SOFTWARE AS: # +# Berends MS, Luz CF, Friedrich AW, et al. (2022). # +# AMR: An R Package for Working with Antimicrobial Resistance Data. # +# Journal of Statistical Software, 104(3), 1-31. # +# https://doi.org/10.18637/jss.v104.i03 # +# # +# Developed at the University of Groningen and the University Medical # +# Center Groningen in the Netherlands, in collaboration with many # +# colleagues from around the world, see our website. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://amr-for-r.org # +# ==================================================================== # + +# Run all unit tests and all examples against the INSTALLED AMR package, in a library where some suggested packages are not available. +# Used by .github/workflows/check-without-dplyr.yaml; run from the root of the repository: +# Rscript .github/scripts/test_installed_without.R dplyr tidyselect +# The package must have been installed BEFORE the listed packages were made unavailable, as binary packages from CRAN are built on machines that have all suggested packages: code that depends on what was available at installation (instead of at runtime) then fails, which R CMD check cannot detect as it reinstalls the package. + +unavailable <- commandArgs(trailingOnly = TRUE) +if (length(unavailable) == 0) { + stop("provide the package(s) that must be unavailable, e.g.: Rscript test_installed_without.R dplyr tidyselect") +} +still_available <- unavailable[vapply(unavailable, requireNamespace, logical(1), quietly = TRUE)] +if (length(still_available) > 0) { + stop("these packages must not be available, but are: ", paste(still_available, collapse = ", ")) +} +cat("Not available:", paste(unavailable, collapse = ", "), "\n") +cat("AMR", format(utils::packageVersion("AMR")), "installed in", find.package("AMR"), "\n\n") + +Sys.setenv(NOT_CRAN = "true") +library(AMR) + +# 1. all unit tests, against the installed package +cat("== Unit tests ==\n") +results <- as.data.frame(testthat::test_dir( + "tests/testthat", + package = "AMR", + load_package = "installed", + reporter = "summary", + stop_on_failure = FALSE +)) +n_failed <- sum(results$failed) + sum(results$error) +cat("\nTests: ", sum(results$nb), " expectations, ", sum(results$failed), " failed, ", sum(results$error), " errored, ", sum(results$skipped), " skipped\n", sep = "") + +# 2. all examples, including \donttest{} (not \dontrun{}), against the installed package +cat("\n== Examples ==\n") +rd_db <- tools::Rd_db("AMR") +failed_examples <- character(0) +n_examples <- 0 +for (rd in sort(names(rd_db))) { + ex_file <- tempfile(fileext = ".R") + tools::Rd2ex(rd_db[[rd]], ex_file, commentDonttest = FALSE) + if (!file.exists(ex_file)) next + n_examples <- n_examples + 1 + # print the name first, so that a crash of R itself shows which help page caused it + cat(rd, "\n") + ok <- tryCatch( + { + utils::capture.output(suppressMessages(suppressWarnings(source(ex_file, local = new.env(parent = globalenv()), echo = FALSE)))) + TRUE + }, + error = function(e) { + cat("FAILED: ", rd, ": ", conditionMessage(e), "\n", sep = "") + FALSE + } + ) + if (!ok) failed_examples <- c(failed_examples, rd) + grDevices::graphics.off() +} +cat("Examples: ", length(failed_examples), " of ", n_examples, " help pages failed\n", sep = "") + +if (n_failed > 0 || length(failed_examples) > 0) { + stop(n_failed, " test(s) failed and ", length(failed_examples), " example(s) failed without ", paste(unavailable, collapse = " and "), call. = FALSE) +} +cat("\nAll tests and examples passed without ", paste(unavailable, collapse = " and "), ".\n", sep = "") diff --git a/.github/workflows/check-without-dplyr.yaml b/.github/workflows/check-without-dplyr.yaml new file mode 100644 index 000000000..4af3a4e44 --- /dev/null +++ b/.github/workflows/check-without-dplyr.yaml @@ -0,0 +1,116 @@ +# ==================================================================== # +# TITLE: # +# AMR: An R Package for Working with Antimicrobial Resistance Data # +# # +# SOURCE CODE: # +# https://github.com/msberends/AMR # +# # +# PLEASE CITE THIS SOFTWARE AS: # +# Berends MS, Luz CF, Friedrich AW, et al. (2022). # +# AMR: An R Package for Working with Antimicrobial Resistance Data. # +# Journal of Statistical Software, 104(3), 1-31. # +# https://doi.org/10.18637/jss.v104.i03 # +# # +# Developed at the University of Groningen and the University Medical # +# Center Groningen in the Netherlands, in collaboration with many # +# colleagues from around the world, see our website. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://amr-for-r.org # +# ==================================================================== # + +# The AMR package must work fully without dplyr (and without tidyselect), as dplyr is only suggested. +# This workflow mimics a user who installs the CRAN binary (built on a machine with ALL suggested packages) but does not have dplyr: AMR is installed while dplyr and tidyselect are available, after which they and all packages depending on them are removed, and all unit tests and all examples are run against the installed package. R CMD check cannot detect these problems, as it reinstalls the package itself. + +on: + pull_request: + # run in each PR in this repo + branches: '**' + push: + # only on main; pushing to a PR branch is already covered by pull_request above + branches: [main] + schedule: + # also run a schedule everyday at 2 AM + - cron: '0 2 * * *' + +name: check-without-dplyr + +jobs: + setup: + runs-on: ubuntu-latest + outputs: + matrix: ${{ steps.set-matrix.outputs.matrix }} + steps: + - id: set-matrix + shell: bash + run: | + if [ "${{ github.event_name }}" = "pull_request" ]; then + echo 'matrix={"config":[{"os":"ubuntu-latest","r":"release","unavailable":"dplyr tidyselect"},{"os":"ubuntu-latest","r":"release","unavailable":"dplyr"}]}' >> "$GITHUB_OUTPUT" + else + echo 'matrix={"config":[{"os":"ubuntu-latest","r":"release","unavailable":"dplyr tidyselect"},{"os":"ubuntu-latest","r":"release","unavailable":"dplyr"},{"os":"ubuntu-latest","r":"oldrel-1","unavailable":"dplyr tidyselect"},{"os":"windows-latest","r":"release","unavailable":"dplyr tidyselect"}]}' >> "$GITHUB_OUTPUT" + fi + + R-without-dplyr: + needs: setup + runs-on: ${{ matrix.config.os }} + + name: ${{ matrix.config.os }} (R-${{ matrix.config.r }}) without ${{ matrix.config.unavailable }} + + strategy: + fail-fast: false + matrix: ${{ fromJSON(needs.setup.outputs.matrix) }} + + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + UNAVAILABLE: ${{ matrix.config.unavailable }} + + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-r@v2 + with: + r-version: ${{ matrix.config.r }} + # use RStudio Package Manager to quickly install packages + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + # all dependencies, including suggested packages such as dplyr and tidyselect + dependencies: '"all"' + extra-packages: any::testthat + + - name: Install AMR while dplyr and tidyselect are available + shell: Rscript {0} + run: | + stopifnot(requireNamespace("dplyr", quietly = TRUE), requireNamespace("tidyselect", quietly = TRUE)) + install.packages(".", repos = NULL, type = "source") + stopifnot(requireNamespace("AMR", quietly = TRUE)) + + - name: Remove ${{ matrix.config.unavailable }} and all packages depending on them + shell: Rscript {0} + run: | + remove <- strsplit(Sys.getenv("UNAVAILABLE"), " ", fixed = TRUE)[[1]] + ip <- utils::installed.packages() + rev <- tools::dependsOnPkgs(remove, dependencies = c("Depends", "Imports", "LinkingTo"), recursive = TRUE, installed = ip) + drop <- setdiff(unique(c(remove, rev)), "AMR") + stopifnot(!"testthat" %in% drop) + cat("Removing", length(drop), "packages:", paste(sort(drop), collapse = ", "), "\n") + for (i in which(ip[, "Package"] %in% drop)) { + utils::remove.packages(ip[i, "Package"], lib = ip[i, "LibPath"]) + } + for (pkg in remove) { + if (requireNamespace(pkg, quietly = TRUE)) stop(pkg, " is still available") + } + stopifnot(requireNamespace("testthat", quietly = TRUE), requireNamespace("AMR", quietly = TRUE)) + + - name: Run all unit tests and examples against the installed package + shell: bash + run: Rscript .github/scripts/test_installed_without.R $UNAVAILABLE diff --git a/DESCRIPTION b/DESCRIPTION index b960a0f0f..757a31faa 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: AMR -Version: 3.0.1.9115 +Version: 3.0.1.9116 Date: 2026-10-11 Title: Antimicrobial Resistance Data Analysis Description: Functions to simplify and standardise antimicrobial resistance (AMR) diff --git a/NAMESPACE b/NAMESPACE index c8c3cea72..cc84ade57 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -370,6 +370,7 @@ export(semi_join_microorganisms) export(set_AMR_locale) export(set_ab_names) export(set_mo_source) +export(sir_combine) export(sir_confidence_interval) export(sir_df) export(sir_interpretation_history) diff --git a/NEWS.md b/NEWS.md index 44a7d34b1..5d1ac40be 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# AMR 3.0.1.9115 +# AMR 3.0.1.9116 Planned as v3.1.0, mid October 2026. @@ -25,6 +25,7 @@ Planned as v3.1.0, mid October 2026. * Faster parallel computing via the `future` package for `as.sir()` and `wisca()`: a non-sequential plan (e.g. `future::plan(future::multisession)`) must be active before using `parallel = TRUE`. * `as.mo()` no longer guesses unknown MO codes (these become `NA` with a warning), and MO codes from versions before v2.0.0 are no longer supported +* With multiple antimicrobials, `count_*()` and `proportion_*()` now follow the documented combination therapy rules: `resistance()` returns the proportion of failing combinations instead of resistance to any of the antimicrobials, and `count_all()` excludes isolates of which the combination result is unknown (#321) ### New * EUCAST 2026 and CLSI 2026 breakpoints: over 5,700 new breakpoints added to the `clinical_breakpoints` data set; EUCAST 2026 is now the default for all MIC and disk diffusion interpretations @@ -45,6 +46,7 @@ Planned as v3.1.0, mid October 2026. * A registry of all microbial IDs (MO codes) since v2.0.0 now prevents existing IDs from being reused or mixed up; IDs of earlier releases are translated to the current ID of the same taxon * `add_custom_antimicrobial_synonyms()` to add local names, such as trade names, to existing antimicrobials (#307) * Sulbactam/durlobactam (`SUD1`) added to the `antimicrobials` data set (#308) +* `sir_combine()` to combine SIR results of multiple antimicrobials into one variable for combination therapy, using the same rules as `antibiogram()` (#321) ### Fixed * `as.mo()` returned *Salmonella bongori* or another subspecies for *Salmonella* serovars written with the species, such as "Salmonella enterica serovar Typhi" @@ -83,6 +85,10 @@ Planned as v3.1.0, mid October 2026. * Taxonomy: synonyms without a current name are linked via LPSN or removed, with their codes retired; the *M. tuberculosis* complex is always kept * Taxonomy: consistent higher taxonomy and parent records, and data sets refer only to current names (except `intrinsic_resistant`) * `antimicrobials`: trade names of combinations (Tazocin, Timentin, Recarbrio, Exblifep) were listed under a single component, and names of screening libraries and suppliers (e.g. Prestwick, Spectrum) as synonyms (#315) +* WT, NWT, NS and NI results were handled incorrectly in `count_*()` and `proportion_*()` with multiple antimicrobials (#321) +* `g.test()` returned the degrees of freedom as `argument` instead of `parameter`, so they were not printed +* `antibiogram()` and `wisca()` failed without the `antimicrobials` argument if tidyselect was not available, e.g. for binary installations without dplyr +* R could crash after unloading data.table, and suggested packages available on the machine that built the package were used even if not available to the user ### Updated * Faster `as.ab()`, `as.mo()` and all `mo_*()` functions through one consistent session cache design, which is cleared when lookup tables change, e.g. after `add_custom_microorganisms()` (#313) diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index a4d0f21f3..644df6f1f 100755 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -1715,40 +1715,41 @@ readRDS_AMR <- function(file, refhook = NULL) { readRDS(con, refhook = refhook) } -# Support `where()` if tidyselect not installed ---- -if (!is.null(import_fn("where", "tidyselect", error_on_fail = FALSE))) { - # tidyselect::where() exists, retrieve from their namespace to make `where()`s work across the package in default arguments - where <- tidyselect::where -} else { - where <- function(fn) { - # based on https://github.com/nathaneastwood/poorman/blob/52eb6947e0b4430cd588976ed8820013eddf955f/R/where.R#L17-L32 - if (!is.function(fn)) { - stop_("{.fun ", deparse(substitute(fn)), "} is not a valid predicate function.") - } - df <- pm_select_env$.data - cols <- pm_select_env$get_colnames() - if (is.null(df)) { - df <- get_current_data("where", call = FALSE) - cols <- colnames(df) - } - preds <- unlist(lapply( - df, - function(x, fn) { - do.call("fn", list(x)) - }, - fn - )) - if (!is.logical(preds)) stop_("{.fun where} must be used with functions that return {.code TRUE} or {.code FALSE}.") - data_cols <- cols - cols <- data_cols[preds] - which(data_cols %in% cols) +# Support `where()`, also if tidyselect not installed ---- +# this must be decided at runtime, not at installation: a copy of tidyselect::where() made during installation fails if tidyselect is not available at runtime, e.g. for binary packages built on a machine with tidyselect +where <- function(fn) { + if (pkg_is_available("tidyselect") && !is.null(tryCatch(tidyselect::peek_vars(fn = "where"), error = function(e) NULL))) { + # called inside a tidyselect selection, such as dplyr::select(), so let tidyselect handle it + return(tidyselect::where(fn)) } + # based on https://github.com/nathaneastwood/poorman/blob/52eb6947e0b4430cd588976ed8820013eddf955f/R/where.R#L17-L32 + if (!is.function(fn)) { + stop_("{.fun ", deparse(substitute(fn)), "} is not a valid predicate function.") + } + df <- pm_select_env$.data + cols <- pm_select_env$get_colnames() + if (is.null(df)) { + df <- get_current_data("where", call = FALSE) + cols <- colnames(df) + } + preds <- unlist(lapply( + df, + function(x, fn) { + do.call("fn", list(x)) + }, + fn + )) + if (!is.logical(preds)) stop_("{.fun where} must be used with functions that return {.code TRUE} or {.code FALSE}.") + data_cols <- cols + cols <- data_cols[preds] + which(data_cols %in% cols) } # Faster data.table implementations ---- match <- function(x, table, ...) { - if (!is.null(AMR_env$chmatch) && inherits(x, "character") && inherits(table, "character")) { + # data.table must still be loaded: calling its compiled code after it was unloaded (e.g., using detach("package:data.table", unload = TRUE)) crashes R + if (!is.null(AMR_env$chmatch) && inherits(x, "character") && inherits(table, "character") && isNamespaceLoaded("data.table")) { # data.table::chmatch() is much faster than base::match() for character tryCatch(AMR_env$chmatch(x, table, ...), error = function(e) base::match(x, table, ...)) } else { @@ -1756,7 +1757,7 @@ match <- function(x, table, ...) { } } `%in%` <- function(x, table) { - if (!is.null(AMR_env$chin) && inherits(x, "character") && inherits(table, "character")) { + if (!is.null(AMR_env$chin) && inherits(x, "character") && inherits(table, "character") && isNamespaceLoaded("data.table")) { # data.table::`%chin%`() is much faster than base::`%in%`() for character tryCatch(AMR_env$chin(x, table), error = function(e) base::`%in%`(x, table)) } else { diff --git a/R/antibiogram.R b/R/antibiogram.R index 826a8d688..bfe97c2c8 100755 --- a/R/antibiogram.R +++ b/R/antibiogram.R @@ -137,26 +137,7 @@ #' #' ### Inclusion in Combination Antibiograms #' -#' Note that for combination antibiograms, it is important to realise that susceptibility can be calculated in two ways, which can be set with the `only_all_tested` argument (default is `FALSE`). See this example for two antimicrobials, Drug A and Drug B, about how [antibiogram()] works to calculate the %SI: -#' -#' ``` -#' -------------------------------------------------------------------- -#' only_all_tested = FALSE only_all_tested = TRUE -#' ----------------------- ----------------------- -#' Drug A Drug B considered considered considered considered -#' susceptible tested susceptible tested -#' -------- -------- ----------- ---------- ----------- ---------- -#' S or I S or I X X X X -#' R S or I X X X X -#' S or I X X - - -#' S or I R X X X X -#' R R - X - X -#' R - - - - -#' S or I X X - - -#' R - - - - -#' - - - - -#' -------------------------------------------------------------------- -#' ``` +#' For combination antibiograms, the results of the antimicrobials are combined using the same rules as [sir_combine()], see the section *Combination Therapy* below. Whether isolates must be tested for all antimicrobials can be set with the `only_all_tested` argument (default is `FALSE`). The 'I' and 'SDD' categories are considered susceptible if `combine_SI = TRUE` (default), which also determines whether a missing result can be ignored. To use a combination in other analyses as well, create a new variable with [sir_combine()]. #' #' ### Plotting #' @@ -177,6 +158,7 @@ #' **Interpreting the output:** Overlapping credible intervals between regimens indicate no significant difference in coverage; if a narrower-spectrum regimen overlaps with a broader one, the narrower-spectrum option may be preferred on stewardship grounds. Non-overlapping intervals indicate a clinically meaningful difference. For small sample sizes, consider pooling data from multiple sites to improve precision, provided pathogen distributions are sufficiently similar (Bielicki *et al.*, 2016). #' #' For the full mathematical derivation and worked examples, see the [WISCA vignette](https://amr-for-r.org/articles/WISCA.html). +#' @inheritSection sir_combine Combination Therapy #' @references #' * Hebert C *et al.* (2012). **Demonstration of the weighted-incidence syndromic combination antibiogram: an empiric prescribing decision aid.** *Infection Control & Hospital Epidemiology* 33(4):381-388; \doi{10.1086/664768} #' * Bielicki JA *et al.* (2016). **Selecting appropriate empirical antibiotic regimens for paediatric bloodstream infections: application of a Bayesian decision model to local and pooled antimicrobial resistance surveillance data.** *Journal of Antimicrobial Chemotherapy* 71(3):794-802; \doi{10.1093/jac/dkv397} @@ -625,16 +607,10 @@ antibiogram.default <- function(x, if (isTRUE(combine_SI)) { S_values <- c(S_values, "SDD", "I") } - other_values <- setdiff(c("S", "SDD", "I", "R", "WT", "NWT", "NS"), S_values) - x_transposed <- as.list(as.data.frame(t(x[, abx, drop = FALSE]), stringsAsFactors = FALSE)) - if (isTRUE(only_all_tested)) { - x[new_colname] <- as.sir(vapply(FUN.VALUE = character(1), x_transposed, function(x) ifelse(anyNA(x), NA_character_, ifelse(any(x %in% S_values), "S", "R")), USE.NAMES = FALSE)) - } else { - x[new_colname] <- as.sir(vapply( - FUN.VALUE = character(1), x_transposed, function(x) ifelse(any(x %in% S_values, na.rm = TRUE), "S", ifelse(anyNA(x), NA_character_, "R")), - USE.NAMES = FALSE - )) - } + # same rules as sir_combine(), after which the result is reduced to S or R + combined <- as.character(sir_combine_engine(as.list(x[, abx, drop = FALSE]), S_values = S_values, only_all_tested = only_all_tested)) + combined[!is.na(combined)] <- ifelse(combined[!is.na(combined)] %in% S_values, "S", "R") + x[new_colname] <- as_sir_structure(combined) } antimicrobials[[i]] <- new_colname } diff --git a/R/count.R b/R/count.R index 0b78535cc..d49aca89a 100755 --- a/R/count.R +++ b/R/count.R @@ -42,10 +42,10 @@ #' @inheritSection as.sir Interpretation of SIR #' @details These functions are meant to count isolates. Use the [resistance()]/[susceptibility()] functions to calculate microbial resistance/susceptibility. #' -#' The function [n_sir()] is an alias of [count_all()]. They can be used to count all available isolates, i.e. where all input antimicrobials have an available result (S, I or R). Their use is equal to `dplyr`'s `n_distinct()`. Their function is equal to `count_susceptible(...) + count_resistant(...)`. +#' The function [n_sir()] is an alias of [count_all()]. They can be used to count all available isolates, i.e. where the input antimicrobial has an available result (S, I or R), or for multiple antimicrobials, where the result of the combination is available (see *Combination Therapy* below). Their use is equal to `dplyr`'s `n_distinct()`. Their function is equal to `count_susceptible(...) + count_resistant(...)`. #' #' The function [count_df()] takes any variable from `data` that has an [`sir`] class (created with [as.sir()]) and counts the number of S's, I's and R's. It also supports grouped variables. The function [sir_df()] works exactly like [count_df()], but adds the percentage of S, I and R. -#' @inheritSection proportion Combination Therapy +#' @inheritSection sir_combine Combination Therapy #' @seealso [`proportion_*`][proportion] to calculate microbial resistance and susceptibility. #' @return An [integer] #' @rdname count @@ -143,6 +143,7 @@ count_resistant <- function(..., if (identical(guideline, "CLSI")) "I" ), only_all_tested = only_all_tested, + guideline = guideline, only_count = TRUE ), error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5) @@ -172,6 +173,7 @@ count_susceptible <- function(..., if (identical(guideline, "EUCAST")) "I" ), only_all_tested = only_all_tested, + guideline = guideline, only_count = TRUE ), error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5) diff --git a/R/g.test.R b/R/g.test.R index 42ec9c223..5e8d661df 100755 --- a/R/g.test.R +++ b/R/g.test.R @@ -30,7 +30,17 @@ #' *G*-test for Count Data #' #' [g.test()] performs chi-squared contingency table tests and goodness-of-fit tests, just like [chisq.test()] but is more reliable (1). A *G*-test can be used to see whether the number of observations in each category fits a theoretical expectation (called a ***G*-test of goodness-of-fit**), or to see whether the proportions of one variable are different for different values of the other variable (called a ***G*-test of independence**). -#' @inherit stats::chisq.test params return +#' @inherit stats::chisq.test params +#' @return A [list] with class `"htest"` containing the following components: +#' * `statistic`: the value of the test statistic +#' * `parameter`: the degrees of freedom of the approximate chi-squared distribution of the test statistic, `NA` if the p-value is computed by Monte Carlo simulation +#' * `p.value`: the p-value for the test +#' * `method`: a character string indicating the type of test performed, and whether Monte Carlo simulation was used +#' * `data.name`: a character string giving the name(s) of the data +#' * `observed`: the observed counts +#' * `expected`: the expected counts under the null hypothesis +#' * `residuals`: the Pearson residuals, `(observed - expected) / sqrt(expected)` +#' * `stdres`: standardised residuals, `(observed - expected) / sqrt(V)`, where `V` is the residual cell variance (Agresti 2007, section 2.4.5) for the case where `x` is a matrix, `n * p * (1 - p)` otherwise #' @details If `x` is a [matrix] with one row or column, or if `x` is a vector and `y` is not given, then a *goodness-of-fit test* is performed (`x` is treated as a one-dimensional contingency table). The entries of `x` must be non-negative integers. In this case, the hypothesis tested is whether the population probabilities equal those in `p`, or are all equal if `p` is not given. #' #' If `x` is a [matrix] with at least two rows and columns, it is taken as a two-dimensional contingency table: the entries of `x` must be non-negative integers. Otherwise, `x` and `y` must be vectors or factors of the same length; cases with missing values are removed, the objects are coerced to factors, and the contingency table is computed from these. Then Pearson's chi-squared test is performed of the null hypothesis that the joint distribution of the cell counts in a 2-dimensional contingency table is the product of the row and column marginals. @@ -73,6 +83,8 @@ #' If there are more than two categories and you want to find out which ones are significantly different from their null expectation, you can use the same method of testing each category vs. the sum of all categories, with the Bonferroni correction. You use *G*-tests for each category, of course. #' @seealso [chisq.test()] #' @references 1. McDonald, J.H. 2014. **Handbook of Biological Statistics (3rd ed.)**. Sparky House Publishing, Baltimore, Maryland. +#' +#' 2. Agresti, A. 2007. **An Introduction to Categorical Data Analysis (2nd ed.)**. Wiley, New York. #' @source The code for this function is identical to that of [chisq.test()], except that: #' - The calculation of the statistic was changed to \eqn{2 * sum(x * log(x / E))} #' - Yates' continuity correction was removed as it does not apply to a *G*-test @@ -218,7 +230,7 @@ g.test <- function(x, } structure(list( - statistic = STATISTIC, argument = PARAMETER, + statistic = STATISTIC, parameter = PARAMETER, p.value = PVAL, method = METHOD, data.name = DNAME, observed = x, expected = E, residuals = (x - E) / sqrt(E), stdres = (x - E) / sqrt(V) diff --git a/R/ggplot_pca.R b/R/ggplot_pca.R index 226d53c7f..89225a6f7 100755 --- a/R/ggplot_pca.R +++ b/R/ggplot_pca.R @@ -32,6 +32,7 @@ #' Produces a `ggplot2` variant of a so-called [biplot](https://en.wikipedia.org/wiki/Biplot) for PCA (principal component analysis), but is more flexible and more appealing than the base \R [biplot()] function. #' @param x An object returned by [pca()], [prcomp()] or [princomp()]. #' @inheritParams stats::biplot.prcomp +#' @param pc.biplot If `TRUE`, use what Gabriel (1971) refers to as a 'principal component biplot', with `lambda = 1` and observations scaled up by `sqrt(n)` and variables scaled down by `sqrt(n)`. Then inner products between variables approximate covariances and distances between observations approximate Mahalanobis distance. #' @param labels An optional vector of labels for the observations. If set, the labels will be placed below their respective points. When using the [pca()] function as input for `x`, this will be determined automatically based on the attribute `non_numeric_cols`, see [pca()]. #' @param labels_textsize The size of the text used for the labels. #' @param labels_text_placement Adjustment factor the placement of the variable names (`>=1` means further away from the arrow head). @@ -51,6 +52,7 @@ #' @param arrows_alpha The alpha (transparency) of the arrows and their text. #' @param base_textsize The text size for all plot elements except the labels and arrows. #' @param ... Arguments passed on to functions. +#' @references Gabriel, K.R. 1971. **The biplot graphical display of matrices with application to principal component analysis**. *Biometrika* 58(3):453-467. \doi{10.1093/biomet/58.3.453} #' @source The [ggplot_pca()] function is based on the `ggbiplot()` function from the `ggbiplot` package by Vince Vu, as found on GitHub: (retrieved: 2 March 2020, their latest commit: [`7325e88`](https://github.com/vqv/ggbiplot/commit/7325e880485bea4c07465a0304c470608fffb5d9); 12 February 2015). #' #' As per their GPL-2 licence that demands documentation of code changes, the changes made based on the source code were: diff --git a/R/like.R b/R/like.R index 0d412005b..60e8330ad 100755 --- a/R/like.R +++ b/R/like.R @@ -49,8 +49,8 @@ #' @seealso [grepl()] #' @examples -#' # data.table has a more limited version of %like%, so unload it: -#' try(detach("package:data.table", unload = TRUE), silent = TRUE) +#' # data.table has a more limited version of %like%, so detach it (without unloading it, as data.table does not support being unloaded): +#' try(detach("package:data.table"), silent = TRUE) #' #' a <- "This is a test" #' b <- "TEST" diff --git a/R/proportion.R b/R/proportion.R index 9303d33a2..d5cb9cf1f 100755 --- a/R/proportion.R +++ b/R/proportion.R @@ -35,7 +35,7 @@ #' @param ... One or more vectors (or columns) with antibiotic interpretations. They will be transformed internally with [as.sir()] if needed. Use multiple columns to calculate (the lack of) co-resistance: the probability where one of two drugs have a resistant or susceptible result. See *Examples*. #' @param minimum The minimum allowed number of available (tested) isolates. Any isolate count lower than `minimum` will return `NA` with a warning. The default number of `30` isolates is advised by the Clinical and Laboratory Standards Institute (CLSI) as best practice, see *Source*. #' @param as_percent A [logical] to indicate whether the output must be returned as a hundred fold with % sign (a character). A value of `0.123456` will then be returned as `"12.3%"`. -#' @param only_all_tested (for combination therapies, i.e. using more than one variable for `...`): a [logical] to indicate that isolates must be tested for all antimicrobials, see section *Combination Therapy* below. +#' @param only_all_tested (for combination therapies, i.e. using more than one variable for `...`): a [logical] to indicate that isolates must be tested for all antimicrobials, see section *Combination Therapy* below. Use [sir_combine()] to create a new variable for a combination therapy. #' @param data A [data.frame] containing columns with class [`sir`] (see [as.sir()]). #' @param translate_ab A column name of the [antimicrobials] data set to translate the antibiotic abbreviations to, using [ab_property()]. #' @param guideline Either `"EUCAST"` (default) or `"CLSI"`. With EUCAST, the 'I' category will be considered as susceptible (see [EUCAST website](https://www.eucast.org/bacteria/clinical-breakpoints-and-interpretation/definition-of-s-i-and-r/)), but with with CLSI, it will be considered resistant. Therefore: @@ -62,44 +62,7 @@ #' These functions are not meant to count isolates, but to calculate the proportion of resistance/susceptibility. Use the [`count_*()`][AMR::count()] functions to count isolates. The function [susceptibility()] is essentially equal to [count_susceptible()]` / `[count_all()]. *Low counts can influence the outcome - the `proportion_*()` functions may camouflage this, since they only return the proportion (albeit dependent on the `minimum` argument).* #' #' The function [proportion_df()] takes any variable from `data` that has an [`sir`] class (created with [as.sir()]) and calculates the proportions S, I, and R. It also supports grouped variables. The function [sir_df()] works exactly like [proportion_df()], but adds the number of isolates. -#' @section Combination Therapy: -#' When using more than one variable for `...` (= combination therapy), use `only_all_tested` to only count isolates that are tested for all antimicrobials/variables that you test them for. See this example for two antimicrobials, Drug A and Drug B, about how [susceptibility()] works to calculate the %SI: -#' -#' -#' ``` -#' -------------------------------------------------------------------- -#' only_all_tested = FALSE only_all_tested = TRUE -#' ----------------------- ----------------------- -#' Drug A Drug B considered considered considered considered -#' susceptible tested susceptible tested -#' -------- -------- ----------- ---------- ----------- ---------- -#' S or I S or I X X X X -#' R S or I X X X X -#' S or I X X - - -#' S or I R X X X X -#' R R - X - X -#' R - - - - -#' S or I X X - - -#' R - - - - -#' - - - - -#' -------------------------------------------------------------------- -#' ``` -#' -#' Please note that, in combination therapies, for `only_all_tested = TRUE` applies that: -#' -#' ``` -#' count_S() + count_I() + count_R() = count_all() -#' proportion_S() + proportion_I() + proportion_R() = 1 -#' ``` -#' -#' and that, in combination therapies, for `only_all_tested = FALSE` applies that: -#' -#' ``` -#' count_S() + count_I() + count_R() >= count_all() -#' proportion_S() + proportion_I() + proportion_R() >= 1 -#' ``` -#' -#' Using `only_all_tested` has no impact when only using one antibiotic as input. +#' @inheritSection sir_combine Combination Therapy #' @references **M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 5th Edition**, 2022, *Clinical and Laboratory Standards Institute (CLSI)*. . #' @seealso [AMR::count()] to count resistant and susceptible isolates. #' @return A [double] or, when `as_percent = TRUE`, a [character]. @@ -255,6 +218,7 @@ resistance <- function(..., minimum = minimum, as_percent = as_percent, only_all_tested = only_all_tested, + guideline = guideline, only_count = FALSE ), error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5) @@ -288,6 +252,7 @@ susceptibility <- function(..., minimum = minimum, as_percent = as_percent, only_all_tested = only_all_tested, + guideline = guideline, only_count = FALSE ), error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5) diff --git a/R/sir_calc.R b/R/sir_calc.R index 8c3eec53a..4ba14bd75 100755 --- a/R/sir_calc.R +++ b/R/sir_calc.R @@ -40,7 +40,8 @@ sir_calc <- function(..., minimum = 0, as_percent = FALSE, only_all_tested = FALSE, - only_count = FALSE) { + only_count = FALSE, + guideline = getOption("AMR_guideline", "EUCAST")) { meet_criteria(ab_result, allow_class = c("character", "sir"), has_length = seq_along(VALID_SIR_LEVELS), is_in = VALID_SIR_LEVELS) meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE) meet_criteria(as_percent, allow_class = "logical", has_length = 1) @@ -129,42 +130,23 @@ sir_calc <- function(..., # this will give a warning for invalid results, of all input columns (so only 1 warning) sir_integrity_check <- as.sir(sir_integrity_check) } - - x_transposed <- as.list(as.data.frame(t(x), stringsAsFactors = FALSE)) - if (isTRUE(only_all_tested)) { - # no NAs in any column - y <- apply( - X = as.data.frame(lapply(x, as.double), stringsAsFactors = FALSE), - MARGIN = 1, - FUN = min - ) - if ("SDD" %in% ab_result && "SDD" %in% y && message_not_thrown_before("sir_calc", only_count, ab_result, entire_session = TRUE)) { - message_("Note that {.fun ", ifelse(only_count, "count", "proportion"), "_", ifelse("S" %in% ab_result, "S", ""), "I", ifelse("R" %in% ab_result, "R", ""), "} will also include dose-dependent susceptibility, {.val SDD}. This note will be shown once for this session.", as_note = FALSE) - } - numerator <- sum(!is.na(y) & y %in% as.double(ab_result), na.rm = TRUE) - denominator <- sum(vapply(FUN.VALUE = logical(1), x_transposed, function(y) !(anyNA(y)))) + if (ncol(x) == 1) { + x <- x[, 1, drop = TRUE] } else { - # may contain NAs in any column - other_values <- setdiff(c(NA, denominator_vals), ab_result) - if ("SDD" %in% ab_result && "SDD" %in% unlist(x_transposed) && message_not_thrown_before("sir_calc", only_count, ab_result, entire_session = TRUE)) { - message_("Note that {.fun ", ifelse(only_count, "count", "proportion"), "_", ifelse("S" %in% ab_result, "S", ""), "I", ifelse("R" %in% ab_result, "R", ""), "} will also include dose-dependent susceptibility, {.val SDD}. This note will be shown once for this session.", as_note = FALSE) - } - numerator <- sum(vapply(FUN.VALUE = logical(1), x_transposed, function(y) any(y %in% ab_result, na.rm = TRUE))) - denominator <- sum(vapply(FUN.VALUE = logical(1), x_transposed, function(y) !(all(y %in% other_values) & anyNA(y)))) + # combination therapy: determine the result of the combination for every isolate, see ?sir_combine + x <- sir_combine_engine(as.list(x), S_values = get_susceptible_values(guideline), only_all_tested = only_all_tested) } - } else { - # x is not a data.frame - if (!is.sir(x)) { - x <- as.sir(x) - print_warning <- TRUE - } - if ("SDD" %in% ab_result && "SDD" %in% x && message_not_thrown_before("sir_calc", only_count, ab_result, entire_session = TRUE)) { - message_("Note that `", ifelse(only_count, "count", "proportion"), "_", ifelse("S" %in% ab_result, "S", ""), "I", ifelse("R" %in% ab_result, "R", ""), "()` will also include dose-dependent susceptibility, {.val SDD}. This note will be shown once for this session.", as_note = FALSE) - } - numerator <- sum(x %in% ab_result, na.rm = TRUE) - denominator <- sum(x %in% denominator_vals, na.rm = TRUE) + } else if (!is.sir(x)) { + x <- as.sir(x) + print_warning <- TRUE } + if ("SDD" %in% ab_result && "SDD" %in% x && message_not_thrown_before("sir_calc", only_count, ab_result, entire_session = TRUE)) { + message_("Note that {.fun ", ifelse(only_count, "count", "proportion"), "_", ifelse("S" %in% ab_result, "S", ""), "I", ifelse("R" %in% ab_result, "R", ""), "} will also include dose-dependent susceptibility, {.val SDD}. This note will be shown once for this session.", as_note = FALSE) + } + numerator <- sum(x %in% ab_result, na.rm = TRUE) + denominator <- sum(x %in% denominator_vals, na.rm = TRUE) + if (print_warning == TRUE) { if (message_not_thrown_before("sir_calc")) { warning_("Increase speed by transforming to class {.cls sir} on beforehand:\n", diff --git a/R/sir_combine.R b/R/sir_combine.R new file mode 100644 index 000000000..14cbf67ad --- /dev/null +++ b/R/sir_combine.R @@ -0,0 +1,182 @@ +# ==================================================================== # +# TITLE: # +# AMR: An R Package for Working with Antimicrobial Resistance Data # +# # +# SOURCE CODE: # +# https://github.com/msberends/AMR # +# # +# PLEASE CITE THIS SOFTWARE AS: # +# Berends MS, Luz CF, Friedrich AW, et al. (2022). # +# AMR: An R Package for Working with Antimicrobial Resistance Data. # +# Journal of Statistical Software, 104(3), 1-31. # +# https://doi.org/10.18637/jss.v104.i03 # +# # +# Developed at the University of Groningen and the University Medical # +# Center Groningen in the Netherlands, in collaboration with many # +# colleagues from around the world, see our website. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://amr-for-r.org # +# ==================================================================== # + + +#' Combine SIR Results of Multiple Antimicrobials +#' +#' @description Combine the SIR results of two or more antimicrobials into one SIR result per isolate, e.g. to create a variable `TZP_GEN` for the combination therapy of piperacillin/tazobactam with gentamicin. The result is the best result of the antimicrobials, as a combination therapy covers the isolate if any of its antimicrobials is active. See *Combination Therapy* below for the exact rules. +#' +#' The same rules are used by [antibiogram()] and [wisca()] for combination antibiograms, and by the [`count_*()`][count()] and [`proportion_*()`][proportion()] functions when more than one variable is used, so the result of [sir_combine()] can be used in any further analysis. +#' @param ... Two or more vectors (or columns) with antimicrobial interpretations, or a data frame with such columns. They will be transformed internally with [as.sir()] if needed. All vectors must be of the same length. +#' @param only_all_tested A [logical] to indicate that isolates must be tested for all antimicrobials. If `TRUE`, the result is `NA` for isolates with a missing result for any of the antimicrobials. If `FALSE` (default), a missing result only leads to `NA` if a result for the missing antimicrobial could have changed the result of the combination, see *Combination Therapy* below. +#' @param guideline Either `"EUCAST"` (default) or `"CLSI"`, to determine whether the 'I' category is considered susceptible. This only affects isolates with a missing result for any of the antimicrobials when `only_all_tested = FALSE`, see *Combination Therapy* below. The default can be changed with the `AMR_guideline` option, see [AMR-options]. +#' @section Combination Therapy: +#' A combination of antimicrobials is considered as good as its most active antimicrobial. Results are ranked as follows, from best to worst: +#' +#' 1. `"S"` and `"WT"` +#' 2. `"SDD"` +#' 3. `"I"` +#' 4. `"R"`, `"NWT"`, and `"NS"` +#' +#' The result of the combination is the best result of the antimicrobials, i.e., the result keeps its original category instead of being reduced to only S or R. If antimicrobials have an equally ranked result, `"S"` is preferred over `"WT"`, and `"R"` over `"NWT"` and `"NS"`. The value `"NI"` (non-interpretable) is considered a missing result. +#' +#' A missing result can only be ignored if the result of the combination is susceptible regardless of the missing result, which depends on the `only_all_tested` argument and on the guideline: under EUCAST, the 'I' category is considered susceptible (*susceptible, increased exposure*), and under CLSI, it is not. This is an example for two antimicrobials, Drug A and Drug B (the order of the antimicrobials does not matter): +#' +#' ``` +#' ------------------------------------------------------------------------- +#' Result of the combination +#' ----------------------------------------------------- +#' Drug A Drug B only_all_tested = FALSE only_all_tested = TRUE +#' -------- -------- ---------------------------- ---------------------- +#' S S, I, R S S +#' I I, R I I +#' R R R R +#' S S +#' I I (EUCAST), (CLSI) +#' R +#' +#' ------------------------------------------------------------------------- +#' ``` +#' +#' The [`count_*()`][count()] and [`proportion_*()`][proportion()] functions, such as [susceptibility()] and [resistance()], apply exactly these rules when more than one variable is used: an isolate is considered tested if the result of the combination is not `NA`, and is then counted by the result of the combination. Consequently, [count_susceptible()] `+` [count_resistant()] `=` [count_all()], and [susceptibility()] `+` [resistance()] `= 1`, for both values of `only_all_tested`. The guideline is taken from their `guideline` argument if they have one, and otherwise from the `AMR_guideline` option. +#' +#' In [antibiogram()] and [wisca()], the 'I' and 'SDD' categories are considered susceptible if `combine_SI = TRUE` (default), and the result of the combination is then reduced to S or R. +#' @return A [`sir`] vector with the same length as the input. +#' @seealso [count()] and [proportion()] for counting and calculating susceptibility of (combinations of) antimicrobials, and [antibiogram()] for combination antibiograms. +#' @export +#' @examples +#' drug_a <- as.sir(c("S", "R", "R", "I", "I", NA, "R", "SDD")) +#' drug_b <- as.sir(c("R", "S", "R", "R", NA, NA, NA, "I")) +#' +#' sir_combine(drug_a, drug_b) +#' sir_combine(drug_a, drug_b, guideline = "CLSI") +#' sir_combine(drug_a, drug_b, only_all_tested = TRUE) +#' +#' # the count and proportion functions use the same rules +#' susceptibility(drug_a, drug_b, minimum = 0) +#' susceptibility(sir_combine(drug_a, drug_b), minimum = 0) +#' +#' \donttest{ +#' if (require("dplyr")) { +#' # create a new variable for piperacillin/tazobactam + gentamicin +#' example_isolates %>% +#' mutate(TZP_GEN = sir_combine(TZP, GEN)) %>% +#' select(mo, TZP, GEN, TZP_GEN) +#' } +#' if (require("dplyr")) { +#' # combine any number of antimicrobials +#' example_isolates %>% +#' mutate(any_aminoglycoside = sir_combine(GEN, TOB, AMK, KAN)) %>% +#' count(any_aminoglycoside) +#' } +#' if (require("dplyr")) { +#' # use the new variable in further analyses +#' example_isolates %>% +#' mutate(TZP_GEN = sir_combine(TZP, GEN)) %>% +#' group_by(ward) %>% +#' summarise( +#' TZP = susceptibility(TZP), +#' TZP_GEN = susceptibility(TZP_GEN) +#' ) +#' } +#' } +sir_combine <- function(..., only_all_tested = FALSE, guideline = getOption("AMR_guideline", "EUCAST")) { + meet_criteria(only_all_tested, allow_class = "logical", has_length = 1) + meet_criteria(guideline, allow_class = "character", has_length = 1) + if (guideline %like% "EUCAST") { + guideline <- "EUCAST" + } else if (guideline %like% "CLSI") { + guideline <- "CLSI" + } + meet_criteria(guideline, allow_class = "character", is_in = c("EUCAST", "CLSI"), has_length = 1) + + # unpack data frames, so that e.g. sir_combine(df[, c("GEN", "TOB")], CIP) works + cols <- list() + for (dot in list(...)) { + if (is.data.frame(dot)) { + cols <- c(cols, unname(as.list(dot))) + } else { + cols <- c(cols, list(dot)) + } + } + stop_if(length(cols) < 2, "at least two vectors or columns must be provided to combine, but ", length(cols), " ", ifelse(length(cols) == 1, "was", "were"), " provided.") + col_lengths <- vapply(FUN.VALUE = integer(1), cols, length) + stop_if(length(unique(col_lengths)) > 1, "all vectors or columns must be of the same length, but they have lengths ", vector_and(sort(unique(col_lengths)), quotes = FALSE), ".") + cols <- lapply(cols, function(x) if (is.sir(x)) x else as.sir(x)) + + out <- sir_combine_engine(cols, S_values = get_susceptible_values(guideline), only_all_tested = only_all_tested) + + if (isFALSE(only_all_tested) && is.null(getOption("AMR_guideline")) && missing(guideline)) { + # only notify about the assumed guideline if it affected the result + any_missing <- Reduce(`|`, lapply(cols, function(x) is.na(x) | as.character(x) == "NI")) + if (any(any_missing & as.character(out) %in% "I") && message_not_thrown_before("sir_combine", "eucast_default", entire_session = TRUE)) { + message_("{.help [{.fun sir_combine}](AMR::sir_combine)} assumes the EUCAST guideline and thus considers the 'I' category susceptible, so a missing result does not change a combination with an 'I' result. Set the {.arg guideline} argument or the {.code AMR_guideline} option to either \"CLSI\" or \"EUCAST\", see {.topic [AMR-options](AMR::AMR-options)}.") + message_("This message will be shown once per session.") + } + } + out +} + +get_susceptible_values <- function(guideline) { + # the SIR values considered susceptible, as in count_susceptible() and susceptibility() + if (!is.null(guideline) && guideline %like% "CLSI") { + c("S", "SDD", "WT") + } else { + c("S", "SDD", "I", "WT") + } +} + +sir_combine_engine <- function(cols, S_values, only_all_tested = FALSE) { + # this is the engine for combination therapy, used by sir_combine(), sir_calc() and antibiogram() + # - cols: a list of vectors of equal length, with class 'sir' or with SIR values as character + # - S_values: the values considered susceptible, so that a missing result cannot change the result of the combination + # the order of preference: the first value is the best result, values with equal rank are resolved by this order + preference <- c("S", "WT", "SDD", "I", "R", "NWT", "NS") + ranks <- c(1L, 1L, 2L, 3L, 4L, 4L, 4L) + cols <- lapply(cols, as.character) + if (length(cols) == 0) { + return(as_sir_structure(character(0))) + } + # 'NI' and NA get no rank, so they are missing results + col_ranks <- lapply(cols, function(x) ranks[match(x, preference)]) + best <- do.call(pmin, c(col_ranks, list(na.rm = TRUE))) + out <- rep(NA_character_, length(best)) + for (i in seq_along(preference)) { + is_present <- Reduce(`|`, lapply(cols, function(x) x %in% preference[i])) + out[is.na(out) & best %in% ranks[i] & is_present] <- preference[i] + } + any_missing <- Reduce(`|`, lapply(col_ranks, is.na)) + if (isTRUE(only_all_tested)) { + out[any_missing] <- NA_character_ + } else { + # a missing result could have been better, unless the combination is already susceptible + out[any_missing & !out %in% S_values] <- NA_character_ + } + as_sir_structure(out) +} diff --git a/R/zzz.R b/R/zzz.R index ba0108c31..5cf2a20b8 100755 --- a/R/zzz.R +++ b/R/zzz.R @@ -76,18 +76,18 @@ AMR_env$custom_ab_synonyms <- data.frame(ab = character(0), synonym = character( AMR_env$custom_mo_codes <- character(0) AMR_env$is_dark_theme <- NULL AMR_env$supports_colour <- NULL -AMR_env$chmatch <- import_fn("chmatch", "data.table", error_on_fail = FALSE) -AMR_env$chin <- import_fn("%chin%", "data.table", error_on_fail = FALSE) - -# take cli symbols and error function if available -AMR_env$bullet_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$bullet %||% "*" -AMR_env$ellipsis_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$ellipsis %||% "..." -AMR_env$info_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$info %||% "i" -AMR_env$sup_1_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$sup_1 %||% "*" -AMR_env$cli_abort <- import_fn("cli_abort", "cli", error_on_fail = FALSE) -AMR_env$cross_icon <- if (isTRUE(base::l10n_info()$`UTF-8`)) "\u00d7" else "x" .onLoad <- function(libname, pkgname) { + # functions and symbols from suggested packages must be retrieved here, at runtime: code outside functions runs at installation, so it would store what was available on the machine that built the package (e.g., CRAN), which fails if these packages are not available to the user + AMR_env$chmatch <- import_fn("chmatch", "data.table", error_on_fail = FALSE) + AMR_env$chin <- import_fn("%chin%", "data.table", error_on_fail = FALSE) + # take cli symbols and error function if available + AMR_env$bullet_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$bullet %||% "*" + AMR_env$ellipsis_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$ellipsis %||% "..." + AMR_env$info_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$info %||% "i" + AMR_env$sup_1_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$sup_1 %||% "*" + AMR_env$cross_icon <- if (isTRUE(base::l10n_info()$`UTF-8`)) "\u00d7" else "x" + # if mo source exists, fire it up (see mo_source()) if (tryCatch(file.exists(getOption("AMR_mo_source", "~/mo_source.rds")), error = function(e) FALSE)) { try(invisible(get_mo_source()), silent = TRUE) diff --git a/_pkgdown.yml b/_pkgdown.yml index d5116649e..74a180985 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -180,6 +180,7 @@ reference: - "`antibiogram`" - "`proportion`" - "`count`" + - "`sir_combine`" - "`is_new_episode`" - "`first_isolate`" - "`key_antimicrobials`" diff --git a/man/antibiogram.Rd b/man/antibiogram.Rd index eba2e6fac..20da01b24 100644 --- a/man/antibiogram.Rd +++ b/man/antibiogram.Rd @@ -243,25 +243,7 @@ your_data \%>\% \subsection{Inclusion in Combination Antibiograms}{ -Note that for combination antibiograms, it is important to realise that susceptibility can be calculated in two ways, which can be set with the \code{only_all_tested} argument (default is \code{FALSE}). See this example for two antimicrobials, Drug A and Drug B, about how \code{\link[=antibiogram]{antibiogram()}} works to calculate the \%SI: - -\if{html}{\out{
}}\preformatted{-------------------------------------------------------------------- - only_all_tested = FALSE only_all_tested = TRUE - ----------------------- ----------------------- - Drug A Drug B considered considered considered considered - susceptible tested susceptible tested --------- -------- ----------- ---------- ----------- ---------- - S or I S or I X X X X - R S or I X X X X - S or I X X - - - S or I R X X X X - R R - X - X - R - - - - - S or I X X - - - R - - - - - - - - - --------------------------------------------------------------------- -}\if{html}{\out{
}} +For combination antibiograms, the results of the antimicrobials are combined using the same rules as \code{\link[=sir_combine]{sir_combine()}}, see the section \emph{Combination Therapy} below. Whether isolates must be tested for all antimicrobials can be set with the \code{only_all_tested} argument (default is \code{FALSE}). The 'I' and 'SDD' categories are considered susceptible if \code{combine_SI = TRUE} (default), which also determines whether a missing result can be ignored. To use a combination in other analyses as well, create a new variable with \code{\link[=sir_combine]{sir_combine()}}. } \subsection{Plotting}{ @@ -287,6 +269,40 @@ It does so by combining two quantities: the relative incidence of each pathogen For the full mathematical derivation and worked examples, see the \href{https://amr-for-r.org/articles/WISCA.html}{WISCA vignette}. } +\section{Combination Therapy}{ + +A combination of antimicrobials is considered as good as its most active antimicrobial. Results are ranked as follows, from best to worst: +\enumerate{ +\item \code{"S"} and \code{"WT"} +\item \code{"SDD"} +\item \code{"I"} +\item \code{"R"}, \code{"NWT"}, and \code{"NS"} +} + +The result of the combination is the best result of the antimicrobials, i.e., the result keeps its original category instead of being reduced to only S or R. If antimicrobials have an equally ranked result, \code{"S"} is preferred over \code{"WT"}, and \code{"R"} over \code{"NWT"} and \code{"NS"}. The value \code{"NI"} (non-interpretable) is considered a missing result. + +A missing result can only be ignored if the result of the combination is susceptible regardless of the missing result, which depends on the \code{only_all_tested} argument and on the guideline: under EUCAST, the 'I' category is considered susceptible (\emph{susceptible, increased exposure}), and under CLSI, it is not. This is an example for two antimicrobials, Drug A and Drug B (the order of the antimicrobials does not matter): + +\if{html}{\out{
}}\preformatted{------------------------------------------------------------------------- + Result of the combination + ----------------------------------------------------- + Drug A Drug B only_all_tested = FALSE only_all_tested = TRUE +-------- -------- ---------------------------- ---------------------- + S S, I, R S S + I I, R I I + R R R R + S S + I I (EUCAST), (CLSI) + R + +------------------------------------------------------------------------- +}\if{html}{\out{
}} + +The \code{\link[=count]{count_*()}} and \code{\link[=proportion]{proportion_*()}} functions, such as \code{\link[=susceptibility]{susceptibility()}} and \code{\link[=resistance]{resistance()}}, apply exactly these rules when more than one variable is used: an isolate is considered tested if the result of the combination is not \code{NA}, and is then counted by the result of the combination. Consequently, \code{\link[=count_susceptible]{count_susceptible()}} \code{+} \code{\link[=count_resistant]{count_resistant()}} \code{=} \code{\link[=count_all]{count_all()}}, and \code{\link[=susceptibility]{susceptibility()}} \code{+} \code{\link[=resistance]{resistance()}} \verb{= 1}, for both values of \code{only_all_tested}. The guideline is taken from their \code{guideline} argument if they have one, and otherwise from the \code{AMR_guideline} option. + +In \code{\link[=antibiogram]{antibiogram()}} and \code{\link[=wisca]{wisca()}}, the 'I' and 'SDD' categories are considered susceptible if \code{combine_SI = TRUE} (default), and the result of the combination is then reduced to S or R. +} + \examples{ # example_isolates is a data set available in the AMR package. # run ?example_isolates for more info. diff --git a/man/count.Rd b/man/count.Rd index 4c06f60e1..81bc6af2f 100644 --- a/man/count.Rd +++ b/man/count.Rd @@ -50,7 +50,7 @@ count_df( \arguments{ \item{...}{One or more vectors (or columns) with antibiotic interpretations. They will be transformed internally with \code{\link[=as.sir]{as.sir()}} if needed.} -\item{only_all_tested}{(for combination therapies, i.e. using more than one variable for \code{...}): a \link{logical} to indicate that isolates must be tested for all antimicrobials, see section \emph{Combination Therapy} below.} +\item{only_all_tested}{(for combination therapies, i.e. using more than one variable for \code{...}): a \link{logical} to indicate that isolates must be tested for all antimicrobials, see section \emph{Combination Therapy} below. Use \code{\link[=sir_combine]{sir_combine()}} to create a new variable for a combination therapy.} \item{guideline}{Either \code{"EUCAST"} (default) or \code{"CLSI"}. With EUCAST, the 'I' category will be considered as susceptible (see \href{https://www.eucast.org/bacteria/clinical-breakpoints-and-interpretation/definition-of-s-i-and-r/}{EUCAST website}), but with with CLSI, it will be considered resistant. Therefore: \itemize{ @@ -79,7 +79,7 @@ These functions can be used to count resistant/susceptible microbial isolates. A \details{ These functions are meant to count isolates. Use the \code{\link[=resistance]{resistance()}}/\code{\link[=susceptibility]{susceptibility()}} functions to calculate microbial resistance/susceptibility. -The function \code{\link[=n_sir]{n_sir()}} is an alias of \code{\link[=count_all]{count_all()}}. They can be used to count all available isolates, i.e. where all input antimicrobials have an available result (S, I or R). Their use is equal to \code{dplyr}'s \code{n_distinct()}. Their function is equal to \code{count_susceptible(...) + count_resistant(...)}. +The function \code{\link[=n_sir]{n_sir()}} is an alias of \code{\link[=count_all]{count_all()}}. They can be used to count all available isolates, i.e. where the input antimicrobial has an available result (S, I or R), or for multiple antimicrobials, where the result of the combination is available (see \emph{Combination Therapy} below). Their use is equal to \code{dplyr}'s \code{n_distinct()}. Their function is equal to \code{count_susceptible(...) + count_resistant(...)}. The function \code{\link[=count_df]{count_df()}} takes any variable from \code{data} that has an \code{\link{sir}} class (created with \code{\link[=as.sir]{as.sir()}}) and counts the number of S's, I's and R's. It also supports grouped variables. The function \code{\link[=sir_df]{sir_df()}} works exactly like \code{\link[=count_df]{count_df()}}, but adds the percentage of S, I and R. } @@ -92,39 +92,36 @@ This AMR package follows insight; use \code{\link[=susceptibility]{susceptibilit \section{Combination Therapy}{ -When using more than one variable for \code{...} (= combination therapy), use \code{only_all_tested} to only count isolates that are tested for all antimicrobials/variables that you test them for. See this example for two antimicrobials, Drug A and Drug B, about how \code{\link[=susceptibility]{susceptibility()}} works to calculate the \%SI: +A combination of antimicrobials is considered as good as its most active antimicrobial. Results are ranked as follows, from best to worst: +\enumerate{ +\item \code{"S"} and \code{"WT"} +\item \code{"SDD"} +\item \code{"I"} +\item \code{"R"}, \code{"NWT"}, and \code{"NS"} +} -\if{html}{\out{
}}\preformatted{-------------------------------------------------------------------- - only_all_tested = FALSE only_all_tested = TRUE - ----------------------- ----------------------- - Drug A Drug B considered considered considered considered - susceptible tested susceptible tested --------- -------- ----------- ---------- ----------- ---------- - S or I S or I X X X X - R S or I X X X X - S or I X X - - - S or I R X X X X - R R - X - X - R - - - - - S or I X X - - - R - - - - - - - - - --------------------------------------------------------------------- +The result of the combination is the best result of the antimicrobials, i.e., the result keeps its original category instead of being reduced to only S or R. If antimicrobials have an equally ranked result, \code{"S"} is preferred over \code{"WT"}, and \code{"R"} over \code{"NWT"} and \code{"NS"}. The value \code{"NI"} (non-interpretable) is considered a missing result. + +A missing result can only be ignored if the result of the combination is susceptible regardless of the missing result, which depends on the \code{only_all_tested} argument and on the guideline: under EUCAST, the 'I' category is considered susceptible (\emph{susceptible, increased exposure}), and under CLSI, it is not. This is an example for two antimicrobials, Drug A and Drug B (the order of the antimicrobials does not matter): + +\if{html}{\out{
}}\preformatted{------------------------------------------------------------------------- + Result of the combination + ----------------------------------------------------- + Drug A Drug B only_all_tested = FALSE only_all_tested = TRUE +-------- -------- ---------------------------- ---------------------- + S S, I, R S S + I I, R I I + R R R R + S S + I I (EUCAST), (CLSI) + R + +------------------------------------------------------------------------- }\if{html}{\out{
}} -Please note that, in combination therapies, for \code{only_all_tested = TRUE} applies that: +The \code{\link[=count]{count_*()}} and \code{\link[=proportion]{proportion_*()}} functions, such as \code{\link[=susceptibility]{susceptibility()}} and \code{\link[=resistance]{resistance()}}, apply exactly these rules when more than one variable is used: an isolate is considered tested if the result of the combination is not \code{NA}, and is then counted by the result of the combination. Consequently, \code{\link[=count_susceptible]{count_susceptible()}} \code{+} \code{\link[=count_resistant]{count_resistant()}} \code{=} \code{\link[=count_all]{count_all()}}, and \code{\link[=susceptibility]{susceptibility()}} \code{+} \code{\link[=resistance]{resistance()}} \verb{= 1}, for both values of \code{only_all_tested}. The guideline is taken from their \code{guideline} argument if they have one, and otherwise from the \code{AMR_guideline} option. -\if{html}{\out{
}}\preformatted{ count_S() + count_I() + count_R() = count_all() - proportion_S() + proportion_I() + proportion_R() = 1 -}\if{html}{\out{
}} - -and that, in combination therapies, for \code{only_all_tested = FALSE} applies that: - -\if{html}{\out{
}}\preformatted{ count_S() + count_I() + count_R() >= count_all() - proportion_S() + proportion_I() + proportion_R() >= 1 -}\if{html}{\out{
}} - -Using \code{only_all_tested} has no impact when only using one antibiotic as input. +In \code{\link[=antibiogram]{antibiogram()}} and \code{\link[=wisca]{wisca()}}, the 'I' and 'SDD' categories are considered susceptible if \code{combine_SI = TRUE} (default), and the result of the combination is then reduced to S or R. } \examples{ diff --git a/man/g.test.Rd b/man/g.test.Rd index 8d072b379..469f88681 100644 --- a/man/g.test.Rd +++ b/man/g.test.Rd @@ -29,25 +29,18 @@ g.test(x, y = NULL, p = rep(1/length(x), length(x)), rescale.p = FALSE) \code{p} does not sum to 1, an error is given.} } \value{ -A list with class \code{"htest"} containing the following - components: - \item{statistic}{the value the chi-squared test statistic.} - \item{parameter}{the degrees of freedom of the approximate - chi-squared distribution of the test statistic, \code{NA} if the - p-value is computed by Monte Carlo simulation.} - \item{p.value}{the p-value for the test.} - \item{method}{a character string indicating the type of test - performed, and whether Monte Carlo simulation or continuity - correction was used.} - \item{data.name}{a character string giving the name(s) of the data.} - \item{observed}{the observed counts.} - \item{expected}{the expected counts under the null hypothesis.} - \item{residuals}{the Pearson residuals, - \code{(observed - expected) / sqrt(expected)}.} - \item{stdres}{standardized residuals, - \code{(observed - expected) / sqrt(V)}, where \code{V} is the - residual cell variance {(\if{html}{\out{}}Agresti 2007\if{html}{\out{}}, section 2.4.5)} - for the case where \code{x} is a matrix, \code{n * p * (1 - p)} otherwise).} +A \link{list} with class \code{"htest"} containing the following components: +\itemize{ +\item \code{statistic}: the value of the test statistic +\item \code{parameter}: the degrees of freedom of the approximate chi-squared distribution of the test statistic, \code{NA} if the p-value is computed by Monte Carlo simulation +\item \code{p.value}: the p-value for the test +\item \code{method}: a character string indicating the type of test performed, and whether Monte Carlo simulation was used +\item \code{data.name}: a character string giving the name(s) of the data +\item \code{observed}: the observed counts +\item \code{expected}: the expected counts under the null hypothesis +\item \code{residuals}: the Pearson residuals, \code{(observed - expected) / sqrt(expected)} +\item \code{stdres}: standardised residuals, \code{(observed - expected) / sqrt(V)}, where \code{V} is the residual cell variance (Agresti 2007, section 2.4.5) for the case where \code{x} is a matrix, \code{n * p * (1 - p)} otherwise +} } \description{ \code{\link[=g.test]{g.test()}} performs chi-squared contingency table tests and goodness-of-fit tests, just like \code{\link[=chisq.test]{chisq.test()}} but is more reliable (1). A \emph{G}-test can be used to see whether the number of observations in each category fits a theoretical expectation (called a \strong{\emph{G}-test of goodness-of-fit}), or to see whether the proportions of one variable are different for different values of the other variable (called a \strong{\emph{G}-test of independence}). @@ -134,6 +127,7 @@ g.test(x) \references{ \enumerate{ \item McDonald, J.H. 2014. \strong{Handbook of Biological Statistics (3rd ed.)}. Sparky House Publishing, Baltimore, Maryland. +\item Agresti, A. 2007. \strong{An Introduction to Categorical Data Analysis (2nd ed.)}. Wiley, New York. } } \seealso{ diff --git a/man/ggplot_pca.Rd b/man/ggplot_pca.Rd index 671e01287..e3171da70 100644 --- a/man/ggplot_pca.Rd +++ b/man/ggplot_pca.Rd @@ -58,14 +58,7 @@ ggplot_pca( will be issued if the specified \code{scale} is outside this range. } -\item{pc.biplot}{ - If true, use what {\if{html}{\cite{}\out{}}Gabriel (1971)\if{html}{\out{}}} refers to as a - \dQuote{principal component biplot}, - with \code{lambda = 1} and observations scaled up by sqrt(n) and - variables scaled down by sqrt(n). Then inner products between - variables approximate covariances and distances between observations - approximate Mahalanobis distance. - } +\item{pc.biplot}{If \code{TRUE}, use what Gabriel (1971) refers to as a 'principal component biplot', with \code{lambda = 1} and observations scaled up by \code{sqrt(n)} and variables scaled down by \code{sqrt(n)}. Then inner products between variables approximate covariances and distances between observations approximate Mahalanobis distance.} \item{labels}{An optional vector of labels for the observations. If set, the labels will be placed below their respective points. When using the \code{\link[=pca]{pca()}} function as input for \code{x}, this will be determined automatically based on the attribute \code{non_numeric_cols}, see \code{\link[=pca]{pca()}}.} @@ -147,3 +140,6 @@ if (require("dplyr")) { } } } +\references{ +Gabriel, K.R. 1971. \strong{The biplot graphical display of matrices with application to principal component analysis}. \emph{Biometrika} 58(3):453-467. \doi{10.1093/biomet/58.3.453} +} diff --git a/man/like.Rd b/man/like.Rd index c1c72187c..7564c1a4a 100644 --- a/man/like.Rd +++ b/man/like.Rd @@ -46,8 +46,8 @@ These \code{\link[=like]{like()}} and \verb{\%like\%}/\verb{\%unlike\%} function Using RStudio? The \verb{\%like\%}/\verb{\%unlike\%} functions can also be directly inserted in your code from the Addins menu and can have its own keyboard shortcut like \code{Shift+Ctrl+L} or \code{Shift+Cmd+L} (see menu \code{Tools} > \verb{Modify Keyboard Shortcuts...}). If you keep pressing your shortcut, the inserted text will be iterated over \verb{\%like\%} -> \verb{\%unlike\%} -> \verb{\%like_case\%} -> \verb{\%unlike_case\%}. } \examples{ -# data.table has a more limited version of \%like\%, so unload it: -try(detach("package:data.table", unload = TRUE), silent = TRUE) +# data.table has a more limited version of \%like\%, so detach it (without unloading it, as data.table does not support being unloaded): +try(detach("package:data.table"), silent = TRUE) a <- "This is a test" b <- "TEST" diff --git a/man/proportion.Rd b/man/proportion.Rd index 4483e99c0..56ef028ce 100644 --- a/man/proportion.Rd +++ b/man/proportion.Rd @@ -79,7 +79,7 @@ sir_df( \item{as_percent}{A \link{logical} to indicate whether the output must be returned as a hundred fold with \% sign (a character). A value of \code{0.123456} will then be returned as \code{"12.3\%"}.} -\item{only_all_tested}{(for combination therapies, i.e. using more than one variable for \code{...}): a \link{logical} to indicate that isolates must be tested for all antimicrobials, see section \emph{Combination Therapy} below.} +\item{only_all_tested}{(for combination therapies, i.e. using more than one variable for \code{...}): a \link{logical} to indicate that isolates must be tested for all antimicrobials, see section \emph{Combination Therapy} below. Use \code{\link[=sir_combine]{sir_combine()}} to create a new variable for a combination therapy.} \item{guideline}{Either \code{"EUCAST"} (default) or \code{"CLSI"}. With EUCAST, the 'I' category will be considered as susceptible (see \href{https://www.eucast.org/bacteria/clinical-breakpoints-and-interpretation/definition-of-s-i-and-r/}{EUCAST website}), but with with CLSI, it will be considered resistant. Therefore: \itemize{ @@ -126,43 +126,6 @@ These functions are not meant to count isolates, but to calculate the proportion The function \code{\link[=proportion_df]{proportion_df()}} takes any variable from \code{data} that has an \code{\link{sir}} class (created with \code{\link[=as.sir]{as.sir()}}) and calculates the proportions S, I, and R. It also supports grouped variables. The function \code{\link[=sir_df]{sir_df()}} works exactly like \code{\link[=proportion_df]{proportion_df()}}, but adds the number of isolates. } -\section{Combination Therapy}{ - -When using more than one variable for \code{...} (= combination therapy), use \code{only_all_tested} to only count isolates that are tested for all antimicrobials/variables that you test them for. See this example for two antimicrobials, Drug A and Drug B, about how \code{\link[=susceptibility]{susceptibility()}} works to calculate the \%SI: - -\if{html}{\out{
}}\preformatted{-------------------------------------------------------------------- - only_all_tested = FALSE only_all_tested = TRUE - ----------------------- ----------------------- - Drug A Drug B considered considered considered considered - susceptible tested susceptible tested --------- -------- ----------- ---------- ----------- ---------- - S or I S or I X X X X - R S or I X X X X - S or I X X - - - S or I R X X X X - R R - X - X - R - - - - - S or I X X - - - R - - - - - - - - - --------------------------------------------------------------------- -}\if{html}{\out{
}} - -Please note that, in combination therapies, for \code{only_all_tested = TRUE} applies that: - -\if{html}{\out{
}}\preformatted{ count_S() + count_I() + count_R() = count_all() - proportion_S() + proportion_I() + proportion_R() = 1 -}\if{html}{\out{
}} - -and that, in combination therapies, for \code{only_all_tested = FALSE} applies that: - -\if{html}{\out{
}}\preformatted{ count_S() + count_I() + count_R() >= count_all() - proportion_S() + proportion_I() + proportion_R() >= 1 -}\if{html}{\out{
}} - -Using \code{only_all_tested} has no impact when only using one antibiotic as input. -} - \section{Interpretation of SIR}{ In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R (\url{https://www.eucast.org/bacteria/clinical-breakpoints-and-interpretation/definition-of-s-i-and-r/}). @@ -170,6 +133,40 @@ In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) This AMR package follows insight; use \code{\link[=susceptibility]{susceptibility()}} (equal to \code{\link[=proportion_SI]{proportion_SI()}}) to determine antimicrobial susceptibility and \code{\link[=count_susceptible]{count_susceptible()}} (equal to \code{\link[=count_SI]{count_SI()}}) to count susceptible isolates. } +\section{Combination Therapy}{ + +A combination of antimicrobials is considered as good as its most active antimicrobial. Results are ranked as follows, from best to worst: +\enumerate{ +\item \code{"S"} and \code{"WT"} +\item \code{"SDD"} +\item \code{"I"} +\item \code{"R"}, \code{"NWT"}, and \code{"NS"} +} + +The result of the combination is the best result of the antimicrobials, i.e., the result keeps its original category instead of being reduced to only S or R. If antimicrobials have an equally ranked result, \code{"S"} is preferred over \code{"WT"}, and \code{"R"} over \code{"NWT"} and \code{"NS"}. The value \code{"NI"} (non-interpretable) is considered a missing result. + +A missing result can only be ignored if the result of the combination is susceptible regardless of the missing result, which depends on the \code{only_all_tested} argument and on the guideline: under EUCAST, the 'I' category is considered susceptible (\emph{susceptible, increased exposure}), and under CLSI, it is not. This is an example for two antimicrobials, Drug A and Drug B (the order of the antimicrobials does not matter): + +\if{html}{\out{
}}\preformatted{------------------------------------------------------------------------- + Result of the combination + ----------------------------------------------------- + Drug A Drug B only_all_tested = FALSE only_all_tested = TRUE +-------- -------- ---------------------------- ---------------------- + S S, I, R S S + I I, R I I + R R R R + S S + I I (EUCAST), (CLSI) + R + +------------------------------------------------------------------------- +}\if{html}{\out{
}} + +The \code{\link[=count]{count_*()}} and \code{\link[=proportion]{proportion_*()}} functions, such as \code{\link[=susceptibility]{susceptibility()}} and \code{\link[=resistance]{resistance()}}, apply exactly these rules when more than one variable is used: an isolate is considered tested if the result of the combination is not \code{NA}, and is then counted by the result of the combination. Consequently, \code{\link[=count_susceptible]{count_susceptible()}} \code{+} \code{\link[=count_resistant]{count_resistant()}} \code{=} \code{\link[=count_all]{count_all()}}, and \code{\link[=susceptibility]{susceptibility()}} \code{+} \code{\link[=resistance]{resistance()}} \verb{= 1}, for both values of \code{only_all_tested}. The guideline is taken from their \code{guideline} argument if they have one, and otherwise from the \code{AMR_guideline} option. + +In \code{\link[=antibiogram]{antibiogram()}} and \code{\link[=wisca]{wisca()}}, the 'I' and 'SDD' categories are considered susceptible if \code{combine_SI = TRUE} (default), and the result of the combination is then reduced to S or R. +} + \examples{ # example_isolates is a data set available in the AMR package. # run ?example_isolates for more info. diff --git a/man/sir_combine.Rd b/man/sir_combine.Rd new file mode 100644 index 000000000..efc159575 --- /dev/null +++ b/man/sir_combine.Rd @@ -0,0 +1,101 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sir_combine.R +\name{sir_combine} +\alias{sir_combine} +\title{Combine SIR Results of Multiple Antimicrobials} +\usage{ +sir_combine( + ..., + only_all_tested = FALSE, + guideline = getOption("AMR_guideline", "EUCAST") +) +} +\arguments{ +\item{...}{Two or more vectors (or columns) with antimicrobial interpretations, or a data frame with such columns. They will be transformed internally with \code{\link[=as.sir]{as.sir()}} if needed. All vectors must be of the same length.} + +\item{only_all_tested}{A \link{logical} to indicate that isolates must be tested for all antimicrobials. If \code{TRUE}, the result is \code{NA} for isolates with a missing result for any of the antimicrobials. If \code{FALSE} (default), a missing result only leads to \code{NA} if a result for the missing antimicrobial could have changed the result of the combination, see \emph{Combination Therapy} below.} + +\item{guideline}{Either \code{"EUCAST"} (default) or \code{"CLSI"}, to determine whether the 'I' category is considered susceptible. This only affects isolates with a missing result for any of the antimicrobials when \code{only_all_tested = FALSE}, see \emph{Combination Therapy} below. The default can be changed with the \code{AMR_guideline} option, see \link{AMR-options}.} +} +\value{ +A \code{\link{sir}} vector with the same length as the input. +} +\description{ +Combine the SIR results of two or more antimicrobials into one SIR result per isolate, e.g. to create a variable \code{TZP_GEN} for the combination therapy of piperacillin/tazobactam with gentamicin. The result is the best result of the antimicrobials, as a combination therapy covers the isolate if any of its antimicrobials is active. See \emph{Combination Therapy} below for the exact rules. + +The same rules are used by \code{\link[=antibiogram]{antibiogram()}} and \code{\link[=wisca]{wisca()}} for combination antibiograms, and by the \code{\link[=count]{count_*()}} and \code{\link[=proportion]{proportion_*()}} functions when more than one variable is used, so the result of \code{\link[=sir_combine]{sir_combine()}} can be used in any further analysis. +} +\section{Combination Therapy}{ + +A combination of antimicrobials is considered as good as its most active antimicrobial. Results are ranked as follows, from best to worst: +\enumerate{ +\item \code{"S"} and \code{"WT"} +\item \code{"SDD"} +\item \code{"I"} +\item \code{"R"}, \code{"NWT"}, and \code{"NS"} +} + +The result of the combination is the best result of the antimicrobials, i.e., the result keeps its original category instead of being reduced to only S or R. If antimicrobials have an equally ranked result, \code{"S"} is preferred over \code{"WT"}, and \code{"R"} over \code{"NWT"} and \code{"NS"}. The value \code{"NI"} (non-interpretable) is considered a missing result. + +A missing result can only be ignored if the result of the combination is susceptible regardless of the missing result, which depends on the \code{only_all_tested} argument and on the guideline: under EUCAST, the 'I' category is considered susceptible (\emph{susceptible, increased exposure}), and under CLSI, it is not. This is an example for two antimicrobials, Drug A and Drug B (the order of the antimicrobials does not matter): + +\if{html}{\out{
}}\preformatted{------------------------------------------------------------------------- + Result of the combination + ----------------------------------------------------- + Drug A Drug B only_all_tested = FALSE only_all_tested = TRUE +-------- -------- ---------------------------- ---------------------- + S S, I, R S S + I I, R I I + R R R R + S S + I I (EUCAST), (CLSI) + R + +------------------------------------------------------------------------- +}\if{html}{\out{
}} + +The \code{\link[=count]{count_*()}} and \code{\link[=proportion]{proportion_*()}} functions, such as \code{\link[=susceptibility]{susceptibility()}} and \code{\link[=resistance]{resistance()}}, apply exactly these rules when more than one variable is used: an isolate is considered tested if the result of the combination is not \code{NA}, and is then counted by the result of the combination. Consequently, \code{\link[=count_susceptible]{count_susceptible()}} \code{+} \code{\link[=count_resistant]{count_resistant()}} \code{=} \code{\link[=count_all]{count_all()}}, and \code{\link[=susceptibility]{susceptibility()}} \code{+} \code{\link[=resistance]{resistance()}} \verb{= 1}, for both values of \code{only_all_tested}. The guideline is taken from their \code{guideline} argument if they have one, and otherwise from the \code{AMR_guideline} option. + +In \code{\link[=antibiogram]{antibiogram()}} and \code{\link[=wisca]{wisca()}}, the 'I' and 'SDD' categories are considered susceptible if \code{combine_SI = TRUE} (default), and the result of the combination is then reduced to S or R. +} + +\examples{ +drug_a <- as.sir(c("S", "R", "R", "I", "I", NA, "R", "SDD")) +drug_b <- as.sir(c("R", "S", "R", "R", NA, NA, NA, "I")) + +sir_combine(drug_a, drug_b) +sir_combine(drug_a, drug_b, guideline = "CLSI") +sir_combine(drug_a, drug_b, only_all_tested = TRUE) + +# the count and proportion functions use the same rules +susceptibility(drug_a, drug_b, minimum = 0) +susceptibility(sir_combine(drug_a, drug_b), minimum = 0) + +\donttest{ +if (require("dplyr")) { + # create a new variable for piperacillin/tazobactam + gentamicin + example_isolates \%>\% + mutate(TZP_GEN = sir_combine(TZP, GEN)) \%>\% + select(mo, TZP, GEN, TZP_GEN) +} +if (require("dplyr")) { + # combine any number of antimicrobials + example_isolates \%>\% + mutate(any_aminoglycoside = sir_combine(GEN, TOB, AMK, KAN)) \%>\% + count(any_aminoglycoside) +} +if (require("dplyr")) { + # use the new variable in further analyses + example_isolates \%>\% + mutate(TZP_GEN = sir_combine(TZP, GEN)) \%>\% + group_by(ward) \%>\% + summarise( + TZP = susceptibility(TZP), + TZP_GEN = susceptibility(TZP_GEN) + ) +} +} +} +\seealso{ +\code{\link[=count]{count()}} and \code{\link[=proportion]{proportion()}} for counting and calculating susceptibility of (combinations of) antimicrobials, and \code{\link[=antibiogram]{antibiogram()}} for combination antibiograms. +} diff --git a/tests/testthat/test-_misc.R b/tests/testthat/test-_misc.R index e45cf9b40..28ecc2bac 100755 --- a/tests/testthat/test-_misc.R +++ b/tests/testthat/test-_misc.R @@ -56,6 +56,19 @@ test_that("test-misc.R", { } + # test where() ---- + # where() must be AMR's own function, decided at runtime: a copy of tidyselect::where() made at installation fails without tidyselect at runtime + expect_identical(environment(AMR:::where), asNamespace("AMR")) + expect_identical(colnames(example_isolates[, AMR:::where(is.sir), drop = FALSE]), colnames(example_isolates)[vapply(FUN.VALUE = logical(1), example_isolates, is.sir)]) + expect_identical(colnames(example_isolates[, c(1:2, AMR:::where(is.mo)), drop = FALSE]), c("date", "patient", "mo")) + expect_error(AMR:::where("is.sir")) + # default argument where(is.sir) of antibiogram() works with and without tidyselect + expect_inherits(antibiogram(example_isolates), "antibiogram") + if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) { + expect_identical(colnames(example_isolates %>% select(AMR:::where(is.sir))), colnames(example_isolates[, AMR:::where(is.sir), drop = FALSE])) + expect_identical(colnames(example_isolates %>% select(mo, AMR:::where(is.sir))), c("mo", colnames(example_isolates[, AMR:::where(is.sir), drop = FALSE]))) + } + # test get_current_data() ---- is_right <- FALSE diff --git a/tests/testthat/test-count.R b/tests/testthat/test-count.R index a39483386..452bf8be2 100644 --- a/tests/testthat/test-count.R +++ b/tests/testthat/test-count.R @@ -68,12 +68,17 @@ test_that("test-count.R", { expect_equal(example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = TRUE), 1687) expect_equal(example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = FALSE), 1764) expect_equal(example_isolates %>% count_all(AMC, GEN, only_all_tested = TRUE), 1798) - expect_equal(example_isolates %>% count_all(AMC, GEN, only_all_tested = FALSE), 1936) + expect_equal(example_isolates %>% count_all(AMC, GEN, only_all_tested = FALSE), 1875) expect_identical( example_isolates %>% count_all(AMC, GEN, only_all_tested = TRUE), example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = TRUE) + example_isolates %>% count_resistant(AMC, GEN, only_all_tested = TRUE) ) + expect_identical( + example_isolates %>% count_all(AMC, GEN, only_all_tested = FALSE), + example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = FALSE) + + example_isolates %>% count_resistant(AMC, GEN, only_all_tested = FALSE) + ) # count of cases expect_equal( diff --git a/tests/testthat/test-g.test.R b/tests/testthat/test-g.test.R index f1343011b..22d2fe018 100644 --- a/tests/testthat/test-g.test.R +++ b/tests/testthat/test-g.test.R @@ -45,6 +45,10 @@ test_that("test-g.test.R", { 0.017873, tolerance = 0.0001 ) + # degrees of freedom are returned as the standard 'htest' component, so print() shows them + expect_identical(g.test(x)$parameter, c(df = 1)) + expect_identical(names(g.test(matrix(c(762, 327, 468, 484, 239, 477), nrow = 2))$parameter), "df") + expect_equal(unname(g.test(matrix(c(762, 327, 468, 484, 239, 477), nrow = 2))$parameter), 2) expect_error(g.test(0)) expect_error(g.test(c(0, 1), 0)) diff --git a/tests/testthat/test-proportion.R b/tests/testthat/test-proportion.R index c7bdeaa2a..80561eac0 100755 --- a/tests/testthat/test-proportion.R +++ b/tests/testthat/test-proportion.R @@ -95,7 +95,7 @@ test_that("test-proportion.R", { combination_n = n_sir(CIP, GEN) ) %>% pull(combination_n), - c(1181, 577, 116) + c(979, 462, 101) ) # proportion_df diff --git a/tests/testthat/test-sir_combine.R b/tests/testthat/test-sir_combine.R new file mode 100644 index 000000000..f5957007b --- /dev/null +++ b/tests/testthat/test-sir_combine.R @@ -0,0 +1,170 @@ +# ==================================================================== # +# TITLE: # +# AMR: An R Package for Working with Antimicrobial Resistance Data # +# # +# SOURCE CODE: # +# https://github.com/msberends/AMR # +# # +# PLEASE CITE THIS SOFTWARE AS: # +# Berends MS, Luz CF, Friedrich AW, et al. (2022). # +# AMR: An R Package for Working with Antimicrobial Resistance Data. # +# Journal of Statistical Software, 104(3), 1-31. # +# https://doi.org/10.18637/jss.v104.i03 # +# # +# Developed at the University of Groningen and the University Medical # +# Center Groningen in the Netherlands, in collaboration with many # +# colleagues from around the world, see our website. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://amr-for-r.org # +# ==================================================================== # + + +test_that("test-sir_combine.R", { + skip_on_cran() + + # truth table, written by hand: best result of two non-missing values + vals <- c("S", "SDD", "I", "R", "WT", "NWT", "NS") + best <- matrix( + c( + "S", "S", "S", "S", "S", "S", "S", + "S", "SDD", "SDD", "SDD", "WT", "SDD", "SDD", + "S", "SDD", "I", "I", "WT", "I", "I", + "S", "SDD", "I", "R", "WT", "R", "R", + "S", "WT", "WT", "WT", "WT", "WT", "WT", + "S", "SDD", "I", "R", "WT", "NWT", "NWT", + "S", "SDD", "I", "R", "WT", "NWT", "NS" + ), + nrow = 7, byrow = TRUE, dimnames = list(vals, vals) + ) + expect_identical(best, t(best)) + # result of a non-missing value combined with a missing value (NA or NI), for only_all_tested = FALSE + with_missing_eucast <- c(S = "S", SDD = "SDD", I = "I", R = NA, WT = "WT", NWT = NA, NS = NA) + with_missing_clsi <- c(S = "S", SDD = "SDD", I = NA, R = NA, WT = "WT", NWT = NA, NS = NA) + + for (missing_val in c(NA, "NI")) { + a <- c(rep(vals, each = length(vals)), vals, rep(missing_val, length(vals)), missing_val, "NI") + b <- c(rep(vals, times = length(vals)), rep(missing_val, length(vals)), vals, NA, missing_val) + expected_complete <- best[cbind(rep(vals, each = length(vals)), rep(vals, times = length(vals)))] + expected_eucast <- c(expected_complete, with_missing_eucast[vals], with_missing_eucast[vals], NA, NA) + expected_clsi <- c(expected_complete, with_missing_clsi[vals], with_missing_clsi[vals], NA, NA) + expected_all_tested <- c(expected_complete, rep(NA, 2 * length(vals) + 2)) + + a <- as.sir(a) + b <- as.sir(b) + expect_identical(sir_combine(a, b, guideline = "EUCAST"), as.sir(unname(expected_eucast))) + expect_identical(sir_combine(a, b, guideline = "CLSI"), as.sir(unname(expected_clsi))) + expect_identical(sir_combine(a, b, only_all_tested = TRUE, guideline = "EUCAST"), as.sir(unname(expected_all_tested))) + expect_identical(sir_combine(a, b, only_all_tested = TRUE, guideline = "CLSI"), as.sir(unname(expected_all_tested))) + # order of the antimicrobials does not matter + expect_identical(sir_combine(a, b), sir_combine(b, a)) + expect_identical(sir_combine(a, b, guideline = "CLSI"), sir_combine(b, a, guideline = "CLSI")) + } + + # three or more antimicrobials + x1 <- as.sir(c("R", "R", "R", NA, "I", "R", "NI")) + x2 <- as.sir(c("R", "I", "R", "R", "R", NA, "R")) + x3 <- as.sir(c("R", "R", "S", "R", NA, "SDD", "R")) + expect_identical(sir_combine(x1, x2, x3, guideline = "EUCAST"), as.sir(c("R", "I", "S", NA, "I", "SDD", NA))) + expect_identical(sir_combine(x1, x2, x3, guideline = "CLSI"), as.sir(c("R", "I", "S", NA, NA, "SDD", NA))) + expect_identical(sir_combine(x1, x2, x3, only_all_tested = TRUE), as.sir(c("R", "I", "S", NA, NA, NA, NA))) + expect_identical(sir_combine(x1, x2, x3), sir_combine(x3, x1, x2)) + expect_identical(sir_combine(x1, x2, x3), sir_combine(sir_combine(x1, x2, only_all_tested = TRUE), x3)) + + # input types + expect_inherits(sir_combine(x1, x2), "sir") + expect_identical(sir_combine(as.character(x1), as.character(x2)), sir_combine(x1, x2)) + expect_identical(sir_combine(data.frame(x1, x2, x3)), sir_combine(x1, x2, x3)) + expect_identical(sir_combine(data.frame(x1, x2), x3), sir_combine(x1, x2, x3)) + expect_identical(sir_combine(as.sir(character(0)), as.sir(character(0))), as.sir(character(0))) + expect_identical(sir_combine(example_isolates$TZP, example_isolates$GEN), sir_combine(example_isolates[, c("TZP", "GEN")])) + expect_identical(length(sir_combine(example_isolates$TZP, example_isolates$GEN)), nrow(example_isolates)) + expect_error(sir_combine(x1)) + expect_error(sir_combine(data.frame(x1))) + expect_error(sir_combine()) + expect_error(sir_combine(x1, x2[1:3])) + expect_error(sir_combine(x1, x2, only_all_tested = "yes")) + expect_error(sir_combine(x1, x2, guideline = "something else")) + + # count and proportion functions use the same rules for combinations + set.seed(321) + n <- 500 + random_sir_values <- function() as.sir(sample(c("S", "SDD", "I", "R", "WT", "NWT", "NS", "NI", NA), n, replace = TRUE, prob = c(0.3, 0.05, 0.1, 0.25, 0.05, 0.05, 0.05, 0.05, 0.1))) + r1 <- random_sir_values() + r2 <- random_sir_values() + r3 <- random_sir_values() + for (oat in c(FALSE, TRUE)) { + for (gl in c("EUCAST", "CLSI")) { + combined <- sir_combine(r1, r2, r3, only_all_tested = oat, guideline = gl) + expect_identical(count_all(r1, r2, r3, only_all_tested = oat), sum(!is.na(sir_combine(r1, r2, r3, only_all_tested = oat, guideline = "EUCAST")))) + expect_identical(count_susceptible(r1, r2, r3, only_all_tested = oat, guideline = gl), count_susceptible(combined, guideline = gl)) + expect_identical(count_resistant(r1, r2, r3, only_all_tested = oat, guideline = gl), count_resistant(combined, guideline = gl)) + expect_equal(susceptibility(r1, r2, r3, only_all_tested = oat, guideline = gl, minimum = 0), susceptibility(combined, guideline = gl, minimum = 0)) + expect_equal(resistance(r1, r2, r3, only_all_tested = oat, guideline = gl, minimum = 0), resistance(combined, guideline = gl, minimum = 0)) + expect_equal(susceptibility(r1, r2, r3, only_all_tested = oat, guideline = gl, minimum = 0) + resistance(r1, r2, r3, only_all_tested = oat, guideline = gl, minimum = 0), 1) + expect_identical(count_susceptible(combined, guideline = gl) + count_resistant(combined, guideline = gl), sum(!is.na(combined))) + } + combined <- sir_combine(r1, r2, only_all_tested = oat, guideline = "EUCAST") + expect_identical(count_SI(r1, r2, only_all_tested = oat) + count_R(r1, r2, only_all_tested = oat), count_all(r1, r2, only_all_tested = oat)) + expect_identical(count_S(r1, r2, only_all_tested = oat), sum(combined %in% "S")) + expect_identical(count_I(r1, r2, only_all_tested = oat), sum(combined %in% c("I", "SDD"))) + expect_identical(count_all(r1, r2, only_all_tested = oat), sum(!is.na(combined))) + expect_identical(count_R(r1, r2, only_all_tested = oat), sum(combined %in% c("R", "NWT", "NS"))) + expect_equal(proportion_SI(r1, r2, only_all_tested = oat, minimum = 0) + proportion_R(r1, r2, only_all_tested = oat, minimum = 0), 1) + } + + # antibiogram() gives the same result as the frozen implementation from before sir_combine() existed + old_combination <- function(df, S_values, only_all_tested) { + df[] <- lapply(df, function(col) { + col <- as.sir(col) + col[col == "NI"] <- NA_sir_ + col + }) + x_transposed <- as.list(as.data.frame(t(df), stringsAsFactors = FALSE)) + if (isTRUE(only_all_tested)) { + as.sir(vapply(FUN.VALUE = character(1), x_transposed, function(x) ifelse(anyNA(x), NA_character_, ifelse(any(x %in% S_values), "S", "R")), USE.NAMES = FALSE)) + } else { + as.sir(vapply(FUN.VALUE = character(1), x_transposed, function(x) ifelse(any(x %in% S_values, na.rm = TRUE), "S", ifelse(anyNA(x), NA_character_, "R")), USE.NAMES = FALSE)) + } + } + df_random <- data.frame(mo = as.mo(sample(c("E. coli", "K. pneumoniae", "P. aeruginosa"), n, replace = TRUE)), TZP = r1, GEN = r2, TOB = r3, stringsAsFactors = FALSE) + for (combine_SI in c(TRUE, FALSE)) { + S_values <- c("S", "WT", if (combine_SI) c("SDD", "I")) + for (oat in c(FALSE, TRUE)) { + df_old <- df_random + df_old$OLD <- old_combination(df_random[, c("TZP", "GEN", "TOB")], S_values, oat) + ab_new <- suppressWarnings(suppressMessages(antibiogram(df_random, antimicrobials = "TZP+GEN+TOB", combine_SI = combine_SI, only_all_tested = oat, minimum = 0))) + ab_old <- suppressWarnings(suppressMessages(antibiogram(df_old, antimicrobials = "OLD", combine_SI = combine_SI, only_all_tested = oat, minimum = 0))) + long_new <- attributes(ab_new)$long_numeric + long_old <- attributes(ab_old)$long_numeric + expect_true(nrow(long_new) > 0) + expect_identical(long_new[, colnames(long_new) != "ab"], long_old[, colnames(long_old) != "ab"]) + # wisca() uses the same combination step: the input of its Bayesian model must be identical + wisca_new <- suppressWarnings(suppressMessages(wisca(df_random, antimicrobials = "TZP+GEN+TOB", combine_SI = combine_SI, only_all_tested = oat, simulations = 10, info = FALSE))) + wisca_old <- suppressWarnings(suppressMessages(wisca(df_old, antimicrobials = "OLD", combine_SI = combine_SI, only_all_tested = oat, simulations = 10, info = FALSE))) + params_new <- as.data.frame(attributes(wisca_new)$wisca_parameters) + params_old <- as.data.frame(attributes(wisca_old)$wisca_parameters) + expect_true(sum(params_new$n_tested) > 0) + expect_identical(params_new[, colnames(params_new) != "ab"], params_old[, colnames(params_old) != "ab"]) + } + } + + if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) { + out <- example_isolates %>% mutate(TZP_GEN = sir_combine(TZP, GEN)) + expect_identical(out$TZP_GEN, sir_combine(example_isolates$TZP, example_isolates$GEN)) + out <- example_isolates %>% mutate(any_aminoglycoside = sir_combine(GEN, TOB, AMK, KAN)) + expect_identical(out$any_aminoglycoside, sir_combine(example_isolates[, c("GEN", "TOB", "AMK", "KAN")])) + expect_identical( + example_isolates %>% group_by(ward) %>% summarise(s = susceptibility(TZP, GEN, minimum = 0)) %>% pull(s), + example_isolates %>% mutate(TZP_GEN = sir_combine(TZP, GEN)) %>% group_by(ward) %>% summarise(s = susceptibility(TZP_GEN, minimum = 0)) %>% pull(s) + ) + } +}) diff --git a/tests/testthat/test-zzz.R b/tests/testthat/test-zzz.R index a710e642d..e684b0ebe 100644 --- a/tests/testthat/test-zzz.R +++ b/tests/testthat/test-zzz.R @@ -220,3 +220,43 @@ test_that("test-zzz.R", { expect_true(is.function(ggplot2::scale_fill_discrete()$transform)) } }) + +test_that("test-zzz.R: no installation-time dependency on suggested packages", { + skip_on_cran() + # code outside functions runs when the package is installed, not when it is loaded: anything it takes from a suggested package is then decided by the machine that built the package (e.g., the CRAN binary builders, which have all suggested packages), and fails for users who do not have that package, see .onLoad() in R/zzz.R + r_dir <- file.path(testthat::test_path(), "..", "..", "R") + skip_if(!dir.exists(r_dir), "R source files not available") + suggests <- trimws(gsub("[(].*", "", strsplit(read.dcf(file.path(r_dir, "..", "DESCRIPTION"), fields = "Suggests")[1, 1], ",")[[1]])) + runtime_calls <- c("import_fn", "requireNamespace", "loadNamespace", "pkg_is_available", "l10n_info", "require", "library") + find_offending <- function(expr) { + if (!is.call(expr)) { + return(character(0)) + } + fn <- expr[[1]] + if (identical(fn, as.name("function"))) { + # function bodies run at runtime, so these are fine + return(character(0)) + } + found <- character(0) + fn_name <- if (is.name(fn)) as.character(fn) else if (is.call(fn) && (identical(fn[[1]], as.name("::")) || identical(fn[[1]], as.name(":::")))) as.character(fn[[3]]) else "" + if (fn_name %in% runtime_calls) { + found <- paste0(fn_name, "()") + } + if ((identical(fn, as.name("::")) || identical(fn, as.name(":::"))) && as.character(expr[[2]]) %in% suggests) { + found <- paste0(as.character(expr[[2]]), "::", as.character(expr[[3]])) + } + c(found, unlist(lapply(as.list(expr)[-1], find_offending))) + } + offending <- character(0) + for (f in list.files(r_dir, pattern = "[.]R$", full.names = TRUE)) { + exprs <- parse(f, keep.source = TRUE) + lines <- vapply(FUN.VALUE = integer(1), attr(exprs, "srcref"), function(x) x[1]) + for (i in seq_along(exprs)) { + found <- find_offending(exprs[[i]]) + if (length(found) > 0) { + offending <- c(offending, paste0(basename(f), ":", lines[i], ": ", paste(unique(found), collapse = ", "))) + } + } + } + expect_identical(offending, character(0), info = paste(offending, collapse = "\n")) +})