mirror of
https://github.com/msberends/AMR.git
synced 2025-07-09 08:11:58 +02:00
Compare commits
18 Commits
8dcf101a9c
...
v2.0.0
Author | SHA1 | Date | |
---|---|---|---|
dee675e717 | |||
80cfc503c2 | |||
9179e98e12 | |||
7ad8635994 | |||
45e840c02f | |||
262598b8d7 | |||
4416394e10 | |||
1d3d7d40bc | |||
2c5a9bb622 | |||
92029c9e95 | |||
049baf0a71 | |||
e70f2cd32c | |||
a84101db08 | |||
551aaf6517 | |||
c2cfc5ef84 | |||
dad25302f2 | |||
380cbec0e8 | |||
8d902410f9 |
2
.github/prehooks/pre-commit
vendored
2
.github/prehooks/pre-commit
vendored
@ -37,7 +37,7 @@ if command -v Rscript > /dev/null; then
|
||||
Rscript -e "source('data-raw/_pre_commit_hook.R')"
|
||||
currentpkg=$(Rscript -e "cat(pkgload::pkg_name())")
|
||||
echo "- Adding changed files in ./data-raw and ./man to this commit"
|
||||
git add data-raw/* --quiet
|
||||
git add data-raw/*
|
||||
git add man/*
|
||||
git add R/sysdata.rda
|
||||
git add NAMESPACE
|
||||
|
2
.gitignore
vendored
2
.gitignore
vendored
@ -25,4 +25,4 @@ data-raw/DSMZ_bactnames.xlsx
|
||||
data-raw/country_analysis_url_token.R
|
||||
data-raw/country_analysis2.R
|
||||
data-raw/taxonomy.csv
|
||||
data-raw/WHONET
|
||||
data-raw/WHONET/*
|
||||
|
@ -1,3 +1,3 @@
|
||||
Version: 1.8.2
|
||||
Date: 2022-09-27 12:18:42 UTC
|
||||
SHA: ccb09706e4f168ab6133de3d2294bcaeed0d3fc8
|
||||
Version: 2.0.0
|
||||
Date: 2023-03-12 12:42:08 UTC
|
||||
SHA: 80cfc503c29ad48806e526b97d4570600bbd5420
|
||||
|
@ -1,6 +1,6 @@
|
||||
Package: AMR
|
||||
Version: 1.8.2.9135
|
||||
Date: 2023-02-18
|
||||
Version: 2.0.0
|
||||
Date: 2023-03-12
|
||||
Title: Antimicrobial Resistance Data Analysis
|
||||
Description: Functions to simplify and standardise antimicrobial resistance (AMR)
|
||||
data analysis and to work with microbial and antimicrobial properties by
|
||||
|
@ -131,7 +131,6 @@ S3method(plot,resistance_predict)
|
||||
S3method(plot,rsi)
|
||||
S3method(plot,sir)
|
||||
S3method(print,ab)
|
||||
S3method(print,antibiogram)
|
||||
S3method(print,av)
|
||||
S3method(print,bug_drug_combinations)
|
||||
S3method(print,custom_eucast_rules)
|
||||
|
20
NEWS.md
20
NEWS.md
@ -1,6 +1,4 @@
|
||||
# AMR 1.8.2.9135
|
||||
|
||||
*(this beta version will eventually become v2.0! We're happy to reach a new major milestone soon!)*
|
||||
# AMR 2.0.0
|
||||
|
||||
This is a new major release of the AMR package, with great new additions but also some breaking changes for current users. These are all listed below.
|
||||
|
||||
@ -48,6 +46,12 @@ We added support for the following ten languages: Chinese (simplified), Czech, F
|
||||
|
||||
We are very grateful for the valuable input by our colleagues from other countries. The `AMR` package is now available in 20 languages in total, and according to download stats used in almost all countries in the world!
|
||||
|
||||
### Outbreak management
|
||||
|
||||
For analysis in outbreak management, we updated the `get_episode()` and `is_new_episode()` functions: they now contain an argument `case_free_days`. This argument can be used to quantify the duration of case-free days (the inter-epidemic interval), after which a new episode will start.
|
||||
|
||||
This is common requirement in outbreak management, e.g. when determining the number of norovirus outbreaks in a hospital. The case-free period could then be 14 or 28 days, so that new norovirus cases after that time will be considered a different (or new) episode.
|
||||
|
||||
### Microbiological taxonomy
|
||||
|
||||
The `microorganisms` data set no longer relies on the Catalogue of Life, but on the List of Prokaryotic names with Standing in Nomenclature (LPSN) and is supplemented with the 'backbone taxonomy' from the Global Biodiversity Information Facility (GBIF). The structure of this data set has changed to include separate LPSN and GBIF identifiers. Almost all previous MO codes were retained. It contains over 1,400 taxonomic names from 2022.
|
||||
@ -59,6 +63,7 @@ The new function `add_custom_microorganisms()` allows users to add custom microo
|
||||
We also made the following changes regarding the included taxonomy or microorganisms functions:
|
||||
|
||||
* Updated full microbiological taxonomy according to the latest daily LPSN data set (December 2022) and latest yearly GBIF taxonomy backbone (November 2022)
|
||||
* Added function `mo_current()` to get the currently valid taxonomic name of a microorganism
|
||||
* Support for all 1,516 city-like serovars of *Salmonella*, such as *Salmonella* Goldcoast. Formally, these are serovars belonging to the *S. enterica* species, but they are reported with only the name of the genus and the city. For this reason, the serovars are in the `subspecies` column of the `microorganisms` data set and "enterica" is in the `species` column, but the full name does not contain the species name (*enterica*).
|
||||
* All new algorithm for `as.mo()` (and thus all `mo_*()` functions) while still following our original set-up as described in our recently published JSS paper (DOI [10.18637/jss.v104.i03](https://doi.org/10.18637/jss.v104.i03)).
|
||||
* A new argument `keep_synonyms` allows to *not* correct for updated taxonomy, in favour of the now deleted argument `allow_uncertain`
|
||||
@ -100,11 +105,14 @@ We now added extensive support for antiviral agents! For the first time, the `AM
|
||||
* Function `sir_confidence_interval()` to add confidence intervals in AMR calculation. This is now also included in `sir_df()` and `proportion_df()`.
|
||||
* Function `mean_amr_distance()` to calculate the mean AMR distance. The mean AMR distance is a normalised numeric value to compare AMR test results and can help to identify similar isolates, without comparing antibiograms by hand.
|
||||
* Function `sir_interpretation_history()` to view the history of previous runs of `as.sir()` (previously `as.rsi()`). This returns a 'logbook' with the selected guideline, reference table and specific interpretation of each row in a data set on which `as.sir()` was run.
|
||||
* Function `mo_current()` to get the currently valid taxonomic name of a microorganism
|
||||
* Function `add_custom_antimicrobials()` to add custom antimicrobial codes and names to the `AMR` package
|
||||
|
||||
|
||||
## Changes
|
||||
|
||||
* `get_episode()` (and its wrapper `is_new_episode()`):
|
||||
* Fix for working with `NA` values
|
||||
* Fix for unsorted dates of length 2
|
||||
* Now returns class `integer` instead of `numeric` since they are always whole numbers
|
||||
* Argument `combine_IR` has been removed from this package (affecting functions `count_df()`, `proportion_df()`, and `sir_df()` and some plotting functions), since it was replaced with `combine_SI` three years ago
|
||||
* Using `units` in `ab_ddd(..., units = "...")` had been deprecated for some time and is now not supported anymore. Use `ab_ddd_units()` instead.
|
||||
* Support for `data.frame`-enhancing R packages, more specifically: `data.table::data.table`, `janitor::tabyl`, `tibble::tibble`, and `tsibble::tsibble`. AMR package functions that have a data set as output (such as `sir_df()` and `bug_drug_combinations()`), will now return the same data type as the input.
|
||||
@ -134,7 +142,7 @@ We now added extensive support for antiviral agents! For the first time, the `AM
|
||||
* Fix for `mo_shortname()` in case of higher taxonomic ranks (order, class, phylum)
|
||||
* Cleaning columns with `as.sir()`, `as.mic()`, or `as.disk()` will now show the column name in the warning for invalid results
|
||||
* Fix for using `g.test()` with zeroes in a 2x2 table
|
||||
* `get_episode()` now returns class `integer` instead of `numeric` since they are always whole numbers
|
||||
* `mo_synonyns()` now contains the scientific reference as names
|
||||
|
||||
## Other
|
||||
|
||||
|
@ -34,11 +34,11 @@
|
||||
#'
|
||||
#' The `AMR` package is a [free and open-source](https://msberends.github.io/AMR/#copyright) R package with [zero dependencies](https://en.wikipedia.org/wiki/Dependency_hell) to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. **Our aim is to provide a standard** for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting. [Many different researchers](https://msberends.github.io/AMR/authors.html) from around the globe are continually helping us to make this a successful and durable project!
|
||||
#'
|
||||
#' This work was published in the Journal of Statistical Software (Volume 104(3); [DOI 10.18637/jss.v104.i03](https://doi.org/10.18637/jss.v104.i03)) and formed the basis of two PhD theses ([DOI 10.33612/diss.177417131](https://doi.org/10.33612/diss.177417131) and [DOI 10.33612/diss.192486375](https://doi.org/10.33612/diss.192486375)).
|
||||
#' This work was published in the Journal of Statistical Software (Volume 104(3); \doi{jss.v104.i03}) and formed the basis of two PhD theses (\doi{10.33612/diss.177417131} and \doi{10.33612/diss.192486375}).
|
||||
#'
|
||||
#' After installing this package, R knows [**`r format_included_data_number(AMR::microorganisms)`**](https://msberends.github.io/AMR/reference/microorganisms.html) (updated December 2022) and all [**~600 antibiotic, antimycotic and antiviral drugs**](https://msberends.github.io/AMR/reference/antibiotics.html) by name and code (including ATC, EARS-Net, ASIARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid SIR and MIC values. The integral breakpoint guidelines from CLSI and EUCAST are included from the last 10 years. It supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl), in collaboration with non-profit organisations [Certe Medical Diagnostics and Advice Foundation](https://www.certe.nl) and [University Medical Center Groningen](https://www.umcg.nl).
|
||||
#' After installing this package, R knows [**`r format_included_data_number(AMR::microorganisms)` microorganisms**](https://msberends.github.io/AMR/reference/microorganisms.html) (updated `r format(TAXONOMY_VERSION$GBIF$accessed_date, "%B %Y")`) and all [**`r format_included_data_number(nrow(AMR::antibiotics) + nrow(AMR::antivirals))` antibiotic, antimycotic and antiviral drugs**](https://msberends.github.io/AMR/reference/antibiotics.html) by name and code (including ATC, EARS-Net, ASIARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid SIR and MIC values. The integral breakpoint guidelines from CLSI and EUCAST are included from the last 10 years. It supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl), in collaboration with non-profit organisations [Certe Medical Diagnostics and Advice Foundation](https://www.certe.nl) and [University Medical Center Groningen](https://www.umcg.nl).
|
||||
#'
|
||||
#' The `AMR` package is available in English, Chinese, Danish, Dutch, French, German, Greek, Italian, Japanese, Polish, Portuguese, Russian, Spanish, Swedish, Turkish and Ukrainian. Antimicrobial drug (group) names and colloquial microorganism names are provided in these languages.
|
||||
#' The `AMR` package is available in `r vector_and(vapply(FUN.VALUE = character(1), LANGUAGES_SUPPORTED_NAMES, function(x) x$exonym), quotes = FALSE, sort = FALSE)`. Antimicrobial drug (group) names and colloquial microorganism names are provided in these languages.
|
||||
#' @section Reference Data Publicly Available:
|
||||
#' All data sets in this `AMR` package (about microorganisms, antibiotics, SIR interpretation, EUCAST rules, etc.) are publicly and freely available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. We also provide tab-separated plain text files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
|
||||
#' @source
|
||||
|
@ -63,9 +63,9 @@ pm_left_join <- function(x, y, by = NULL, suffix = c(".x", ".y")) {
|
||||
merged
|
||||
}
|
||||
|
||||
# support where() like tidyverse:
|
||||
# support where() like tidyverse (this function will also be used when running `antibiogram()`):
|
||||
where <- function(fn) {
|
||||
# adapted from https://github.com/nathaneastwood/poorman/blob/52eb6947e0b4430cd588976ed8820013eddf955f/R/where.R#L17-L32
|
||||
# based on https://github.com/nathaneastwood/poorman/blob/52eb6947e0b4430cd588976ed8820013eddf955f/R/where.R#L17-L32
|
||||
if (!is.function(fn)) {
|
||||
stop_("`", deparse(substitute(fn)), "()` is not a valid predicate function.")
|
||||
}
|
||||
@ -90,7 +90,7 @@ where <- function(fn) {
|
||||
|
||||
# copied and slightly rewritten from {poorman} under permissive license (2021-10-15)
|
||||
# https://github.com/nathaneastwood/poorman, MIT licensed, Nathan Eastwood, 2020
|
||||
quick_case_when <- function(...) {
|
||||
case_when_AMR <- function(...) {
|
||||
fs <- list(...)
|
||||
lapply(fs, function(x) {
|
||||
if (!inherits(x, "formula")) {
|
||||
@ -163,8 +163,8 @@ quick_case_when <- function(...) {
|
||||
out
|
||||
}
|
||||
|
||||
rbind2 <- function(...) {
|
||||
# this is just rbind(), but then with the functionality of dplyr::bind_rows(),
|
||||
rbind_AMR <- function(...) {
|
||||
# this is just rbind(), but with the functionality of dplyr::bind_rows(),
|
||||
# to allow differences in available columns
|
||||
l <- list(...)
|
||||
l_names <- unique(unlist(lapply(l, names)))
|
||||
@ -388,7 +388,7 @@ stop_ifnot_installed <- function(package) {
|
||||
}
|
||||
}
|
||||
|
||||
pkg_is_available <- function(pkg, also_load = TRUE, min_version = NULL) {
|
||||
pkg_is_available <- function(pkg, also_load = FALSE, min_version = NULL) {
|
||||
if (also_load == TRUE) {
|
||||
out <- suppressWarnings(require(pkg, character.only = TRUE, warn.conflicts = FALSE))
|
||||
} else {
|
||||
@ -531,10 +531,10 @@ warning_ <- function(...,
|
||||
immediate = FALSE,
|
||||
call = FALSE) {
|
||||
warning(
|
||||
word_wrap(...,
|
||||
trimws2(word_wrap(...,
|
||||
add_fn = add_fn,
|
||||
as_note = FALSE
|
||||
),
|
||||
)),
|
||||
immediate. = immediate,
|
||||
call. = call
|
||||
)
|
||||
@ -554,7 +554,7 @@ stop_ <- function(..., call = TRUE) {
|
||||
}
|
||||
msg <- paste0("in ", call, "(): ", msg)
|
||||
}
|
||||
msg <- word_wrap(msg, add_fn = list(), as_note = FALSE)
|
||||
msg <- trimws2(word_wrap(msg, add_fn = list(), as_note = FALSE))
|
||||
stop(msg, call. = FALSE)
|
||||
}
|
||||
|
||||
@ -633,7 +633,9 @@ documentation_date <- function(d) {
|
||||
}
|
||||
|
||||
format_included_data_number <- function(data) {
|
||||
if (is.data.frame(data)) {
|
||||
if (is.numeric(data) && length(data) == 1) {
|
||||
n <- data
|
||||
} else if (is.data.frame(data)) {
|
||||
n <- nrow(data)
|
||||
} else {
|
||||
n <- length(unique(data))
|
||||
@ -703,6 +705,10 @@ vector_or <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE, initial_ca
|
||||
# class 'sir' should be sorted like this
|
||||
v <- c("S", "I", "R")
|
||||
}
|
||||
# oxford comma
|
||||
if (last_sep %in% c(" or ", " and ") && length(v) > 2) {
|
||||
last_sep <- paste0(",", last_sep)
|
||||
}
|
||||
# all commas except for last item, so will become '"val1", "val2", "val3" or "val4"'
|
||||
paste0(
|
||||
paste0(quotes, v[seq_len(length(v) - 1)], quotes, collapse = ", "),
|
||||
@ -753,7 +759,7 @@ format_class <- function(class, plural = FALSE) {
|
||||
}
|
||||
|
||||
# a check for every single argument in all functions
|
||||
meet_criteria <- function(object,
|
||||
meet_criteria <- function(object, # can be literally `list(...)` for `allow_arguments_from`
|
||||
allow_class = NULL,
|
||||
has_length = NULL,
|
||||
looks_like = NULL,
|
||||
@ -765,6 +771,7 @@ meet_criteria <- function(object,
|
||||
allow_NULL = FALSE,
|
||||
allow_NA = FALSE,
|
||||
ignore.case = FALSE,
|
||||
allow_arguments_from = NULL, # 1 function, or a list of functions
|
||||
.call_depth = 0) { # depth in calling
|
||||
|
||||
obj_name <- deparse(substitute(object))
|
||||
@ -877,8 +884,26 @@ meet_criteria <- function(object,
|
||||
}
|
||||
), na.rm = TRUE),
|
||||
"the data provided in argument `", obj_name,
|
||||
"` must contain at least one column of class '", contains_column_class, "'. ",
|
||||
"See ?as.", contains_column_class, ".",
|
||||
"` must contain at least one column of class '", contains_column_class[1L], "'. ",
|
||||
"See `?as.", contains_column_class[1L], "`.",
|
||||
call = call_depth
|
||||
)
|
||||
}
|
||||
if (!is.null(allow_arguments_from) && !is.null(names(object))) {
|
||||
args_given <- names(object)
|
||||
if (is.function(allow_arguments_from)) {
|
||||
allow_arguments_from <- list(allow_arguments_from)
|
||||
}
|
||||
args_allowed <- sort(unique(unlist(lapply(allow_arguments_from, function(x) names(formals(x))))))
|
||||
args_allowed <- args_allowed[args_allowed != "..."]
|
||||
disallowed <- args_given[!args_given %in% args_allowed]
|
||||
stop_if(length(disallowed) > 0,
|
||||
ifelse(length(disallowed) == 1,
|
||||
paste("the argument", vector_and(disallowed), "is"),
|
||||
paste("the arguments", vector_and(disallowed), "are")
|
||||
),
|
||||
" not valid. Valid arguments are: ",
|
||||
vector_and(args_allowed), ".",
|
||||
call = call_depth
|
||||
)
|
||||
}
|
||||
@ -911,7 +936,7 @@ get_current_data <- function(arg_name, call) {
|
||||
}
|
||||
}
|
||||
|
||||
# now go over all underlying environments looking for other dplyr and base R selection environments
|
||||
# now go over all underlying environments looking for other dplyr, data.table and base R selection environments
|
||||
with_generic <- vapply(FUN.VALUE = logical(1), frms, function(e) !is.null(e$`.Generic`))
|
||||
for (env in frms[which(with_generic)]) {
|
||||
if (valid_df(env$`.data`)) {
|
||||
@ -922,6 +947,7 @@ get_current_data <- function(arg_name, call) {
|
||||
return(env$xx)
|
||||
} else if (valid_df(env$x)) {
|
||||
# an element `x` will be in the environment for only cols in base R, e.g. `example_isolates[, carbapenems()]`
|
||||
# this element will also be present in data.table environments where there's a .Generic available
|
||||
return(env$x)
|
||||
}
|
||||
}
|
||||
@ -1318,14 +1344,14 @@ create_pillar_column <- function(x, ...) {
|
||||
}
|
||||
|
||||
as_original_data_class <- function(df, old_class = NULL, extra_class = NULL) {
|
||||
if ("tbl_df" %in% old_class && pkg_is_available("tibble", also_load = FALSE)) {
|
||||
if ("tbl_df" %in% old_class && pkg_is_available("tibble")) {
|
||||
# this will then also remove groups
|
||||
fn <- import_fn("as_tibble", "tibble")
|
||||
} else if ("tbl_ts" %in% old_class && pkg_is_available("tsibble", also_load = FALSE)) {
|
||||
} else if ("tbl_ts" %in% old_class && pkg_is_available("tsibble")) {
|
||||
fn <- import_fn("as_tsibble", "tsibble")
|
||||
} else if ("data.table" %in% old_class && pkg_is_available("data.table", also_load = FALSE)) {
|
||||
} else if ("data.table" %in% old_class && pkg_is_available("data.table")) {
|
||||
fn <- import_fn("as.data.table", "data.table")
|
||||
} else if ("tabyl" %in% old_class && pkg_is_available("janitor", also_load = FALSE)) {
|
||||
} else if ("tabyl" %in% old_class && pkg_is_available("janitor")) {
|
||||
fn <- import_fn("as_tabyl", "janitor")
|
||||
} else {
|
||||
fn <- function(x) base::as.data.frame(df, stringsAsFactors = FALSE)
|
||||
@ -1478,7 +1504,7 @@ trimws2 <- function(..., whitespace = "[\u0009\u000A\u000B\u000C\u000D\u0020\u00
|
||||
trimws(..., whitespace = whitespace)
|
||||
}
|
||||
|
||||
readRDS2 <- function(file, refhook = NULL) {
|
||||
readRDS_AMR <- function(file, refhook = NULL) {
|
||||
# this is readRDS with remote file support
|
||||
con <- file(file)
|
||||
on.exit(close(con))
|
||||
|
@ -988,7 +988,7 @@ pm_summarise.default <- function(.data, ...) {
|
||||
if (is.list(x_res)) I(x_res) else x_res
|
||||
}
|
||||
)
|
||||
res <- as.data.frame(res)
|
||||
res <- as.data.frame(res, stringsAsFactors = FALSE)
|
||||
fn_names <- names(fns)
|
||||
colnames(res) <- if (is.null(fn_names)) fns else fn_names
|
||||
if (pm_groups_exist) res <- cbind(group, res, row.names = NULL)
|
||||
|
@ -34,12 +34,13 @@
|
||||
#' * `AMR_custom_ab` \cr Allows to use custom antimicrobial drugs with this package. This is explained in [add_custom_antimicrobials()].
|
||||
#' * `AMR_custom_mo` \cr Allows to use custom microorganisms with this package. This is explained in [add_custom_microorganisms()].
|
||||
#' * `AMR_eucastrules` \cr Used for setting the default types of rules for [eucast_rules()] function, must be one or more of: `"breakpoints"`, `"expert"`, `"other"`, `"custom"`, `"all"`, and defaults to `c("breakpoints", "expert")`.
|
||||
#' * `AMR_guideline` \cr Used for setting the default guideline for interpreting MIC values and disk diffusion diameters with [as.sir()]. Can be only the guideline name (e.g., `"CLSI"`) or the name with a year (e.g. `"CLSI 2019"`). The default is \code{"`r clinical_breakpoints$guideline[1]`"}. Supported guideline are currently EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`) and CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`).
|
||||
#' * `AMR_ignore_pattern` \cr A [regular expression][base::regex] to define input that must be ignored in [as.mo()] and all [`mo_*`][mo_property()] functions.
|
||||
#' * `AMR_include_PKPD` \cr A [logical] to use in [as.sir()], to indicate that PK/PD clinical breakpoints must be applied as a last resort, defaults to `TRUE`.
|
||||
#' * `AMR_include_screening` \cr A [logical] to use in [as.sir()], to indicate that clinical breakpoints for screening are allowed, defaults to `FALSE`.
|
||||
#' * `AMR_keep_synonyms` \cr A [logical] to use in [as.mo()] and all [`mo_*`][mo_property()] functions, to indicate if old, previously valid taxonomic names must be preserved and not be corrected to currently accepted names.
|
||||
#' * `AMR_locale` \cr A language to use for the `AMR` package, can be one of these supported language names or ISO-639-1 codes: `r vector_or(paste0(sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), " (" , LANGUAGES_SUPPORTED, ")"), quotes = FALSE, sort = FALSE)`.
|
||||
#' * `AMR_guideline` \cr Used for setting the default guideline for interpreting MIC values and disk diffusion diameters with [as.sir()]. Can be only the guideline name (e.g., `"CLSI"`) or the name with a year (e.g. `"CLSI 2019"`). The default to the latest implemented EUCAST guideline, currently \code{"`r clinical_breakpoints$guideline[1]`"}. Supported guideline are currently EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`) and CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`).
|
||||
#' * `AMR_ignore_pattern` \cr A [regular expression][base::regex] to ignore (i.e., make `NA`) any match given in [as.mo()] and all [`mo_*`][mo_property()] functions.
|
||||
#' * `AMR_include_PKPD` \cr A [logical] to use in [as.sir()], to indicate that PK/PD clinical breakpoints must be applied as a last resort - the default is `TRUE`.
|
||||
#' * `AMR_include_screening` \cr A [logical] to use in [as.sir()], to indicate that clinical breakpoints for screening are allowed - the default is `FALSE`.
|
||||
#' * `AMR_keep_synonyms` \cr A [logical] to use in [as.mo()] and all [`mo_*`][mo_property()] functions, to indicate if old, previously valid taxonomic names must be preserved and not be corrected to currently accepted names. The default is `FALSE`.
|
||||
#' * `AMR_cleaning_regex` \cr A [regular expression][base::regex] (case-insensitive) to use in [as.mo()] and all [`mo_*`][mo_property()] functions, to clean the user input. The default is the outcome of [mo_cleaning_regex()], which removes texts between brackets and texts such as "species" and "serovar".
|
||||
#' * `AMR_locale` \cr A language to use for the `AMR` package, can be one of these supported language names or ISO-639-1 codes: `r vector_or(paste0(sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), " (" , LANGUAGES_SUPPORTED, ")"), quotes = FALSE, sort = FALSE)`. The default is the current system language (if supported).
|
||||
#' * `AMR_mo_source` \cr A file location for a manual code list to be used in [as.mo()] and all [`mo_*`][mo_property()] functions. This is explained in [set_mo_source()].
|
||||
#'
|
||||
#' @section Saving Settings Between Sessions:
|
||||
|
10
R/ab.R
10
R/ab.R
@ -32,7 +32,7 @@
|
||||
#' Use this function to determine the antibiotic drug code of one or more antibiotics. The data set [antibiotics] will be searched for abbreviations, official names and synonyms (brand names).
|
||||
#' @param x a [character] vector to determine to antibiotic ID
|
||||
#' @param flag_multiple_results a [logical] to indicate whether a note should be printed to the console that probably more than one antibiotic drug code or name can be retrieved from a single input value.
|
||||
#' @param info a [logical] to indicate whether a progress bar should be printed, defaults to `TRUE` only in interactive mode
|
||||
#' @param info a [logical] to indicate whether a progress bar should be printed - the default is `TRUE` only in interactive mode
|
||||
#' @param ... arguments passed on to internal functions
|
||||
#' @rdname as.ab
|
||||
#' @inheritSection WHOCC WHOCC
|
||||
@ -133,11 +133,11 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
|
||||
note_if_more_than_one_found <- function(found, index, from_text) {
|
||||
if (isTRUE(initial_search) && isTRUE(length(from_text) > 1)) {
|
||||
abnames <- ab_name(from_text, tolower = TRUE, initial_search = FALSE)
|
||||
if (ab_name(found[1L], language = NULL) %like% "(clavulanic acid|avibactam)") {
|
||||
abnames <- abnames[!abnames %in% c("clavulanic acid", "avibactam")]
|
||||
if (ab_name(found[1L], language = NULL) %like% "(clavulanic acid|(avi|tazo|mono|vabor)bactam)") {
|
||||
abnames <- abnames[!abnames %in% c("clavulanic acid", "avibactam", "tazobactam", "vaborbactam", "monobactam")]
|
||||
}
|
||||
if (length(abnames) > 1) {
|
||||
warning_(
|
||||
message_(
|
||||
"More than one result was found for item ", index, ": ",
|
||||
vector_and(abnames, quotes = FALSE)
|
||||
)
|
||||
@ -495,7 +495,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
|
||||
# save to package env to save time for next time
|
||||
if (isTRUE(initial_search)) {
|
||||
AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(!AMR_env$ab_previously_coerced$x %in% x), , drop = FALSE]
|
||||
AMR_env$ab_previously_coerced <- unique(rbind2(
|
||||
AMR_env$ab_previously_coerced <- unique(rbind_AMR(
|
||||
AMR_env$ab_previously_coerced,
|
||||
data.frame(
|
||||
x = x,
|
||||
|
@ -33,9 +33,9 @@
|
||||
#' @param text text to analyse
|
||||
#' @param type type of property to search for, either `"drug"`, `"dose"` or `"administration"`, see *Examples*
|
||||
#' @param collapse a [character] to pass on to `paste(, collapse = ...)` to only return one [character] per element of `text`, see *Examples*
|
||||
#' @param translate_ab if `type = "drug"`: a column name of the [antibiotics] data set to translate the antibiotic abbreviations to, using [ab_property()]. Defaults to `FALSE`. Using `TRUE` is equal to using "name".
|
||||
#' @param translate_ab if `type = "drug"`: a column name of the [antibiotics] data set to translate the antibiotic abbreviations to, using [ab_property()]. The default is `FALSE`. Using `TRUE` is equal to using "name".
|
||||
#' @param thorough_search a [logical] to indicate whether the input must be extensively searched for misspelling and other faulty input values. Setting this to `TRUE` will take considerably more time than when using `FALSE`. At default, it will turn `TRUE` when all input elements contain a maximum of three words.
|
||||
#' @param info a [logical] to indicate whether a progress bar should be printed, defaults to `TRUE` only in interactive mode
|
||||
#' @param info a [logical] to indicate whether a progress bar should be printed - the default is `TRUE` only in interactive mode
|
||||
#' @param ... arguments passed on to [as.ab()]
|
||||
#' @details This function is also internally used by [as.ab()], although it then only searches for the first drug name and will throw a note if more drug names could have been returned. Note: the [as.ab()] function may use very long regular expression to match brand names of antimicrobial drugs. This may fail on some systems.
|
||||
#'
|
||||
|
@ -33,7 +33,7 @@
|
||||
#' @param x any (vector of) text that can be coerced to a valid antibiotic drug code with [as.ab()]
|
||||
#' @param tolower a [logical] to indicate whether the first [character] of every output should be transformed to a lower case [character]. This will lead to e.g. "polymyxin B" and not "polymyxin b".
|
||||
#' @param property one of the column names of one of the [antibiotics] data set: `vector_or(colnames(antibiotics), sort = FALSE)`.
|
||||
#' @param language language of the returned text, defaults to system language (see [get_AMR_locale()]) and can also be set with the option [`AMR_locale`][AMR-options]. Use `language = NULL` or `language = ""` to prevent translation.
|
||||
#' @param language language of the returned text - the default is the current system language (see [get_AMR_locale()]) and can also be set with the [package option][AMR-options] [`AMR_locale`][AMR-options]. Use `language = NULL` or `language = ""` to prevent translation.
|
||||
#' @param administration way of administration, either `"oral"` or `"iv"`
|
||||
#' @param open browse the URL using [utils::browseURL()]
|
||||
#' @param ... in case of [set_ab_names()] and `data` is a [data.frame]: columns to select (supports tidy selection such as `column1:column4`), otherwise other arguments passed on to [as.ab()]
|
||||
|
173
R/ab_selectors.R
173
R/ab_selectors.R
@ -29,14 +29,16 @@
|
||||
|
||||
#' Antibiotic Selectors
|
||||
#'
|
||||
#' These functions allow for filtering rows and selecting columns based on antibiotic test results that are of a specific antibiotic class or group, without the need to define the columns or antibiotic abbreviations. In short, if you have a column name that resembles an antimicrobial drug, it will be picked up by any of these functions that matches its pharmaceutical class: "cefazolin", "CZO" and "J01DB04" will all be picked up by [cephalosporins()].
|
||||
#' @description These functions allow for filtering rows and selecting columns based on antibiotic test results that are of a specific antibiotic class or group (according to the [antibiotics] data set), without the need to define the columns or antibiotic abbreviations.
|
||||
#'
|
||||
#' In short, if you have a column name that resembles an antimicrobial drug, it will be picked up by any of these functions that matches its pharmaceutical class: "cefazolin", "kefzol", "CZO" and "J01DB04" will all be picked up by [cephalosporins()].
|
||||
#' @param ab_class an antimicrobial class or a part of it, such as `"carba"` and `"carbapenems"`. The columns `group`, `atc_group1` and `atc_group2` of the [antibiotics] data set will be searched (case-insensitive) for this value.
|
||||
#' @param filter an [expression] to be evaluated in the [antibiotics] data set, such as `name %like% "trim"`
|
||||
#' @param only_sir_columns a [logical] to indicate whether only columns of class `sir` must be selected (defaults to `FALSE`), see [as.sir()]
|
||||
#' @param only_treatable a [logical] to indicate whether antimicrobial drugs should be excluded that are only for laboratory tests (defaults to `TRUE`), such as gentamicin-high (`GEH`) and imipenem/EDTA (`IPE`)
|
||||
#' @param only_sir_columns a [logical] to indicate whether only columns of class `sir` must be selected (default is `FALSE`), see [as.sir()]
|
||||
#' @param only_treatable a [logical] to indicate whether antimicrobial drugs should be excluded that are only for laboratory tests (default is `TRUE`), such as gentamicin-high (`GEH`) and imipenem/EDTA (`IPE`)
|
||||
#' @param ... ignored, only in place to allow future extensions
|
||||
#' @details
|
||||
#' These functions can be used in data set calls for selecting columns and filtering rows. They are heavily inspired by the [Tidyverse selection helpers][tidyselect::language] such as [`everything()`][tidyselect::everything()], but also work in base \R and not only in `dplyr` verbs. Nonetheless, they are very convenient to use with `dplyr` functions such as [`select()`][dplyr::select()], [`filter()`][dplyr::filter()] and [`summarise()`][dplyr::summarise()], see *Examples*.
|
||||
#' These functions can be used in data set calls for selecting columns and filtering rows. They work with base \R, the Tidyverse, and `data.table`. They are heavily inspired by the [Tidyverse selection helpers][tidyselect::language] such as [`everything()`][tidyselect::everything()], but are not limited to `dplyr` verbs. Nonetheless, they are very convenient to use with `dplyr` functions such as [`select()`][dplyr::select()], [`filter()`][dplyr::filter()] and [`summarise()`][dplyr::summarise()], see *Examples*.
|
||||
#'
|
||||
#' All columns in the data in which these functions are called will be searched for known antibiotic names, abbreviations, brand names, and codes (ATC, EARS-Net, WHO, etc.) according to the [antibiotics] data set. This means that a selector such as [aminoglycosides()] will pick up column names like 'gen', 'genta', 'J01GB03', 'tobra', 'Tobracin', etc.
|
||||
#'
|
||||
@ -54,6 +56,10 @@
|
||||
#' # See ?example_isolates.
|
||||
#' example_isolates
|
||||
#'
|
||||
#'
|
||||
#' # Examples sections below are split into 'base R', 'dplyr', and 'data.table':
|
||||
#'
|
||||
#'
|
||||
#' # base R ------------------------------------------------------------------
|
||||
#'
|
||||
#' # select columns 'IPM' (imipenem) and 'MEM' (meropenem)
|
||||
@ -76,7 +82,7 @@
|
||||
#' # filter with multiple antibiotic selectors using c()
|
||||
#' example_isolates[all(c(carbapenems(), aminoglycosides()) == "R"), ]
|
||||
#'
|
||||
#' # filter + select in one go: get penicillins in carbapenems-resistant strains
|
||||
#' # filter + select in one go: get penicillins in carbapenem-resistant strains
|
||||
#' example_isolates[any(carbapenems() == "R"), penicillins()]
|
||||
#'
|
||||
#' # You can combine selectors with '&' to be more specific. For example,
|
||||
@ -86,13 +92,19 @@
|
||||
#' # and erythromycin is not a penicillin:
|
||||
#' example_isolates[, penicillins() & administrable_per_os()]
|
||||
#'
|
||||
#' # ab_selector() applies a filter in the `antibiotics` data set and is thus very
|
||||
#' # flexible. For instance, to select antibiotic columns with an oral DDD of at
|
||||
#' # least 1 gram:
|
||||
#' # ab_selector() applies a filter in the `antibiotics` data set and is thus
|
||||
#' # very flexible. For instance, to select antibiotic columns with an oral DDD
|
||||
#' # of at least 1 gram:
|
||||
#' example_isolates[, ab_selector(oral_ddd > 1 & oral_units == "g")]
|
||||
#'
|
||||
#' # dplyr -------------------------------------------------------------------
|
||||
#' \donttest{
|
||||
#' # dplyr -------------------------------------------------------------------
|
||||
#'
|
||||
#' if (require("dplyr")) {
|
||||
#' tibble(kefzol = random_sir(5)) %>%
|
||||
#' select(cephalosporins())
|
||||
#' }
|
||||
#'
|
||||
#' if (require("dplyr")) {
|
||||
#' # get AMR for all aminoglycosides e.g., per ward:
|
||||
#' example_isolates %>%
|
||||
@ -167,12 +179,45 @@
|
||||
#' select(penicillins()) # only the 'J01CA01' column will be selected
|
||||
#' }
|
||||
#' if (require("dplyr")) {
|
||||
#' # with recent versions of dplyr this is all equal:
|
||||
#' # with recent versions of dplyr, this is all equal:
|
||||
#' x <- example_isolates[carbapenems() == "R", ]
|
||||
#' y <- example_isolates %>% filter(carbapenems() == "R")
|
||||
#' z <- example_isolates %>% filter(if_all(carbapenems(), ~ .x == "R"))
|
||||
#' identical(x, y) && identical(y, z)
|
||||
#' }
|
||||
#'
|
||||
#'
|
||||
#' # data.table --------------------------------------------------------------
|
||||
#'
|
||||
#' # data.table is supported as well, just use it in the same way as with
|
||||
#' # base R, but add `with = FALSE` if using a single AB selector.
|
||||
#'
|
||||
#' if (require("data.table")) {
|
||||
#' dt <- as.data.table(example_isolates)
|
||||
#'
|
||||
#' # this does not work, it returns column *names*
|
||||
#' dt[, carbapenems()]
|
||||
#' }
|
||||
#' if (require("data.table")) {
|
||||
#' # so `with = FALSE` is required
|
||||
#' dt[, carbapenems(), with = FALSE]
|
||||
#' }
|
||||
#'
|
||||
#' # for multiple selections or AB selectors, `with = FALSE` is not needed:
|
||||
#' if (require("data.table")) {
|
||||
#' dt[, c("mo", aminoglycosides())]
|
||||
#' }
|
||||
#' if (require("data.table")) {
|
||||
#' dt[, c(carbapenems(), aminoglycosides())]
|
||||
#' }
|
||||
#'
|
||||
#' # row filters are also supported:
|
||||
#' if (require("data.table")) {
|
||||
#' dt[any(carbapenems() == "S"), ]
|
||||
#' }
|
||||
#' if (require("data.table")) {
|
||||
#' dt[any(carbapenems() == "S"), penicillins(), with = FALSE]
|
||||
#' }
|
||||
#' }
|
||||
ab_class <- function(ab_class,
|
||||
only_sir_columns = FALSE,
|
||||
@ -181,6 +226,10 @@ ab_class <- function(ab_class,
|
||||
meet_criteria(ab_class, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec(NULL, only_sir_columns = only_sir_columns, ab_class_args = ab_class, only_treatable = only_treatable)
|
||||
}
|
||||
|
||||
@ -193,6 +242,10 @@ ab_selector <- function(filter,
|
||||
...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
|
||||
# get_current_data() has to run each time, for cases where e.g., filter() and select() are used in same call
|
||||
# but it only takes a couple of milliseconds
|
||||
@ -224,6 +277,10 @@ ab_selector <- function(filter,
|
||||
aminoglycosides <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("aminoglycosides", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
|
||||
}
|
||||
|
||||
@ -231,6 +288,10 @@ aminoglycosides <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...
|
||||
#' @export
|
||||
aminopenicillins <- function(only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("aminopenicillins", only_sir_columns = only_sir_columns)
|
||||
}
|
||||
|
||||
@ -238,6 +299,10 @@ aminopenicillins <- function(only_sir_columns = FALSE, ...) {
|
||||
#' @export
|
||||
antifungals <- function(only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("antifungals", only_sir_columns = only_sir_columns)
|
||||
}
|
||||
|
||||
@ -245,6 +310,10 @@ antifungals <- function(only_sir_columns = FALSE, ...) {
|
||||
#' @export
|
||||
antimycobacterials <- function(only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("antimycobacterials", only_sir_columns = only_sir_columns)
|
||||
}
|
||||
|
||||
@ -253,6 +322,10 @@ antimycobacterials <- function(only_sir_columns = FALSE, ...) {
|
||||
betalactams <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("betalactams", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
|
||||
}
|
||||
|
||||
@ -261,6 +334,10 @@ betalactams <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
|
||||
carbapenems <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("carbapenems", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
|
||||
}
|
||||
|
||||
@ -268,6 +345,10 @@ carbapenems <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
|
||||
#' @export
|
||||
cephalosporins <- function(only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("cephalosporins", only_sir_columns = only_sir_columns)
|
||||
}
|
||||
|
||||
@ -275,6 +356,10 @@ cephalosporins <- function(only_sir_columns = FALSE, ...) {
|
||||
#' @export
|
||||
cephalosporins_1st <- function(only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("cephalosporins_1st", only_sir_columns = only_sir_columns)
|
||||
}
|
||||
|
||||
@ -282,6 +367,10 @@ cephalosporins_1st <- function(only_sir_columns = FALSE, ...) {
|
||||
#' @export
|
||||
cephalosporins_2nd <- function(only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("cephalosporins_2nd", only_sir_columns = only_sir_columns)
|
||||
}
|
||||
|
||||
@ -289,6 +378,10 @@ cephalosporins_2nd <- function(only_sir_columns = FALSE, ...) {
|
||||
#' @export
|
||||
cephalosporins_3rd <- function(only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("cephalosporins_3rd", only_sir_columns = only_sir_columns)
|
||||
}
|
||||
|
||||
@ -296,6 +389,10 @@ cephalosporins_3rd <- function(only_sir_columns = FALSE, ...) {
|
||||
#' @export
|
||||
cephalosporins_4th <- function(only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("cephalosporins_4th", only_sir_columns = only_sir_columns)
|
||||
}
|
||||
|
||||
@ -303,6 +400,10 @@ cephalosporins_4th <- function(only_sir_columns = FALSE, ...) {
|
||||
#' @export
|
||||
cephalosporins_5th <- function(only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("cephalosporins_5th", only_sir_columns = only_sir_columns)
|
||||
}
|
||||
|
||||
@ -310,6 +411,10 @@ cephalosporins_5th <- function(only_sir_columns = FALSE, ...) {
|
||||
#' @export
|
||||
fluoroquinolones <- function(only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("fluoroquinolones", only_sir_columns = only_sir_columns)
|
||||
}
|
||||
|
||||
@ -317,6 +422,10 @@ fluoroquinolones <- function(only_sir_columns = FALSE, ...) {
|
||||
#' @export
|
||||
glycopeptides <- function(only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("glycopeptides", only_sir_columns = only_sir_columns)
|
||||
}
|
||||
|
||||
@ -324,6 +433,10 @@ glycopeptides <- function(only_sir_columns = FALSE, ...) {
|
||||
#' @export
|
||||
lincosamides <- function(only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("lincosamides", only_sir_columns = only_sir_columns)
|
||||
}
|
||||
|
||||
@ -331,6 +444,10 @@ lincosamides <- function(only_sir_columns = FALSE, ...) {
|
||||
#' @export
|
||||
lipoglycopeptides <- function(only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("lipoglycopeptides", only_sir_columns = only_sir_columns)
|
||||
}
|
||||
|
||||
@ -338,6 +455,10 @@ lipoglycopeptides <- function(only_sir_columns = FALSE, ...) {
|
||||
#' @export
|
||||
macrolides <- function(only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("macrolides", only_sir_columns = only_sir_columns)
|
||||
}
|
||||
|
||||
@ -345,6 +466,10 @@ macrolides <- function(only_sir_columns = FALSE, ...) {
|
||||
#' @export
|
||||
oxazolidinones <- function(only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("oxazolidinones", only_sir_columns = only_sir_columns)
|
||||
}
|
||||
|
||||
@ -352,6 +477,10 @@ oxazolidinones <- function(only_sir_columns = FALSE, ...) {
|
||||
#' @export
|
||||
penicillins <- function(only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("penicillins", only_sir_columns = only_sir_columns)
|
||||
}
|
||||
|
||||
@ -360,6 +489,10 @@ penicillins <- function(only_sir_columns = FALSE, ...) {
|
||||
polymyxins <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("polymyxins", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
|
||||
}
|
||||
|
||||
@ -367,6 +500,10 @@ polymyxins <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
|
||||
#' @export
|
||||
streptogramins <- function(only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("streptogramins", only_sir_columns = only_sir_columns)
|
||||
}
|
||||
|
||||
@ -374,6 +511,10 @@ streptogramins <- function(only_sir_columns = FALSE, ...) {
|
||||
#' @export
|
||||
quinolones <- function(only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("quinolones", only_sir_columns = only_sir_columns)
|
||||
}
|
||||
|
||||
@ -381,6 +522,10 @@ quinolones <- function(only_sir_columns = FALSE, ...) {
|
||||
#' @export
|
||||
tetracyclines <- function(only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("tetracyclines", only_sir_columns = only_sir_columns)
|
||||
}
|
||||
|
||||
@ -388,6 +533,10 @@ tetracyclines <- function(only_sir_columns = FALSE, ...) {
|
||||
#' @export
|
||||
trimethoprims <- function(only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("trimethoprims", only_sir_columns = only_sir_columns)
|
||||
}
|
||||
|
||||
@ -395,6 +544,10 @@ trimethoprims <- function(only_sir_columns = FALSE, ...) {
|
||||
#' @export
|
||||
ureidopenicillins <- function(only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
ab_select_exec("ureidopenicillins", only_sir_columns = only_sir_columns)
|
||||
}
|
||||
|
||||
|
4
R/age.R
4
R/age.R
@ -31,7 +31,7 @@
|
||||
#'
|
||||
#' Calculates age in years based on a reference date, which is the system date at default.
|
||||
#' @param x date(s), [character] (vectors) will be coerced with [as.POSIXlt()]
|
||||
#' @param reference reference date(s) (defaults to today), [character] (vectors) will be coerced with [as.POSIXlt()]
|
||||
#' @param reference reference date(s) (default is today), [character] (vectors) will be coerced with [as.POSIXlt()]
|
||||
#' @param exact a [logical] to indicate whether age calculation should be exact, i.e. with decimals. It divides the number of days of [year-to-date](https://en.wikipedia.org/wiki/Year-to-date) (YTD) of `x` by the number of days in the year of `reference` (either 365 or 366).
|
||||
#' @param na.rm a [logical] to indicate whether missing values should be removed
|
||||
#' @param ... arguments passed on to [as.POSIXlt()], such as `origin`
|
||||
@ -130,7 +130,7 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
|
||||
#'
|
||||
#' Split ages into age groups defined by the `split` argument. This allows for easier demographic (antimicrobial resistance) analysis.
|
||||
#' @param x age, e.g. calculated with [age()]
|
||||
#' @param split_at values to split `x` at, defaults to age groups 0-11, 12-24, 25-54, 55-74 and 75+. See *Details*.
|
||||
#' @param split_at values to split `x` at - the default is age groups 0-11, 12-24, 25-54, 55-74 and 75+. See *Details*.
|
||||
#' @param na.rm a [logical] to indicate whether missing values should be removed
|
||||
#' @details To split ages, the input for the `split_at` argument can be:
|
||||
#'
|
||||
|
120
R/antibiogram.R
120
R/antibiogram.R
@ -31,25 +31,29 @@
|
||||
#'
|
||||
#' Generate an antibiogram, and communicate the results in plots or tables. These functions follow the logic of Klinker *et al.* and Barbieri *et al.* (see *Source*), and allow reporting in e.g. R Markdown and Quarto as well.
|
||||
#' @param x a [data.frame] containing at least a column with microorganisms and columns with antibiotic results (class 'sir', see [as.sir()])
|
||||
#' @param antibiotics vector of column names, or (any combinations of) [antibiotic selectors][antibiotic_class_selectors] such as [aminoglycosides()] or [carbapenems()]. For combination antibiograms, this can also be column names separated with `"+"`, such as "TZP+TOB" given that the data set contains columns "TZP" and "TOB". See *Examples*.
|
||||
#' @param antibiotics vector of any antibiotic name or code (will be evaluated with [as.ab()], column name of `x`, or (any combinations of) [antibiotic selectors][antibiotic_class_selectors] such as [aminoglycosides()] or [carbapenems()]. For combination antibiograms, this can also be set to values separated with `"+"`, such as "TZP+TOB" or "cipro + genta", given that columns resembling such antibiotics exist in `x`. See *Examples*.
|
||||
#' @param mo_transform a character to transform microorganism input - must be "name", "shortname", "gramstain", or one of the column names of the [microorganisms] data set: `r vector_or(colnames(microorganisms), sort = FALSE, quotes = TRUE)`. Can also be `NULL` to not transform the input.
|
||||
#' @param ab_transform a character to transform antibiotic input - must be one of the column names of the [antibiotics] data set: `r vector_or(colnames(antibiotics), sort = FALSE, quotes = TRUE)`. Can also be `NULL` to not transform the input.
|
||||
#' @param syndromic_group a column name of `x`, or values calculated to split rows of `x`, e.g. by using [ifelse()] or [`case_when()`][dplyr::case_when()]. See *Examples*.
|
||||
#' @param add_total_n a [logical] to indicate whether total available numbers per pathogen should be added to the table (defaults to `TRUE`). This will add the lowest and highest number of available isolate per antibiotic (e.g, if for *E. coli* 200 isolates are available for ciprofloxacin and 150 for amoxicillin, the returned number will be "150-200").
|
||||
#' @param add_total_n a [logical] to indicate whether total available numbers per pathogen should be added to the table (default is `TRUE`). This will add the lowest and highest number of available isolate per antibiotic (e.g, if for *E. coli* 200 isolates are available for ciprofloxacin and 150 for amoxicillin, the returned number will be "150-200").
|
||||
#' @param only_all_tested (for combination antibiograms): a [logical] to indicate that isolates must be tested for all antibiotics, see *Details*
|
||||
#' @param digits number of digits to use for rounding
|
||||
#' @param col_mo column name of the names or codes of the microorganisms (see [as.mo()]), defaults to the first column of class [`mo`]. Values will be coerced using [as.mo()].
|
||||
#' @param col_mo column name of the names or codes of the microorganisms (see [as.mo()]) - the default is the first column of class [`mo`]. Values will be coerced using [as.mo()].
|
||||
#' @param language language to translate text, which defaults to the system language (see [get_AMR_locale()])
|
||||
#' @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 combine_SI a [logical] to indicate whether all susceptibility should be determined by results of either S or I, instead of only S (defaults to `TRUE`)
|
||||
#' @param combine_SI a [logical] to indicate whether all susceptibility should be determined by results of either S or I, instead of only S (default is `TRUE`)
|
||||
#' @param sep a separating character for antibiotic columns in combination antibiograms
|
||||
#' @param info a [logical] to indicate info should be printed, defaults to `TRUE` only in interactive mode
|
||||
#' @param info a [logical] to indicate info should be printed - the default is `TRUE` only in interactive mode
|
||||
#' @param object an [antibiogram()] object
|
||||
#' @param ... when used in [print()]: arguments passed on to [knitr::kable()] (otherwise, has no use)
|
||||
#' @param ... when used in [R Markdown or Quarto][knitr::kable()]: arguments passed on to [knitr::kable()] (otherwise, has no use)
|
||||
#' @details This function returns a table with values between 0 and 100 for *susceptibility*, not resistance.
|
||||
#'
|
||||
#' **Remember that you should filter your data to let it contain only first isolates!** This is needed to exclude duplicates and to reduce selection bias. Use [first_isolate()] to determine them in your data set with one of the four available algorithms.
|
||||
#'
|
||||
#' All types of antibiograms as listed below can be plotted (using [ggplot2::autoplot()] or base \R [plot()]/[barplot()]). The `antibiogram` object can also be used directly in R Markdown / Quarto (i.e., `knitr`) for reports. In this case, [knitr::kable()] will be applied automatically and microorganism names will even be printed in italics at default (see argument `italicise`). You can also use functions from specific 'table reporting' packages to transform the output of [antibiogram()] to your needs, e.g. with `flextable::as_flextable()` or `gt::gt()`.
|
||||
#'
|
||||
#' ### Antibiogram Types
|
||||
#'
|
||||
#' There are four antibiogram types, as proposed by Klinker *et al.* (2021, \doi{10.1177/20499361211011373}), and they are all supported by [antibiogram()]:
|
||||
#'
|
||||
#' 1. **Traditional Antibiogram**
|
||||
@ -103,9 +107,7 @@
|
||||
#' "Study Group", "Control Group"))
|
||||
#' ```
|
||||
#'
|
||||
#' All types of antibiograms can be generated with the functions as described on this page, and can be plotted (using [ggplot2::autoplot()] or base \R [plot()]/[barplot()]) or printed into R Markdown / Quarto formats for reports using `print()`. Use functions from specific 'table reporting' packages to transform the output of [antibiogram()] to your needs, e.g. `flextable::as_flextable()` or `gt::gt()`.
|
||||
#'
|
||||
#' 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 (defaults to `FALSE`). See this example for two antibiotics, Drug A and Drug B, about how [antibiogram()] works to calculate the %SI:
|
||||
#' 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 antibiotics, Drug A and Drug B, about how [antibiogram()] works to calculate the %SI:
|
||||
#'
|
||||
#' ```
|
||||
#' --------------------------------------------------------------------
|
||||
@ -125,6 +127,7 @@
|
||||
#' <NA> <NA> - - - -
|
||||
#' --------------------------------------------------------------------
|
||||
#' ```
|
||||
#'
|
||||
#' @source
|
||||
#' * Klinker KP *et al.* (2021). **Antimicrobial stewardship and antibiograms: importance of moving beyond traditional antibiograms**. *Therapeutic Advances in Infectious Disease*, May 5;8:20499361211011373; \doi{10.1177/20499361211011373}
|
||||
#' * Barbieri E *et al.* (2021). **Development of a Weighted-Incidence Syndromic Combination Antibiogram (WISCA) to guide the choice of the empiric antibiotic treatment for urinary tract infection in paediatric patients: a Bayesian approach** *Antimicrobial Resistance & Infection Control* May 1;10(1):74; \doi{10.1186/s13756-021-00939-2}
|
||||
@ -165,8 +168,9 @@
|
||||
#' mo_transform = "gramstain"
|
||||
#' )
|
||||
#'
|
||||
#' # names of antibiotics do not need to resemble columns exactly:
|
||||
#' antibiogram(example_isolates,
|
||||
#' antibiotics = c("TZP", "TZP+TOB"),
|
||||
#' antibiotics = c("Cipro", "cipro + genta"),
|
||||
#' mo_transform = "gramstain",
|
||||
#' ab_transform = "name",
|
||||
#' sep = " & "
|
||||
@ -209,14 +213,19 @@
|
||||
#' )
|
||||
#' )
|
||||
#'
|
||||
#'
|
||||
#' # Print the output for R Markdown / Quarto -----------------------------
|
||||
#'
|
||||
#' ureido <- antibiogram(example_isolates,
|
||||
#' antibiotics = ureidopenicillins(),
|
||||
#' ab_transform = "name")
|
||||
#' ab_transform = "name"
|
||||
#' )
|
||||
#'
|
||||
#' # in an Rmd file, you would just need print(ureido), but to be explicit:
|
||||
#' print(ureido, as_kable = TRUE, format = "markdown", italicise = TRUE)
|
||||
#' # in an Rmd file, you would just need to return `ureido` in a chunk,
|
||||
#' # but to be explicit here:
|
||||
#' if (requireNamespace("knitr")) {
|
||||
#' knitr::knit_print(ureido)
|
||||
#' }
|
||||
#'
|
||||
#'
|
||||
#' # Generate plots with ggplot2 or base R --------------------------------
|
||||
@ -240,7 +249,6 @@
|
||||
#'
|
||||
#' plot(ab1)
|
||||
#' plot(ab2)
|
||||
#'
|
||||
#' }
|
||||
antibiogram <- function(x,
|
||||
antibiotics = where(is.sir),
|
||||
@ -256,7 +264,7 @@ antibiogram <- function(x,
|
||||
combine_SI = TRUE,
|
||||
sep = " + ",
|
||||
info = interactive()) {
|
||||
meet_criteria(x, allow_class = "data.frame", contains_column_class = "sir")
|
||||
meet_criteria(x, allow_class = "data.frame", contains_column_class = c("sir", "rsi"))
|
||||
meet_criteria(mo_transform, allow_class = "character", has_length = 1, is_in = c("name", "shortname", "gramstain", colnames(AMR::microorganisms)), allow_NULL = TRUE)
|
||||
meet_criteria(ab_transform, allow_class = "character", has_length = 1, is_in = colnames(AMR::antibiotics), allow_NULL = TRUE)
|
||||
meet_criteria(syndromic_group, allow_class = "character", allow_NULL = TRUE, allow_NA = TRUE)
|
||||
@ -305,14 +313,28 @@ antibiogram <- function(x,
|
||||
|
||||
# get antibiotics
|
||||
if (tryCatch(is.character(antibiotics), error = function(e) FALSE)) {
|
||||
antibiotics.bak <- antibiotics
|
||||
# split antibiotics on separator and make it a list
|
||||
antibiotics <- strsplit(gsub(" ", "", antibiotics), "+", fixed = TRUE)
|
||||
non_existing <- unlist(antibiotics)[!unlist(antibiotics) %in% colnames(x)]
|
||||
# get available antibiotics in data set
|
||||
df_ab <- get_column_abx(x, verbose = FALSE, info = FALSE)
|
||||
# get antibiotics from user
|
||||
user_ab <- suppressMessages(suppressWarnings(lapply(antibiotics, as.ab, flag_multiple_results = FALSE, info = FALSE)))
|
||||
non_existing <- character(0)
|
||||
user_ab <- lapply(user_ab, function(x) {
|
||||
out <- unname(df_ab[match(x, names(df_ab))])
|
||||
non_existing <<- c(non_existing, x[is.na(out) & !is.na(x)])
|
||||
# remove non-existing columns
|
||||
out[!is.na(out)]
|
||||
})
|
||||
user_ab <- user_ab[unlist(lapply(user_ab, length)) > 0]
|
||||
|
||||
if (length(non_existing) > 0) {
|
||||
warning_("The following antibiotics were not available and ignored: ", vector_and(non_existing, sort = FALSE))
|
||||
antibiotics <- lapply(antibiotics, function(ab) ab[!ab %in% non_existing])
|
||||
warning_("The following antibiotics were not available and ignored: ", vector_and(ab_name(non_existing, language = NULL, tolower = TRUE), quotes = FALSE))
|
||||
}
|
||||
|
||||
# make list unique
|
||||
antibiotics <- unique(antibiotics)
|
||||
antibiotics <- unique(user_ab)
|
||||
# go through list to set AMR in combinations
|
||||
for (i in seq_len(length(antibiotics))) {
|
||||
abx <- antibiotics[[i]]
|
||||
@ -436,7 +458,7 @@ antibiogram <- function(x,
|
||||
if (i == 1) {
|
||||
new_df <- long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits)
|
||||
} else {
|
||||
new_df <- rbind2(
|
||||
new_df <- rbind_AMR(
|
||||
new_df,
|
||||
long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits)
|
||||
)
|
||||
@ -473,13 +495,21 @@ antibiogram <- function(x,
|
||||
count_group <- n_per_mo$count[match(new_df[[1]], n_per_mo$mo)]
|
||||
edit_col <- 1
|
||||
}
|
||||
if (NCOL(new_df) == edit_col + 1) {
|
||||
# only 1 antibiotic
|
||||
new_df[[edit_col]] <- paste0(new_df[[edit_col]], " (", unlist(lapply(strsplit(x = count_group, split = "-", fixed = TRUE), function(x) x[1])), ")")
|
||||
colnames(new_df)[edit_col] <- paste(colnames(new_df)[edit_col], "(N)")
|
||||
} else {
|
||||
# more than 1 antibiotic
|
||||
new_df[[edit_col]] <- paste0(new_df[[edit_col]], " (", count_group, ")")
|
||||
colnames(new_df)[edit_col] <- paste(colnames(new_df)[edit_col], "(N min-max)")
|
||||
}
|
||||
}
|
||||
|
||||
out <- as_original_data_class(new_df, class(x), extra_class = "antibiogram")
|
||||
rownames(out) <- NULL
|
||||
structure(out,
|
||||
has_syndromic_group = has_syndromic_group,
|
||||
long = long,
|
||||
combine_SI = combine_SI
|
||||
)
|
||||
@ -553,42 +583,26 @@ autoplot.antibiogram <- function(object, ...) {
|
||||
)
|
||||
}
|
||||
|
||||
#' @export
|
||||
#' @param as_kable a [logical] to indicate whether the printing should be done using [knitr::kable()] (which is the default in non-interactive sessions)
|
||||
#' @param italicise a [logical] to indicate whether the microorganism names in the output table should be made italic, using [italicise_taxonomy()]. This only works when the output format is markdown, such as in HTML output.
|
||||
#' @details Printing the antibiogram in non-interactive sessions will be done by [knitr::kable()], with support for [all their implemented formats][knitr::kable()], such as "markdown". The knitr format will be automatically determined if printed inside a knitr document (LaTeX, HTML, etc.).
|
||||
# will be exported in zzz.R
|
||||
#' @method knit_print antibiogram
|
||||
#' @param italicise a [logical] to indicate whether the microorganism names in the [knitr][knitr::kable()] table should be made italic, using [italicise_taxonomy()].
|
||||
#' @param na character to use for showing `NA` values
|
||||
#' @rdname antibiogram
|
||||
print.antibiogram <- function(x, as_kable = !interactive(), italicise = TRUE, ...) {
|
||||
meet_criteria(as_kable, allow_class = "logical", has_length = 1)
|
||||
knit_print.antibiogram <- function(x, italicise = TRUE, na = getOption("knitr.kable.NA", default = ""), ...) {
|
||||
stop_ifnot_installed("knitr")
|
||||
meet_criteria(italicise, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(na, allow_class = "character", has_length = 1, allow_NA = TRUE)
|
||||
|
||||
if (isTRUE(as_kable) &&
|
||||
# be sure not to run kable in pkgdown for our website generation
|
||||
!(missing(as_kable) && identical(Sys.getenv("IN_PKGDOWN"), "true"))) {
|
||||
out <- knitr::kable(x, ...)
|
||||
format <- attributes(out)$format
|
||||
if (!is.null(format) && format %in% c("markdown", "pipe")) {
|
||||
# try to italicise the output
|
||||
rows_with_txt <- which(out %like% "[a-z]")
|
||||
rows_without_txt <- setdiff(seq_len(length(out)), rows_with_txt)
|
||||
out[rows_with_txt] <- gsub("^[|]", "| ", out[rows_with_txt])
|
||||
# put hyphen directly after second character
|
||||
out[rows_without_txt] <- gsub("^[|](.)", "|\\1-", out[rows_without_txt])
|
||||
out_ita <- italicise_taxonomy(as.character(out), type = "markdown")
|
||||
if (length(unique(nchar(out_ita))) != 1) {
|
||||
# so there has been alterations done by italicise_taxonomy()
|
||||
to_fill <- which(nchar(out_ita) < max(nchar(out_ita)))
|
||||
out_ita[intersect(to_fill, rows_with_txt)] <- gsub("(^[|].*?)([|])(.*)", "\\1 \\2\\3", out_ita[intersect(to_fill, rows_with_txt)], perl = TRUE)
|
||||
out_ita[intersect(to_fill, rows_without_txt)] <- gsub("(^[|].*?)([|])(.*)", "\\1--\\2\\3", out_ita[intersect(to_fill, rows_without_txt)], perl = TRUE)
|
||||
if (isTRUE(italicise)) {
|
||||
# make all microorganism names italic, according to nomenclature
|
||||
names_col <- ifelse(isTRUE(attributes(x)$has_syndromic_group), 2, 1)
|
||||
x[[names_col]] <- italicise_taxonomy(x[[names_col]], type = "markdown")
|
||||
}
|
||||
attributes(out_ita) <- attributes(out)
|
||||
out <- out_ita
|
||||
}
|
||||
out
|
||||
|
||||
} else {
|
||||
# remove 'antibiogram' class and print with default method
|
||||
class(x) <- class(x)[class(x) != "antibiogram"]
|
||||
print(x, ...)
|
||||
}
|
||||
old_option <- getOption("knitr.kable.NA")
|
||||
options(knitr.kable.NA = na)
|
||||
on.exit(options(knitr.kable.NA = old_option))
|
||||
|
||||
out <- paste(c("", "", knitr::kable(x, ..., output = FALSE)), collapse = "\n")
|
||||
knitr::asis_output(out)
|
||||
}
|
||||
|
4
R/av.R
4
R/av.R
@ -32,7 +32,7 @@
|
||||
#' Use this function to determine the antiviral drug code of one or more antiviral drugs. The data set [antivirals] will be searched for abbreviations, official names and synonyms (brand names).
|
||||
#' @param x a [character] vector to determine to antiviral drug ID
|
||||
#' @param flag_multiple_results a [logical] to indicate whether a note should be printed to the console that probably more than one antiviral drug code or name can be retrieved from a single input value.
|
||||
#' @param info a [logical] to indicate whether a progress bar should be printed, defaults to `TRUE` only in interactive mode
|
||||
#' @param info a [logical] to indicate whether a progress bar should be printed - the default is `TRUE` only in interactive mode
|
||||
#' @param ... arguments passed on to internal functions
|
||||
#' @rdname as.av
|
||||
#' @inheritSection WHOCC WHOCC
|
||||
@ -461,7 +461,7 @@ as.av <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
|
||||
# save to package env to save time for next time
|
||||
if (isTRUE(initial_search)) {
|
||||
AMR_env$av_previously_coerced <- AMR_env$av_previously_coerced[which(!AMR_env$av_previously_coerced$x %in% x), , drop = FALSE]
|
||||
AMR_env$av_previously_coerced <- unique(rbind2(
|
||||
AMR_env$av_previously_coerced <- unique(rbind_AMR(
|
||||
AMR_env$av_previously_coerced,
|
||||
data.frame(
|
||||
x = x,
|
||||
|
@ -33,9 +33,9 @@
|
||||
#' @param text text to analyse
|
||||
#' @param type type of property to search for, either `"drug"`, `"dose"` or `"administration"`, see *Examples*
|
||||
#' @param collapse a [character] to pass on to `paste(, collapse = ...)` to only return one [character] per element of `text`, see *Examples*
|
||||
#' @param translate_av if `type = "drug"`: a column name of the [antivirals] data set to translate the antibiotic abbreviations to, using [av_property()]. Defaults to `FALSE`. Using `TRUE` is equal to using "name".
|
||||
#' @param translate_av if `type = "drug"`: a column name of the [antivirals] data set to translate the antibiotic abbreviations to, using [av_property()]. The default is `FALSE`. Using `TRUE` is equal to using "name".
|
||||
#' @param thorough_search a [logical] to indicate whether the input must be extensively searched for misspelling and other faulty input values. Setting this to `TRUE` will take considerably more time than when using `FALSE`. At default, it will turn `TRUE` when all input elements contain a maximum of three words.
|
||||
#' @param info a [logical] to indicate whether a progress bar should be printed, defaults to `TRUE` only in interactive mode
|
||||
#' @param info a [logical] to indicate whether a progress bar should be printed - the default is `TRUE` only in interactive mode
|
||||
#' @param ... arguments passed on to [as.av()]
|
||||
#' @details This function is also internally used by [as.av()], although it then only searches for the first drug name and will throw a note if more drug names could have been returned. Note: the [as.av()] function may use very long regular expression to match brand names of antiviral drugs. This may fail on some systems.
|
||||
#'
|
||||
|
@ -33,7 +33,7 @@
|
||||
#' @param x any (vector of) text that can be coerced to a valid antiviral drug code with [as.av()]
|
||||
#' @param tolower a [logical] to indicate whether the first [character] of every output should be transformed to a lower case [character].
|
||||
#' @param property one of the column names of one of the [antivirals] data set: `vector_or(colnames(antivirals), sort = FALSE)`.
|
||||
#' @param language language of the returned text, defaults to system language (see [get_AMR_locale()]) and can also be set with the option [`AMR_locale`][AMR-options]. Use `language = NULL` or `language = ""` to prevent translation.
|
||||
#' @param language language of the returned text - the default is system language (see [get_AMR_locale()]) and can also be set with the [package option][AMR-options] [`AMR_locale`][AMR-options]. Use `language = NULL` or `language = ""` to prevent translation.
|
||||
#' @param administration way of administration, either `"oral"` or `"iv"`
|
||||
#' @param open browse the URL using [utils::browseURL()]
|
||||
#' @param ... other arguments passed on to [as.av()]
|
||||
|
@ -31,7 +31,7 @@
|
||||
#'
|
||||
#' Easy check for data availability of all columns in a data set. This makes it easy to get an idea of which antimicrobial combinations can be used for calculation with e.g. [susceptibility()] and [resistance()].
|
||||
#' @param tbl a [data.frame] or [list]
|
||||
#' @param width number of characters to present the visual availability, defaults to filling the width of the console
|
||||
#' @param width number of characters to present the visual availability - the default is filling the width of the console
|
||||
#' @details The function returns a [data.frame] with columns `"resistant"` and `"visual_resistance"`. The values in that columns are calculated with [resistance()].
|
||||
#' @return [data.frame] with column names of `tbl` as row names
|
||||
#' @export
|
||||
|
@ -31,15 +31,15 @@
|
||||
#'
|
||||
#' Determine antimicrobial resistance (AMR) of all bug-drug combinations in your data set where at least 30 (default) isolates are available per species. Use [format()] on the result to prettify it to a publishable/printable format, see *Examples*.
|
||||
#' @inheritParams eucast_rules
|
||||
#' @param combine_SI a [logical] to indicate whether values S and I should be summed, so resistance will be based on only R, defaults to `TRUE`
|
||||
#' @param combine_SI a [logical] to indicate whether values S and I should be summed, so resistance will be based on only R - the default is `TRUE`
|
||||
#' @param add_ab_group a [logical] to indicate where the group of the antimicrobials must be included as a first column
|
||||
#' @param remove_intrinsic_resistant [logical] to indicate that rows and columns with 100% resistance for all tested antimicrobials must be removed from the table
|
||||
#' @param FUN the function to call on the `mo` column to transform the microorganism codes, defaults to [mo_shortname()]
|
||||
#' @param FUN the function to call on the `mo` column to transform the microorganism codes - the default is [mo_shortname()]
|
||||
#' @param translate_ab a [character] of length 1 containing column names of the [antibiotics] data set
|
||||
#' @param ... arguments passed on to `FUN`
|
||||
#' @inheritParams sir_df
|
||||
#' @inheritParams base::formatC
|
||||
#' @details The function [format()] calculates the resistance per bug-drug combination. Use `combine_SI = TRUE` (default) to test R vs. S+I and `combine_SI = FALSE` to test R+I vs. S.
|
||||
#' @details The function [format()] calculates the resistance per bug-drug combination and returns a table ready for reporting/publishing. Use `combine_SI = TRUE` (default) to test R vs. S+I and `combine_SI = FALSE` to test R+I vs. S. This table can also directly be used in R Markdown / Quarto without the need for e.g. [knitr::kable()].
|
||||
#' @export
|
||||
#' @rdname bug_drug_combinations
|
||||
#' @return The function [bug_drug_combinations()] returns a [data.frame] with columns "mo", "ab", "S", "I", "R" and "total".
|
||||
@ -71,7 +71,7 @@ bug_drug_combinations <- function(x,
|
||||
col_mo = NULL,
|
||||
FUN = mo_shortname,
|
||||
...) {
|
||||
meet_criteria(x, allow_class = "data.frame", contains_column_class = "sir")
|
||||
meet_criteria(x, allow_class = "data.frame", contains_column_class = c("sir", "rsi"))
|
||||
meet_criteria(col_mo, allow_class = "character", is_in = colnames(x), has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(FUN, allow_class = "function", has_length = 1)
|
||||
|
||||
@ -124,7 +124,7 @@ bug_drug_combinations <- function(x,
|
||||
m <- as.matrix(table(x))
|
||||
data.frame(S = m["S", ], I = m["I", ], R = m["R", ], stringsAsFactors = FALSE)
|
||||
})
|
||||
merged <- do.call(rbind2, pivot)
|
||||
merged <- do.call(rbind_AMR, pivot)
|
||||
out_group <- data.frame(
|
||||
mo = rep(unique_mo[i], NROW(merged)),
|
||||
ab = rownames(merged),
|
||||
@ -144,14 +144,14 @@ bug_drug_combinations <- function(x,
|
||||
}
|
||||
out_group <- cbind(group_values, out_group)
|
||||
}
|
||||
out <- rbind2(out, out_group)
|
||||
out <- rbind_AMR(out, out_group)
|
||||
}
|
||||
out
|
||||
}
|
||||
# based on pm_apply_grouped_function
|
||||
apply_group <- function(.data, fn, groups, drop = FALSE, ...) {
|
||||
grouped <- pm_split_into_groups(.data, groups, drop)
|
||||
res <- do.call(rbind2, unname(lapply(grouped, fn, ...)))
|
||||
res <- do.call(rbind_AMR, unname(lapply(grouped, fn, ...)))
|
||||
if (any(groups %in% colnames(res))) {
|
||||
class(res) <- c("grouped_data", class(res))
|
||||
res <- pm_set_groups(res, groups[groups %in% colnames(res)])
|
||||
@ -327,7 +327,15 @@ format.bug_drug_combinations <- function(x,
|
||||
}
|
||||
|
||||
rownames(y) <- NULL
|
||||
as_original_data_class(y, class(x.bak)) # will remove tibble groups
|
||||
as_original_data_class(y, class(x.bak), extra_class = "formatted_bug_drug_combinations") # will remove tibble groups
|
||||
}
|
||||
|
||||
# will be exported in zzz.R
|
||||
knit_print.formatted_bug_drug_combinations <- function(x, ...) {
|
||||
stop_ifnot_installed("knitr")
|
||||
# make columns with MO names italic according to nomenclature
|
||||
colnames(x)[3:NCOL(x)] <- italicise_taxonomy(colnames(x)[3:NCOL(x)], type = "markdown")
|
||||
knitr::asis_output(paste("", "", knitr::kable(x, ...), collapse = "\n"))
|
||||
}
|
||||
|
||||
#' @method print bug_drug_combinations
|
||||
|
@ -33,13 +33,13 @@
|
||||
#' @param x a [data.frame] resembling the [antibiotics] data set, at least containing columns "ab" and "name"
|
||||
#' @details **Important:** Due to how \R works, the [add_custom_antimicrobials()] function has to be run in every \R session - added antimicrobials are not stored between sessions and are thus lost when \R is exited.
|
||||
#'
|
||||
#' There are two ways to automate this process:
|
||||
#' There are two ways to circumvent this and automate the process of adding antimicrobials:
|
||||
#'
|
||||
#' **Method 1:** Using the option [`AMR_custom_ab`][AMR-options], which is the preferred method. To use this method:
|
||||
#' **Method 1:** Using the [package option][AMR-options] [`AMR_custom_ab`][AMR-options], which is the preferred method. To use this method:
|
||||
#'
|
||||
#' 1. Create a data set in the structure of the [antibiotics] data set (containing at the very least columns "ab" and "name") and save it with [saveRDS()] to a location of choice, e.g. `"~/my_custom_ab.rds"`, or any remote location.
|
||||
#'
|
||||
#' 2. Set the file location to the option [`AMR_custom_ab`][AMR-options]: `options(AMR_custom_ab = "~/my_custom_ab.rds")`. This can even be a remote file location, such as an https URL. Since options are not saved between \R sessions, it is best to save this option to the `.Rprofile` file so that it will be loaded on start-up of \R. To do this, open the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`, add this text and save the file:
|
||||
#' 2. Set the file location to the [package option][AMR-options] [`AMR_custom_ab`][AMR-options]: `options(AMR_custom_ab = "~/my_custom_ab.rds")`. This can even be a remote file location, such as an https URL. Since options are not saved between \R sessions, it is best to save this option to the `.Rprofile` file so that it will be loaded on start-up of \R. To do this, open the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`, add this text and save the file:
|
||||
#'
|
||||
#' ```r
|
||||
#' # Add custom antimicrobial codes:
|
||||
@ -48,7 +48,7 @@
|
||||
#'
|
||||
#' Upon package load, this file will be loaded and run through the [add_custom_antimicrobials()] function.
|
||||
#'
|
||||
#' **Method 2:** Loading the antimicrobial additions directly from your `.Rprofile` file. An important downside is that this requires the `AMR` package to be installed or else this method will fail. To use this method:
|
||||
#' **Method 2:** Loading the antimicrobial additions directly from your `.Rprofile` file. Note that the definitions will be stored in a user-specific \R file, which is a suboptimal workflow. To use this method:
|
||||
#'
|
||||
#' 1. Edit the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`.
|
||||
#'
|
||||
@ -153,7 +153,7 @@ add_custom_antimicrobials <- function(x) {
|
||||
# assign new values
|
||||
new_df[, col] <- x[, col, drop = TRUE]
|
||||
}
|
||||
AMR_env$AB_lookup <- unique(rbind2(AMR_env$AB_lookup, new_df))
|
||||
AMR_env$AB_lookup <- unique(rbind_AMR(AMR_env$AB_lookup, new_df))
|
||||
|
||||
AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(!AMR_env$ab_previously_coerced$ab %in% x$ab), , drop = FALSE]
|
||||
class(AMR_env$AB_lookup$ab) <- c("ab", "character")
|
||||
|
@ -35,13 +35,13 @@
|
||||
#'
|
||||
#' **Important:** Due to how \R works, the [add_custom_microorganisms()] function has to be run in every \R session - added microorganisms are not stored between sessions and are thus lost when \R is exited.
|
||||
#'
|
||||
#' There are two ways to automate this process:
|
||||
#' There are two ways to circumvent this and automate the process of adding microorganisms:
|
||||
#'
|
||||
#' **Method 1:** Using the option [`AMR_custom_mo`][AMR-options], which is the preferred method. To use this method:
|
||||
#' **Method 1:** Using the [package option][AMR-options] [`AMR_custom_mo`][AMR-options], which is the preferred method. To use this method:
|
||||
#'
|
||||
#' 1. Create a data set in the structure of the [microorganisms] data set (containing at the very least column "genus") and save it with [saveRDS()] to a location of choice, e.g. `"~/my_custom_mo.rds"`, or any remote location.
|
||||
#'
|
||||
#' 2. Set the file location to the option [`AMR_custom_mo`][AMR-options]: `options(AMR_custom_mo = "~/my_custom_mo.rds")`. This can even be a remote file location, such as an https URL. Since options are not saved between \R sessions, it is best to save this option to the `.Rprofile` file so that it will be loaded on start-up of \R. To do this, open the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`, add this text and save the file:
|
||||
#' 2. Set the file location to the [package option][AMR-options] [`AMR_custom_mo`][AMR-options]: `options(AMR_custom_mo = "~/my_custom_mo.rds")`. This can even be a remote file location, such as an https URL. Since options are not saved between \R sessions, it is best to save this option to the `.Rprofile` file so that it will be loaded on start-up of \R. To do this, open the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`, add this text and save the file:
|
||||
#'
|
||||
#' ```r
|
||||
#' # Add custom microorganism codes:
|
||||
@ -50,7 +50,7 @@
|
||||
#'
|
||||
#' Upon package load, this file will be loaded and run through the [add_custom_microorganisms()] function.
|
||||
#'
|
||||
#' **Method 2:** Loading the microorganism directly from your `.Rprofile` file. An important downside is that this requires the `AMR` package to be installed or else this method will fail. To use this method:
|
||||
#' **Method 2:** Loading the microorganism directly from your `.Rprofile` file. Note that the definitions will be stored in a user-specific \R file, which is a suboptimal workflow. To use this method:
|
||||
#'
|
||||
#' 1. Edit the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`.
|
||||
#'
|
||||
@ -64,7 +64,7 @@
|
||||
#' )
|
||||
#' ```
|
||||
#'
|
||||
#' Use [clear_custom_microorganisms()] to clear the previously added antimicrobials.
|
||||
#' Use [clear_custom_microorganisms()] to clear the previously added microorganisms.
|
||||
#' @seealso [add_custom_antimicrobials()] to add custom antimicrobials.
|
||||
#' @rdname add_custom_microorganisms
|
||||
#' @export
|
||||
@ -279,7 +279,7 @@ add_custom_microorganisms <- function(x) {
|
||||
# clear previous coercions
|
||||
suppressMessages(mo_reset_session())
|
||||
|
||||
AMR_env$MO_lookup <- unique(rbind2(AMR_env$MO_lookup, new_df))
|
||||
AMR_env$MO_lookup <- unique(rbind_AMR(AMR_env$MO_lookup, new_df))
|
||||
class(AMR_env$MO_lookup$mo) <- c("mo", "character")
|
||||
if (nrow(x) <= 3) {
|
||||
message_("Added ", vector_and(italicise(x$fullname), quotes = FALSE), " to the internal `microorganisms` data set.")
|
||||
@ -297,6 +297,9 @@ clear_custom_microorganisms <- function() {
|
||||
AMR_env$MO_lookup <- NULL
|
||||
add_MO_lookup_to_AMR_env()
|
||||
|
||||
# clear previous coercions
|
||||
suppressMessages(mo_reset_session())
|
||||
|
||||
n2 <- nrow(AMR_env$MO_lookup)
|
||||
AMR_env$custom_mo_codes <- character(0)
|
||||
AMR_env$mo_previously_coerced <- AMR_env$mo_previously_coerced[which(AMR_env$mo_previously_coerced$mo %in% AMR_env$MO_lookup$mo), , drop = FALSE]
|
||||
|
2
R/data.R
2
R/data.R
@ -197,7 +197,7 @@
|
||||
|
||||
#' Data Set with `r format(nrow(WHONET), big.mark = " ")` Isolates - WHONET Example
|
||||
#'
|
||||
#' This example data set has the exact same structure as an export file from WHONET. Such files can be used with this package, as this example data set shows. The antibiotic results are from our [example_isolates] data set. All patient names are created using online surname generators and are only in place for practice purposes.
|
||||
#' This example data set has the exact same structure as an export file from WHONET. Such files can be used with this package, as this example data set shows. The antibiotic results are from our [example_isolates] data set. All patient names were created using online surname generators and are only in place for practice purposes.
|
||||
#' @format A [tibble][tibble::tibble] with `r format(nrow(WHONET), big.mark = " ")` observations and `r ncol(WHONET)` variables:
|
||||
#' - `Identification number`\cr ID of the sample
|
||||
#' - `Specimen number`\cr ID of the specimen
|
||||
|
@ -60,16 +60,16 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
|
||||
#'
|
||||
#' To improve the interpretation of the antibiogram before EUCAST rules are applied, some non-EUCAST rules can applied at default, see *Details*.
|
||||
#' @param x a data set with antibiotic columns, such as `amox`, `AMX` and `AMC`
|
||||
#' @param info a [logical] to indicate whether progress should be printed to the console, defaults to only print while in interactive sessions
|
||||
#' @param rules a [character] vector that specifies which rules should be applied. Must be one or more of `"breakpoints"`, `"expert"`, `"other"`, `"custom"`, `"all"`, and defaults to `c("breakpoints", "expert")`. The default value can be set to another value using the option [`AMR_eucastrules`][AMR-options]: `options(AMR_eucastrules = "all")`. If using `"custom"`, be sure to fill in argument `custom_rules` too. Custom rules can be created with [custom_eucast_rules()].
|
||||
#' @param info a [logical] to indicate whether progress should be printed to the console - the default is only print while in interactive sessions
|
||||
#' @param rules a [character] vector that specifies which rules should be applied. Must be one or more of `"breakpoints"`, `"expert"`, `"other"`, `"custom"`, `"all"`, and defaults to `c("breakpoints", "expert")`. The default value can be set to another value using the [package option][AMR-options] [`AMR_eucastrules`][AMR-options]: `options(AMR_eucastrules = "all")`. If using `"custom"`, be sure to fill in argument `custom_rules` too. Custom rules can be created with [custom_eucast_rules()].
|
||||
#' @param verbose a [logical] to turn Verbose mode on and off (default is off). In Verbose mode, the function does not apply rules to the data, but instead returns a data set in logbook form with extensive info about which rows and columns would be effected and in which way. Using Verbose mode takes a lot more time.
|
||||
#' @param version_breakpoints the version number to use for the EUCAST Clinical Breakpoints guideline. Can be either `r vector_or(names(EUCAST_VERSION_BREAKPOINTS), reverse = TRUE)`.
|
||||
#' @param version_expertrules the version number to use for the EUCAST Expert Rules and Intrinsic Resistance guideline. Can be either `r vector_or(names(EUCAST_VERSION_EXPERT_RULES), reverse = TRUE)`.
|
||||
#' @param ampc_cephalosporin_resistance a [character] value that should be applied to cefotaxime, ceftriaxone and ceftazidime for AmpC de-repressed cephalosporin-resistant mutants, defaults to `NA`. Currently only works when `version_expertrules` is `3.2` and higher; these version of '*EUCAST Expert Rules on Enterobacterales*' state that results of cefotaxime, ceftriaxone and ceftazidime should be reported with a note, or results should be suppressed (emptied) for these three drugs. A value of `NA` (the default) for this argument will remove results for these three drugs, while e.g. a value of `"R"` will make the results for these drugs resistant. Use `NULL` or `FALSE` to not alter results for these three drugs of AmpC de-repressed cephalosporin-resistant mutants. Using `TRUE` is equal to using `"R"`. \cr For *EUCAST Expert Rules* v3.2, this rule applies to: `r vector_and(gsub("[^a-zA-Z ]+", "", unlist(strsplit(EUCAST_RULES_DF[which(EUCAST_RULES_DF$reference.version %in% c(3.2, 3.3) & EUCAST_RULES_DF$reference.rule %like% "ampc"), "this_value"][1], "|", fixed = TRUE))), quotes = "*")`.
|
||||
#' @param ampc_cephalosporin_resistance a [character] value that should be applied to cefotaxime, ceftriaxone and ceftazidime for AmpC de-repressed cephalosporin-resistant mutants - the default is `NA`. Currently only works when `version_expertrules` is `3.2` and higher; these version of '*EUCAST Expert Rules on Enterobacterales*' state that results of cefotaxime, ceftriaxone and ceftazidime should be reported with a note, or results should be suppressed (emptied) for these three drugs. A value of `NA` (the default) for this argument will remove results for these three drugs, while e.g. a value of `"R"` will make the results for these drugs resistant. Use `NULL` or `FALSE` to not alter results for these three drugs of AmpC de-repressed cephalosporin-resistant mutants. Using `TRUE` is equal to using `"R"`. \cr For *EUCAST Expert Rules* v3.2, this rule applies to: `r vector_and(gsub("[^a-zA-Z ]+", "", unlist(strsplit(EUCAST_RULES_DF[which(EUCAST_RULES_DF$reference.version %in% c(3.2, 3.3) & EUCAST_RULES_DF$reference.rule %like% "ampc"), "this_value"][1], "|", fixed = TRUE))), quotes = "*")`.
|
||||
#' @param ... column name of an antibiotic, see section *Antibiotics* below
|
||||
#' @param ab any (vector of) text that can be coerced to a valid antibiotic drug code with [as.ab()]
|
||||
#' @param administration route of administration, either `r vector_or(dosage$administration)`
|
||||
#' @param only_sir_columns a [logical] to indicate whether only antibiotic columns must be detected that were transformed to class `sir` (see [as.sir()]) on beforehand (defaults to `FALSE`)
|
||||
#' @param only_sir_columns a [logical] to indicate whether only antibiotic columns must be detected that were transformed to class `sir` (see [as.sir()]) on beforehand (default is `FALSE`)
|
||||
#' @param custom_rules custom rules to apply, created with [custom_eucast_rules()]
|
||||
#' @inheritParams first_isolate
|
||||
#' @details
|
||||
@ -98,7 +98,7 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
|
||||
#'
|
||||
#' Important examples include amoxicillin and amoxicillin/clavulanic acid, and trimethoprim and trimethoprim/sulfamethoxazole. Needless to say, for these rules to work, both drugs must be available in the data set.
|
||||
#'
|
||||
#' Since these rules are not officially approved by EUCAST, they are not applied at default. To use these rules, include `"other"` to the `rules` argument, or use `eucast_rules(..., rules = "all")`. You can also set the option [`AMR_eucastrules`][AMR-options], i.e. run `options(AMR_eucastrules = "all")`.
|
||||
#' Since these rules are not officially approved by EUCAST, they are not applied at default. To use these rules, include `"other"` to the `rules` argument, or use `eucast_rules(..., rules = "all")`. You can also set the [package option][AMR-options] [`AMR_eucastrules`][AMR-options], i.e. run `options(AMR_eucastrules = "all")`.
|
||||
#' @section Antibiotics:
|
||||
#' To define antibiotics column names, leave as it is to determine it automatically with [guess_ab_col()] or input a text (case-insensitive), or use `NULL` to skip a column (e.g. `TIC = NULL` to skip ticarcillin). Manually defined but non-existing columns will be skipped with a warning.
|
||||
#'
|
||||
@ -181,6 +181,7 @@ eucast_rules <- function(x,
|
||||
meet_criteria(ampc_cephalosporin_resistance, allow_class = c("logical", "character", "sir"), has_length = 1, allow_NA = TRUE, allow_NULL = TRUE)
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(custom_rules, allow_class = "custom_eucast_rules", allow_NULL = TRUE)
|
||||
if ("only_rsi_columns" %in% names(list(...))) only_sir_columns <- list(...)$only_rsi_columns
|
||||
|
||||
add_MO_lookup_to_AMR_env()
|
||||
|
||||
@ -475,7 +476,7 @@ eucast_rules <- function(x,
|
||||
amox$base_ab <- "AMX"
|
||||
amox$base_name <- ab_name("AMX", language = NULL)
|
||||
# merge and sort
|
||||
ab_enzyme <- rbind2(ab_enzyme, ampi, amox)
|
||||
ab_enzyme <- rbind_AMR(ab_enzyme, ampi, amox)
|
||||
ab_enzyme <- ab_enzyme[order(ab_enzyme$enzyme_name), , drop = FALSE]
|
||||
|
||||
for (i in seq_len(nrow(ab_enzyme))) {
|
||||
@ -1161,7 +1162,7 @@ edit_sir <- function(x,
|
||||
)
|
||||
verbose_new <- verbose_new %pm>% pm_filter(old != new | is.na(old) | is.na(new) & !is.na(old))
|
||||
# save changes to data set 'verbose_info'
|
||||
track_changes$verbose_info <- rbind2(
|
||||
track_changes$verbose_info <- rbind_AMR(
|
||||
track_changes$verbose_info,
|
||||
verbose_new
|
||||
)
|
||||
@ -1215,11 +1216,11 @@ eucast_dosage <- function(ab, administration = "iv", version_breakpoints = 12.0)
|
||||
)
|
||||
)
|
||||
}
|
||||
out <- do.call(rbind2, lapply(lst, as.data.frame, stringsAsFactors = FALSE))
|
||||
out <- do.call(rbind_AMR, lapply(lst, as.data.frame, stringsAsFactors = FALSE))
|
||||
rownames(out) <- NULL
|
||||
out$ab <- ab
|
||||
out$name <- ab_name(ab, language = NULL)
|
||||
if (pkg_is_available("tibble", also_load = FALSE)) {
|
||||
if (pkg_is_available("tibble")) {
|
||||
import_fn("as_tibble", "tibble")(out)
|
||||
} else {
|
||||
out
|
||||
|
@ -31,13 +31,13 @@
|
||||
#'
|
||||
#' Determine first isolates of all microorganisms of every patient per episode and (if needed) per specimen type. These functions support all four methods as summarised by Hindler *et al.* in 2007 (\doi{10.1086/511864}). To determine patient episodes not necessarily based on microorganisms, use [is_new_episode()] that also supports grouping with the `dplyr` package.
|
||||
#' @param x a [data.frame] containing isolates. Can be left blank for automatic determination, see *Examples*.
|
||||
#' @param col_date column name of the result date (or date that is was received on the lab), defaults to the first column with a date class
|
||||
#' @param col_patient_id column name of the unique IDs of the patients, defaults to the first column that starts with 'patient' or 'patid' (case insensitive)
|
||||
#' @param col_mo column name of the names or codes of the microorganisms (see [as.mo()]), defaults to the first column of class [`mo`]. Values will be coerced using [as.mo()].
|
||||
#' @param col_date column name of the result date (or date that is was received on the lab) - the default is the first column with a date class
|
||||
#' @param col_patient_id column name of the unique IDs of the patients - the default is the first column that starts with 'patient' or 'patid' (case insensitive)
|
||||
#' @param col_mo column name of the names or codes of the microorganisms (see [as.mo()]) - the default is the first column of class [`mo`]. Values will be coerced using [as.mo()].
|
||||
#' @param col_testcode column name of the test codes. Use `col_testcode = NULL` to **not** exclude certain test codes (such as test codes for screening). In that case `testcodes_exclude` will be ignored.
|
||||
#' @param col_specimen column name of the specimen type or group
|
||||
#' @param col_icu column name of the logicals (`TRUE`/`FALSE`) whether a ward or department is an Intensive Care Unit (ICU). This can also be a [logical] vector with the same length as rows in `x`.
|
||||
#' @param col_keyantimicrobials (only useful when `method = "phenotype-based"`) column name of the key antimicrobials to determine first isolates, see [key_antimicrobials()]. Defaults to the first column that starts with 'key' followed by 'ab' or 'antibiotics' or 'antimicrobials' (case insensitive). Use `col_keyantimicrobials = FALSE` to prevent this. Can also be the output of [key_antimicrobials()].
|
||||
#' @param col_keyantimicrobials (only useful when `method = "phenotype-based"`) column name of the key antimicrobials to determine first isolates, see [key_antimicrobials()]. The default is the first column that starts with 'key' followed by 'ab' or 'antibiotics' or 'antimicrobials' (case insensitive). Use `col_keyantimicrobials = FALSE` to prevent this. Can also be the output of [key_antimicrobials()].
|
||||
#' @param episode_days episode in days after which a genus/species combination will be determined as 'first isolate' again. The default of 365 days is based on the guideline by CLSI, see *Source*.
|
||||
#' @param testcodes_exclude a [character] vector with test codes that should be excluded (case-insensitive)
|
||||
#' @param icu_exclude a [logical] to indicate whether ICU isolates should be excluded (rows with value `TRUE` in the column set with `col_icu`)
|
||||
@ -46,7 +46,7 @@
|
||||
#' @param method the method to apply, either `"phenotype-based"`, `"episode-based"`, `"patient-based"` or `"isolate-based"` (can be abbreviated), see *Details*. The default is `"phenotype-based"` if antimicrobial test results are present in the data, and `"episode-based"` otherwise.
|
||||
#' @param ignore_I [logical] to indicate whether antibiotic interpretations with `"I"` will be ignored when `type = "keyantimicrobials"`, see *Details*
|
||||
#' @param points_threshold minimum number of points to require before differences in the antibiogram will lead to inclusion of an isolate when `type = "points"`, see *Details*
|
||||
#' @param info a [logical] to indicate info should be printed, defaults to `TRUE` only in interactive mode
|
||||
#' @param info a [logical] to indicate info should be printed - the default is `TRUE` only in interactive mode
|
||||
#' @param include_unknown a [logical] to indicate whether 'unknown' microorganisms should be included too, i.e. microbial code `"UNKNOWN"`, which defaults to `FALSE`. For WHONET users, this means that all records with organism code `"con"` (*contamination*) will be excluded at default. Isolates with a microbial ID of `NA` will always be excluded as first isolate.
|
||||
#' @param include_untested_sir a [logical] to indicate whether also rows without antibiotic results are still eligible for becoming a first isolate. Use `include_untested_sir = FALSE` to always return `FALSE` for such rows. This checks the data set for columns of class `sir` and consequently requires transforming columns with antibiotic results using [as.sir()] first.
|
||||
#' @param ... arguments passed on to [first_isolate()] when using [filter_first_isolate()], otherwise arguments passed on to [key_antimicrobials()] (such as `universal`, `gram_negative`, `gram_positive`)
|
||||
@ -226,6 +226,10 @@ first_isolate <- function(x = NULL,
|
||||
meet_criteria(points_threshold, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(include_unknown, allow_class = "logical", has_length = 1)
|
||||
if ("include_untested_rsi" %in% names(list(...))) {
|
||||
deprecation_warning("include_untested_rsi", "include_untested_sir", is_function = FALSE)
|
||||
include_untested_sir <- list(...)$include_untested_rsi
|
||||
}
|
||||
meet_criteria(include_untested_sir, allow_class = "logical", has_length = 1)
|
||||
|
||||
# remove data.table, grouping from tibbles, etc.
|
||||
@ -346,7 +350,7 @@ first_isolate <- function(x = NULL,
|
||||
x$newvar_mo <- as.mo(x[, col_mo, drop = TRUE])
|
||||
x$newvar_genus_species <- paste(mo_genus(x$newvar_mo), mo_species(x$newvar_mo))
|
||||
x$newvar_date <- x[, col_date, drop = TRUE]
|
||||
x$newvar_patient_id <- x[, col_patient_id, drop = TRUE]
|
||||
x$newvar_patient_id <- as.character(x[, col_patient_id, drop = TRUE])
|
||||
|
||||
if (is.null(col_testcode)) {
|
||||
testcodes_exclude <- NULL
|
||||
@ -374,7 +378,7 @@ first_isolate <- function(x = NULL,
|
||||
}
|
||||
}
|
||||
if (!is.null(col_keyantimicrobials)) {
|
||||
x$newvar_key_ab <- x[, col_keyantimicrobials, drop = TRUE]
|
||||
x$newvar_key_ab <- as.character(x[, col_keyantimicrobials, drop = TRUE])
|
||||
}
|
||||
|
||||
if (is.null(testcodes_exclude)) {
|
||||
|
118
R/get_episode.R
118
R/get_episode.R
@ -27,16 +27,55 @@
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Determine (Clinical) Episodes
|
||||
#' Determine Clinical or Epidemic Episodes
|
||||
#'
|
||||
#' These functions determine which items in a vector can be considered (the start of) a new episode, based on the argument `episode_days`. This can be used to determine clinical episodes for any epidemiological analysis. The [get_episode()] function returns the index number of the episode per group, while the [is_new_episode()] function returns `TRUE` for every new [get_episode()] index, and is thus equal to `!duplicated(get_episode(...))`.
|
||||
#' These functions determine which items in a vector can be considered (the start of) a new episode. This can be used to determine clinical episodes for any epidemiological analysis. The [get_episode()] function returns the index number of the episode per group, while the [is_new_episode()] function returns `TRUE` for every new [get_episode()] index. Both absolute and relative episode determination are supported.
|
||||
#' @param x vector of dates (class `Date` or `POSIXt`), will be sorted internally to determine episodes
|
||||
#' @param episode_days required episode length in days, can also be less than a day or `Inf`, see *Details*
|
||||
#' @param episode_days episode length in days to specify the time period after which a new episode begins, can also be less than a day or `Inf`, see *Details*
|
||||
#' @param case_free_days (inter-epidemic) interval length in days after which a new episode will start, can also be less than a day or `Inf`, see *Details*
|
||||
#' @param ... ignored, only in place to allow future extensions
|
||||
#' @details The functions [get_episode()] and [is_new_episode()] differ in this way when setting `episode_days` to 365:
|
||||
#' @details Episodes can be determined in two ways: absolute and relative.
|
||||
#'
|
||||
#' 1. Absolute
|
||||
#'
|
||||
#' | person_id | date | `get_episode()` | `is_new_episode()` |
|
||||
#' This method uses `episode_days` to define an episode length in days, after which a new episode will start. A common use case in AMR data analysis is microbial epidemiology: episodes of *S. aureus* bacteraemia in ICU patients for example. The episode length could then be 30 days, so that new *S. aureus* isolates after an ICU episode of 30 days will be considered a different (or new) episode.
|
||||
#'
|
||||
#' Thus, this method counts **since the start of the previous episode**.
|
||||
#'
|
||||
#' 2. Relative
|
||||
#'
|
||||
#' This method uses `case_free_days` to quantify the duration of case-free days (the inter-epidemic interval), after which a new episode will start. A common use case is infectious disease epidemiology: episodes of norovirus outbreaks in a hospital for example. The case-free period could then be 14 days, so that new norovirus cases after that time will be considered a different (or new) episode.
|
||||
#'
|
||||
#' Thus, this methods counts **since the last case in the previous episode**.
|
||||
#'
|
||||
#' In a table:
|
||||
#'
|
||||
#' | Date | Using `episode_days = 7` | Using `case_free_days = 7` |
|
||||
#' |:----------:|:------------------------:|:--------------------------:|
|
||||
#' | 2023-01-01 | 1 | 1 |
|
||||
#' | 2023-01-02 | 1 | 1 |
|
||||
#' | 2023-01-05 | 1 | 1 |
|
||||
#' | 2023-01-08 | 2** | 1 |
|
||||
#' | 2023-02-21 | 3 | 2*** |
|
||||
#' | 2023-02-22 | 3 | 2 |
|
||||
#' | 2023-02-23 | 3 | 2 |
|
||||
#' | 2023-02-24 | 3 | 2 |
|
||||
#' | 2023-03-01 | 4 | 2 |
|
||||
#'
|
||||
#' ** This marks the start of a new episode, because 8 January 2023 is more than 7 days since the start of the previous episode (1 January 2023). \cr
|
||||
#' *** This marks the start of a new episode, because 21 January 2023 is more than 7 days since the last case in the previous episode (8 January 2023).
|
||||
#'
|
||||
#' Either `episode_days` or `case_free_days` must be provided in the function.
|
||||
#'
|
||||
#' ### Difference between `get_episode()` and `is_new_episode()`
|
||||
#'
|
||||
#' The [get_episode()] function returns the index number of the episode, so all cases/patients/isolates in the first episode will have the number 1, all cases/patients/isolates in the second episode will have the number 2, etc.
|
||||
#'
|
||||
#' The [is_new_episode()] function on the other hand, returns `TRUE` for every new [get_episode()] index.
|
||||
#'
|
||||
#' To specify, when setting `episode_days = 365` (using method 1 as explained above), this is how the two functions differ:
|
||||
#'
|
||||
#' | patient | date | `get_episode()` | `is_new_episode()` |
|
||||
#' |:---------:|:----------:|:---------------:|:------------------:|
|
||||
#' | A | 2019-01-01 | 1 | TRUE |
|
||||
#' | A | 2019-03-01 | 1 | FALSE |
|
||||
@ -45,7 +84,7 @@
|
||||
#' | B | 2008-01-01 | 1 | FALSE |
|
||||
#' | C | 2020-01-01 | 1 | TRUE |
|
||||
#'
|
||||
#' Dates are first sorted from old to new. The oldest date will mark the start of the first episode. After this date, the next date will be marked that is at least `episode_days` days later than the start of the first episode. From that second marked date on, the next date will be marked that is at least `episode_days` days later than the start of the second episode which will be the start of the third episode, and so on. Before the vector is being returned, the original order will be restored.
|
||||
#' ### Other
|
||||
#'
|
||||
#' The [first_isolate()] function is a wrapper around the [is_new_episode()] function, but is more efficient for data sets containing microorganism codes or names and allows for different isolate selection methods.
|
||||
#'
|
||||
@ -57,6 +96,24 @@
|
||||
#' @rdname get_episode
|
||||
#' @export
|
||||
#' @examples
|
||||
#' # difference between absolute and relative determination of episodes:
|
||||
#' x <- data.frame(dates = as.Date(c(
|
||||
#' "2021-01-01",
|
||||
#' "2021-01-02",
|
||||
#' "2021-01-05",
|
||||
#' "2021-01-08",
|
||||
#' "2021-02-21",
|
||||
#' "2021-02-22",
|
||||
#' "2021-02-23",
|
||||
#' "2021-02-24",
|
||||
#' "2021-03-01",
|
||||
#' "2021-03-01"
|
||||
#' )))
|
||||
#' x$absolute <- get_episode(x$dates, episode_days = 7)
|
||||
#' x$relative <- get_episode(x$dates, case_free_days = 7)
|
||||
#' x
|
||||
#'
|
||||
#'
|
||||
#' # `example_isolates` is a data set available in the AMR package.
|
||||
#' # See ?example_isolates
|
||||
#' df <- example_isolates[sample(seq_len(2000), size = 100), ]
|
||||
@ -140,55 +197,72 @@
|
||||
#' select(group_vars(.), flag_episode)
|
||||
#' }
|
||||
#' }
|
||||
get_episode <- function(x, episode_days, ...) {
|
||||
get_episode <- function(x, episode_days = NULL, case_free_days = NULL, ...) {
|
||||
meet_criteria(x, allow_class = c("Date", "POSIXt"), allow_NA = TRUE)
|
||||
meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE)
|
||||
as.integer(exec_episode(x, episode_days, ...))
|
||||
meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE, allow_NULL = TRUE)
|
||||
meet_criteria(case_free_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE, allow_NULL = TRUE)
|
||||
as.integer(exec_episode(x, episode_days, case_free_days, ...))
|
||||
}
|
||||
|
||||
#' @rdname get_episode
|
||||
#' @export
|
||||
is_new_episode <- function(x, episode_days, ...) {
|
||||
is_new_episode <- function(x, episode_days = NULL, case_free_days = NULL, ...) {
|
||||
meet_criteria(x, allow_class = c("Date", "POSIXt"), allow_NA = TRUE)
|
||||
meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE)
|
||||
!duplicated(exec_episode(x, episode_days, ...))
|
||||
meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE, allow_NULL = TRUE)
|
||||
meet_criteria(case_free_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE, allow_NULL = TRUE)
|
||||
!duplicated(exec_episode(x, episode_days, case_free_days, ...))
|
||||
}
|
||||
|
||||
exec_episode <- function(x, episode_days, ...) {
|
||||
exec_episode <- function(x, episode_days, case_free_days, ...) {
|
||||
stop_ifnot(is.null(episode_days) || is.null(case_free_days),
|
||||
"either argument `episode_days` or argument `case_free_days` must be set.",
|
||||
call = -2
|
||||
)
|
||||
|
||||
# running as.double() on a POSIXct object will return its number of seconds since 1970-01-01
|
||||
x <- as.double(as.POSIXct(x)) # as.POSIXct() required for Date classes
|
||||
|
||||
# since x is now in seconds, get seconds from episode_days as well
|
||||
episode_seconds <- episode_days * 60 * 60 * 24
|
||||
case_free_seconds <- case_free_days * 60 * 60 * 24
|
||||
|
||||
if (length(x) == 1) { # this will also match 1 NA, which is fine
|
||||
return(1)
|
||||
} else if (length(x) == 2 && !all(is.na(x))) {
|
||||
if (max(x) - min(x) >= episode_seconds) {
|
||||
} else if (length(x) == 2 && all(!is.na(x))) {
|
||||
if ((length(episode_seconds) > 0 && (max(x) - min(x)) >= episode_seconds) ||
|
||||
(length(case_free_seconds) > 0 && (max(x) - min(x)) >= case_free_seconds)) {
|
||||
if (x[1] <= x[2]) {
|
||||
return(c(1, 2))
|
||||
} else {
|
||||
return(c(2, 1))
|
||||
}
|
||||
} else {
|
||||
return(c(1, 1))
|
||||
}
|
||||
}
|
||||
|
||||
# we asked on StackOverflow:
|
||||
# https://stackoverflow.com/questions/42122245/filter-one-row-every-year
|
||||
run_episodes <- function(x, episode_seconds) {
|
||||
indices <- integer()
|
||||
run_episodes <- function(x, episode_seconds, case_free) {
|
||||
NAs <- which(is.na(x))
|
||||
x[NAs] <- 0
|
||||
|
||||
indices <- integer(length = length(x))
|
||||
start <- x[1]
|
||||
ind <- 1
|
||||
indices[1] <- 1
|
||||
indices[ind] <- 1
|
||||
for (i in 2:length(x)) {
|
||||
if (isTRUE((x[i] - start) >= episode_seconds)) {
|
||||
if ((length(episode_seconds) > 0 && (x[i] - start) >= episode_seconds) ||
|
||||
(length(case_free_seconds) > 0 && (x[i] - x[i - 1]) >= case_free_seconds)) {
|
||||
ind <- ind + 1
|
||||
start <- x[i]
|
||||
}
|
||||
indices[i] <- ind
|
||||
}
|
||||
indices[NAs] <- NA
|
||||
indices
|
||||
}
|
||||
|
||||
ord <- order(x)
|
||||
out <- run_episodes(x[ord], episode_seconds)[order(ord)]
|
||||
out <- run_episodes(x[ord], episode_seconds, case_free_seconds)[order(ord)]
|
||||
out[is.na(x) & ord != 1] <- NA # every NA expect for the first must remain NA
|
||||
out
|
||||
}
|
||||
|
@ -40,7 +40,7 @@
|
||||
#' @inheritParams proportion
|
||||
#' @param nrow (when using `facet`) number of rows
|
||||
#' @param colours a named vactor with colour to be used for filling. The default colours are colour-blind friendly.
|
||||
#' @param aesthetics aesthetics to apply the colours to, defaults to "fill" but can also be (a combination of) "alpha", "colour", "fill", "linetype", "shape" or "size"
|
||||
#' @param aesthetics aesthetics to apply the colours to - the default is "fill" but can also be (a combination of) "alpha", "colour", "fill", "linetype", "shape" or "size"
|
||||
#' @param datalabels show datalabels using [labels_sir_count()]
|
||||
#' @param datalabels.size size of the datalabels
|
||||
#' @param datalabels.colour colour of the datalabels
|
||||
@ -193,7 +193,7 @@ ggplot_sir <- function(data,
|
||||
y.title = "Proportion",
|
||||
...) {
|
||||
stop_ifnot_installed("ggplot2")
|
||||
meet_criteria(data, allow_class = "data.frame", contains_column_class = "sir")
|
||||
meet_criteria(data, allow_class = "data.frame", contains_column_class = c("sir", "rsi"))
|
||||
meet_criteria(position, allow_class = "character", has_length = 1, is_in = c("fill", "stack", "dodge"), allow_NULL = TRUE)
|
||||
meet_criteria(x, allow_class = "character", has_length = 1)
|
||||
meet_criteria(fill, allow_class = "character", has_length = 1)
|
||||
|
@ -33,7 +33,7 @@
|
||||
#' @param x a [data.frame]
|
||||
#' @param search_string a text to search `x` for, will be checked with [as.ab()] if this value is not a column in `x`
|
||||
#' @param verbose a [logical] to indicate whether additional info should be printed
|
||||
#' @param only_sir_columns a [logical] to indicate whether only antibiotic columns must be detected that were transformed to class `sir` (see [as.sir()]) on beforehand (defaults to `FALSE`)
|
||||
#' @param only_sir_columns a [logical] to indicate whether only antibiotic columns must be detected that were transformed to class `sir` (see [as.sir()]) on beforehand (default is `FALSE`)
|
||||
#' @details You can look for an antibiotic (trade) name or abbreviation and it will search `x` and the [antibiotics] data set for any column containing a name or code of that antibiotic.
|
||||
#' @return A column name of `x`, or `NULL` when no result is found.
|
||||
#' @export
|
||||
|
@ -130,7 +130,7 @@ join_microorganisms <- function(type, x, by, suffix, ...) {
|
||||
add_MO_lookup_to_AMR_env()
|
||||
|
||||
if (!is.data.frame(x)) {
|
||||
if (pkg_is_available("tibble", also_load = FALSE)) {
|
||||
if (pkg_is_available("tibble")) {
|
||||
x <- import_fn("tibble", "tibble")(mo = x)
|
||||
} else {
|
||||
x <- data.frame(mo = x, stringsAsFactors = FALSE)
|
||||
|
@ -37,7 +37,7 @@
|
||||
#' @param gram_negative names of antibiotic drugs for **Gram-positives**, case-insensitive. Set to `NULL` to ignore. See *Details* for the default antibiotic drugs
|
||||
#' @param gram_positive names of antibiotic drugs for **Gram-negatives**, case-insensitive. Set to `NULL` to ignore. See *Details* for the default antibiotic drugs
|
||||
#' @param antifungal names of antifungal drugs for **fungi**, case-insensitive. Set to `NULL` to ignore. See *Details* for the default antifungal drugs
|
||||
#' @param only_sir_columns a [logical] to indicate whether only columns must be included that were transformed to class `sir` (see [as.sir()]) on beforehand (defaults to `FALSE`)
|
||||
#' @param only_sir_columns a [logical] to indicate whether only columns must be included that were transformed to class `sir` (see [as.sir()]) on beforehand (default is `FALSE`)
|
||||
#' @param ... ignored, only in place to allow future extensions
|
||||
#' @details
|
||||
#' The [key_antimicrobials()] and [all_antimicrobials()] functions are context-aware. This means that the `x` argument can be left blank if used inside a [data.frame] call, see *Examples*.
|
||||
@ -149,6 +149,10 @@ key_antimicrobials <- function(x = NULL,
|
||||
meet_criteria(gram_positive, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(antifungal, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
|
||||
# force regular data.frame, not a tibble or data.table
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
|
4
R/mdro.R
4
R/mdro.R
@ -192,6 +192,10 @@ mdro <- function(x = NULL,
|
||||
meet_criteria(pct_required_classes, allow_class = "numeric", has_length = 1)
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(verbose, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
|
||||
if (!any(is_sir_eligible(x))) {
|
||||
|
@ -32,7 +32,7 @@
|
||||
#' Calculates a normalised mean for antimicrobial resistance between multiple observations, to help to identify similar isolates without comparing antibiograms by hand.
|
||||
#' @param x a vector of class [sir][as.sir()], [mic][as.mic()] or [disk][as.disk()], or a [data.frame] containing columns of any of these classes
|
||||
#' @param ... variables to select (supports [tidyselect language][tidyselect::language] such as `column1:column4` and `where(is.mic)`, and can thus also be [antibiotic selectors][ab_selector()]
|
||||
#' @param combine_SI a [logical] to indicate whether all values of S and I must be merged into one, so the input only consists of S+I vs. R (susceptible vs. resistant), defaults to `TRUE`
|
||||
#' @param combine_SI a [logical] to indicate whether all values of S and I must be merged into one, so the input only consists of S+I vs. R (susceptible vs. resistant) - the default is `TRUE`
|
||||
#' @details The mean AMR distance is effectively [the Z-score](https://en.wikipedia.org/wiki/Standard_score); a normalised numeric value to compare AMR test results which can help to identify similar isolates, without comparing antibiograms by hand.
|
||||
#'
|
||||
#' MIC values (see [as.mic()]) are transformed with [log2()] first; their distance is thus calculated as `(log2(x) - mean(log2(x))) / sd(log2(x))`.
|
||||
|
2
R/mic.R
2
R/mic.R
@ -286,7 +286,7 @@ as.numeric.mic <- function(x, ...) {
|
||||
|
||||
#' @rdname as.mic
|
||||
#' @method droplevels mic
|
||||
#' @param as.mic a [logical] to indicate whether the `mic` class should be kept, defaults to `FALSE`
|
||||
#' @param as.mic a [logical] to indicate whether the `mic` class should be kept - the default is `FALSE`
|
||||
#' @export
|
||||
droplevels.mic <- function(x, as.mic = FALSE, ...) {
|
||||
x <- droplevels.factor(x, ...)
|
||||
|
57
R/mo.R
57
R/mo.R
@ -27,23 +27,23 @@
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Transform Input to a Microorganism Code
|
||||
#' Transform Arbitrary Input to Valid Microbial Taxonomy
|
||||
#'
|
||||
#' Use this function to determine a valid microorganism code ([`mo`]). Determination is done using intelligent rules and the complete taxonomic kingdoms `r vector_and(unique(microorganisms$kingdom[which(!grepl("(unknown|Fungi)", microorganisms$kingdom))]), quotes = FALSE)`, and most microbial species from the kingdom Fungi (see *Source*). The input can be almost anything: a full name (like `"Staphylococcus aureus"`), an abbreviated name (such as `"S. aureus"`), an abbreviation known in the field (such as `"MRSA"`), or just a genus. See *Examples*.
|
||||
#' Use this function to get a valid microorganism code ([`mo`]) based on arbitrary user input. Determination is done using intelligent rules and the complete taxonomic tree of the kingdoms `r vector_and(unique(microorganisms$kingdom[which(!grepl("(unknown|Fungi)", microorganisms$kingdom))]), quotes = FALSE)`, and most microbial species from the kingdom Fungi (see *Source*). The input can be almost anything: a full name (like `"Staphylococcus aureus"`), an abbreviated name (such as `"S. aureus"`), an abbreviation known in the field (such as `"MRSA"`), or just a genus. See *Examples*.
|
||||
#' @param x a [character] vector or a [data.frame] with one or two columns
|
||||
#' @param Becker a [logical] to indicate whether staphylococci should be categorised into coagulase-negative staphylococci ("CoNS") and coagulase-positive staphylococci ("CoPS") instead of their own species, according to Karsten Becker *et al.* (see Source).
|
||||
#' @param Becker a [logical] to indicate whether staphylococci should be categorised into coagulase-negative staphylococci ("CoNS") and coagulase-positive staphylococci ("CoPS") instead of their own species, according to Karsten Becker *et al.* (see *Source*). Please see *Details* for a full list of staphylococcal species that will be converted.
|
||||
#'
|
||||
#' This excludes *Staphylococcus aureus* at default, use `Becker = "all"` to also categorise *S. aureus* as "CoPS".
|
||||
#' @param Lancefield a [logical] to indicate whether a beta-haemolytic *Streptococcus* should be categorised into Lancefield groups instead of their own species, according to Rebecca C. Lancefield (see Source). These streptococci will be categorised in their first group, e.g. *Streptococcus dysgalactiae* will be group C, although officially it was also categorised into groups G and L.
|
||||
#' @param Lancefield a [logical] to indicate whether a beta-haemolytic *Streptococcus* should be categorised into Lancefield groups instead of their own species, according to Rebecca C. Lancefield (see *Source*). These streptococci will be categorised in their first group, e.g. *Streptococcus dysgalactiae* will be group C, although officially it was also categorised into groups G and L. . Please see *Details* for a full list of streptococcal species that will be converted.
|
||||
#'
|
||||
#' This excludes enterococci at default (who are in group D), use `Lancefield = "all"` to also categorise all enterococci as group D.
|
||||
#' @param minimum_matching_score a numeric value to set as the lower limit for the [MO matching score][mo_matching_score()]. When left blank, this will be determined automatically based on the character length of `x`, its [taxonomic kingdom][microorganisms] and [human pathogenicity][mo_matching_score()].
|
||||
#' @param keep_synonyms a [logical] to indicate if old, previously valid taxonomic names must be preserved and not be corrected to currently accepted names. The default is `FALSE`, which will return a note if old taxonomic names were processed. The default can be set with the option [`AMR_keep_synonyms`][AMR-options], i.e. `options(AMR_keep_synonyms = TRUE)` or `options(AMR_keep_synonyms = FALSE)`.
|
||||
#' @param keep_synonyms a [logical] to indicate if old, previously valid taxonomic names must be preserved and not be corrected to currently accepted names. The default is `FALSE`, which will return a note if old taxonomic names were processed. The default can be set with the [package option][AMR-options] [`AMR_keep_synonyms`][AMR-options], i.e. `options(AMR_keep_synonyms = TRUE)` or `options(AMR_keep_synonyms = FALSE)`.
|
||||
#' @param reference_df a [data.frame] to be used for extra reference when translating `x` to a valid [`mo`]. See [set_mo_source()] and [get_mo_source()] to automate the usage of your own codes (e.g. used in your analysis or organisation).
|
||||
#' @param ignore_pattern a [regular expression][base::regex] (case-insensitive) of which all matches in `x` must return `NA`. This can be convenient to exclude known non-relevant input and can also be set with the option [`AMR_ignore_pattern`][AMR-options], e.g. `options(AMR_ignore_pattern = "(not reported|contaminated flora)")`.
|
||||
#' @param remove_from_input a [regular expression][base::regex] (case-insensitive) to clean the input of `x`. Everything matched in `x` will be removed. At default, this is the outcome of [mo_cleaning_regex()], which removes texts between brackets and texts such as "species" and "serovar".
|
||||
#' @param ignore_pattern a Perl-compatible [regular expression][base::regex] (case-insensitive) of which all matches in `x` must return `NA`. This can be convenient to exclude known non-relevant input and can also be set with the [package option][AMR-options] [`AMR_ignore_pattern`][AMR-options], e.g. `options(AMR_ignore_pattern = "(not reported|contaminated flora)")`.
|
||||
#' @param cleaning_regex a Perl-compatible [regular expression][base::regex] (case-insensitive) to clean the input of `x`. Every matched part in `x` will be removed. At default, this is the outcome of [mo_cleaning_regex()], which removes texts between brackets and texts such as "species" and "serovar". The default can be set with the [package option][AMR-options] [`AMR_cleaning_regex`][AMR-options].
|
||||
#' @param language language to translate text like "no growth", which defaults to the system language (see [get_AMR_locale()])
|
||||
#' @param info a [logical] to indicate if a progress bar should be printed if more than 25 items are to be coerced, defaults to `TRUE` only in interactive mode
|
||||
#' @param info a [logical] to indicate if a progress bar should be printed if more than 25 items are to be coerced - the default is `TRUE` only in interactive mode
|
||||
#' @param ... other arguments passed on to functions
|
||||
#' @rdname as.mo
|
||||
#' @aliases mo
|
||||
@ -68,13 +68,17 @@
|
||||
#'
|
||||
#' Use the [`mo_*`][mo_property()] functions to get properties based on the returned code, see *Examples*.
|
||||
#'
|
||||
#' The [as.mo()] function uses a novel [matching score algorithm][mo_matching_score()] (see *Matching Score for Microorganisms* below) to match input against the [available microbial taxonomy][microorganisms] in this package. This will lead to the effect that e.g. `"E. coli"` (a microorganism highly prevalent in humans) will return the microbial ID of *Escherichia coli* and not *Entamoeba coli* (a microorganism less prevalent in humans), although the latter would alphabetically come first. The algorithm uses data from the List of Prokaryotic names with Standing in Nomenclature (LPSN) and the Global Biodiversity Information Facility (GBIF) (see [microorganisms]).
|
||||
#' The [as.mo()] function uses a novel [matching score algorithm][mo_matching_score()] (see *Matching Score for Microorganisms* below) to match input against the [available microbial taxonomy][microorganisms] in this package. This will lead to the effect that e.g. `"E. coli"` (a microorganism highly prevalent in humans) will return the microbial ID of *Escherichia coli* and not *Entamoeba coli* (a microorganism less prevalent in humans), although the latter would alphabetically come first.
|
||||
#'
|
||||
#' With `Becker = TRUE`, the following `r length(MO_CONS[MO_CONS != "B_STPHY_CONS"])` staphylococci will be converted to the **coagulase-negative group**: `r vector_and(gsub("Staphylococcus", "S.", mo_name(MO_CONS[MO_CONS != "B_STPHY_CONS"], keep_synonyms = TRUE)), quotes = "*")`.\cr The following `r length(MO_COPS[MO_COPS != "B_STPHY_COPS"])` staphylococci will be converted to the **coagulase-positive group**: `r vector_and(gsub("Staphylococcus", "S.", mo_name(MO_COPS[MO_COPS != "B_STPHY_COPS"], keep_synonyms = TRUE)), quotes = "*")`.
|
||||
#'
|
||||
#' With `Lancefield = TRUE`, the following streptococci will be converted to their corresponding Lancefield group: `r vector_and(gsub("Streptococcus", "S.", paste0("*", mo_name(MO_LANCEFIELD, keep_synonyms = TRUE), "* (", mo_species(MO_LANCEFIELD, keep_synonyms = TRUE, Lancefield = TRUE), ")")), quotes = FALSE)`.
|
||||
#'
|
||||
#' ### Coping with Uncertain Results
|
||||
#'
|
||||
#' Results of non-exact taxonomic input are based on their [matching score][mo_matching_score()]. The lowest allowed score can be set with the `minimum_matching_score` argument. At default this will be determined based on the character length of the input, and the [taxonomic kingdom][microorganisms] and [human pathogenicity][mo_matching_score()] of the taxonomic outcome. If values are matched with uncertainty, a message will be shown to suggest the user to evaluate the results with [mo_uncertainties()], which returns a [data.frame] with all specifications.
|
||||
#'
|
||||
#' To increase the quality of matching, the `remove_from_input` argument can be used to clean the input (i.e., `x`). This must be a [regular expression][base::regex] that matches parts of the input that should be removed before the input is matched against the [available microbial taxonomy][microorganisms]. It will be matched Perl-compatible and case-insensitive. The default value of `remove_from_input` is the outcome of the helper function [mo_cleaning_regex()].
|
||||
#' To increase the quality of matching, the `cleaning_regex` argument can be used to clean the input (i.e., `x`). This must be a [regular expression][base::regex] that matches parts of the input that should be removed before the input is matched against the [available microbial taxonomy][microorganisms]. It will be matched Perl-compatible and case-insensitive. The default value of `cleaning_regex` is the outcome of the helper function [mo_cleaning_regex()].
|
||||
#'
|
||||
#' There are three helper functions that can be run after using the [as.mo()] function:
|
||||
#' - Use [mo_uncertainties()] to get a [data.frame] that prints in a pretty format with all taxonomic names that were guessed. The output contains the matching score for all matches (see *Matching Score for Microorganisms* below).
|
||||
@ -150,17 +154,18 @@ as.mo <- function(x,
|
||||
keep_synonyms = getOption("AMR_keep_synonyms", FALSE),
|
||||
reference_df = get_mo_source(),
|
||||
ignore_pattern = getOption("AMR_ignore_pattern", NULL),
|
||||
remove_from_input = mo_cleaning_regex(),
|
||||
cleaning_regex = getOption("AMR_cleaning_regex", mo_cleaning_regex()),
|
||||
language = get_AMR_locale(),
|
||||
info = interactive(),
|
||||
...) {
|
||||
meet_criteria(x, allow_class = c("mo", "data.frame", "list", "character", "numeric", "integer", "factor"), allow_NA = TRUE)
|
||||
meet_criteria(Becker, allow_class = c("logical", "character"), has_length = 1)
|
||||
meet_criteria(Lancefield, allow_class = c("logical", "character"), has_length = 1)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(minimum_matching_score, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE, is_positive_or_zero = TRUE, is_finite = TRUE)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(reference_df, allow_class = "data.frame", allow_NULL = TRUE)
|
||||
meet_criteria(ignore_pattern, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(cleaning_regex, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
|
||||
@ -174,7 +179,6 @@ as.mo <- function(x,
|
||||
return(set_clean_class(x, new_class = c("mo", "character")))
|
||||
}
|
||||
|
||||
|
||||
# start off with replaced language-specific non-ASCII characters with ASCII characters
|
||||
x <- parse_and_convert(x)
|
||||
# replace mo codes used in older package versions
|
||||
@ -185,7 +189,7 @@ as.mo <- function(x,
|
||||
x_lower <- tolower(x)
|
||||
|
||||
complexes <- x[trimws2(x_lower) %like_case% " (complex|group)$"]
|
||||
if (length(complexes) > 0 && identical(remove_from_input, mo_cleaning_regex()) && !any(AMR_env$MO_lookup$fullname[which(AMR_env$MO_lookup$source == "Added by user")] %like% "(group|complex)", na.rm = TRUE)) {
|
||||
if (length(complexes) > 0 && identical(cleaning_regex, mo_cleaning_regex()) && !any(AMR_env$MO_lookup$fullname[which(AMR_env$MO_lookup$source == "Added by user")] %like% "(group|complex)", na.rm = TRUE)) {
|
||||
warning_("in `as.mo()`: 'complex' and 'group' were ignored from the input in ", length(complexes), " case", ifelse(length(complexes) > 1, "s", ""), ", as they are currently not supported.\nYou can add your own microorganism with `add_custom_microorganisms()`.", call = FALSE)
|
||||
}
|
||||
|
||||
@ -256,8 +260,8 @@ as.mo <- function(x,
|
||||
|
||||
# some required cleaning steps
|
||||
x_out <- trimws2(x_search)
|
||||
# this applies the `remove_from_input` argument, which defaults to mo_cleaning_regex()
|
||||
x_out <- gsub(remove_from_input, " ", x_out, ignore.case = TRUE, perl = TRUE)
|
||||
# this applies the `cleaning_regex` argument, which defaults to mo_cleaning_regex()
|
||||
x_out <- gsub(cleaning_regex, " ", x_out, ignore.case = TRUE, perl = TRUE)
|
||||
x_out <- trimws2(gsub(" +", " ", x_out, perl = TRUE))
|
||||
x_search_cleaned <- x_out
|
||||
x_out <- tolower(x_out)
|
||||
@ -325,21 +329,21 @@ as.mo <- function(x,
|
||||
result_mo <- NA_character_
|
||||
} else {
|
||||
result_mo <- AMR_env$MO_lookup$mo[match(top_hits[1], AMR_env$MO_lookup$fullname)]
|
||||
AMR_env$mo_uncertainties <- rbind2(
|
||||
AMR_env$mo_uncertainties <- rbind_AMR(
|
||||
AMR_env$mo_uncertainties,
|
||||
data.frame(
|
||||
original_input = x_search,
|
||||
input = x_search_cleaned,
|
||||
fullname = top_hits[1],
|
||||
mo = result_mo,
|
||||
candidates = ifelse(length(top_hits) > 1, paste(top_hits[2:min(26, length(top_hits))], collapse = ", "), ""),
|
||||
candidates = ifelse(length(top_hits) > 1, paste(top_hits[2:min(99, length(top_hits))], collapse = ", "), ""),
|
||||
minimum_matching_score = ifelse(is.null(minimum_matching_score), "NULL", minimum_matching_score),
|
||||
keep_synonyms = keep_synonyms,
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
)
|
||||
# save to package env to save time for next time
|
||||
AMR_env$mo_previously_coerced <- unique(rbind2(
|
||||
AMR_env$mo_previously_coerced <- unique(rbind_AMR(
|
||||
AMR_env$mo_previously_coerced,
|
||||
data.frame(
|
||||
x = paste(x_search, minimum_matching_score),
|
||||
@ -794,7 +798,7 @@ rep.mo <- function(x, ...) {
|
||||
#' @method print mo_uncertainties
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.mo_uncertainties <- function(x, ...) {
|
||||
print.mo_uncertainties <- function(x, n = 10, ...) {
|
||||
if (NROW(x) == 0) {
|
||||
cat(word_wrap("No uncertainties to show. Only uncertainties of the last call of `as.mo()` or any `mo_*()` function are stored.\n\n", add_fn = font_blue))
|
||||
return(invisible(NULL))
|
||||
@ -829,9 +833,14 @@ print.mo_uncertainties <- function(x, ...) {
|
||||
}
|
||||
|
||||
txt <- ""
|
||||
any_maxed_out <- FALSE
|
||||
for (i in seq_len(nrow(x))) {
|
||||
if (x[i, ]$candidates != "") {
|
||||
candidates <- unlist(strsplit(x[i, ]$candidates, ", ", fixed = TRUE))
|
||||
if (length(candidates) > n) {
|
||||
any_maxed_out <- TRUE
|
||||
candidates <- candidates[seq_len(n)]
|
||||
}
|
||||
scores <- mo_matching_score(x = x[i, ]$input, n = candidates)
|
||||
n_candidates <- length(candidates)
|
||||
|
||||
@ -852,10 +861,6 @@ print.mo_uncertainties <- function(x, ...) {
|
||||
font_blue(paste0(" (", scores_formatted, ")"), collapse = NULL)
|
||||
),
|
||||
quotes = FALSE, sort = FALSE
|
||||
),
|
||||
ifelse(n_candidates == 25,
|
||||
font_grey(" [showing first 25]"),
|
||||
""
|
||||
)
|
||||
),
|
||||
extra_indent = nchar("Also matched: "),
|
||||
@ -901,7 +906,11 @@ print.mo_uncertainties <- function(x, ...) {
|
||||
txt <- gsub("(^[\n]|[\n]$)", "", txt)
|
||||
txt <- paste0("\n", txt, "\n")
|
||||
}
|
||||
|
||||
cat(txt)
|
||||
if (isTRUE(any_maxed_out)) {
|
||||
cat(font_blue(word_wrap("\nOnly the first ", n, " other matches of each record are shown. Run `print(mo_uncertainties(), n = ...)` to view more entries, or save `mo_uncertainties()` to an object.")))
|
||||
}
|
||||
}
|
||||
|
||||
#' @method print mo_renamed
|
||||
|
@ -58,7 +58,7 @@
|
||||
#'
|
||||
#' SNOMED codes ([mo_snomed()]) are from the version of `r documentation_date(TAXONOMY_VERSION$SNOMED$accessed_date)`. See *Source* and the [microorganisms] data set for more info.
|
||||
#'
|
||||
#' Old taxonomic names (so-called 'synonyms') can be retrieved with [mo_synonyms()], the current taxonomic name can be retrieved with [mo_current()]. Both functions return full names.
|
||||
#' Old taxonomic names (so-called 'synonyms') can be retrieved with [mo_synonyms()] (which will have the scientific reference as [name][base::names()]), the current taxonomic name can be retrieved with [mo_current()]. Both functions return full names.
|
||||
#'
|
||||
#' All output [will be translated][translate] where possible.
|
||||
#' @section Matching Score for Microorganisms:
|
||||
@ -108,12 +108,12 @@
|
||||
#'
|
||||
#' # scientific reference -----------------------------------------------------
|
||||
#'
|
||||
#' mo_ref("Klebsiella pneumoniae")
|
||||
#' mo_authors("Klebsiella pneumoniae")
|
||||
#' mo_year("Klebsiella pneumoniae")
|
||||
#' mo_lpsn("Klebsiella pneumoniae")
|
||||
#' mo_gbif("Klebsiella pneumoniae")
|
||||
#' mo_synonyms("Klebsiella pneumoniae")
|
||||
#' mo_ref("Klebsiella aerogenes")
|
||||
#' mo_authors("Klebsiella aerogenes")
|
||||
#' mo_year("Klebsiella aerogenes")
|
||||
#' mo_lpsn("Klebsiella aerogenes")
|
||||
#' mo_gbif("Klebsiella aerogenes")
|
||||
#' mo_synonyms("Klebsiella aerogenes")
|
||||
#'
|
||||
#'
|
||||
#' # abbreviations known in the field -----------------------------------------
|
||||
@ -124,7 +124,8 @@
|
||||
#' mo_gramstain("VISA")
|
||||
#'
|
||||
#' mo_genus("EHEC")
|
||||
#' mo_species("EHEC")
|
||||
#' mo_species("EIEC")
|
||||
#' mo_name("UPEC")
|
||||
#'
|
||||
#'
|
||||
#' # known subspecies ---------------------------------------------------------
|
||||
@ -740,23 +741,22 @@ mo_synonyms <- function(x, language = get_AMR_locale(), keep_synonyms = getOptio
|
||||
syns <- lapply(x.mo, function(y) {
|
||||
gbif <- AMR_env$MO_lookup$gbif[match(y, AMR_env$MO_lookup$mo)]
|
||||
lpsn <- AMR_env$MO_lookup$lpsn[match(y, AMR_env$MO_lookup$mo)]
|
||||
out <- AMR_env$MO_lookup[which(AMR_env$MO_lookup$lpsn_renamed_to == lpsn | AMR_env$MO_lookup$gbif_renamed_to == gbif), "fullname", drop = TRUE]
|
||||
if (length(out) == 0) {
|
||||
fullname <- AMR_env$MO_lookup[which(AMR_env$MO_lookup$lpsn_renamed_to == lpsn | AMR_env$MO_lookup$gbif_renamed_to == gbif), "fullname", drop = TRUE]
|
||||
if (length(fullname) == 0) {
|
||||
NULL
|
||||
} else {
|
||||
out
|
||||
ref <- AMR_env$MO_lookup[which(AMR_env$MO_lookup$lpsn_renamed_to == lpsn | AMR_env$MO_lookup$gbif_renamed_to == gbif), "ref", drop = TRUE]
|
||||
names(fullname) <- ref
|
||||
fullname
|
||||
}
|
||||
})
|
||||
|
||||
if (length(syns) > 1) {
|
||||
names(syns) <- mo_name(x, language = language)
|
||||
result <- syns
|
||||
} else {
|
||||
result <- unlist(syns)
|
||||
if (length(syns) == 1) {
|
||||
syns <- unlist(syns)
|
||||
}
|
||||
|
||||
load_mo_uncertainties(metadata)
|
||||
result
|
||||
syns
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
|
@ -33,13 +33,13 @@
|
||||
#'
|
||||
#' This is **the fastest way** to have your organisation (or analysis) specific codes picked up and translated by this package, since you don't have to bother about it again after setting it up once.
|
||||
#' @param path location of your reference file, this can be any text file (comma-, tab- or pipe-separated) or an Excel file (see *Details*). Can also be `""`, `NULL` or `FALSE` to delete the reference file.
|
||||
#' @param destination destination of the compressed data file, default to the user's home directory.
|
||||
#' @param destination destination of the compressed data file - the default is the user's home directory.
|
||||
#' @rdname mo_source
|
||||
#' @name mo_source
|
||||
#' @aliases set_mo_source get_mo_source
|
||||
#' @details The reference file can be a text file separated with commas (CSV) or tabs or pipes, an Excel file (either 'xls' or 'xlsx' format) or an \R object file (extension '.rds'). To use an Excel file, you will need to have the `readxl` package installed.
|
||||
#'
|
||||
#' [set_mo_source()] will check the file for validity: it must be a [data.frame], must have a column named `"mo"` which contains values from [`microorganisms$mo`][microorganisms] or [`microorganisms$fullname`][microorganisms] and must have a reference column with your own defined values. If all tests pass, [set_mo_source()] will read the file into \R and will ask to export it to `"~/mo_source.rds"`. The CRAN policy disallows packages to write to the file system, although '*exceptions may be allowed in interactive sessions if the package obtains confirmation from the user*'. For this reason, this function only works in interactive sessions so that the user can **specifically confirm and allow** that this file will be created. The destination of this file can be set with the `destination` argument and defaults to the user's home directory. It can also be set with the option [`AMR_mo_source`][AMR-options], e.g. `options(AMR_mo_source = "my/location/file.rds")`.
|
||||
#' [set_mo_source()] will check the file for validity: it must be a [data.frame], must have a column named `"mo"` which contains values from [`microorganisms$mo`][microorganisms] or [`microorganisms$fullname`][microorganisms] and must have a reference column with your own defined values. If all tests pass, [set_mo_source()] will read the file into \R and will ask to export it to `"~/mo_source.rds"`. The CRAN policy disallows packages to write to the file system, although '*exceptions may be allowed in interactive sessions if the package obtains confirmation from the user*'. For this reason, this function only works in interactive sessions so that the user can **specifically confirm and allow** that this file will be created. The destination of this file can be set with the `destination` argument and defaults to the user's home directory. It can also be set with the [package option][AMR-options] [`AMR_mo_source`][AMR-options], e.g. `options(AMR_mo_source = "my/location/file.rds")`.
|
||||
#'
|
||||
#' The created compressed data file `"mo_source.rds"` will be used at default for MO determination (function [as.mo()] and consequently all `mo_*` functions like [mo_genus()] and [mo_gramstain()]). The location and timestamp of the original file will be saved as an [attribute][base::attributes()] to the compressed data file.
|
||||
#'
|
||||
@ -149,7 +149,7 @@ set_mo_source <- function(path, destination = getOption("AMR_mo_source", "~/mo_s
|
||||
|
||||
df <- NULL
|
||||
if (path %like% "[.]rds$") {
|
||||
df <- readRDS2(path)
|
||||
df <- readRDS_AMR(path)
|
||||
} else if (path %like% "[.]xlsx?$") {
|
||||
# is Excel file (old or new)
|
||||
stop_ifnot_installed("readxl")
|
||||
@ -248,7 +248,7 @@ get_mo_source <- function(destination = getOption("AMR_mo_source", "~/mo_source.
|
||||
return(NULL)
|
||||
}
|
||||
if (is.null(AMR_env$mo_source)) {
|
||||
AMR_env$mo_source <- readRDS2(path.expand(destination))
|
||||
AMR_env$mo_source <- readRDS_AMR(path.expand(destination))
|
||||
}
|
||||
|
||||
old_time <- attributes(AMR_env$mo_source)$mo_source_timestamp
|
||||
|
239
R/plot.R
239
R/plot.R
@ -34,11 +34,11 @@
|
||||
#' @param x,object values created with [as.mic()], [as.disk()] or [as.sir()] (or their `random_*` variants, such as [random_mic()])
|
||||
#' @param mo any (vector of) text that can be coerced to a valid microorganism code with [as.mo()]
|
||||
#' @param ab any (vector of) text that can be coerced to a valid antimicrobial drug code with [as.ab()]
|
||||
#' @param guideline interpretation guideline to use, defaults to the latest included EUCAST guideline, see *Details*
|
||||
#' @param guideline interpretation guideline to use - the default is the latest included EUCAST guideline, see *Details*
|
||||
#' @param main,title title of the plot
|
||||
#' @param xlab,ylab axis title
|
||||
#' @param colours_SIR colours to use for filling in the bars, must be a vector of three values (in the order S, I and R). The default colours are colour-blind friendly.
|
||||
#' @param language language to be used to translate 'Susceptible', 'Increased exposure'/'Intermediate' and 'Resistant', defaults to system language (see [get_AMR_locale()]) and can be overwritten by setting the option [`AMR_locale`][AMR-options], e.g. `options(AMR_locale = "de")`, see [translate]. Use `language = NULL` or `language = ""` to prevent translation.
|
||||
#' @param language language to be used to translate 'Susceptible', 'Increased exposure'/'Intermediate' and 'Resistant' - the default is system language (see [get_AMR_locale()]) and can be overwritten by setting the [package option][AMR-options] [`AMR_locale`][AMR-options], e.g. `options(AMR_locale = "de")`, see [translate]. Use `language = NULL` or `language = ""` to prevent translation.
|
||||
#' @param expand a [logical] to indicate whether the range on the x axis should be expanded between the lowest and highest value. For MIC values, intermediate values will be factors of 2 starting from the highest MIC value. For disk diameters, the whole diameter range will be filled.
|
||||
#' @details
|
||||
#' The interpretation of "I" will be named "Increased exposure" for all EUCAST guidelines since 2019, and will be named "Intermediate" in all other cases.
|
||||
@ -88,8 +88,8 @@ plot.mic <- function(x,
|
||||
ab = NULL,
|
||||
guideline = "EUCAST",
|
||||
main = deparse(substitute(x)),
|
||||
ylab = "Frequency",
|
||||
xlab = "Minimum Inhibitory Concentration (mg/L)",
|
||||
ylab = translate_AMR("Frequency", language = language),
|
||||
xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language = language),
|
||||
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
|
||||
language = get_AMR_locale(),
|
||||
expand = TRUE,
|
||||
@ -100,18 +100,14 @@ plot.mic <- function(x,
|
||||
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(ylab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(xlab, allow_class = "character", has_length = 1)
|
||||
if ("colours_RSI" %in% names(list(...))) {
|
||||
deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
|
||||
colours_SIR <- list(...)$colours_RSI
|
||||
}
|
||||
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
|
||||
language <- validate_language(language)
|
||||
meet_criteria(expand, allow_class = "logical", has_length = 1)
|
||||
|
||||
# translate if not specifically set
|
||||
if (missing(ylab)) {
|
||||
ylab <- translate_into_language(ylab, language = language)
|
||||
}
|
||||
if (missing(xlab)) {
|
||||
xlab <- translate_into_language(xlab, language = language)
|
||||
}
|
||||
|
||||
if (length(colours_SIR) == 1) {
|
||||
colours_SIR <- rep(colours_SIR, 3)
|
||||
}
|
||||
@ -127,6 +123,7 @@ plot.mic <- function(x,
|
||||
colours_SIR = colours_SIR,
|
||||
fn = as.mic,
|
||||
language = language,
|
||||
type = "MIC",
|
||||
...
|
||||
)
|
||||
barplot(x,
|
||||
@ -146,15 +143,15 @@ plot.mic <- function(x,
|
||||
legend_txt <- character(0)
|
||||
legend_col <- character(0)
|
||||
if (any(cols_sub$cols == colours_SIR[1] & cols_sub$count > 0)) {
|
||||
legend_txt <- "Susceptible"
|
||||
legend_txt <- c(legend_txt, "(S) Susceptible")
|
||||
legend_col <- colours_SIR[1]
|
||||
}
|
||||
if (any(cols_sub$cols == colours_SIR[2] & cols_sub$count > 0)) {
|
||||
legend_txt <- c(legend_txt, plot_name_of_I(cols_sub$guideline))
|
||||
legend_txt <- c(legend_txt, paste("(I)", plot_name_of_I(cols_sub$guideline)))
|
||||
legend_col <- c(legend_col, colours_SIR[2])
|
||||
}
|
||||
if (any(cols_sub$cols == colours_SIR[3] & cols_sub$count > 0)) {
|
||||
legend_txt <- c(legend_txt, "Resistant")
|
||||
legend_txt <- c(legend_txt, "(R) Resistant")
|
||||
legend_col <- c(legend_col, colours_SIR[3])
|
||||
}
|
||||
|
||||
@ -179,8 +176,8 @@ barplot.mic <- function(height,
|
||||
ab = NULL,
|
||||
guideline = "EUCAST",
|
||||
main = deparse(substitute(height)),
|
||||
ylab = "Frequency",
|
||||
xlab = "Minimum Inhibitory Concentration (mg/L)",
|
||||
ylab = translate_AMR("Frequency", language = language),
|
||||
xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language = language),
|
||||
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
|
||||
language = get_AMR_locale(),
|
||||
expand = TRUE,
|
||||
@ -191,18 +188,14 @@ barplot.mic <- function(height,
|
||||
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
|
||||
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
|
||||
meet_criteria(guideline, allow_class = "character", has_length = 1)
|
||||
if ("colours_RSI" %in% names(list(...))) {
|
||||
deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
|
||||
colours_SIR <- list(...)$colours_RSI
|
||||
}
|
||||
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
|
||||
language <- validate_language(language)
|
||||
meet_criteria(expand, allow_class = "logical", has_length = 1)
|
||||
|
||||
# translate if not specifically set
|
||||
if (missing(ylab)) {
|
||||
ylab <- translate_into_language(ylab, language = language)
|
||||
}
|
||||
if (missing(xlab)) {
|
||||
xlab <- translate_into_language(xlab, language = language)
|
||||
}
|
||||
|
||||
main <- gsub(" +", " ", paste0(main, collapse = " "))
|
||||
|
||||
plot(
|
||||
@ -226,8 +219,8 @@ autoplot.mic <- function(object,
|
||||
ab = NULL,
|
||||
guideline = "EUCAST",
|
||||
title = deparse(substitute(object)),
|
||||
ylab = "Frequency",
|
||||
xlab = "Minimum Inhibitory Concentration (mg/L)",
|
||||
ylab = translate_AMR("Frequency", language = language),
|
||||
xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language = language),
|
||||
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
|
||||
language = get_AMR_locale(),
|
||||
expand = TRUE,
|
||||
@ -239,18 +232,14 @@ autoplot.mic <- function(object,
|
||||
meet_criteria(title, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(ylab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(xlab, allow_class = "character", has_length = 1)
|
||||
if ("colours_RSI" %in% names(list(...))) {
|
||||
deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
|
||||
colours_SIR <- list(...)$colours_RSI
|
||||
}
|
||||
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
|
||||
language <- validate_language(language)
|
||||
meet_criteria(expand, allow_class = "logical", has_length = 1)
|
||||
|
||||
# translate if not specifically set
|
||||
if (missing(ylab)) {
|
||||
ylab <- translate_into_language(ylab, language = language)
|
||||
}
|
||||
if (missing(xlab)) {
|
||||
xlab <- translate_into_language(xlab, language = language)
|
||||
}
|
||||
|
||||
if ("main" %in% names(list(...))) {
|
||||
title <- list(...)$main
|
||||
}
|
||||
@ -267,16 +256,22 @@ autoplot.mic <- function(object,
|
||||
colours_SIR = colours_SIR,
|
||||
fn = as.mic,
|
||||
language = language,
|
||||
type = "MIC",
|
||||
...
|
||||
)
|
||||
df <- as.data.frame(x, stringsAsFactors = TRUE)
|
||||
colnames(df) <- c("mic", "count")
|
||||
df$cols <- cols_sub$cols
|
||||
df$cols[df$cols == colours_SIR[1]] <- "Susceptible"
|
||||
df$cols[df$cols == colours_SIR[2]] <- plot_name_of_I(cols_sub$guideline)
|
||||
df$cols[df$cols == colours_SIR[3]] <- "Resistant"
|
||||
df$cols[df$cols == colours_SIR[1]] <- "(S) Susceptible"
|
||||
df$cols[df$cols == colours_SIR[2]] <- paste("(I)", plot_name_of_I(cols_sub$guideline))
|
||||
df$cols[df$cols == colours_SIR[3]] <- "(R) Resistant"
|
||||
df$cols <- factor(translate_into_language(df$cols, language = language),
|
||||
levels = translate_into_language(c("Susceptible", plot_name_of_I(cols_sub$guideline), "Resistant"),
|
||||
levels = translate_into_language(
|
||||
c(
|
||||
"(S) Susceptible",
|
||||
paste("(I)", plot_name_of_I(cols_sub$guideline)),
|
||||
"(R) Resistant"
|
||||
),
|
||||
language = language
|
||||
),
|
||||
ordered = TRUE
|
||||
@ -285,10 +280,10 @@ autoplot.mic <- function(object,
|
||||
|
||||
if (any(colours_SIR %in% cols_sub$cols)) {
|
||||
vals <- c(
|
||||
"Susceptible" = colours_SIR[1],
|
||||
"Susceptible, incr. exp." = colours_SIR[2],
|
||||
"Intermediate" = colours_SIR[2],
|
||||
"Resistant" = colours_SIR[3]
|
||||
"(S) Susceptible" = colours_SIR[1],
|
||||
"(I) Susceptible, incr. exp." = colours_SIR[2],
|
||||
"(I) Intermediate" = colours_SIR[2],
|
||||
"(R) Resistant" = colours_SIR[3]
|
||||
)
|
||||
names(vals) <- translate_into_language(names(vals), language = language)
|
||||
p <- p +
|
||||
@ -324,8 +319,8 @@ fortify.mic <- function(object, ...) {
|
||||
#' @rdname plot
|
||||
plot.disk <- function(x,
|
||||
main = deparse(substitute(x)),
|
||||
ylab = "Frequency",
|
||||
xlab = "Disk diffusion diameter (mm)",
|
||||
ylab = translate_AMR("Frequency", language = language),
|
||||
xlab = translate_AMR("Disk diffusion diameter (mm)", language = language),
|
||||
mo = NULL,
|
||||
ab = NULL,
|
||||
guideline = "EUCAST",
|
||||
@ -339,18 +334,14 @@ plot.disk <- function(x,
|
||||
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
|
||||
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
|
||||
meet_criteria(guideline, allow_class = "character", has_length = 1)
|
||||
if ("colours_RSI" %in% names(list(...))) {
|
||||
deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
|
||||
colours_SIR <- list(...)$colours_RSI
|
||||
}
|
||||
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
|
||||
language <- validate_language(language)
|
||||
meet_criteria(expand, allow_class = "logical", has_length = 1)
|
||||
|
||||
# translate if not specifically set
|
||||
if (missing(ylab)) {
|
||||
ylab <- translate_into_language(ylab, language = language)
|
||||
}
|
||||
if (missing(xlab)) {
|
||||
xlab <- translate_into_language(xlab, language = language)
|
||||
}
|
||||
|
||||
if (length(colours_SIR) == 1) {
|
||||
colours_SIR <- rep(colours_SIR, 3)
|
||||
}
|
||||
@ -366,6 +357,7 @@ plot.disk <- function(x,
|
||||
colours_SIR = colours_SIR,
|
||||
fn = as.disk,
|
||||
language = language,
|
||||
type = "disk",
|
||||
...
|
||||
)
|
||||
|
||||
@ -386,15 +378,15 @@ plot.disk <- function(x,
|
||||
legend_txt <- character(0)
|
||||
legend_col <- character(0)
|
||||
if (any(cols_sub$cols == colours_SIR[3] & cols_sub$count > 0)) {
|
||||
legend_txt <- "Resistant"
|
||||
legend_txt <- "(R) Resistant"
|
||||
legend_col <- colours_SIR[3]
|
||||
}
|
||||
if (any(cols_sub$cols == colours_SIR[2] & cols_sub$count > 0)) {
|
||||
legend_txt <- c(legend_txt, plot_name_of_I(cols_sub$guideline))
|
||||
legend_txt <- c(legend_txt, paste("(I)", plot_name_of_I(cols_sub$guideline)))
|
||||
legend_col <- c(legend_col, colours_SIR[2])
|
||||
}
|
||||
if (any(cols_sub$cols == colours_SIR[1] & cols_sub$count > 0)) {
|
||||
legend_txt <- c(legend_txt, "Susceptible")
|
||||
legend_txt <- c(legend_txt, "(S) Susceptible")
|
||||
legend_col <- c(legend_col, colours_SIR[1])
|
||||
}
|
||||
legend("top",
|
||||
@ -415,8 +407,8 @@ plot.disk <- function(x,
|
||||
#' @noRd
|
||||
barplot.disk <- function(height,
|
||||
main = deparse(substitute(height)),
|
||||
ylab = "Frequency",
|
||||
xlab = "Disk diffusion diameter (mm)",
|
||||
ylab = translate_AMR("Frequency", language = language),
|
||||
xlab = translate_AMR("Disk diffusion diameter (mm)", language = language),
|
||||
mo = NULL,
|
||||
ab = NULL,
|
||||
guideline = "EUCAST",
|
||||
@ -430,18 +422,14 @@ barplot.disk <- function(height,
|
||||
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
|
||||
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
|
||||
meet_criteria(guideline, allow_class = "character", has_length = 1)
|
||||
if ("colours_RSI" %in% names(list(...))) {
|
||||
deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
|
||||
colours_SIR <- list(...)$colours_RSI
|
||||
}
|
||||
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
|
||||
language <- validate_language(language)
|
||||
meet_criteria(expand, allow_class = "logical", has_length = 1)
|
||||
|
||||
# translate if not specifically set
|
||||
if (missing(ylab)) {
|
||||
ylab <- translate_into_language(ylab, language = language)
|
||||
}
|
||||
if (missing(xlab)) {
|
||||
xlab <- translate_into_language(xlab, language = language)
|
||||
}
|
||||
|
||||
main <- gsub(" +", " ", paste0(main, collapse = " "))
|
||||
|
||||
plot(
|
||||
@ -464,8 +452,8 @@ autoplot.disk <- function(object,
|
||||
mo = NULL,
|
||||
ab = NULL,
|
||||
title = deparse(substitute(object)),
|
||||
ylab = "Frequency",
|
||||
xlab = "Disk diffusion diameter (mm)",
|
||||
ylab = translate_AMR("Frequency", language = language),
|
||||
xlab = translate_AMR("Disk diffusion diameter (mm)", language = language),
|
||||
guideline = "EUCAST",
|
||||
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
|
||||
language = get_AMR_locale(),
|
||||
@ -478,18 +466,14 @@ autoplot.disk <- function(object,
|
||||
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
|
||||
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
|
||||
meet_criteria(guideline, allow_class = "character", has_length = 1)
|
||||
if ("colours_RSI" %in% names(list(...))) {
|
||||
deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
|
||||
colours_SIR <- list(...)$colours_RSI
|
||||
}
|
||||
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
|
||||
language <- validate_language(language)
|
||||
meet_criteria(expand, allow_class = "logical", has_length = 1)
|
||||
|
||||
# translate if not specifically set
|
||||
if (missing(ylab)) {
|
||||
ylab <- translate_into_language(ylab, language = language)
|
||||
}
|
||||
if (missing(xlab)) {
|
||||
xlab <- translate_into_language(xlab, language = language)
|
||||
}
|
||||
|
||||
if ("main" %in% names(list(...))) {
|
||||
title <- list(...)$main
|
||||
}
|
||||
@ -506,17 +490,23 @@ autoplot.disk <- function(object,
|
||||
colours_SIR = colours_SIR,
|
||||
fn = as.disk,
|
||||
language = language,
|
||||
type = "disk",
|
||||
...
|
||||
)
|
||||
df <- as.data.frame(x, stringsAsFactors = TRUE)
|
||||
colnames(df) <- c("disk", "count")
|
||||
df$cols <- cols_sub$cols
|
||||
|
||||
df$cols[df$cols == colours_SIR[1]] <- "Susceptible"
|
||||
df$cols[df$cols == colours_SIR[2]] <- plot_name_of_I(cols_sub$guideline)
|
||||
df$cols[df$cols == colours_SIR[3]] <- "Resistant"
|
||||
df$cols[df$cols == colours_SIR[1]] <- "(S) Susceptible"
|
||||
df$cols[df$cols == colours_SIR[2]] <- paste("(I)", plot_name_of_I(cols_sub$guideline))
|
||||
df$cols[df$cols == colours_SIR[3]] <- "(R) Resistant"
|
||||
df$cols <- factor(translate_into_language(df$cols, language = language),
|
||||
levels = translate_into_language(c("Susceptible", plot_name_of_I(cols_sub$guideline), "Resistant"),
|
||||
levels = translate_into_language(
|
||||
c(
|
||||
"(S) Susceptible",
|
||||
paste("(I)", plot_name_of_I(cols_sub$guideline)),
|
||||
"(R) Resistant"
|
||||
),
|
||||
language = language
|
||||
),
|
||||
ordered = TRUE
|
||||
@ -525,10 +515,10 @@ autoplot.disk <- function(object,
|
||||
|
||||
if (any(colours_SIR %in% cols_sub$cols)) {
|
||||
vals <- c(
|
||||
"Susceptible" = colours_SIR[1],
|
||||
"Susceptible, incr. exp." = colours_SIR[2],
|
||||
"Intermediate" = colours_SIR[2],
|
||||
"Resistant" = colours_SIR[3]
|
||||
"(S) Susceptible" = colours_SIR[1],
|
||||
"(I) Susceptible, incr. exp." = colours_SIR[2],
|
||||
"(I) Intermediate" = colours_SIR[2],
|
||||
"(R) Resistant" = colours_SIR[3]
|
||||
)
|
||||
names(vals) <- translate_into_language(names(vals), language = language)
|
||||
p <- p +
|
||||
@ -563,8 +553,8 @@ fortify.disk <- function(object, ...) {
|
||||
#' @importFrom graphics plot text axis
|
||||
#' @rdname plot
|
||||
plot.sir <- function(x,
|
||||
ylab = "Percentage",
|
||||
xlab = "Antimicrobial Interpretation",
|
||||
ylab = translate_AMR("Percentage", language = language),
|
||||
xlab = translate_AMR("Antimicrobial Interpretation", language = language),
|
||||
main = deparse(substitute(x)),
|
||||
language = get_AMR_locale(),
|
||||
...) {
|
||||
@ -572,26 +562,18 @@ plot.sir <- function(x,
|
||||
meet_criteria(xlab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
|
||||
# translate if not specifically set
|
||||
if (missing(ylab)) {
|
||||
ylab <- translate_into_language(ylab, language = language)
|
||||
}
|
||||
if (missing(xlab)) {
|
||||
xlab <- translate_into_language(xlab, language = language)
|
||||
}
|
||||
|
||||
data <- as.data.frame(table(x), stringsAsFactors = FALSE)
|
||||
colnames(data) <- c("x", "n")
|
||||
data$s <- round((data$n / sum(data$n)) * 100, 1)
|
||||
|
||||
if (!"S" %in% data$x) {
|
||||
data <- rbind2(data, data.frame(x = "S", n = 0, s = 0, stringsAsFactors = FALSE))
|
||||
data <- rbind_AMR(data, data.frame(x = "S", n = 0, s = 0, stringsAsFactors = FALSE))
|
||||
}
|
||||
if (!"I" %in% data$x) {
|
||||
data <- rbind2(data, data.frame(x = "I", n = 0, s = 0, stringsAsFactors = FALSE))
|
||||
data <- rbind_AMR(data, data.frame(x = "I", n = 0, s = 0, stringsAsFactors = FALSE))
|
||||
}
|
||||
if (!"R" %in% data$x) {
|
||||
data <- rbind2(data, data.frame(x = "R", n = 0, s = 0, stringsAsFactors = FALSE))
|
||||
data <- rbind_AMR(data, data.frame(x = "R", n = 0, s = 0, stringsAsFactors = FALSE))
|
||||
}
|
||||
|
||||
data$x <- factor(data$x, levels = c("S", "I", "R"), ordered = TRUE)
|
||||
@ -627,8 +609,8 @@ plot.sir <- function(x,
|
||||
#' @noRd
|
||||
barplot.sir <- function(height,
|
||||
main = deparse(substitute(height)),
|
||||
xlab = "Antimicrobial Interpretation",
|
||||
ylab = "Frequency",
|
||||
xlab = translate_AMR("Antimicrobial Interpretation", language = language),
|
||||
ylab = translate_AMR("Frequency", language = language),
|
||||
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
|
||||
language = get_AMR_locale(),
|
||||
expand = TRUE,
|
||||
@ -636,18 +618,14 @@ barplot.sir <- function(height,
|
||||
meet_criteria(xlab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(ylab, allow_class = "character", has_length = 1)
|
||||
if ("colours_RSI" %in% names(list(...))) {
|
||||
deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
|
||||
colours_SIR <- list(...)$colours_RSI
|
||||
}
|
||||
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
|
||||
language <- validate_language(language)
|
||||
meet_criteria(expand, allow_class = "logical", has_length = 1)
|
||||
|
||||
# translate if not specifically set
|
||||
if (missing(ylab)) {
|
||||
ylab <- translate_into_language(ylab, language = language)
|
||||
}
|
||||
if (missing(xlab)) {
|
||||
xlab <- translate_into_language(xlab, language = language)
|
||||
}
|
||||
|
||||
if (length(colours_SIR) == 1) {
|
||||
colours_SIR <- rep(colours_SIR, 3)
|
||||
}
|
||||
@ -670,8 +648,8 @@ barplot.sir <- function(height,
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
autoplot.sir <- function(object,
|
||||
title = deparse(substitute(object)),
|
||||
xlab = "Antimicrobial Interpretation",
|
||||
ylab = "Frequency",
|
||||
xlab = translate_AMR("Antimicrobial Interpretation", language = language),
|
||||
ylab = translate_AMR("Frequency", language = language),
|
||||
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
|
||||
language = get_AMR_locale(),
|
||||
...) {
|
||||
@ -681,14 +659,6 @@ autoplot.sir <- function(object,
|
||||
meet_criteria(xlab, allow_class = "character", has_length = 1)
|
||||
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
|
||||
|
||||
# translate if not specifically set
|
||||
if (missing(ylab)) {
|
||||
ylab <- translate_into_language(ylab, language = language)
|
||||
}
|
||||
if (missing(xlab)) {
|
||||
xlab <- translate_into_language(xlab, language = language)
|
||||
}
|
||||
|
||||
if ("main" %in% names(list(...))) {
|
||||
title <- list(...)$main
|
||||
}
|
||||
@ -774,33 +744,44 @@ plot_name_of_I <- function(guideline) {
|
||||
}
|
||||
}
|
||||
|
||||
plot_colours_subtitle_guideline <- function(x, mo, ab, guideline, colours_SIR, fn, language, ...) {
|
||||
plot_colours_subtitle_guideline <- function(x, mo, ab, guideline, colours_SIR, fn, language, type, ...) {
|
||||
guideline <- get_guideline(guideline, AMR::clinical_breakpoints)
|
||||
if (!is.null(mo) && !is.null(ab)) {
|
||||
# interpret and give colour based on MIC values
|
||||
mo <- as.mo(mo)
|
||||
ab <- as.ab(ab)
|
||||
sir <- suppressWarnings(suppressMessages(as.sir(fn(names(x)), mo = mo, ab = ab, guideline = guideline, ...)))
|
||||
cols <- character(length = length(sir))
|
||||
cols[is.na(sir)] <- "#BEBEBE"
|
||||
cols[sir == "S"] <- colours_SIR[1]
|
||||
cols[sir == "I"] <- colours_SIR[2]
|
||||
cols[sir == "R"] <- colours_SIR[3]
|
||||
moname <- mo_name(mo, language = language)
|
||||
ab <- as.ab(ab)
|
||||
abname <- ab_name(ab, language = language)
|
||||
if (all(cols == "#BEBEBE")) {
|
||||
|
||||
sir <- suppressWarnings(suppressMessages(as.sir(fn(names(x)), mo = mo, ab = ab, guideline = guideline, include_screening = FALSE, include_PKPD = TRUE, ...)))
|
||||
guideline_txt <- guideline
|
||||
if (all(is.na(sir))) {
|
||||
sir_screening <- suppressWarnings(suppressMessages(as.sir(fn(names(x)), mo = mo, ab = ab, guideline = guideline, include_screening = TRUE, include_PKPD = TRUE, ...)))
|
||||
if (!all(is.na(sir_screening))) {
|
||||
message_(
|
||||
"No ", guideline, " interpretations found for ",
|
||||
ab_name(ab, language = NULL, tolower = TRUE), " in ", moname
|
||||
"Only ", guideline, " ", type, " interpretations found for ",
|
||||
ab_name(ab, language = NULL, tolower = TRUE), " in ", italicise(moname), " for screening"
|
||||
)
|
||||
sir <- sir_screening
|
||||
guideline_txt <- paste0("(Screen, ", guideline_txt, ")")
|
||||
} else {
|
||||
message_(
|
||||
"No ", guideline, " ", type, " interpretations found for ",
|
||||
ab_name(ab, language = NULL, tolower = TRUE), " in ", italicise(moname)
|
||||
)
|
||||
guideline_txt <- ""
|
||||
}
|
||||
} else {
|
||||
guideline_txt <- guideline
|
||||
if (isTRUE(list(...)$uti)) {
|
||||
guideline_txt <- paste("UTIs,", guideline_txt)
|
||||
}
|
||||
guideline_txt <- paste0("(", guideline_txt, ")")
|
||||
}
|
||||
cols <- character(length = length(sir))
|
||||
cols[is.na(sir)] <- "#BEBEBE"
|
||||
cols[sir == "S"] <- colours_SIR[1]
|
||||
cols[sir == "I"] <- colours_SIR[2]
|
||||
cols[sir == "R"] <- colours_SIR[3]
|
||||
sub <- bquote(.(abname) ~ "-" ~ italic(.(moname)) ~ .(guideline_txt))
|
||||
} else {
|
||||
cols <- "#BEBEBE"
|
||||
|
@ -39,10 +39,11 @@
|
||||
#' @param data a [data.frame] containing columns with class [`sir`] (see [as.sir()])
|
||||
#' @param translate_ab a column name of the [antibiotics] data set to translate the antibiotic abbreviations to, using [ab_property()]
|
||||
#' @inheritParams ab_property
|
||||
#' @param combine_SI a [logical] to indicate whether all values of S and I must be merged into one, so the output only consists of S+I vs. R (susceptible vs. resistant), defaults to `TRUE`
|
||||
#' @param combine_SI a [logical] to indicate whether all values of S and I must be merged into one, so the output only consists of S+I vs. R (susceptible vs. resistant) - the default is `TRUE`
|
||||
#' @param ab_result antibiotic results to test against, must be one or more values of "S", "I", or "R"
|
||||
#' @param confidence_level the confidence level for the returned confidence interval. For the calculation, the number of S or SI isolates, and R isolates are compared with the total number of available isolates with R, S, or I by using [binom.test()], i.e., the Clopper-Pearson method.
|
||||
#' @param side the side of the confidence interval to return. Defaults to `"both"` for a length 2 vector, but can also be (abbreviated as) `"min"`/`"left"`/`"lower"`/`"less"` or `"max"`/`"right"`/`"higher"`/`"greater"`.
|
||||
#' @param side the side of the confidence interval to return. The default is `"both"` for a length 2 vector, but can also be (abbreviated as) `"min"`/`"left"`/`"lower"`/`"less"` or `"max"`/`"right"`/`"higher"`/`"greater"`.
|
||||
#' @param collapse a [logical] to indicate whether the output values should be 'collapsed', i.e. be merged together into one value, or a character value to use for collapsing
|
||||
#' @inheritSection as.sir Interpretation of SIR
|
||||
#' @details
|
||||
#' The function [resistance()] is equal to the function [proportion_R()]. The function [susceptibility()] is equal to the function [proportion_SI()].
|
||||
@ -112,6 +113,10 @@
|
||||
#' sir_confidence_interval(example_isolates$AMX,
|
||||
#' confidence_level = 0.975
|
||||
#' )
|
||||
#' sir_confidence_interval(example_isolates$AMX,
|
||||
#' confidence_level = 0.975,
|
||||
#' collapse = ", "
|
||||
#' )
|
||||
#'
|
||||
#' # determines %S+I:
|
||||
#' susceptibility(example_isolates$AMX)
|
||||
@ -260,10 +265,16 @@ sir_confidence_interval <- function(...,
|
||||
as_percent = FALSE,
|
||||
only_all_tested = FALSE,
|
||||
confidence_level = 0.95,
|
||||
side = "both") {
|
||||
side = "both",
|
||||
collapse = FALSE) {
|
||||
meet_criteria(ab_result, allow_class = c("character", "sir"), has_length = c(1, 2, 3), is_in = c("S", "I", "R"))
|
||||
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)
|
||||
meet_criteria(only_all_tested, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(confidence_level, allow_class = "numeric", is_positive = TRUE, has_length = 1)
|
||||
meet_criteria(side, allow_class = "character", has_length = 1, is_in = c("both", "b", "left", "l", "lower", "lowest", "less", "min", "right", "r", "higher", "highest", "greater", "g", "max"))
|
||||
meet_criteria(collapse, allow_class = c("logical", "character"), has_length = 1)
|
||||
|
||||
x <- tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = ab_result,
|
||||
@ -281,19 +292,7 @@ sir_confidence_interval <- function(...,
|
||||
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
|
||||
if (n < minimum) {
|
||||
warning_("Introducing NA: ",
|
||||
ifelse(n == 0, "no", paste("only", n)),
|
||||
" results available for `sir_confidence_interval()` (`minimum` = ", minimum, ").",
|
||||
call = FALSE
|
||||
)
|
||||
if (as_percent == TRUE) {
|
||||
return(NA_character_)
|
||||
} else {
|
||||
return(NA_real_)
|
||||
}
|
||||
}
|
||||
|
||||
# this applies the Clopper-Pearson method
|
||||
out <- stats::binom.test(x = x, n = n, conf.level = confidence_level)$conf.int
|
||||
out <- set_clean_class(out, "double")
|
||||
|
||||
@ -302,11 +301,30 @@ sir_confidence_interval <- function(...,
|
||||
} else if (side %in% c("right", "r", "higher", "highest", "greater", "g", "max")) {
|
||||
out <- out[2]
|
||||
}
|
||||
if (as_percent == TRUE) {
|
||||
percentage(out, digits = 1)
|
||||
} else {
|
||||
out
|
||||
if (isTRUE(as_percent)) {
|
||||
out <- percentage(out, digits = 1)
|
||||
}
|
||||
if (!isFALSE(collapse) && length(out) > 1) {
|
||||
if (is.numeric(out)) {
|
||||
out <- round(out, digits = 3)
|
||||
}
|
||||
out <- paste(out, collapse = ifelse(isTRUE(collapse), "-", collapse))
|
||||
}
|
||||
|
||||
if (n < minimum) {
|
||||
warning_("Introducing NA: ",
|
||||
ifelse(n == 0, "no", paste("only", n)),
|
||||
" results available for `sir_confidence_interval()` (`minimum` = ", minimum, ").",
|
||||
call = FALSE
|
||||
)
|
||||
if (is.character(out)) {
|
||||
return(NA_character_)
|
||||
} else {
|
||||
return(NA_real_)
|
||||
}
|
||||
}
|
||||
|
||||
out
|
||||
}
|
||||
|
||||
#' @rdname proportion
|
||||
|
@ -83,6 +83,10 @@ random_disk <- function(size = NULL, mo = NULL, ab = NULL, ...) {
|
||||
#' @export
|
||||
random_sir <- function(size = NULL, prob_SIR = c(0.33, 0.33, 0.33), ...) {
|
||||
meet_criteria(size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE, allow_NULL = TRUE)
|
||||
if ("prob_RSI" %in% names(list(...))) {
|
||||
deprecation_warning("prob_RSI", "prob_SIR", is_function = FALSE)
|
||||
prob_SIR <- list(...)$prob_RSI
|
||||
}
|
||||
meet_criteria(prob_SIR, allow_class = c("numeric", "integer"), has_length = 3)
|
||||
if (is.null(size)) {
|
||||
size <- NROW(get_current_data(arg_name = "size", call = -3))
|
||||
@ -91,7 +95,7 @@ random_sir <- function(size = NULL, prob_SIR = c(0.33, 0.33, 0.33), ...) {
|
||||
}
|
||||
|
||||
random_exec <- function(type, size, mo = NULL, ab = NULL) {
|
||||
df <- clinical_breakpoints %pm>%
|
||||
df <- AMR::clinical_breakpoints %pm>%
|
||||
pm_filter(guideline %like% "EUCAST") %pm>%
|
||||
pm_arrange(pm_desc(guideline)) %pm>%
|
||||
subset(guideline == max(guideline) &
|
||||
|
@ -32,9 +32,9 @@
|
||||
#' Create a prediction model to predict antimicrobial resistance for the next years on statistical solid ground. Standard errors (SE) will be returned as columns `se_min` and `se_max`. See *Examples* for a real live example.
|
||||
#' @param object model data to be plotted
|
||||
#' @param col_ab column name of `x` containing antimicrobial interpretations (`"R"`, `"I"` and `"S"`)
|
||||
#' @param col_date column name of the date, will be used to calculate years if this column doesn't consist of years already, defaults to the first column of with a date class
|
||||
#' @param col_date column name of the date, will be used to calculate years if this column doesn't consist of years already - the default is the first column of with a date class
|
||||
#' @param year_min lowest year to use in the prediction model, dafaults to the lowest year in `col_date`
|
||||
#' @param year_max highest year to use in the prediction model, defaults to 10 years after today
|
||||
#' @param year_max highest year to use in the prediction model - the default is 10 years after today
|
||||
#' @param year_every unit of sequence between lowest year found in the data and `year_max`
|
||||
#' @param minimum minimal amount of available isolates per year to include. Years containing less observations will be estimated by the model.
|
||||
#' @param model the statistical model of choice. This could be a generalised linear regression model with binomial distribution (i.e. using `glm(..., family = binomial)`, assuming that a period of zero resistance was followed by a period of increasing resistance leading slowly to more and more resistance. See *Details* for all valid options.
|
||||
|
27
R/sir.R
27
R/sir.R
@ -38,11 +38,11 @@
|
||||
#' @param ab any (vector of) text that can be coerced to a valid antimicrobial drug code with [as.ab()]
|
||||
#' @param uti (Urinary Tract Infection) A vector with [logical]s (`TRUE` or `FALSE`) to specify whether a UTI specific interpretation from the guideline should be chosen. For using [as.sir()] on a [data.frame], this can also be a column containing [logical]s or when left blank, the data set will be searched for a column 'specimen', and rows within this column containing 'urin' (such as 'urine', 'urina') will be regarded isolates from a UTI. See *Examples*.
|
||||
#' @inheritParams first_isolate
|
||||
#' @param guideline defaults to EUCAST `r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "EUCAST")$guideline)))` (the latest implemented EUCAST guideline in the [AMR::clinical_breakpoints] data set), but can be set with the option [`AMR_guideline`][AMR-options]. Currently supports EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`) and CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "CLSI")$guideline)))`), see *Details*.
|
||||
#' @param guideline defaults to EUCAST `r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "EUCAST")$guideline)))` (the latest implemented EUCAST guideline in the [AMR::clinical_breakpoints] data set), but can be set with the [package option][AMR-options] [`AMR_guideline`][AMR-options]. Currently supports EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`) and CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "CLSI")$guideline)))`), see *Details*.
|
||||
#' @param conserve_capped_values a [logical] to indicate that MIC values starting with `">"` (but not `">="`) must always return "R" , and that MIC values starting with `"<"` (but not `"<="`) must always return "S"
|
||||
#' @param add_intrinsic_resistance *(only useful when using a EUCAST guideline)* a [logical] to indicate whether intrinsic antibiotic resistance must also be considered for applicable bug-drug combinations, meaning that e.g. ampicillin will always return "R" in *Klebsiella* species. Determination is based on the [intrinsic_resistant] data set, that itself is based on `r format_eucast_version_nr(3.3)`.
|
||||
#' @param include_screening a [logical] to indicate that clinical breakpoints for screening are allowed, defaults to `FALSE`. Can also be set with the option [`AMR_include_screening`][AMR-options].
|
||||
#' @param include_PKPD a [logical] to indicate that PK/PD clinical breakpoints must be applied as a last resort, defaults to `TRUE`. Can also be set with the option [`AMR_include_PKPD`][AMR-options].
|
||||
#' @param include_screening a [logical] to indicate that clinical breakpoints for screening are allowed - the default is `FALSE`. Can also be set with the [package option][AMR-options] [`AMR_include_screening`][AMR-options].
|
||||
#' @param include_PKPD a [logical] to indicate that PK/PD clinical breakpoints must be applied as a last resort - the default is `TRUE`. Can also be set with the [package option][AMR-options] [`AMR_include_PKPD`][AMR-options].
|
||||
#' @param reference_data a [data.frame] to be used for interpretation, which defaults to the [clinical_breakpoints] data set. Changing this argument allows for using own interpretation guidelines. This argument must contain a data set that is equal in structure to the [clinical_breakpoints] data set (same column names and column types). Please note that the `guideline` argument will be ignored when `reference_data` is manually set.
|
||||
#' @param threshold maximum fraction of invalid antimicrobial interpretations of `x`, see *Examples*
|
||||
#' @param ... for using on a [data.frame]: names of columns to apply [as.sir()] on (supports tidy selection such as `column1:column4`). Otherwise: arguments passed on to methods.
|
||||
@ -76,7 +76,7 @@
|
||||
#'
|
||||
#' Thus, the `guideline` argument must be set to e.g., ``r paste0('"', subset(AMR::clinical_breakpoints, guideline %like% "EUCAST")$guideline[1], '"')`` or ``r paste0('"', subset(AMR::clinical_breakpoints, guideline %like% "CLSI")$guideline[1], '"')``. By simply using `"EUCAST"` (the default) or `"CLSI"` as input, the latest included version of that guideline will automatically be selected. You can set your own data set using the `reference_data` argument. The `guideline` argument will then be ignored.
|
||||
#'
|
||||
#' You can set the default guideline with the option [`AMR_guideline`][AMR-options] (e.g. in your `.Rprofile` file), such as:
|
||||
#' You can set the default guideline with the [package option][AMR-options] [`AMR_guideline`][AMR-options] (e.g. in your `.Rprofile` file), such as:
|
||||
#'
|
||||
#' ```
|
||||
#' options(AMR_guideline = "CLSI")
|
||||
@ -232,7 +232,12 @@ is.sir <- function(x) {
|
||||
if (inherits(x, "data.frame")) {
|
||||
unname(vapply(FUN.VALUE = logical(1), x, is.sir))
|
||||
} else {
|
||||
inherits(x, "sir")
|
||||
rsi <- inherits(x, "rsi")
|
||||
sir <- inherits(x, "sir")
|
||||
if (isTRUE(rsi) && message_not_thrown_before("is.sir-rsi")) {
|
||||
deprecation_warning(extra_msg = "The 'rsi' class has been replaced with 'sir'. Transform your 'rsi' columns to 'sir' with `as.sir()`, e.g.:\n your_data %>% mutate_if(is.rsi, as.sir)")
|
||||
}
|
||||
isTRUE(rsi) || isTRUE(sir)
|
||||
}
|
||||
}
|
||||
|
||||
@ -295,7 +300,7 @@ is_sir_eligible <- function(x, threshold = 0.05) {
|
||||
#' @export
|
||||
# extra param: warn (logical, to never throw a warning)
|
||||
as.sir.default <- function(x, ...) {
|
||||
if (is.sir(x)) {
|
||||
if (inherits(x, "sir")) {
|
||||
return(x)
|
||||
}
|
||||
|
||||
@ -770,7 +775,7 @@ as_sir_method <- function(method_short,
|
||||
} else {
|
||||
mo.bak <- mo
|
||||
}
|
||||
# be sure to take current taxonomy, as the clinical_breakpoints data set only contains current taxonomy
|
||||
# be sure to take current taxonomy, as the 'clinical_breakpoints' data set only contains current taxonomy
|
||||
mo <- suppressWarnings(suppressMessages(as.mo(mo, keep_synonyms = FALSE, inf0 = FALSE)))
|
||||
guideline_coerced <- get_guideline(guideline, reference_data)
|
||||
if (is.na(ab)) {
|
||||
@ -994,7 +999,7 @@ as_sir_method <- function(method_short,
|
||||
}
|
||||
|
||||
if (method == "mic") {
|
||||
new_sir <- quick_case_when(
|
||||
new_sir <- case_when_AMR(
|
||||
is.na(values) ~ NA_sir_,
|
||||
values <= breakpoints_current$breakpoint_S ~ as.sir("S"),
|
||||
guideline_coerced %like% "EUCAST" & values > breakpoints_current$breakpoint_R ~ as.sir("R"),
|
||||
@ -1005,7 +1010,7 @@ as_sir_method <- function(method_short,
|
||||
TRUE ~ NA_sir_
|
||||
)
|
||||
} else if (method == "disk") {
|
||||
new_sir <- quick_case_when(
|
||||
new_sir <- case_when_AMR(
|
||||
is.na(values) ~ NA_sir_,
|
||||
as.double(values) >= as.double(breakpoints_current$breakpoint_S) ~ as.sir("S"),
|
||||
guideline_coerced %like% "EUCAST" & as.double(values) < as.double(breakpoints_current$breakpoint_R) ~ as.sir("R"),
|
||||
@ -1018,7 +1023,7 @@ as_sir_method <- function(method_short,
|
||||
}
|
||||
|
||||
# write to verbose output
|
||||
AMR_env$sir_interpretation_history <- rbind2(
|
||||
AMR_env$sir_interpretation_history <- rbind_AMR(
|
||||
AMR_env$sir_interpretation_history,
|
||||
# recycling 1 to 2 rows does not seem to work, which is why rep() was added
|
||||
data.frame(
|
||||
@ -1080,7 +1085,7 @@ sir_interpretation_history <- function(clean = FALSE) {
|
||||
# sort descending on time
|
||||
out <- out[order(out$datetime, decreasing = TRUE), , drop = FALSE]
|
||||
|
||||
if (pkg_is_available("tibble", also_load = FALSE)) {
|
||||
if (pkg_is_available("tibble")) {
|
||||
import_fn("as_tibble", "tibble")(out)
|
||||
} else {
|
||||
out
|
||||
|
@ -223,7 +223,7 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
|
||||
combine_SI = TRUE,
|
||||
confidence_level = 0.95) {
|
||||
meet_criteria(type, is_in = c("proportion", "count", "both"), has_length = 1)
|
||||
meet_criteria(data, allow_class = "data.frame", contains_column_class = "sir")
|
||||
meet_criteria(data, allow_class = "data.frame", contains_column_class = c("sir", "rsi"))
|
||||
meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)
|
||||
@ -322,7 +322,7 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
|
||||
}
|
||||
out_new <- cbind(group_values, out_new)
|
||||
}
|
||||
out <- rbind2(out, out_new)
|
||||
out <- rbind_AMR(out, out_new)
|
||||
}
|
||||
}
|
||||
out
|
||||
@ -331,7 +331,7 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
|
||||
# based on pm_apply_grouped_function
|
||||
apply_group <- function(.data, fn, groups, drop = FALSE, ...) {
|
||||
grouped <- pm_split_into_groups(.data, groups, drop)
|
||||
res <- do.call(rbind2, unname(lapply(grouped, fn, ...)))
|
||||
res <- do.call(rbind_AMR, unname(lapply(grouped, fn, ...)))
|
||||
if (any(groups %in% colnames(res))) {
|
||||
class(res) <- c("grouped_data", class(res))
|
||||
res <- pm_set_groups(res, groups[groups %in% colnames(res)])
|
||||
|
BIN
R/sysdata.rda
BIN
R/sysdata.rda
Binary file not shown.
@ -34,7 +34,7 @@
|
||||
#' @param language language to choose. Use one of these supported language names or ISO-639-1 codes: `r vector_or(paste0(sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), " (" , LANGUAGES_SUPPORTED, ")"), quotes = FALSE, sort = FALSE)`.
|
||||
#' @details The currently `r length(LANGUAGES_SUPPORTED)` supported languages are `r vector_and(paste0(sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), " (" , LANGUAGES_SUPPORTED, ")"), quotes = FALSE, sort = FALSE)`. All these languages have translations available for all antimicrobial drugs and colloquial microorganism names.
|
||||
#'
|
||||
#' To permanently silence the once-per-session language note on a non-English operating system, you can set the option [`AMR_locale`][AMR-options] in your `.Rprofile` file like this:
|
||||
#' To permanently silence the once-per-session language note on a non-English operating system, you can set the [package option][AMR-options] [`AMR_locale`][AMR-options] in your `.Rprofile` file like this:
|
||||
#'
|
||||
#' ```r
|
||||
#' # Open .Rprofile file
|
||||
@ -51,12 +51,12 @@
|
||||
#' ### Changing the Default Language
|
||||
#' The system language will be used at default (as returned by `Sys.getenv("LANG")` or, if `LANG` is not set, [`Sys.getlocale("LC_COLLATE")`][Sys.getlocale()]), if that language is supported. But the language to be used can be overwritten in two ways and will be checked in this order:
|
||||
#'
|
||||
#' 1. Setting the option [`AMR_locale`][AMR-options], either by using e.g. `set_AMR_locale("German")` or by running e.g. `options(AMR_locale = "German")`.
|
||||
#' 1. Setting the [package option][AMR-options] [`AMR_locale`][AMR-options], either by using e.g. `set_AMR_locale("German")` or by running e.g. `options(AMR_locale = "German")`.
|
||||
#'
|
||||
#' Note that setting an \R option only works in the same session. Save the command `options(AMR_locale = "(your language)")` to your `.Rprofile` file to apply it for every session. Run `utils::file.edit("~/.Rprofile")` to edit your `.Rprofile` file.
|
||||
#' 2. Setting the system variable `LANGUAGE` or `LANG`, e.g. by adding `LANGUAGE="de_DE.utf8"` to your `.Renviron` file in your home directory.
|
||||
#'
|
||||
#' Thus, if the option [`AMR_locale`][AMR-options] is set, the system variables `LANGUAGE` and `LANG` will be ignored.
|
||||
#' Thus, if the [package option][AMR-options] [`AMR_locale`][AMR-options] is set, the system variables `LANGUAGE` and `LANG` will be ignored.
|
||||
#' @rdname translate
|
||||
#' @name translate
|
||||
#' @export
|
||||
|
@ -90,13 +90,9 @@ ggplot_rsi_predict <- function(...) {
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
is.rsi <- function(x, ...) {
|
||||
# this is an exception, so mutate_if(is.rsi, as.sir) can be used
|
||||
if (inherits(x, "data.frame")) {
|
||||
unname(vapply(FUN.VALUE = logical(1), x, is.rsi))
|
||||
} else {
|
||||
inherits(x, "rsi")
|
||||
}
|
||||
is.rsi <- function(...) {
|
||||
# REMINDER: change as.sir() to remove the deprecation warning there
|
||||
suppressWarnings(is.sir(...))
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
@ -150,8 +146,10 @@ theme_rsi <- function(...) {
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
pillar_shaft.rsi <- pillar_shaft.sir
|
||||
type_sum.rsi <- function(x, ...) {
|
||||
deprecation_warning(extra_msg = "* The 'rsi' class has been replaced with 'sir'. Transform your 'rsi' columns to 'sir' with `as.sir()`, e.g.:\n your_data %>% mutate_if(is.rsi, as.sir)")
|
||||
paste0("rsi", font_bold(font_red("[!]")))
|
||||
if (message_not_thrown_before("type_sum.rsi")) {
|
||||
deprecation_warning(extra_msg = "The 'rsi' class has been replaced with 'sir'. Transform your 'rsi' columns to 'sir' with `as.sir()`, e.g.:\n your_data %>% mutate_if(is.rsi, as.sir)")
|
||||
}
|
||||
"rsi"
|
||||
}
|
||||
|
||||
#' @method print rsi
|
||||
@ -191,21 +189,33 @@ summary.rsi <- summary.sir
|
||||
#' @export
|
||||
unique.rsi <- unique.sir
|
||||
|
||||
# WHEN REMOVING RSI, DON'T FORGET TO REMOVE THE "rsi_df" CLASS FROM R/sir_calc.R
|
||||
# WHEN REMOVING RSI, DON'T FORGET TO REMOVE :
|
||||
# - THE "rsi_df" CLASS FROM R/sir_calc.R
|
||||
# - CODE CONTAINING only_rsi_columns, colours_RSI, include_untested_rsi, prob_RSI
|
||||
|
||||
deprecation_warning <- function(old = NULL, new = NULL, extra_msg = NULL) {
|
||||
deprecation_warning <- function(old = NULL, new = NULL, extra_msg = NULL, is_function = TRUE) {
|
||||
if (is.null(old)) {
|
||||
warning_(extra_msg)
|
||||
} else {
|
||||
env <- paste0("deprecated_", old)
|
||||
if (!env %in% names(AMR_env)) {
|
||||
AMR_env[[paste0("deprecated_", old)]] <- 1
|
||||
if (isTRUE(is_function)) {
|
||||
old <- paste0(old, "()")
|
||||
new <- paste0(new, "()")
|
||||
type <- "function"
|
||||
} else {
|
||||
type <- "argument"
|
||||
}
|
||||
warning_(
|
||||
ifelse(is.null(new),
|
||||
paste0("The `", old, "()` function is no longer in use"),
|
||||
paste0("The `", old, "()` function has been replaced with `", new, "()`")
|
||||
paste0("The `", old, "` ", type, " is no longer in use"),
|
||||
paste0("The `", old, "` ", type, " has been replaced with `", new, "`")
|
||||
),
|
||||
ifelse(type == "argument",
|
||||
". While the old argument still works, it will be removed in a future version, so please update your code.",
|
||||
", see `?AMR-deprecated`."
|
||||
),
|
||||
", see `?AMR-deprecated`.",
|
||||
ifelse(!is.null(extra_msg),
|
||||
paste0(" ", extra_msg),
|
||||
""
|
||||
|
11
R/zzz.R
11
R/zzz.R
@ -112,7 +112,7 @@ if (utf8_supported && !is_latex) {
|
||||
s3_register("cleaner::freq", "mo")
|
||||
s3_register("cleaner::freq", "sir")
|
||||
# Support for skim() from the skimr package
|
||||
if (pkg_is_available("skimr", also_load = FALSE, min_version = "2.0.0")) {
|
||||
if (pkg_is_available("skimr", min_version = "2.0.0")) {
|
||||
s3_register("skimr::get_skimmers", "mo")
|
||||
s3_register("skimr::get_skimmers", "sir")
|
||||
s3_register("skimr::get_skimmers", "mic")
|
||||
@ -128,6 +128,9 @@ if (utf8_supported && !is_latex) {
|
||||
s3_register("ggplot2::fortify", "sir")
|
||||
s3_register("ggplot2::fortify", "mic")
|
||||
s3_register("ggplot2::fortify", "disk")
|
||||
# Support for knitr (R Markdown/Quarto)
|
||||
s3_register("knitr::knit_print", "antibiogram")
|
||||
s3_register("knitr::knit_print", "formatted_bug_drug_combinations")
|
||||
# Support vctrs package for use in e.g. dplyr verbs
|
||||
# S3: ab_selector
|
||||
s3_register("vctrs::vec_ptype2", "character.ab_selector")
|
||||
@ -178,7 +181,7 @@ if (utf8_supported && !is_latex) {
|
||||
try(invisible(get_mo_source()), silent = TRUE)
|
||||
}
|
||||
# be sure to print tibbles as tibbles
|
||||
if (pkg_is_available("tibble", also_load = FALSE)) {
|
||||
if (pkg_is_available("tibble")) {
|
||||
try(loadNamespace("tibble"), silent = TRUE)
|
||||
}
|
||||
|
||||
@ -192,7 +195,7 @@ if (utf8_supported && !is_latex) {
|
||||
# if custom ab option is available, load it
|
||||
if (!is.null(getOption("AMR_custom_ab")) && file.exists(getOption("AMR_custom_ab", default = ""))) {
|
||||
packageStartupMessage("Adding custom antimicrobials from '", getOption("AMR_custom_ab"), "'...", appendLF = FALSE)
|
||||
x <- readRDS2(getOption("AMR_custom_ab"))
|
||||
x <- readRDS_AMR(getOption("AMR_custom_ab"))
|
||||
tryCatch(
|
||||
{
|
||||
suppressWarnings(suppressMessages(add_custom_antimicrobials(x)))
|
||||
@ -204,7 +207,7 @@ if (utf8_supported && !is_latex) {
|
||||
# if custom mo option is available, load it
|
||||
if (!is.null(getOption("AMR_custom_mo")) && file.exists(getOption("AMR_custom_mo", default = ""))) {
|
||||
packageStartupMessage("Adding custom microorganisms from '", getOption("AMR_custom_mo"), "'...", appendLF = FALSE)
|
||||
x <- readRDS2(getOption("AMR_custom_mo"))
|
||||
x <- readRDS_AMR(getOption("AMR_custom_mo"))
|
||||
tryCatch(
|
||||
{
|
||||
suppressWarnings(suppressMessages(add_custom_microorganisms(x)))
|
||||
|
26
README.md
26
README.md
@ -27,26 +27,8 @@ install.packages("AMR")
|
||||
|
||||
It will be downloaded and installed automatically. For RStudio, click on the menu *Tools* > *Install Packages...* and then type in "AMR" and press <kbd>Install</kbd>.
|
||||
|
||||
### Copyright
|
||||
----
|
||||
|
||||
This R package is licensed under the [GNU General Public License (GPL) v2.0](https://github.com/msberends/AMR/blob/main/LICENSE). In a nutshell, this means that this package:
|
||||
|
||||
- May be used for commercial purposes
|
||||
|
||||
- May be used for private purposes
|
||||
|
||||
- May **not** be used for patent purposes
|
||||
|
||||
- May be modified, although:
|
||||
|
||||
- Modifications **must** be released under the same license when distributing the package
|
||||
- Changes made to the code **must** be documented
|
||||
|
||||
- May be distributed, although:
|
||||
|
||||
- Source code **must** be made available when the package is distributed
|
||||
- A copy of the license and copyright notice **must** be included with the package.
|
||||
|
||||
- Comes with a LIMITATION of liability
|
||||
|
||||
- Comes with NO warranty
|
||||
<small>
|
||||
This AMR package for R is free, open-source software and licensed under the [GNU General Public License v2.0 (GPL-2)](https://msberends.github.io/AMR/LICENSE-text.html). These requirements are consequently legally binding: modifications must be released under the same license when distributing the package, changes made to the code must be documented, source code must be made available when the package is distributed, and a copy of the license and copyright notice must be included with the package.
|
||||
</small>
|
||||
|
@ -76,9 +76,6 @@ navbar:
|
||||
- text: "How to"
|
||||
icon: "fa-question-circle"
|
||||
menu:
|
||||
- text: "User- Or Team-specific Package Settings"
|
||||
icon: "fa-gear"
|
||||
href: "reference/AMR-options.html"
|
||||
- text: "Conduct AMR Analysis"
|
||||
icon: "fa-directions"
|
||||
href: "articles/AMR.html"
|
||||
@ -88,9 +85,12 @@ navbar:
|
||||
- text: "Predict Antimicrobial Resistance"
|
||||
icon: "fa-dice"
|
||||
href: "articles/resistance_predict.html"
|
||||
- text: "Data Sets for Download / Own Use"
|
||||
- text: "Download Data Sets for Own Use"
|
||||
icon: "fa-database"
|
||||
href: "articles/datasets.html"
|
||||
- text: "Set User- Or Team-specific Package Settings"
|
||||
icon: "fa-gear"
|
||||
href: "reference/AMR-options.html"
|
||||
- text: "Conduct Principal Component Analysis for AMR"
|
||||
icon: "fa-compress"
|
||||
href: "articles/PCA.html"
|
||||
|
@ -1,2 +1,5 @@
|
||||
Extra release for fixing image options, as requested by CRAN team on 17 February 2022 (Kurt Hornik).
|
||||
As with all previous >20 releases, some CHECKs might return a NOTE for *just* hitting the installation size limit, though its size has been brought down to a minimum in collaboration with CRAN maintainers previously.
|
||||
|
||||
We consider this a high-impact package: it was published in the Journal of Statistical Software (2022), is including in a CRAN Task View (Epidemiology), and is according to download stats used in almost all countries in the world. If there is anything to note, please let us know up-front without directly archiving the current version. That said, we continually unit test our package extensively and have no reason to assume that anything is wrong.
|
||||
|
||||
Thanks for maintaining and hosting CRAN! It's empowering R and its use enormously!
|
||||
|
@ -148,11 +148,12 @@ create_species_cons_cops <- function(type = c("CoNS", "CoPS")) {
|
||||
}
|
||||
MO_CONS <- create_species_cons_cops("CoNS")
|
||||
MO_COPS <- create_species_cons_cops("CoPS")
|
||||
MO_STREP_ABCG <- AMR_env$MO_lookup$mo[which(AMR_env$MO_lookup$genus == "Streptococcus" &
|
||||
AMR_env$MO_lookup$species %in% c(
|
||||
MO_STREP_ABCG <- AMR::microorganisms$mo[which(AMR::microorganisms$genus == "Streptococcus" &
|
||||
tolower(AMR::microorganisms$species) %in% c(
|
||||
"pyogenes", "agalactiae", "dysgalactiae", "equi", "canis",
|
||||
"group A", "group B", "group C", "group G"
|
||||
"group a", "group b", "group c", "group g"
|
||||
))]
|
||||
MO_LANCEFIELD <- AMR::microorganisms$mo[which(AMR::microorganisms$mo %like% "^(B_STRPT_PYGN(_|$)|B_STRPT_AGLC(_|$)|B_STRPT_(DYSG|EQUI)(_|$)|B_STRPT_ANGN(_|$)|B_STRPT_(DYSG|CANS)(_|$)|B_STRPT_SNGN(_|$)|B_STRPT_SLVR(_|$))")]
|
||||
MO_PREVALENT_GENERA <- c(
|
||||
"Absidia", "Acanthamoeba", "Acremonium", "Aedes", "Alternaria", "Amoeba", "Ancylostoma", "Angiostrongylus",
|
||||
"Anisakis", "Anopheles", "Apophysomyces", "Aspergillus", "Aureobasidium", "Basidiobolus", "Beauveria",
|
||||
@ -285,6 +286,7 @@ suppressMessages(usethis::use_data(EUCAST_RULES_DF,
|
||||
MO_CONS,
|
||||
MO_COPS,
|
||||
MO_STREP_ABCG,
|
||||
MO_LANCEFIELD,
|
||||
MO_PREVALENT_GENERA,
|
||||
AB_LOOKUP,
|
||||
AV_LOOKUP,
|
||||
|
@ -1 +1 @@
|
||||
43220347c34d06a5c57f2014a8ecaa82
|
||||
8bf97fd5f1d8d82486902d05916ebca0
|
||||
|
@ -2,7 +2,7 @@
|
||||
title: "Generating antibiograms with the AMR package"
|
||||
author: "AMR package developers"
|
||||
date: "`r Sys.Date()`"
|
||||
output: html_document
|
||||
output: pdf_document
|
||||
---
|
||||
|
||||
```{r setup, include=FALSE}
|
||||
@ -22,35 +22,28 @@ example_isolates
|
||||
### Traditional Antibiogram
|
||||
|
||||
```{r trad}
|
||||
print(
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c(aminoglycosides(), carbapenems()))
|
||||
)
|
||||
```
|
||||
|
||||
### Combined Antibiogram
|
||||
|
||||
```{r comb}
|
||||
print(
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"))
|
||||
)
|
||||
```
|
||||
|
||||
### Syndromic Antibiogram
|
||||
|
||||
```{r synd}
|
||||
print(
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c(aminoglycosides(), carbapenems()),
|
||||
syndromic_group = "ward")
|
||||
)
|
||||
```
|
||||
|
||||
### Weighted-Incidence Syndromic Combination Antibiogram (WISCA)
|
||||
|
||||
```{r wisca}
|
||||
print(
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"),
|
||||
mo_transform = "gramstain",
|
||||
@ -58,5 +51,4 @@ print(
|
||||
syndromic_group = ifelse(example_isolates$age >= 65 &
|
||||
example_isolates$gender == "M",
|
||||
"WISCA Group 1", "WISCA Group 2"))
|
||||
)
|
||||
```
|
||||
|
@ -11,7 +11,7 @@
|
||||
|
||||
<meta name="author" content="AMR package developers" />
|
||||
|
||||
<meta name="date" content="2023-02-08" />
|
||||
<meta name="date" content="2023-02-24" />
|
||||
|
||||
<title>Generating antibiograms with the AMR package</title>
|
||||
|
||||
@ -353,7 +353,7 @@ display: none;
|
||||
<h1 class="title toc-ignore">Generating antibiograms with the AMR
|
||||
package</h1>
|
||||
<h4 class="author">AMR package developers</h4>
|
||||
<h4 class="date">2023-02-08</h4>
|
||||
<h4 class="date">2023-02-24</h4>
|
||||
|
||||
</div>
|
||||
|
||||
@ -385,10 +385,8 @@ looks like:</p>
|
||||
## # CHL <sir>, COL <sir>, MUP <sir>, RIF <sir></code></pre>
|
||||
<div id="traditional-antibiogram" class="section level3">
|
||||
<h3>Traditional Antibiogram</h3>
|
||||
<pre class="r"><code>print(
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c(aminoglycosides(), carbapenems()))
|
||||
)</code></pre>
|
||||
<pre class="r"><code>antibiogram(example_isolates,
|
||||
antibiotics = c(aminoglycosides(), carbapenems()))</code></pre>
|
||||
<table>
|
||||
<thead>
|
||||
<tr class="header">
|
||||
@ -412,84 +410,84 @@ looks like:</p>
|
||||
<td align="right">22</td>
|
||||
</tr>
|
||||
<tr class="even">
|
||||
<td align="left">E. coli (0-462)</td>
|
||||
<td align="left"><em>E. coli</em> (0-462)</td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">98</td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">97</td>
|
||||
</tr>
|
||||
<tr class="odd">
|
||||
<td align="left">E. faecalis (0-39)</td>
|
||||
<td align="left"><em>E. faecalis</em> (0-39)</td>
|
||||
<td align="right">0</td>
|
||||
<td align="right">0</td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">0</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">0</td>
|
||||
</tr>
|
||||
<tr class="even">
|
||||
<td align="left">K. pneumoniae (0-58)</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="left"><em>K. pneumoniae</em> (0-58)</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">90</td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">90</td>
|
||||
</tr>
|
||||
<tr class="odd">
|
||||
<td align="left">P. aeruginosa (17-30)</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="left"><em>P. aeruginosa</em> (17-30)</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">0</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">100</td>
|
||||
</tr>
|
||||
<tr class="even">
|
||||
<td align="left">P. mirabilis (0-34)</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="left"><em>P. mirabilis</em> (0-34)</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">94</td>
|
||||
<td align="right">94</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
<td align="right">94</td>
|
||||
</tr>
|
||||
<tr class="odd">
|
||||
<td align="left">S. aureus (2-233)</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="left"><em>S. aureus</em> (2-233)</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">99</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
<td align="right">98</td>
|
||||
</tr>
|
||||
<tr class="even">
|
||||
<td align="left">S. epidermidis (8-163)</td>
|
||||
<td align="left"><em>S. epidermidis</em> (8-163)</td>
|
||||
<td align="right">0</td>
|
||||
<td align="right">79</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">0</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">51</td>
|
||||
</tr>
|
||||
<tr class="odd">
|
||||
<td align="left">S. hominis (3-80)</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="left"><em>S. hominis</em> (3-80)</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">92</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
<td align="right">85</td>
|
||||
</tr>
|
||||
<tr class="even">
|
||||
<td align="left">S. pneumoniae (11-117)</td>
|
||||
<td align="left"><em>S. pneumoniae</em> (11-117)</td>
|
||||
<td align="right">0</td>
|
||||
<td align="right">0</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">0</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">0</td>
|
||||
</tr>
|
||||
</tbody>
|
||||
@ -497,10 +495,8 @@ looks like:</p>
|
||||
</div>
|
||||
<div id="combined-antibiogram" class="section level3">
|
||||
<h3>Combined Antibiogram</h3>
|
||||
<pre class="r"><code>print(
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"))
|
||||
)</code></pre>
|
||||
<pre class="r"><code>antibiogram(example_isolates,
|
||||
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"))</code></pre>
|
||||
<table>
|
||||
<thead>
|
||||
<tr class="header">
|
||||
@ -515,52 +511,52 @@ looks like:</p>
|
||||
<td align="left">CoNS (29-274)</td>
|
||||
<td align="right">30</td>
|
||||
<td align="right">97</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
</tr>
|
||||
<tr class="even">
|
||||
<td align="left">E. coli (416-461)</td>
|
||||
<td align="left"><em>E. coli</em> (416-461)</td>
|
||||
<td align="right">94</td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">99</td>
|
||||
</tr>
|
||||
<tr class="odd">
|
||||
<td align="left">K. pneumoniae (53-58)</td>
|
||||
<td align="left"><em>K. pneumoniae</em> (53-58)</td>
|
||||
<td align="right">89</td>
|
||||
<td align="right">93</td>
|
||||
<td align="right">93</td>
|
||||
</tr>
|
||||
<tr class="even">
|
||||
<td align="left">P. aeruginosa (27-30)</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="left"><em>P. aeruginosa</em> (27-30)</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">100</td>
|
||||
</tr>
|
||||
<tr class="odd">
|
||||
<td align="left">P. mirabilis (27-34)</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="left"><em>P. mirabilis</em> (27-34)</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">100</td>
|
||||
</tr>
|
||||
<tr class="even">
|
||||
<td align="left">S. aureus (7-231)</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="left"><em>S. aureus</em> (7-231)</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">100</td>
|
||||
</tr>
|
||||
<tr class="odd">
|
||||
<td align="left">S. epidermidis (5-128)</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="left"><em>S. epidermidis</em> (5-128)</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">100</td>
|
||||
</tr>
|
||||
<tr class="even">
|
||||
<td align="left">S. hominis (0-74)</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="left"><em>S. hominis</em> (0-74)</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">100</td>
|
||||
</tr>
|
||||
<tr class="odd">
|
||||
<td align="left">S. pneumoniae (112-112)</td>
|
||||
<td align="left"><em>S. pneumoniae</em> (112-112)</td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">100</td>
|
||||
@ -570,12 +566,20 @@ looks like:</p>
|
||||
</div>
|
||||
<div id="syndromic-antibiogram" class="section level3">
|
||||
<h3>Syndromic Antibiogram</h3>
|
||||
<pre class="r"><code>print(
|
||||
antibiogram(example_isolates,
|
||||
<pre class="r"><code>antibiogram(example_isolates,
|
||||
antibiotics = c(aminoglycosides(), carbapenems()),
|
||||
syndromic_group = "ward")
|
||||
)</code></pre>
|
||||
syndromic_group = "ward")</code></pre>
|
||||
<table>
|
||||
<colgroup>
|
||||
<col width="25%" />
|
||||
<col width="37%" />
|
||||
<col width="6%" />
|
||||
<col width="6%" />
|
||||
<col width="6%" />
|
||||
<col width="6%" />
|
||||
<col width="6%" />
|
||||
<col width="6%" />
|
||||
</colgroup>
|
||||
<thead>
|
||||
<tr class="header">
|
||||
<th align="left">Syndromic Group</th>
|
||||
@ -592,141 +596,141 @@ looks like:</p>
|
||||
<tr class="odd">
|
||||
<td align="left">Clinical</td>
|
||||
<td align="left">CoNS (23-205)</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">89</td>
|
||||
<td align="right">57</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">57</td>
|
||||
<td align="right">26</td>
|
||||
</tr>
|
||||
<tr class="even">
|
||||
<td align="left">ICU</td>
|
||||
<td align="left">CoNS (10-73)</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">79</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
</tr>
|
||||
<tr class="odd">
|
||||
<td align="left">Outpatient</td>
|
||||
<td align="left">CoNS (3-31)</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">84</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
</tr>
|
||||
<tr class="even">
|
||||
<td align="left">Clinical</td>
|
||||
<td align="left">E. coli (0-299)</td>
|
||||
<td align="left"><em>E. coli</em> (0-299)</td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">98</td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">98</td>
|
||||
</tr>
|
||||
<tr class="odd">
|
||||
<td align="left">ICU</td>
|
||||
<td align="left">E. coli (0-137)</td>
|
||||
<td align="left"><em>E. coli</em> (0-137)</td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">99</td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">96</td>
|
||||
</tr>
|
||||
<tr class="even">
|
||||
<td align="left">Clinical</td>
|
||||
<td align="left">K. pneumoniae (0-51)</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="left"><em>K. pneumoniae</em> (0-51)</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">92</td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">92</td>
|
||||
</tr>
|
||||
<tr class="odd">
|
||||
<td align="left">Clinical</td>
|
||||
<td align="left">P. mirabilis (0-30)</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="left"><em>P. mirabilis</em> (0-30)</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
<td align="right">100</td>
|
||||
</tr>
|
||||
<tr class="even">
|
||||
<td align="left">Clinical</td>
|
||||
<td align="left">S. aureus (2-150)</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="left"><em>S. aureus</em> (2-150)</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">99</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
<td align="right">97</td>
|
||||
</tr>
|
||||
<tr class="odd">
|
||||
<td align="left">ICU</td>
|
||||
<td align="left">S. aureus (0-66)</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="left"><em>S. aureus</em> (0-66)</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">100</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
</tr>
|
||||
<tr class="even">
|
||||
<td align="left">Clinical</td>
|
||||
<td align="left">S. epidermidis (4-79)</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="left"><em>S. epidermidis</em> (4-79)</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">82</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
<td align="right">55</td>
|
||||
</tr>
|
||||
<tr class="odd">
|
||||
<td align="left">ICU</td>
|
||||
<td align="left">S. epidermidis (4-75)</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="left"><em>S. epidermidis</em> (4-75)</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">72</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
<td align="right">41</td>
|
||||
</tr>
|
||||
<tr class="even">
|
||||
<td align="left">Clinical</td>
|
||||
<td align="left">S. hominis (1-45)</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="left"><em>S. hominis</em> (1-45)</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">96</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
<td align="right"></td>
|
||||
<td align="right">94</td>
|
||||
</tr>
|
||||
<tr class="odd">
|
||||
<td align="left">Clinical</td>
|
||||
<td align="left">S. pneumoniae (5-78)</td>
|
||||
<td align="left"><em>S. pneumoniae</em> (5-78)</td>
|
||||
<td align="right">0</td>
|
||||
<td align="right">0</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">0</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">0</td>
|
||||
</tr>
|
||||
<tr class="even">
|
||||
<td align="left">ICU</td>
|
||||
<td align="left">S. pneumoniae (5-30)</td>
|
||||
<td align="left"><em>S. pneumoniae</em> (5-30)</td>
|
||||
<td align="right">0</td>
|
||||
<td align="right">0</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">0</td>
|
||||
<td align="right">NA</td>
|
||||
<td align="right"></td>
|
||||
<td align="right">0</td>
|
||||
</tr>
|
||||
</tbody>
|
||||
@ -734,15 +738,13 @@ looks like:</p>
|
||||
</div>
|
||||
<div id="weighted-incidence-syndromic-combination-antibiogram-wisca" class="section level3">
|
||||
<h3>Weighted-Incidence Syndromic Combination Antibiogram (WISCA)</h3>
|
||||
<pre class="r"><code>print(
|
||||
antibiogram(example_isolates,
|
||||
<pre class="r"><code>antibiogram(example_isolates,
|
||||
antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"),
|
||||
mo_transform = "gramstain",
|
||||
minimum = 10, # this should be >= 30, but now just as example
|
||||
syndromic_group = ifelse(example_isolates$age >= 65 &
|
||||
example_isolates$gender == "M",
|
||||
"WISCA Group 1", "WISCA Group 2"))
|
||||
)</code></pre>
|
||||
"WISCA Group 1", "WISCA Group 2"))</code></pre>
|
||||
<table>
|
||||
<colgroup>
|
||||
<col width="23%" />
|
||||
|
BIN
data-raw/antibiograms.pdf
Normal file
BIN
data-raw/antibiograms.pdf
Normal file
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@ -410,7 +410,7 @@
|
||||
"SLT3" "Sulfamerazine/trimethoprim" "Trimethoprims" "J01EE07" "Sulfonamides and trimethoprim" "Combinations of sulfonamides and trimethoprim, incl. derivatives" "" "" ""
|
||||
"SUM" 5327 "Sulfamethazine" "Other antibacterials" "NA" "" "azolmetazin,benzene sulfonamide,calfspan,calfspan tablets,cremomethazine,diazil,diazilsulfadine,dimezathine,intradine,kelametazine,mermeth,metazin,neasina,neazina,nsulfanilamide,panazin,pirmazin,primazin,sa iii,solfadimidina,spanbolet,sulfadimerazine,sulfadimesin,sulfadimesine,sulfadimethyldiazine,sulfadimezin,sulfadimezine,sulfadimezinum,sulfadimidin,sulfadimidina,sulfadimidine,sulfadimidinum,sulfadine,sulfametazina,sulfametazyny,sulfamethazine,sulfamethiazine,sulfamezathine,sulfamidine,sulfasure sr bolus,sulfodimesin,sulfodimezine,sulka k boluses,sulka s boluses,sulmet,sulphadimidine,sulphamethasine,sulphamethazine,sulphamezathine,sulphamidine,sulphodimezine,superseptil,superseptyl,vertolan" "87592-2"
|
||||
"SLF4" 5328 "Sulfamethizole" "Trimethoprims" "B05CA04,D06BA04,J01EB02,S01AB01" "Sulfonamides and trimethoprim" "Short-acting sulfonamides" "sfmz" "ayerlucil,lucosil,methazol,microsul,nsulfanilamide,proklar,renasul,salimol,solfametizolo,sulamethizole,sulfa gram,sulfamethizol,sulfamethizole,sulfamethizolum,sulfametizol,sulfapyelon,sulfstat,sulfurine,sulphamethizole,tetracid,thidicur,thiosulfil,thiosulfil forte,ultrasul,urocydal,urodiaton,urolucosil,urosulfin" 4 "g" "60175-7,60176-5,60177-3"
|
||||
"SMX" 5329 "Sulfamethoxazole" "Trimethoprims" "J01EC01" "Sulfonamides and trimethoprim" "Intermediate-acting sulfonamides" "sfmx,sulf" "azo gantanol,bactrim,bactrimel,cotrimoxazole,eusaprim,gamazole,gantanol,gantanol ds,metoxal,nsulfanilamide,nsulphanilamide,radonil,septran,septrin,simsinomin,sinomin,solfametossazolo,sulfamethalazole,sulfamethoxazol,sulfamethoxazole,sulfamethoxazolum,sulfamethoxizole,sulfamethylisoxazole,sulfametoxazol,sulfisomezole,sulmeprim,sulphamethalazole,sulphamethoxazol,sulphamethoxazole,sulphisomezole,urobak" 2 "g" "10342-4,25271-8,39772-9,59971-2,59972-0,60333-2,72674-5,80549-9,80974-9"
|
||||
"SMX" 5329 "Sulfamethoxazole" "Trimethoprims" "J01EC01" "Sulfonamides and trimethoprim" "Intermediate-acting sulfonamides" "sfmx,sulf" "azo gantanol,gamazole,gantanol,gantanol ds,metoxal,nsulfanilamide,nsulphanilamide,radonil,septran,simsinomin,sinomin,solfametossazolo,sulfamethalazole,sulfamethoxazol,sulfamethoxazole,sulfamethoxazolum,sulfamethoxizole,sulfamethylisoxazole,sulfametoxazol,sulfisomezole,sulmeprim,sulphamethalazole,sulphamethoxazol,sulphamethoxazole,sulphisomezole,urobak" 2 "g" "10342-4,25271-8,39772-9,59971-2,59972-0,60333-2,72674-5,80549-9,80974-9"
|
||||
"SLF5" 5330 "Sulfamethoxypyridazine" "Trimethoprims" "J01ED05" "Sulfonamides and trimethoprim" "Long-acting sulfonamides" "" "altezol,davosin,depovernil,kineks,lederkyn,lentac,lisulfen,longin,medicel,midicel,midikel,myasul,nsulfanilamide,opinsul,paramid,paramid supra,petrisul,piridolo,quinoseptyl,retamid,retasulfin,retasulphine,slosul,spofadazine,sulfalex,sulfapyridazine,sulfdurazin,sulfozona,sultirene,vinces" 0.5 "g" ""
|
||||
"SLF6" 19596 "Sulfametomidine" "Trimethoprims" "J01ED03" "Sulfonamides and trimethoprim" "Long-acting sulfonamides" "" "duroprocin,methofadin,methofazine,nsulfanilamide,solfametomidina,sulfamethomidine,sulfametomidin,sulfametomidina,sulfametomidine,sulfametomidinum" ""
|
||||
"SLF7" 5326 "Sulfametoxydiazine" "Trimethoprims" "J01ED04" "Sulfonamides and trimethoprim" "Long-acting sulfonamides" "" "bayrena,berlicid,dairena,durenat,juvoxin,kinecid,kirocid,longasulf,methoxypyrimal,nsulfanilamide,solfametossidiazina,sulfameter,sulfamethorine,sulfamethoxine,sulfamethoxydiazin,sulfamethoxydiazine,sulfamethoxydin,sulfamethoxydine,sulfametin,sulfametinum,sulfametorin,sulfametorine,sulfametorinum,sulfametoxidiazina,sulfametoxidine,sulfametoxydiazine,sulfametoxydiazinum,sulphameter,sulphamethoxydiazine,supramid,ultrax" 0.5 "g" ""
|
||||
|
Binary file not shown.
Binary file not shown.
Binary file not shown.
@ -1 +1 @@
|
||||
b3734ad222d485de6923fc9957d8f2f5
|
||||
7846247d4113c4e8f550cfd2cb87467f
|
||||
|
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@ -45279,7 +45279,7 @@
|
||||
"B_STNTR_INDC" "Stenotrophomonas indicatrix" "accepted" "Bacteria" "Pseudomonadota" "Gammaproteobacteria" "Lysobacterales" "Lysobacteraceae" "Stenotrophomonas" "indicatrix" "" "species" "Weber et al., 2018" "LPSN" "797782" "516670" "10701219" 1.5 ""
|
||||
"B_STNTR_KRNS" "Stenotrophomonas koreensis" "accepted" "Bacteria" "Pseudomonadota" "Gammaproteobacteria" "Lysobacterales" "Lysobacteraceae" "Stenotrophomonas" "koreensis" "" "species" "Yang et al., 2006" "LPSN" "781248" "516670" "3222376" 1.5 ""
|
||||
"B_STNTR_LCTT" "Stenotrophomonas lactitubi" "accepted" "Bacteria" "Pseudomonadota" "Gammaproteobacteria" "Lysobacterales" "Lysobacteraceae" "Stenotrophomonas" "lactitubi" "" "species" "Weber et al., 2018" "LPSN" "797783" "516670" "10788780" 1.5 ""
|
||||
"B_STNTR_MLTP" "Stenotrophomonas maltophilia" "synonym" "Bacteria" "Pseudomonadota" "Gammaproteobacteria" "Lysobacterales" "Lysobacteraceae" "Stenotrophomonas" "maltophilia" "" "species" "Palleroni et al., 1993" "LPSN" "781249" "516670" "783141" "10912104" 1 "113697002"
|
||||
"B_STNTR_MLTP" "Stenotrophomonas maltophilia" "accepted" "Bacteria" "Pseudomonadota" "Gammaproteobacteria" "Lysobacterales" "Lysobacteraceae" "Stenotrophomonas" "maltophilia" "" "species" "Palleroni et al., 1993" "LPSN" "781249" "516670" "10912104" 1 "113697002"
|
||||
"B_STNTR_NTRT" "Stenotrophomonas nitritireducens" "accepted" "Bacteria" "Pseudomonadota" "Gammaproteobacteria" "Lysobacterales" "Lysobacteraceae" "Stenotrophomonas" "nitritireducens" "" "species" "Finkmann et al., 2000" "LPSN" "781250" "516670" "3222370" 1.5 "416746005"
|
||||
"B_STNTR_PNCH" "Stenotrophomonas panacihumi" "accepted" "Bacteria" "Pseudomonadota" "Gammaproteobacteria" "Lysobacterales" "Lysobacteraceae" "Stenotrophomonas" "panacihumi" "" "species" "Yi et al., 2010" "GBIF" "11141735" 1.5 ""
|
||||
"B_STNTR_PAVN" "Stenotrophomonas pavanii" "accepted" "Bacteria" "Pseudomonadota" "Gammaproteobacteria" "Lysobacterales" "Lysobacteraceae" "Stenotrophomonas" "pavanii" "" "species" "Ramos et al., 2011" "LPSN" "789171" "516670" "8102737" 1.5 "704977000"
|
||||
|
Binary file not shown.
@ -188,7 +188,7 @@ abx2 <- abx2 %>%
|
||||
|
||||
abx2$abbr <- lapply(as.list(abx2$abbr), function(x) unlist(strsplit(x, "|", fixed = TRUE)))
|
||||
|
||||
# Update Compound IDs and Trade Names ----
|
||||
# Update Compound IDs and Synonyms ----
|
||||
|
||||
# vector with official names, returns vector with CIDs
|
||||
get_CID <- function(ab) {
|
||||
@ -307,6 +307,7 @@ get_synonyms <- function(CID, clean = TRUE) {
|
||||
# get brand names from PubChem (3-4 min)
|
||||
synonyms <- get_synonyms(CIDs)
|
||||
synonyms.bak <- synonyms
|
||||
|
||||
# add existing ones (will be cleaned later)
|
||||
for (i in seq_len(length(synonyms))) {
|
||||
old <- antibiotics$synonyms[[i]]
|
||||
@ -318,6 +319,13 @@ for (i in seq_len(length(synonyms))) {
|
||||
|
||||
antibiotics$synonyms <- synonyms
|
||||
|
||||
stop("remember to remove co-trimoxazole as synonyms from SXT (Sulfamethoxazole), so it only exists in SXT!")
|
||||
sulfa <- antibiotics[which(antibiotics$ab == "SMX"), "synonyms", drop = TRUE][[1]]
|
||||
cotrim <- antibiotics[which(antibiotics$ab == "SXT"), "synonyms", drop = TRUE][[1]]
|
||||
sulfa <- sulfa[!sulfa %in% cotrim]
|
||||
antibiotics[which(antibiotics$ab == "SMX"), "synonyms"][[1]][[1]] <- sulfa
|
||||
|
||||
|
||||
# now go to end of this file
|
||||
|
||||
|
||||
|
@ -95,8 +95,8 @@ new_mo_codes <- breakpoints %>%
|
||||
new_mo_codes %>%
|
||||
mutate(code = toupper(ORGANISM_CODE)) %>%
|
||||
rename(mo_new = mo) %>%
|
||||
left_join(microorganisms.codes) %>%
|
||||
filter(mo != mo_new)
|
||||
left_join(microorganisms.codes %>% rename(mo_old = mo)) %>%
|
||||
filter(mo_old != mo_new)
|
||||
|
||||
microorganisms.codes <- microorganisms.codes %>%
|
||||
filter(!code %in% toupper(new_mo_codes$ORGANISM_CODE)) %>%
|
||||
|
@ -1357,19 +1357,29 @@ taxonomy <- taxonomy %>%
|
||||
|
||||
# set class <mo>
|
||||
class(taxonomy$mo) <- c("mo", "character")
|
||||
microorganisms <- taxonomy
|
||||
|
||||
### this was previously needed?? Since 2022 M. catarrhalis seems to be "accepted" again
|
||||
# # Moraxella catarrhalis was named Branhamella catarrhalis (Catlin, 1970), but this is unaccepted in clinical microbiology
|
||||
# # we keep them both
|
||||
# taxonomy$status[which(taxonomy$fullname == "Moraxella catarrhalis")]
|
||||
# taxonomy$lpsn_renamed_to[which(taxonomy$fullname == "Moraxella catarrhalis")]
|
||||
# taxonomy$status[which(taxonomy$fullname == "Moraxella catarrhalis")] <- "accepted"
|
||||
# taxonomy$lpsn_renamed_to[which(taxonomy$fullname == "Moraxella catarrhalis")] <- NA_character_
|
||||
|
||||
# Restore 'synonym' microorganisms to 'accepted' --------------------------
|
||||
|
||||
# according to LPSN: Stenotrophomonas maltophilia is the correct name if this species is regarded as a separate species (i.e., if its nomenclatural type is not assigned to another species whose name is validly published, legitimate and not rejected and has priority) within a separate genus Stenotrophomonas.
|
||||
# https://lpsn.dsmz.de/species/stenotrophomonas-maltophilia
|
||||
|
||||
# all MO's to keep as 'accepted', not as 'synonym':
|
||||
to_restore <- c(
|
||||
"Stenotrophomonas maltophilia",
|
||||
"Moraxella catarrhalis"
|
||||
)
|
||||
all(to_restore %in% microorganisms$fullname)
|
||||
for (nm in to_restore) {
|
||||
microorganisms$lpsn_renamed_to[which(microorganisms$fullname == nm)] <- NA
|
||||
microorganisms$gbif_renamed_to[which(microorganisms$fullname == nm)] <- NA
|
||||
microorganisms$status[which(microorganisms$fullname == nm)] <- "accepted"
|
||||
}
|
||||
|
||||
|
||||
# Save to package ---------------------------------------------------------
|
||||
|
||||
microorganisms <- taxonomy
|
||||
usethis::use_data(microorganisms, overwrite = TRUE, version = 2, compress = "xz")
|
||||
rm(microorganisms)
|
||||
|
||||
|
@ -107,3 +107,4 @@ contents <- c(
|
||||
writeLines(contents, "R/aa_helper_pm_functions.R")
|
||||
|
||||
# note: pm_left_join() will be overwritten by aaa_helper_functions.R, which contains a faster implementation
|
||||
# replace `res <- as.data.frame(res)` with `res <- as.data.frame(res, stringsAsFactors = FALSE)`
|
||||
|
BIN
data/WHONET.rda
BIN
data/WHONET.rda
Binary file not shown.
Binary file not shown.
Binary file not shown.
37
index.md
37
index.md
@ -34,6 +34,8 @@ With the help of contributors from all corners of the world, the `AMR` package i
|
||||
|
||||
#### Filtering and selecting data
|
||||
|
||||
One of the most powerful functions of this package, aside from calculating and plotting AMR, is selecting and filtering based on antibiotic columns. This can be done using the so-called [antibiotic class selectors](https://msberends.github.io/AMR/reference/antibiotic_class_selectors.html) that work in base R, `dplyr` and `data.table`:
|
||||
|
||||
```r
|
||||
# AMR works great with dplyr, but it's not required or neccesary
|
||||
library(AMR)
|
||||
@ -41,8 +43,10 @@ library(dplyr)
|
||||
|
||||
example_isolates %>%
|
||||
mutate(bacteria = mo_fullname()) %>%
|
||||
# filtering functions for microorganisms:
|
||||
filter(mo_is_gram_negative(),
|
||||
mo_is_intrinsic_resistant(ab = "cefotax")) %>%
|
||||
# antibiotic selectors:
|
||||
select(bacteria,
|
||||
aminoglycosides(),
|
||||
carbapenems())
|
||||
@ -66,19 +70,24 @@ With only having defined a row filter on Gram-negative bacteria with intrinsic r
|
||||
A base R equivalent would be:
|
||||
|
||||
```r
|
||||
library(AMR)
|
||||
example_isolates$bacteria <- mo_fullname(example_isolates$mo)
|
||||
example_isolates[which(mo_is_gram_negative() &
|
||||
mo_is_intrinsic_resistant(ab = "cefotax")),
|
||||
c("bacteria", aminoglycosides(), carbapenems())]
|
||||
```
|
||||
|
||||
This base R snippet will work in any version of R since April 2013 (R-3.0).
|
||||
This base R code will work in any version of R since April 2013 (R-3.0). Moreover, this code works identically with the `data.table` package, only by starting with:
|
||||
|
||||
```r
|
||||
example_isolates <- data.table::as.data.table(example_isolates)
|
||||
```
|
||||
|
||||
#### Generating antibiograms
|
||||
|
||||
The `AMR` package supports generating traditional, combined, syndromic, and even weighted-incidence syndromic combination antibiograms (WISCA).
|
||||
|
||||
If used inside R Markdown or Quarto, the table will be printed in the right output format automatically (such as markdown, LaTeX, HTML, etc.) when using `print()` on an antibiogram object.
|
||||
If used inside R Markdown or Quarto, the table will be printed in the right output format automatically (such as markdown, LaTeX, HTML, etc.).
|
||||
|
||||
```r
|
||||
antibiogram(example_isolates,
|
||||
@ -115,7 +124,7 @@ Like many other functions in this package, `antibiogram()` comes with support fo
|
||||
|
||||
```r
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c("CIP", "TOB", "GEN"),
|
||||
antibiotics = c("cipro", "tobra", "genta"), # any arbitrary name or code will work
|
||||
mo_transform = "gramstain",
|
||||
ab_transform = "name",
|
||||
language = "uk") # Ukrainian
|
||||
@ -131,6 +140,25 @@ antibiogram(example_isolates,
|
||||
|
||||
For a manual approach, you can use the `resistance` or `susceptibility()` function:
|
||||
|
||||
```r
|
||||
example_isolates %>%
|
||||
# group by ward:
|
||||
group_by(ward) %>%
|
||||
# calculate AMR using resistance() for gentamicin and tobramycin
|
||||
# and get their 95% confidence intervals using sir_confidence_interval():
|
||||
summarise(across(c(GEN, TOB),
|
||||
list(total_R = resistance,
|
||||
conf_int = function(x) sir_confidence_interval(x, collapse = "-"))))
|
||||
```
|
||||
|
||||
|ward | GEN_total_R|GEN_conf_int | TOB_total_R|TOB_conf_int |
|
||||
|:---------:|:----------:|:-----------:|:----------:|:-----------:|
|
||||
|Clinical | 0.229 |0.205-0.254 | 0.315 |0.284-0.347 |
|
||||
|ICU | 0.290 |0.253-0.330 | 0.400 |0.353-0.449 |
|
||||
|Outpatient | 0.200 |0.131-0.285 | 0.368 |0.254-0.493 |
|
||||
|
||||
Or use [antibiotic class selectors](https://msberends.github.io/AMR/reference/antibiotic_class_selectors.html) to select a series of antibiotic columns:
|
||||
|
||||
```r
|
||||
library(AMR)
|
||||
library(dplyr)
|
||||
@ -138,8 +166,7 @@ library(dplyr)
|
||||
out <- example_isolates %>%
|
||||
# group by ward:
|
||||
group_by(ward) %>%
|
||||
# calculate AMR using resistance(), over all aminoglycosides
|
||||
# and polymyxins:
|
||||
# calculate AMR using resistance(), over all aminoglycosides and polymyxins:
|
||||
summarise(across(c(aminoglycosides(), polymyxins()),
|
||||
resistance))
|
||||
out
|
||||
|
@ -54,7 +54,7 @@ expect_identical(suppressWarnings(rsi_df(example_isolates)),
|
||||
expect_identical(suppressWarnings(is.rsi.eligible(example_isolates)),
|
||||
suppressWarnings(is_sir_eligible(example_isolates)))
|
||||
|
||||
if (AMR:::pkg_is_available("ggplot2", also_load = FALSE)) {
|
||||
if (AMR:::pkg_is_available("ggplot2")) {
|
||||
expect_equal(suppressWarnings(ggplot_rsi(example_isolates[, c("CIP", "GEN", "TOB")])),
|
||||
suppressWarnings(ggplot_sir(example_isolates[, c("CIP", "GEN", "TOB")])))
|
||||
|
||||
|
@ -50,12 +50,12 @@ expect_equal(AMR:::trimws2(" test ", "r"), " test")
|
||||
# expect_warning(AMR:::get_column_abx(example_isolates, hard_dependencies = "FUS"))
|
||||
expect_message(AMR:::get_column_abx(example_isolates, soft_dependencies = "FUS"))
|
||||
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
||||
# expect_warning(AMR:::get_column_abx(rename(example_isolates, thisone = AMX), amox = "thisone", tmp = "thisone", verbose = TRUE))
|
||||
# expect_warning(AMR:::get_column_abx(rename(example_isolates, thisone = AMX), amox = "thisone", tmp = "thisone", verbose = FALSE))
|
||||
}
|
||||
|
||||
# we rely on "grouped_tbl" being a class of grouped tibbles, so run a test that checks for this:
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
||||
expect_true(AMR:::is_null_or_grouped_tbl(example_isolates %>% group_by(ward)))
|
||||
}
|
||||
|
@ -82,7 +82,7 @@ expect_identical(
|
||||
c("J01DC01", "J01DD01", "J01DD02", "J01DD04", "J01GB03", "J01GB01")
|
||||
)
|
||||
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
||||
expect_identical(
|
||||
example_isolates %>% set_ab_names(),
|
||||
example_isolates %>% rename_with(set_ab_names)
|
||||
|
@ -95,7 +95,7 @@ expect_identical(
|
||||
c("gen", "tobra")
|
||||
)
|
||||
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
||||
expect_equal(example_isolates %>% select(administrable_per_os() & penicillins()) %>% ncol(), 5, tolerance = 0.5)
|
||||
expect_equal(example_isolates %>% select(administrable_iv() & penicillins()) %>% ncol(), 7, tolerance = 0.5)
|
||||
expect_equal(example_isolates %>% select(administrable_iv() | penicillins()) %>% ncol(), 37, tolerance = 0.5)
|
||||
|
@ -120,12 +120,12 @@ expect_silent(plot(ab7))
|
||||
expect_silent(plot(ab8))
|
||||
|
||||
if (AMR:::pkg_is_available("ggplot2")) {
|
||||
expect_inherits(autoplot(ab1), "gg")
|
||||
expect_inherits(autoplot(ab2), "gg")
|
||||
expect_inherits(autoplot(ab3), "gg")
|
||||
expect_inherits(autoplot(ab4), "gg")
|
||||
expect_inherits(autoplot(ab5), "gg")
|
||||
expect_inherits(autoplot(ab6), "gg")
|
||||
expect_inherits(autoplot(ab7), "gg")
|
||||
expect_inherits(autoplot(ab8), "gg")
|
||||
expect_inherits(ggplot2::autoplot(ab1), "gg")
|
||||
expect_inherits(ggplot2::autoplot(ab2), "gg")
|
||||
expect_inherits(ggplot2::autoplot(ab3), "gg")
|
||||
expect_inherits(ggplot2::autoplot(ab4), "gg")
|
||||
expect_inherits(ggplot2::autoplot(ab5), "gg")
|
||||
expect_inherits(ggplot2::autoplot(ab6), "gg")
|
||||
expect_inherits(ggplot2::autoplot(ab7), "gg")
|
||||
expect_inherits(ggplot2::autoplot(ab8), "gg")
|
||||
}
|
||||
|
@ -27,9 +27,9 @@
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
if (AMR:::pkg_is_available("curl", also_load = FALSE) &&
|
||||
AMR:::pkg_is_available("rvest", also_load = FALSE) &&
|
||||
AMR:::pkg_is_available("xml2", also_load = FALSE) &&
|
||||
if (AMR:::pkg_is_available("curl") &&
|
||||
AMR:::pkg_is_available("rvest") &&
|
||||
AMR:::pkg_is_available("xml2") &&
|
||||
tryCatch(curl::has_internet(), error = function(e) FALSE)) {
|
||||
expect_true(length(atc_online_groups(ab_atc("AMX"))) >= 1)
|
||||
expect_equal(atc_online_ddd(ab_atc("AMX"), administration = "O"), 1.5)
|
||||
|
@ -32,7 +32,7 @@ expect_inherits(b, "bug_drug_combinations")
|
||||
expect_stdout(suppressMessages(print(b)))
|
||||
expect_true(is.data.frame(format(b)))
|
||||
expect_true(is.data.frame(format(b, add_ab_group = FALSE)))
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
||||
expect_true(example_isolates %>%
|
||||
group_by(ward) %>%
|
||||
bug_drug_combinations(FUN = mo_gramstain) %>%
|
||||
|
@ -58,7 +58,7 @@ expect_error(count_susceptible("test", as_percent = "test"))
|
||||
expect_error(count_df(c("A", "B", "C")))
|
||||
expect_error(count_df(example_isolates[, "date", drop = TRUE]))
|
||||
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
||||
expect_equal(example_isolates %>% count_susceptible(AMC), 1433)
|
||||
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)
|
||||
|
@ -55,7 +55,7 @@ expect_false(any(is.na(as.disk(clinical_breakpoints[which(clinical_breakpoints$m
|
||||
# antibiotic names must always be coercible to their original AB code
|
||||
expect_identical(as.ab(antibiotics$name), antibiotics$ab)
|
||||
|
||||
if (AMR:::pkg_is_available("tibble", also_load = FALSE)) {
|
||||
if (AMR:::pkg_is_available("tibble")) {
|
||||
# there should be no diacritics (i.e. non ASCII) characters in the datasets (CRAN policy)
|
||||
datasets <- data(package = "AMR", envir = asNamespace("AMR"))$results[, "Item", drop = TRUE]
|
||||
for (i in seq_len(length(datasets))) {
|
||||
|
@ -48,12 +48,12 @@ expect_silent(plot(as.disk(c(10, 20, 40))))
|
||||
expect_silent(plot(as.disk(c(10, 20, 40)), expand = FALSE))
|
||||
expect_silent(plot(as.disk(c(10, 20, 40)), mo = "Escherichia coli", ab = "cipr"))
|
||||
if (AMR:::pkg_is_available("ggplot2")) {
|
||||
expect_inherits(autoplot(as.disk(c(10, 20, 40))), "gg")
|
||||
expect_inherits(autoplot(as.disk(c(10, 20, 40)), expand = FALSE), "gg")
|
||||
expect_inherits(autoplot(as.disk(c(10, 20, 40)), mo = "Escherichia coli", ab = "cipr"), "gg")
|
||||
expect_inherits(ggplot2::autoplot(as.disk(c(10, 20, 40))), "gg")
|
||||
expect_inherits(ggplot2::autoplot(as.disk(c(10, 20, 40)), expand = FALSE), "gg")
|
||||
expect_inherits(ggplot2::autoplot(as.disk(c(10, 20, 40)), mo = "Escherichia coli", ab = "cipr"), "gg")
|
||||
}
|
||||
expect_stdout(print(as.disk(12)))
|
||||
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
|
||||
expect_stdout(print(tibble(d = as.disk(12))))
|
||||
if (AMR:::pkg_is_available("tibble")) {
|
||||
expect_stdout(print(tibble::tibble(d = as.disk(12))))
|
||||
}
|
||||
|
@ -98,7 +98,7 @@ b <- data.frame(
|
||||
expect_equal(suppressWarnings(eucast_rules(a, "mo", info = FALSE)), b)
|
||||
|
||||
# piperacillin must be R in Enterobacteriaceae when tica is R
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
||||
expect_equal(
|
||||
suppressWarnings(
|
||||
example_isolates %>%
|
||||
@ -150,7 +150,7 @@ expect_equal(
|
||||
)
|
||||
|
||||
# also test norf
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
||||
expect_stdout(suppressWarnings(eucast_rules(example_isolates %>% mutate(NOR = "S", NAL = "S"), info = TRUE)))
|
||||
}
|
||||
|
||||
|
@ -139,7 +139,7 @@ expect_error(first_isolate(example_isolates,
|
||||
col_mo = "mo"
|
||||
))
|
||||
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
||||
# if mo is not an mo class, result should be the same
|
||||
expect_identical(
|
||||
example_isolates %>%
|
||||
|
@ -27,6 +27,14 @@
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
x <- data.frame(dates = as.Date(c("2021-01-01", "2021-01-02", "2021-01-05", "2021-01-08", "2021-02-21", "2021-02-22", "2021-02-23", "2021-02-24", "2021-03-01", "2021-03-01")))
|
||||
x$absolute <- get_episode(x$dates, episode_days = 7)
|
||||
x$relative <- get_episode(x$dates, case_free_days = 7)
|
||||
expect_equal(x$absolute, c(1, 1, 1, 2, 3, 3, 3, 3, 4, 4))
|
||||
expect_equal(x$relative, c(1, 1, 1, 1, 2, 2, 2, 2, 2, 2))
|
||||
expect_equal(get_episode(as.Date(c("2022-01-01", "2020-01-01")), 365), c(2, 1))
|
||||
expect_equal(get_episode(as.Date(c("2020-01-01", "2022-01-01")), 365), c(1, 2))
|
||||
|
||||
test_df <- rbind(
|
||||
data.frame(
|
||||
date = as.Date(c("2015-01-01", "2015-10-01", "2016-02-04", "2016-12-31", "2017-01-01", "2017-02-01", "2017-02-05", "2020-01-01")),
|
||||
@ -51,7 +59,7 @@ expect_equal(
|
||||
c(1, 2, 2, 2, 3)
|
||||
)
|
||||
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
||||
expect_identical(
|
||||
test_df %>% group_by(patient_id) %>% mutate(f = is_new_episode(date, 365)) %>% pull(f),
|
||||
c(TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, TRUE)
|
@ -27,7 +27,8 @@
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0") & AMR:::pkg_is_available("ggplot2")) {
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE) &&
|
||||
AMR:::pkg_is_available("ggplot2", also_load = TRUE)) {
|
||||
pdf(NULL) # prevent Rplots.pdf being created
|
||||
|
||||
# data should be equal
|
||||
|
@ -278,7 +278,7 @@ expect_error(custom_mdro_guideline("test" ~ A))
|
||||
# ))
|
||||
|
||||
# print groups
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
||||
expect_stdout(x <- mdro(example_isolates %>% group_by(ward), info = TRUE, pct_required_classes = 0))
|
||||
expect_stdout(x <- mdro(example_isolates %>% group_by(ward), guideline = custom, info = TRUE))
|
||||
}
|
||||
|
@ -63,16 +63,16 @@ expect_silent(plot(as.mic(c(1, 2, 4, 8))))
|
||||
expect_silent(plot(as.mic(c(1, 2, 4, 8)), expand = FALSE))
|
||||
expect_silent(plot(as.mic(c(1, 2, 4, 8)), mo = "Escherichia coli", ab = "cipr"))
|
||||
if (AMR:::pkg_is_available("ggplot2")) {
|
||||
expect_inherits(autoplot(as.mic(c(1, 2, 4, 8))), "gg")
|
||||
expect_inherits(autoplot(as.mic(c(1, 2, 4, 8)), expand = FALSE), "gg")
|
||||
expect_inherits(autoplot(as.mic(c(1, 2, 4, 8, 32)), mo = "Escherichia coli", ab = "cipr"), "gg")
|
||||
expect_inherits(ggplot2::autoplot(as.mic(c(1, 2, 4, 8))), "gg")
|
||||
expect_inherits(ggplot2::autoplot(as.mic(c(1, 2, 4, 8)), expand = FALSE), "gg")
|
||||
expect_inherits(ggplot2::autoplot(as.mic(c(1, 2, 4, 8, 32)), mo = "Escherichia coli", ab = "cipr"), "gg")
|
||||
}
|
||||
expect_stdout(print(as.mic(c(1, 2, 4, 8))))
|
||||
|
||||
expect_inherits(summary(as.mic(c(2, 8))), c("summaryDefault", "table"))
|
||||
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
|
||||
expect_stdout(print(tibble(m = as.mic(2:4))))
|
||||
if (AMR:::pkg_is_available("tibble")) {
|
||||
expect_stdout(print(tibble::tibble(m = as.mic(2:4))))
|
||||
}
|
||||
|
||||
# all mathematical operations
|
||||
|
@ -160,7 +160,7 @@ expect_identical(as.character(as.mo("S. sanguinis", Lancefield = TRUE)), "B_STRP
|
||||
expect_identical(as.character(as.mo("S. salivarius", Lancefield = FALSE)), "B_STRPT_SLVR")
|
||||
expect_identical(as.character(as.mo("S. salivarius", Lancefield = TRUE)), "B_STRPT_GRPK") # group K
|
||||
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
||||
# select with one column
|
||||
expect_identical(
|
||||
example_isolates %>%
|
||||
@ -302,9 +302,9 @@ expect_equal(
|
||||
c("F_YEAST", "F_FUNGUS")
|
||||
)
|
||||
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
|
||||
if (AMR:::pkg_is_available("tibble")) {
|
||||
# print tibble
|
||||
expect_stdout(print(tibble(mo = as.mo("B_ESCHR_COLI"))))
|
||||
expect_stdout(print(tibble::tibble(mo = as.mo("B_ESCHR_COLI"))))
|
||||
}
|
||||
|
||||
# assigning and subsetting
|
||||
|
@ -198,7 +198,7 @@ expect_equal(
|
||||
mo_name("test", reference_df = data.frame(col1 = "test", mo = "B_ESCHR_COLI")),
|
||||
"Escherichia coli"
|
||||
)
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
||||
expect_equal(example_isolates %>% filter(mo_is_gram_negative()) %>% nrow(),
|
||||
730,
|
||||
tolerance = 0.5
|
||||
|
@ -57,7 +57,7 @@ if (AMR:::pkg_is_available("ggplot2")) {
|
||||
ggplot_pca(pca_model, arrows_textangled = FALSE)
|
||||
}
|
||||
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
||||
resistance_data <- example_isolates %>%
|
||||
group_by(
|
||||
order = mo_order(mo),
|
||||
|
@ -47,7 +47,7 @@ expect_equal(
|
||||
proportion_SI(example_isolates$AMX)
|
||||
)
|
||||
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
||||
expect_equal(example_isolates %>% proportion_SI(AMC),
|
||||
0.7626397,
|
||||
tolerance = 0.0001
|
||||
|
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user