mirror of
https://github.com/msberends/AMR.git
synced 2025-07-09 23:41:55 +02:00
(v2.1.1.9163) cleanup
This commit is contained in:
8
.github/workflows/lintr.yaml
vendored
8
.github/workflows/lintr.yaml
vendored
@ -56,9 +56,15 @@ jobs:
|
||||
extra-packages: |
|
||||
any::lintr
|
||||
any::cyclocomp
|
||||
any::roxygen2
|
||||
any::devtools
|
||||
any::usethis
|
||||
|
||||
- name: Lint
|
||||
run: |
|
||||
# no not check these folders
|
||||
rm -rf data-raw
|
||||
rm -rf tests
|
||||
# old: lintr::lint_package(linters = lintr::with_defaults(line_length_linter = NULL, trailing_whitespace_linter = NULL, object_name_linter = NULL, cyclocomp_linter = NULL, object_length_linter = lintr::object_length_linter(length = 50L)), exclusions = list("R/aa_helper_pm_functions.R"))
|
||||
# now get ALL linters, not just default ones
|
||||
linters <- getNamespaceExports(asNamespace("lintr"))
|
||||
@ -67,7 +73,7 @@ jobs:
|
||||
linters <- linters[!grepl("^(closed_curly|open_curly|paren_brace|semicolon_terminator|consecutive_stopifnot|no_tab|single_quotes|unnecessary_nested_if|unneeded_concatenation)_linter$", linters)]
|
||||
linters <- linters[linters != "linter"]
|
||||
# and the ones we find unnnecessary
|
||||
linters <- linters[!grepl("^(extraction_operator|implicit_integer|line_length|object_name|nonportable_path|is)_linter$", linters)]
|
||||
linters <- linters[!grepl("^(extraction_operator|implicit_integer|line_length|object_length|object_name|object_usage|nonportable_path|is)_linter$", linters)]
|
||||
# put the functions in a list
|
||||
linters_list <- lapply(linters, function(l) eval(parse(text = paste0("lintr::", l, "()")), envir = asNamespace("lintr")))
|
||||
names(linters_list) <- linters
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
Package: AMR
|
||||
Version: 2.1.1.9160
|
||||
Date: 2025-02-26
|
||||
Version: 2.1.1.9163
|
||||
Date: 2025-02-27
|
||||
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
|
||||
|
||||
6
NEWS.md
6
NEWS.md
@ -1,4 +1,4 @@
|
||||
# AMR 2.1.1.9160
|
||||
# AMR 2.1.1.9163
|
||||
|
||||
*(this beta version will eventually become v3.0. We're happy to reach a new major milestone soon, which will be all about the new One Health support! Install this beta using [the instructions here](https://msberends.github.io/AMR/#latest-development-version).)*
|
||||
|
||||
@ -62,6 +62,7 @@ This package now supports not only tools for AMR data analysis in clinical setti
|
||||
* Added Amorolfine (`AMO`, D01AE16), which is now also part of the `antifungals()` selector
|
||||
* Added Efflux (`EFF`), to allow mapping to AMRFinderPlus
|
||||
* Added Tigemonam (`TNM`), a monobactam
|
||||
* Added over 1,500 trade names
|
||||
* MICs
|
||||
* Added as valid levels: 4096, 6 powers of 0.0625, and 5 powers of 192 (192, 384, 576, 768, 960)
|
||||
* Fixed a bug in `as.mic()` that failed translation of scientifically formatted numbers
|
||||
@ -76,12 +77,11 @@ This package now supports not only tools for AMR data analysis in clinical setti
|
||||
* `mo_info()` now contains an extra element `rank` and `group_members` (with the contents of the new `mo_group_members()` function)
|
||||
* Updated all ATC codes from WHOCC
|
||||
* Updated all antibiotic DDDs from WHOCC
|
||||
* Added over 1,500 trade names for antibiotics
|
||||
* Fix for using a manual value for `mo_transform` in `antibiogram()`
|
||||
* Fixed a bug for when `antibiogram()` returns an empty data set
|
||||
* Fix for mapping 'high level' antibiotics in `as.ab()` (amphotericin B-high, gentamicin-high, kanamycin-high, streptomycin-high, tobramycin-high)
|
||||
* Improved overall algorithm of `as.ab()` for better performance and accuracy, including the new function `as_reset_session()` to remove earlier coercions.
|
||||
* Improved overall algorithm of `as.mo()` for better performance and accuracy. Specifically:
|
||||
* Improved overall algorithm of `as.mo()` for better performance and accuracy, specifically:
|
||||
* More weight is given to genus and species combinations in cases where the subspecies is miswritten, so that the result will be the correct genus and species
|
||||
* Genera from the World Health Organization's (WHO) Priority Pathogen List now have the highest prevalence
|
||||
* Fixed a bug for `sir_confidence_interval()` when there are no isolates available
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
Metadata-Version: 2.2
|
||||
Name: AMR
|
||||
Version: 2.1.1.9160
|
||||
Version: 2.1.1.9163
|
||||
Summary: A Python wrapper for the AMR R package
|
||||
Home-page: https://github.com/msberends/AMR
|
||||
Author: Matthijs Berends
|
||||
|
||||
@ -28,8 +28,6 @@ from .functions import age_groups
|
||||
from .functions import antibiogram
|
||||
from .functions import wisca
|
||||
from .functions import retrieve_wisca_parameters
|
||||
from .functions import amr_class
|
||||
from .functions import amr_selector
|
||||
from .functions import aminoglycosides
|
||||
from .functions import aminopenicillins
|
||||
from .functions import antifungals
|
||||
@ -61,6 +59,8 @@ from .functions import streptogramins
|
||||
from .functions import tetracyclines
|
||||
from .functions import trimethoprims
|
||||
from .functions import ureidopenicillins
|
||||
from .functions import amr_class
|
||||
from .functions import amr_selector
|
||||
from .functions import administrable_per_os
|
||||
from .functions import administrable_iv
|
||||
from .functions import not_intrinsic_resistant
|
||||
|
||||
@ -114,12 +114,6 @@ def wisca(x, *args, **kwargs):
|
||||
def retrieve_wisca_parameters(wisca_model, *args, **kwargs):
|
||||
"""See our website of the R package for the manual: https://msberends.github.io/AMR/index.html"""
|
||||
return convert_to_python(amr_r.retrieve_wisca_parameters(wisca_model, *args, **kwargs))
|
||||
def amr_class(amr_class, *args, **kwargs):
|
||||
"""See our website of the R package for the manual: https://msberends.github.io/AMR/index.html"""
|
||||
return convert_to_python(amr_r.amr_class(amr_class, *args, **kwargs))
|
||||
def amr_selector(filter, *args, **kwargs):
|
||||
"""See our website of the R package for the manual: https://msberends.github.io/AMR/index.html"""
|
||||
return convert_to_python(amr_r.amr_selector(filter, *args, **kwargs))
|
||||
def aminoglycosides(only_sir_columns = False, *args, **kwargs):
|
||||
"""See our website of the R package for the manual: https://msberends.github.io/AMR/index.html"""
|
||||
return convert_to_python(amr_r.aminoglycosides(only_sir_columns = False, *args, **kwargs))
|
||||
@ -213,6 +207,12 @@ def trimethoprims(only_sir_columns = False, *args, **kwargs):
|
||||
def ureidopenicillins(only_sir_columns = False, *args, **kwargs):
|
||||
"""See our website of the R package for the manual: https://msberends.github.io/AMR/index.html"""
|
||||
return convert_to_python(amr_r.ureidopenicillins(only_sir_columns = False, *args, **kwargs))
|
||||
def amr_class(amr_class, *args, **kwargs):
|
||||
"""See our website of the R package for the manual: https://msberends.github.io/AMR/index.html"""
|
||||
return convert_to_python(amr_r.amr_class(amr_class, *args, **kwargs))
|
||||
def amr_selector(filter, *args, **kwargs):
|
||||
"""See our website of the R package for the manual: https://msberends.github.io/AMR/index.html"""
|
||||
return convert_to_python(amr_r.amr_selector(filter, *args, **kwargs))
|
||||
def administrable_per_os(only_sir_columns = False, *args, **kwargs):
|
||||
"""See our website of the R package for the manual: https://msberends.github.io/AMR/index.html"""
|
||||
return convert_to_python(amr_r.administrable_per_os(only_sir_columns = False, *args, **kwargs))
|
||||
|
||||
Binary file not shown.
BIN
PythonPackage/AMR/dist/amr-2.1.1.9160.tar.gz
vendored
BIN
PythonPackage/AMR/dist/amr-2.1.1.9160.tar.gz
vendored
Binary file not shown.
BIN
PythonPackage/AMR/dist/amr-2.1.1.9163-py3-none-any.whl
vendored
Normal file
BIN
PythonPackage/AMR/dist/amr-2.1.1.9163-py3-none-any.whl
vendored
Normal file
Binary file not shown.
BIN
PythonPackage/AMR/dist/amr-2.1.1.9163.tar.gz
vendored
Normal file
BIN
PythonPackage/AMR/dist/amr-2.1.1.9163.tar.gz
vendored
Normal file
Binary file not shown.
@ -2,7 +2,7 @@ from setuptools import setup, find_packages
|
||||
|
||||
setup(
|
||||
name='AMR',
|
||||
version='2.1.1.9160',
|
||||
version='2.1.1.9163',
|
||||
packages=find_packages(),
|
||||
install_requires=[
|
||||
'rpy2',
|
||||
|
||||
@ -512,21 +512,31 @@ word_wrap <- function(...,
|
||||
# format backticks
|
||||
if (pkg_is_available("cli") &&
|
||||
tryCatch(isTRUE(getExportedValue("ansi_has_hyperlink_support", ns = asNamespace("cli"))()), error = function(e) FALSE) &&
|
||||
tryCatch(getExportedValue("isAvailable", ns = asNamespace("rstudioapi"))(), error = function(e) return(FALSE)) &&
|
||||
tryCatch(getExportedValue("versionInfo", ns = asNamespace("rstudioapi"))()$version > "2023.6.0.0", error = function(e) return(FALSE))) {
|
||||
tryCatch(getExportedValue("isAvailable", ns = asNamespace("rstudioapi"))(), error = function(e) {
|
||||
return(FALSE)
|
||||
}) &&
|
||||
tryCatch(getExportedValue("versionInfo", ns = asNamespace("rstudioapi"))()$version > "2023.6.0.0", error = function(e) {
|
||||
return(FALSE)
|
||||
})) {
|
||||
# we are in a recent version of RStudio, so do something nice: add links to our help pages in the console.
|
||||
parts <- strsplit(msg, "`", fixed = TRUE)[[1]]
|
||||
cmds <- parts %in% paste0(ls(envir = asNamespace("AMR")), "()")
|
||||
# functions with a dot are not allowed: https://github.com/rstudio/rstudio/issues/11273#issuecomment-1156193252
|
||||
# lead them to the help page of our package
|
||||
parts[cmds & parts %like% "[.]"] <- font_url(url = paste0("ide:help:AMR::", gsub("()", "", parts[cmds & parts %like% "[.]"], fixed = TRUE)),
|
||||
txt = parts[cmds & parts %like% "[.]"])
|
||||
parts[cmds & parts %like% "[.]"] <- font_url(
|
||||
url = paste0("ide:help:AMR::", gsub("()", "", parts[cmds & parts %like% "[.]"], fixed = TRUE)),
|
||||
txt = parts[cmds & parts %like% "[.]"]
|
||||
)
|
||||
# otherwise, give a 'click to run' popup
|
||||
parts[cmds & parts %unlike% "[.]"] <- font_url(url = paste0("ide:run:AMR::", parts[cmds & parts %unlike% "[.]"]),
|
||||
txt = parts[cmds & parts %unlike% "[.]"])
|
||||
parts[cmds & parts %unlike% "[.]"] <- font_url(
|
||||
url = paste0("ide:run:AMR::", parts[cmds & parts %unlike% "[.]"]),
|
||||
txt = parts[cmds & parts %unlike% "[.]"]
|
||||
)
|
||||
# text starting with `?` must also lead to the help page
|
||||
parts[parts %like% "^[?]"] <- font_url(url = paste0("ide:help:AMR::", gsub("()", "", gsub("^[?]", "", parts[parts %like% "^[?]"]), fixed = TRUE)),
|
||||
txt = parts[parts %like% "^[?]"])
|
||||
parts[parts %like% "^[?]"] <- font_url(
|
||||
url = paste0("ide:help:AMR::", gsub("()", "", gsub("^[?]", "", parts[parts %like% "^[?]"]), fixed = TRUE)),
|
||||
txt = parts[parts %like% "^[?]"]
|
||||
)
|
||||
msg <- paste0(parts, collapse = "`")
|
||||
}
|
||||
msg <- gsub("`(.+?)`", font_grey_bg("\\1"), msg)
|
||||
@ -965,9 +975,11 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
|
||||
ascertain_sir_classes <- function(x, obj_name) {
|
||||
sirs <- vapply(FUN.VALUE = logical(1), x, is.sir)
|
||||
if (!any(sirs, na.rm = TRUE)) {
|
||||
warning_("the data provided in argument `", obj_name,
|
||||
warning_(
|
||||
"the data provided in argument `", obj_name,
|
||||
"` should contain at least one column of class 'sir'. Eligible SIR column were now guessed. ",
|
||||
"See `?as.sir`.")
|
||||
"See `?as.sir`."
|
||||
)
|
||||
sirs_eligible <- is_sir_eligible(x)
|
||||
for (col in colnames(x)[sirs_eligible]) {
|
||||
x[[col]] <- as.sir(x[[col]])
|
||||
@ -1322,8 +1334,10 @@ progress_ticker <- function(n = 1, n_min = 0, print = TRUE, clear = TRUE, title
|
||||
# a close()-method was also added, see below for that
|
||||
pb <- progress_bar$new(
|
||||
show_after = 0,
|
||||
format = paste0(title,
|
||||
ifelse(only_bar_percent == TRUE, "[:bar] :percent", "[:bar] :percent (:current/:total,:eta)")),
|
||||
format = paste0(
|
||||
title,
|
||||
ifelse(only_bar_percent == TRUE, "[:bar] :percent", "[:bar] :percent (:current/:total,:eta)")
|
||||
),
|
||||
clear = clear,
|
||||
total = n
|
||||
)
|
||||
|
||||
48
R/ab.R
48
R/ab.R
@ -327,7 +327,6 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
|
||||
|
||||
# More uncertain results ----
|
||||
if (fast_mode == FALSE) {
|
||||
|
||||
ab_df <- AMR_env$AB_lookup
|
||||
ab_df$length_name <- nchar(ab_df$generalised_name)
|
||||
# now retrieve Levensthein distance for name, synonyms, and translated names
|
||||
@ -335,23 +334,32 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
|
||||
ignore.case = FALSE,
|
||||
fixed = TRUE,
|
||||
costs = c(insertions = 1, deletions = 1, substitutions = 2),
|
||||
counts = FALSE))
|
||||
ab_df$lev_syn <- vapply(FUN.VALUE = double(1),
|
||||
counts = FALSE
|
||||
))
|
||||
ab_df$lev_syn <- vapply(
|
||||
FUN.VALUE = double(1),
|
||||
ab_df$generalised_synonyms,
|
||||
function(y) ifelse(length(y[nchar(y) >= 5]) == 0,
|
||||
function(y) {
|
||||
ifelse(length(y[nchar(y) >= 5]) == 0,
|
||||
999,
|
||||
min(as.double(utils::adist(x[i], y[nchar(y) >= 5], ignore.case = FALSE,
|
||||
min(as.double(utils::adist(x[i], y[nchar(y) >= 5],
|
||||
ignore.case = FALSE,
|
||||
fixed = TRUE,
|
||||
costs = c(insertions = 1, deletions = 1, substitutions = 2),
|
||||
counts = FALSE)), na.rm = TRUE)),
|
||||
USE.NAMES = FALSE)
|
||||
counts = FALSE
|
||||
)), na.rm = TRUE)
|
||||
)
|
||||
},
|
||||
USE.NAMES = FALSE
|
||||
)
|
||||
if (!is.null(language) && language != "en") {
|
||||
ab_df$trans <- generalise_antibiotic_name(translate_AMR(ab_df$name, language = language))
|
||||
ab_df$lev_trans <- as.double(utils::adist(x[i], ab_df$trans,
|
||||
ignore.case = FALSE,
|
||||
fixed = TRUE,
|
||||
costs = c(insertions = 1, deletions = 1, substitutions = 2),
|
||||
counts = FALSE))
|
||||
counts = FALSE
|
||||
))
|
||||
} else {
|
||||
ab_df$lev_trans <- ab_df$lev_name
|
||||
}
|
||||
@ -431,13 +439,17 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
|
||||
paste0(
|
||||
'"', x_uncertain, '" (assumed ',
|
||||
ab_name(AMR_env$ab_previously_coerced$ab[which(AMR_env$ab_previously_coerced$x_bak %in% x_uncertain)], language = NULL, tolower = TRUE),
|
||||
", ", AMR_env$ab_previously_coerced$ab[which(AMR_env$ab_previously_coerced$x_bak %in% x_uncertain)], ")"),
|
||||
quotes = FALSE)
|
||||
", ", AMR_env$ab_previously_coerced$ab[which(AMR_env$ab_previously_coerced$x_bak %in% x_uncertain)], ")"
|
||||
),
|
||||
quotes = FALSE
|
||||
)
|
||||
} else {
|
||||
examples <- paste0(nr2char(length(x_uncertain)), " antimicrobials")
|
||||
}
|
||||
message_("Antimicrobial translation was uncertain for ", examples,
|
||||
". If required, use `add_custom_antimicrobials()` to add custom entries.")
|
||||
message_(
|
||||
"Antimicrobial translation was uncertain for ", examples,
|
||||
". If required, use `add_custom_antimicrobials()` to add custom entries."
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
@ -476,8 +488,10 @@ pillar_shaft.ab <- function(x, ...) {
|
||||
|
||||
# add the names to the drugs as mouse-over!
|
||||
if (tryCatch(isTRUE(getExportedValue("ansi_has_hyperlink_support", ns = asNamespace("cli"))()), error = function(e) FALSE)) {
|
||||
out[!is.na(x)] <- font_url(url = paste0(x[!is.na(x)], ": ", ab_name(x[!is.na(x)])),
|
||||
txt = out[!is.na(x)])
|
||||
out[!is.na(x)] <- font_url(
|
||||
url = paste0(x[!is.na(x)], ": ", ab_name(x[!is.na(x)])),
|
||||
txt = out[!is.na(x)]
|
||||
)
|
||||
}
|
||||
|
||||
create_pillar_column(out, align = "left", min_width = 4)
|
||||
@ -494,12 +508,14 @@ type_sum.ab <- function(x, ...) {
|
||||
print.ab <- function(x, ...) {
|
||||
if (!is.null(attributes(x)$amr_selector)) {
|
||||
function_name <- attributes(x)$amr_selector
|
||||
message_("This 'ab' vector was retrieved using `" , function_name, "()`, which should normally be used inside a `dplyr` verb or `data.frame` call, e.g.:\n",
|
||||
message_(
|
||||
"This 'ab' vector was retrieved using `", function_name, "()`, which should normally be used inside a `dplyr` verb or `data.frame` call, e.g.:\n",
|
||||
" ", AMR_env$bullet_icon, " your_data %>% select(", function_name, "())\n",
|
||||
" ", AMR_env$bullet_icon, " your_data %>% select(column_a, column_b, ", function_name, "())\n",
|
||||
" ", AMR_env$bullet_icon, " your_data %>% filter(any(", function_name, "() == \"R\"))\n",
|
||||
" ", AMR_env$bullet_icon, " your_data[, ", function_name, "()]\n",
|
||||
" ", AMR_env$bullet_icon, " your_data[, c(\"column_a\", \"column_b\", ", function_name, "())]")
|
||||
" ", AMR_env$bullet_icon, " your_data[, c(\"column_a\", \"column_b\", ", function_name, "())]"
|
||||
)
|
||||
}
|
||||
cat("Class 'ab'\n")
|
||||
print(as.character(x), quote = FALSE)
|
||||
|
||||
@ -231,57 +231,6 @@
|
||||
#' dt[any(carbapenems() == "S"), penicillins(), with = FALSE]
|
||||
#' }
|
||||
#' }
|
||||
amr_class <- function(amr_class,
|
||||
only_sir_columns = FALSE,
|
||||
only_treatable = TRUE,
|
||||
return_all = TRUE,
|
||||
...) {
|
||||
meet_criteria(amr_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)
|
||||
meet_criteria(return_all, allow_class = "logical", has_length = 1)
|
||||
amr_select_exec(NULL, only_sir_columns = only_sir_columns, amr_class_args = amr_class, only_treatable = only_treatable, return_all = return_all)
|
||||
}
|
||||
|
||||
#' @rdname antimicrobial_selectors
|
||||
#' @details The [amr_selector()] function can be used to internally filter the [antibiotics] data set on any results, see *Examples*. It allows for filtering on a (part of) a certain name, and/or a group name or even a minimum of DDDs for oral treatment. This function yields the highest flexibility, but is also the least user-friendly, since it requires a hard-coded filter to set.
|
||||
#' @export
|
||||
amr_selector <- function(filter,
|
||||
only_sir_columns = FALSE,
|
||||
only_treatable = TRUE,
|
||||
return_all = TRUE,
|
||||
...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(return_all, allow_class = "logical", has_length = 1)
|
||||
|
||||
# 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
|
||||
vars_df <- get_current_data(arg_name = NA, call = -2)
|
||||
# to improve speed, get_column_abx() will only run once when e.g. in a select or group call
|
||||
ab_in_data <- get_column_abx(vars_df,
|
||||
info = FALSE, only_sir_columns = only_sir_columns,
|
||||
sort = FALSE, fn = "amr_selector", return_all = return_all
|
||||
)
|
||||
call <- substitute(filter)
|
||||
agents <- tryCatch(AMR_env$AB_lookup[which(eval(call, envir = AMR_env$AB_lookup)), "ab", drop = TRUE],
|
||||
error = function(e) stop_(e$message, call = -5)
|
||||
)
|
||||
agents <- ab_in_data[ab_in_data %in% agents]
|
||||
message_agent_names(
|
||||
function_name = "amr_selector",
|
||||
agents = agents,
|
||||
ab_group = NULL,
|
||||
examples = "",
|
||||
call = call
|
||||
)
|
||||
structure(unname(agents),
|
||||
class = c("amr_selector", "character")
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname antimicrobial_selectors
|
||||
#' @export
|
||||
aminoglycosides <- function(only_sir_columns = FALSE, only_treatable = TRUE, return_all = TRUE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
|
||||
@ -536,6 +485,57 @@ ureidopenicillins <- function(only_sir_columns = FALSE, return_all = TRUE, ...)
|
||||
#' @rdname antimicrobial_selectors
|
||||
#' @details The [administrable_per_os()] and [administrable_iv()] functions also rely on the [antibiotics] data set - antimicrobials will be matched where a DDD (defined daily dose) for resp. oral and IV treatment is available in the [antibiotics] data set.
|
||||
#' @export
|
||||
amr_class <- function(amr_class,
|
||||
only_sir_columns = FALSE,
|
||||
only_treatable = TRUE,
|
||||
return_all = TRUE,
|
||||
...) {
|
||||
meet_criteria(amr_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)
|
||||
meet_criteria(return_all, allow_class = "logical", has_length = 1)
|
||||
amr_select_exec(NULL, only_sir_columns = only_sir_columns, amr_class_args = amr_class, only_treatable = only_treatable, return_all = return_all)
|
||||
}
|
||||
|
||||
#' @rdname antimicrobial_selectors
|
||||
#' @details The [amr_selector()] function can be used to internally filter the [antibiotics] data set on any results, see *Examples*. It allows for filtering on a (part of) a certain name, and/or a group name or even a minimum of DDDs for oral treatment. This function yields the highest flexibility, but is also the least user-friendly, since it requires a hard-coded filter to set.
|
||||
#' @export
|
||||
amr_selector <- function(filter,
|
||||
only_sir_columns = FALSE,
|
||||
only_treatable = TRUE,
|
||||
return_all = TRUE,
|
||||
...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(return_all, allow_class = "logical", has_length = 1)
|
||||
|
||||
# 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
|
||||
vars_df <- get_current_data(arg_name = NA, call = -2)
|
||||
# to improve speed, get_column_abx() will only run once when e.g. in a select or group call
|
||||
ab_in_data <- get_column_abx(vars_df,
|
||||
info = FALSE, only_sir_columns = only_sir_columns,
|
||||
sort = FALSE, fn = "amr_selector", return_all = return_all
|
||||
)
|
||||
call <- substitute(filter)
|
||||
agents <- tryCatch(AMR_env$AB_lookup[which(eval(call, envir = AMR_env$AB_lookup)), "ab", drop = TRUE],
|
||||
error = function(e) stop_(e$message, call = -5)
|
||||
)
|
||||
agents <- ab_in_data[ab_in_data %in% agents]
|
||||
message_agent_names(
|
||||
function_name = "amr_selector",
|
||||
agents = agents,
|
||||
ab_group = NULL,
|
||||
examples = "",
|
||||
call = call
|
||||
)
|
||||
structure(unname(agents),
|
||||
class = c("amr_selector", "character")
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname antimicrobial_selectors
|
||||
#' @export
|
||||
administrable_per_os <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(return_all, allow_class = "logical", has_length = 1)
|
||||
@ -671,7 +671,8 @@ amr_select_exec <- function(function_name,
|
||||
only_sir_columns = only_sir_columns,
|
||||
sort = FALSE,
|
||||
fn = function_name,
|
||||
return_all = return_all)
|
||||
return_all = return_all
|
||||
)
|
||||
}
|
||||
|
||||
# untreatable drugs
|
||||
@ -772,7 +773,8 @@ amr_select_exec <- function(function_name,
|
||||
#' @noRd
|
||||
print.amr_selector <- function(x, ...) {
|
||||
warning_("It should never be needed to print an antimicrobial selector class. Are you using data.table? Then add the argument `with = FALSE`, see our examples at `?amr_selector`.",
|
||||
immediate = TRUE)
|
||||
immediate = TRUE
|
||||
)
|
||||
cat("Class 'amr_selector'\n")
|
||||
print(as.character(x), quote = FALSE)
|
||||
}
|
||||
|
||||
@ -307,12 +307,14 @@
|
||||
#' antibiogram(example_isolates,
|
||||
#' antibiotics = aminoglycosides(),
|
||||
#' ab_transform = "atc",
|
||||
#' mo_transform = "gramstain")
|
||||
#' mo_transform = "gramstain"
|
||||
#' )
|
||||
#'
|
||||
#' antibiogram(example_isolates,
|
||||
#' antibiotics = carbapenems(),
|
||||
#' ab_transform = "name",
|
||||
#' mo_transform = "name")
|
||||
#' mo_transform = "name"
|
||||
#' )
|
||||
#'
|
||||
#'
|
||||
#' # Combined antibiogram -------------------------------------------------
|
||||
@ -320,14 +322,16 @@
|
||||
#' # combined antibiotics yield higher empiric coverage
|
||||
#' antibiogram(example_isolates,
|
||||
#' antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
|
||||
#' mo_transform = "gramstain")
|
||||
#' mo_transform = "gramstain"
|
||||
#' )
|
||||
#'
|
||||
#' # names of antibiotics do not need to resemble columns exactly:
|
||||
#' antibiogram(example_isolates,
|
||||
#' antibiotics = c("Cipro", "cipro + genta"),
|
||||
#' mo_transform = "gramstain",
|
||||
#' ab_transform = "name",
|
||||
#' sep = " & ")
|
||||
#' sep = " & "
|
||||
#' )
|
||||
#'
|
||||
#'
|
||||
#' # Syndromic antibiogram ------------------------------------------------
|
||||
@ -335,7 +339,8 @@
|
||||
#' # the data set could contain a filter for e.g. respiratory specimens
|
||||
#' antibiogram(example_isolates,
|
||||
#' antibiotics = c(aminoglycosides(), carbapenems()),
|
||||
#' syndromic_group = "ward")
|
||||
#' syndromic_group = "ward"
|
||||
#' )
|
||||
#'
|
||||
#' # now define a data set with only E. coli
|
||||
#' ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ]
|
||||
@ -348,7 +353,8 @@
|
||||
#' syndromic_group = ifelse(ex1$ward == "ICU",
|
||||
#' "UCI", "No UCI"
|
||||
#' ),
|
||||
#' language = "es")
|
||||
#' language = "es"
|
||||
#' )
|
||||
#'
|
||||
#'
|
||||
#' # WISCA antibiogram ----------------------------------------------------
|
||||
@ -357,7 +363,8 @@
|
||||
#' antibiogram(example_isolates,
|
||||
#' antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
|
||||
#' syndromic_group = "ward",
|
||||
#' wisca = TRUE)
|
||||
#' wisca = TRUE
|
||||
#' )
|
||||
#'
|
||||
#'
|
||||
#' # Print the output for R Markdown / Quarto -----------------------------
|
||||
@ -365,7 +372,8 @@
|
||||
#' ureido <- antibiogram(example_isolates,
|
||||
#' antibiotics = ureidopenicillins(),
|
||||
#' syndromic_group = "ward",
|
||||
#' wisca = TRUE)
|
||||
#' wisca = TRUE
|
||||
#' )
|
||||
#'
|
||||
#' # in an Rmd file, you would just need to return `ureido` in a chunk,
|
||||
#' # but to be explicit here:
|
||||
@ -378,11 +386,13 @@
|
||||
#'
|
||||
#' ab1 <- antibiogram(example_isolates,
|
||||
#' antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
|
||||
#' mo_transform = "gramstain")
|
||||
#' mo_transform = "gramstain"
|
||||
#' )
|
||||
#' ab2 <- antibiogram(example_isolates,
|
||||
#' antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
|
||||
#' mo_transform = "gramstain",
|
||||
#' syndromic_group = "ward")
|
||||
#' syndromic_group = "ward"
|
||||
#' )
|
||||
#'
|
||||
#' if (requireNamespace("ggplot2")) {
|
||||
#' ggplot2::autoplot(ab1)
|
||||
@ -639,12 +649,14 @@ antibiogram.default <- function(x,
|
||||
}
|
||||
|
||||
long_numeric <- out %pm>%
|
||||
pm_summarise(coverage = p_susceptible,
|
||||
pm_summarise(
|
||||
coverage = p_susceptible,
|
||||
lower_ci = lower_ci,
|
||||
upper_ci = upper_ci,
|
||||
n_total = n_total,
|
||||
n_tested = n_tested,
|
||||
n_susceptible = n_susceptible)
|
||||
n_susceptible = n_susceptible
|
||||
)
|
||||
|
||||
wisca_parameters <- data.frame()
|
||||
|
||||
@ -660,12 +672,14 @@ antibiogram.default <- function(x,
|
||||
pm_group_by(ab)
|
||||
}
|
||||
out_wisca <- out_wisca %pm>%
|
||||
pm_summarise(coverage = NA_real_,
|
||||
pm_summarise(
|
||||
coverage = NA_real_,
|
||||
lower_ci = NA_real_,
|
||||
upper_ci = NA_real_,
|
||||
n_total = sum(n_total, na.rm = TRUE),
|
||||
n_tested = sum(n_tested, na.rm = TRUE),
|
||||
n_susceptible = sum(n_susceptible, na.rm = TRUE))
|
||||
n_susceptible = sum(n_susceptible, na.rm = TRUE)
|
||||
)
|
||||
out_wisca$p_susceptible <- out_wisca$n_susceptible / out_wisca$n_tested
|
||||
|
||||
if (isTRUE(has_syndromic_group)) {
|
||||
@ -688,17 +702,19 @@ antibiogram.default <- function(x,
|
||||
|
||||
out_current <- out[i, , drop = FALSE]
|
||||
priors <- calculate_priors(out_current, combine_SI = combine_SI)
|
||||
out$gamma_posterior[i] = priors$gamma_posterior
|
||||
out$beta_posterior1[i] = priors$beta_posterior_1
|
||||
out$beta_posterior2[i] = priors$beta_posterior_2
|
||||
out$gamma_posterior[i] <- priors$gamma_posterior
|
||||
out$beta_posterior1[i] <- priors$beta_posterior_1
|
||||
out$beta_posterior2[i] <- priors$beta_posterior_2
|
||||
}
|
||||
|
||||
wisca_parameters <- out
|
||||
|
||||
progress <- progress_ticker(n = length(unique(wisca_parameters$group)) * simulations,
|
||||
progress <- progress_ticker(
|
||||
n = length(unique(wisca_parameters$group)) * simulations,
|
||||
n_min = 25,
|
||||
print = info,
|
||||
title = paste("Calculating WISCA for", length(unique(wisca_parameters$group)), "regimens"))
|
||||
title = paste("Calculating WISCA for", length(unique(wisca_parameters$group)), "regimens")
|
||||
)
|
||||
on.exit(close(progress))
|
||||
|
||||
# run WISCA
|
||||
@ -930,7 +946,8 @@ antibiogram.default <- function(x,
|
||||
conf_interval = conf_interval,
|
||||
formatting_type = formatting_type,
|
||||
wisca_parameters = as_original_data_class(wisca_parameters, class(x)),
|
||||
long_numeric = as_original_data_class(long_numeric, class(x)))
|
||||
long_numeric = as_original_data_class(long_numeric, class(x))
|
||||
)
|
||||
rownames(out) <- NULL
|
||||
out
|
||||
}
|
||||
@ -960,10 +977,12 @@ antibiogram.grouped_df <- function(x,
|
||||
stop_ifnot(is.null(syndromic_group), "`syndromic_group` must not be set if creating an antibiogram using a grouped tibble. The groups will become the variables over which the antimicrobials are calculated, making `syndromic_groups` redundant.", call = FALSE)
|
||||
groups <- attributes(x)$groups
|
||||
n_groups <- NROW(groups)
|
||||
progress <- progress_ticker(n = n_groups,
|
||||
progress <- progress_ticker(
|
||||
n = n_groups,
|
||||
n_min = 5,
|
||||
print = info,
|
||||
title = paste("Calculating AMR for", n_groups, "groups"))
|
||||
title = paste("Calculating AMR for", n_groups, "groups")
|
||||
)
|
||||
on.exit(close(progress))
|
||||
|
||||
out <- NULL
|
||||
@ -994,7 +1013,8 @@ antibiogram.grouped_df <- function(x,
|
||||
simulations = simulations,
|
||||
conf_interval = conf_interval,
|
||||
interval_side = interval_side,
|
||||
info = FALSE)
|
||||
info = FALSE
|
||||
)
|
||||
new_wisca_parameters <- attributes(new_out)$wisca_parameters
|
||||
new_long_numeric <- attributes(new_out)$long_numeric
|
||||
|
||||
@ -1045,7 +1065,8 @@ antibiogram.grouped_df <- function(x,
|
||||
conf_interval = conf_interval,
|
||||
formatting_type = formatting_type,
|
||||
wisca_parameters = as_original_data_class(wisca_parameters, class(x)),
|
||||
long_numeric = as_original_data_class(long_numeric, class(x)))
|
||||
long_numeric = as_original_data_class(long_numeric, class(x))
|
||||
)
|
||||
rownames(out) <- NULL
|
||||
out
|
||||
}
|
||||
@ -1069,7 +1090,8 @@ wisca <- function(x,
|
||||
conf_interval = 0.95,
|
||||
interval_side = "two-tailed",
|
||||
info = interactive()) {
|
||||
antibiogram(x = x,
|
||||
antibiogram(
|
||||
x = x,
|
||||
antibiotics = antibiotics,
|
||||
ab_transform = ab_transform,
|
||||
mo_transform = NULL,
|
||||
@ -1087,7 +1109,8 @@ wisca <- function(x,
|
||||
simulations = simulations,
|
||||
conf_interval = conf_interval,
|
||||
interval_side = interval_side,
|
||||
info = info)
|
||||
info = info
|
||||
)
|
||||
}
|
||||
|
||||
#' @export
|
||||
@ -1137,9 +1160,11 @@ tbl_format_footer.antibiogram <- function(x, ...) {
|
||||
if (NROW(x) == 0) {
|
||||
return(footer)
|
||||
}
|
||||
c(footer, font_subtle(paste0("# Use `plot()` or `ggplot2::autoplot()` to create a plot of this antibiogram,\n",
|
||||
c(footer, font_subtle(paste0(
|
||||
"# Use `plot()` or `ggplot2::autoplot()` to create a plot of this antibiogram,\n",
|
||||
"# or use it directly in R Markdown or ",
|
||||
font_url("https://quarto.org", "Quarto"), ", see ", word_wrap("?antibiogram"))))
|
||||
font_url("https://quarto.org", "Quarto"), ", see ", word_wrap("?antibiogram")
|
||||
)))
|
||||
}
|
||||
|
||||
#' @export
|
||||
@ -1148,7 +1173,8 @@ plot.antibiogram <- function(x, ...) {
|
||||
df <- attributes(x)$long_numeric
|
||||
if (!"mo" %in% colnames(df)) {
|
||||
stop_("Plotting antibiograms using `plot()` is only possible if they were not created using dplyr groups. See `?antibiogram` for how to retrieve numeric values in a long format for advanced plotting.",
|
||||
call = FALSE)
|
||||
call = FALSE
|
||||
)
|
||||
}
|
||||
if ("syndromic_group" %in% colnames(df)) {
|
||||
# barplot in base R does not support facets - paste columns together
|
||||
@ -1203,7 +1229,8 @@ autoplot.antibiogram <- function(object, ...) {
|
||||
df <- attributes(object)$long_numeric
|
||||
if (!"mo" %in% colnames(df)) {
|
||||
stop_("Plotting antibiograms using `autoplot()` is only possible if they were not created using dplyr groups. See `?antibiogram` for how to retrieve numeric values in a long format for advanced plotting.",
|
||||
call = FALSE)
|
||||
call = FALSE
|
||||
)
|
||||
}
|
||||
out <- ggplot2::ggplot(df,
|
||||
mapping = ggplot2::aes(
|
||||
@ -1214,7 +1241,8 @@ autoplot.antibiogram <- function(object, ...) {
|
||||
} else {
|
||||
NULL
|
||||
}
|
||||
)) +
|
||||
)
|
||||
) +
|
||||
ggplot2::geom_col(position = ggplot2::position_dodge2(preserve = "single")) +
|
||||
ggplot2::facet_wrap("mo") +
|
||||
ggplot2::labs(
|
||||
@ -1228,9 +1256,11 @@ autoplot.antibiogram <- function(object, ...) {
|
||||
)
|
||||
if (isTRUE(attributes(object)$wisca)) {
|
||||
out <- out +
|
||||
ggplot2::geom_errorbar(mapping = ggplot2::aes(ymin = lower_ci * 100, ymax = upper_ci * 100),
|
||||
ggplot2::geom_errorbar(
|
||||
mapping = ggplot2::aes(ymin = lower_ci * 100, ymax = upper_ci * 100),
|
||||
position = ggplot2::position_dodge2(preserve = "single"),
|
||||
width = 0.5)
|
||||
width = 0.5
|
||||
)
|
||||
}
|
||||
out
|
||||
}
|
||||
|
||||
@ -127,13 +127,15 @@ bug_drug_combinations <- function(x,
|
||||
# turn and merge everything
|
||||
pivot <- lapply(x_mo_filter, function(x) {
|
||||
m <- as.matrix(table(as.sir(x), useNA = "always"))
|
||||
data.frame(S = m["S", ],
|
||||
data.frame(
|
||||
S = m["S", ],
|
||||
SDD = m["SDD", ],
|
||||
I = m["I", ],
|
||||
R = m["R", ],
|
||||
NI = m["NI", ],
|
||||
na = m[which(is.na(rownames(m))), ],
|
||||
stringsAsFactors = FALSE)
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
})
|
||||
merged <- do.call(rbind_AMR, pivot)
|
||||
out_group <- data.frame(
|
||||
|
||||
@ -178,8 +178,10 @@ custom_eucast_rules <- function(...) {
|
||||
result_group[j] <- paste0(result_group[j], "s")
|
||||
}
|
||||
if (paste0("AB_", toupper(result_group[j])) %in% DEFINED_AB_GROUPS) {
|
||||
result_group_agents <- c(result_group_agents,
|
||||
eval(parse(text = paste0("AB_", toupper(result_group[j]))), envir = asNamespace("AMR")))
|
||||
result_group_agents <- c(
|
||||
result_group_agents,
|
||||
eval(parse(text = paste0("AB_", toupper(result_group[j]))), envir = asNamespace("AMR"))
|
||||
)
|
||||
} else {
|
||||
out_group <- tryCatch(
|
||||
suppressWarnings(as.ab(result_group[j],
|
||||
|
||||
@ -252,8 +252,11 @@ add_custom_microorganisms <- function(x) {
|
||||
paste(abbreviate_mo(x$genus, 5),
|
||||
abbreviate_mo(x$species, 4, hyphen_as_space = TRUE),
|
||||
abbreviate_mo(x$subspecies, 4, hyphen_as_space = TRUE),
|
||||
sep = "_"),
|
||||
whitespace = "_"))
|
||||
sep = "_"
|
||||
),
|
||||
whitespace = "_"
|
||||
)
|
||||
)
|
||||
stop_if(anyDuplicated(c(as.character(AMR_env$MO_lookup$mo), x$mo)), "MO codes must be unique and not match existing MO codes of the AMR package")
|
||||
|
||||
# add to package ----
|
||||
@ -309,19 +312,25 @@ abbreviate_mo <- function(x, minlength = 5, prefix = "", hyphen_as_space = FALSE
|
||||
}
|
||||
# keep a starting Latin ae
|
||||
suppressWarnings(
|
||||
gsub("(\u00C6|\u00E6)+",
|
||||
gsub(
|
||||
"(\u00C6|\u00E6)+",
|
||||
"AE",
|
||||
toupper(
|
||||
paste0(prefix,
|
||||
paste0(
|
||||
prefix,
|
||||
abbreviate(
|
||||
gsub("^ae",
|
||||
"\u00E6\u00E6",
|
||||
x,
|
||||
ignore.case = TRUE),
|
||||
ignore.case = TRUE
|
||||
),
|
||||
minlength = minlength,
|
||||
use.classes = TRUE,
|
||||
method = "both.sides",
|
||||
...
|
||||
))))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
@ -462,10 +462,12 @@ eucast_rules <- function(x,
|
||||
if (isTRUE(info)) {
|
||||
cat(paste0("\n", font_grey(strrep("-", 0.95 * getOption("width", 100))), "\n"))
|
||||
cat(word_wrap(
|
||||
paste0("Rules by the ",
|
||||
paste0(
|
||||
"Rules by the ",
|
||||
font_bold(paste0("AMR package v", utils::packageDescription("AMR")$Version)),
|
||||
" (", format(as.Date(utils::packageDescription("AMR")$Date), format = "%Y"),
|
||||
"), see `?eucast_rules`\n")
|
||||
"), see `?eucast_rules`\n"
|
||||
)
|
||||
))
|
||||
cat("\n\n")
|
||||
}
|
||||
|
||||
@ -517,7 +517,8 @@ first_isolate <- function(x = NULL,
|
||||
if (icu_exclude == TRUE) {
|
||||
if (isTRUE(info)) {
|
||||
message_("Excluding ", format(sum(x$newvar_is_icu, na.rm = TRUE), decimal.mark = decimal.mark, big.mark = big.mark), " isolates from ICU.",
|
||||
add_fn = font_red)
|
||||
add_fn = font_red
|
||||
)
|
||||
}
|
||||
x[which(x$newvar_is_icu), "newvar_first_isolate"] <- FALSE
|
||||
} else if (isTRUE(info)) {
|
||||
@ -673,10 +674,12 @@ duplicated_antibiogram <- function(antibiogram, points_threshold, ignore_I, type
|
||||
return(FALSE)
|
||||
}
|
||||
# first sort on data availability - count the dots and order that ascending so that highest availability of SIR is on top
|
||||
number_dots <- vapply(FUN.VALUE = integer(1),
|
||||
number_dots <- vapply(
|
||||
FUN.VALUE = integer(1),
|
||||
antibiogram,
|
||||
function(x) sum(strsplit(x, "", fixed = TRUE)[[1]] == "."),
|
||||
USE.NAMES = FALSE)
|
||||
USE.NAMES = FALSE
|
||||
)
|
||||
new_order <- order(number_dots, antibiogram)
|
||||
antibiogram.bak <- antibiogram
|
||||
antibiogram <- antibiogram[new_order]
|
||||
@ -685,7 +688,8 @@ duplicated_antibiogram <- function(antibiogram, points_threshold, ignore_I, type
|
||||
out[1] <- FALSE
|
||||
out[2] <- antimicrobials_equal(antibiogram[1], antibiogram[2],
|
||||
ignore_I = ignore_I, points_threshold = points_threshold,
|
||||
type = type)
|
||||
type = type
|
||||
)
|
||||
if (length(antibiogram) == 2) {
|
||||
# fast return, no further check required
|
||||
return(out)
|
||||
@ -702,11 +706,18 @@ duplicated_antibiogram <- function(antibiogram, points_threshold, ignore_I, type
|
||||
for (na in antibiogram[is.na(out)]) {
|
||||
# check if this antibiogram has any change with other antibiograms
|
||||
out[which(antibiogram == na)] <- all(
|
||||
vapply(FUN.VALUE = logical(1),
|
||||
vapply(
|
||||
FUN.VALUE = logical(1),
|
||||
antibiogram[!is.na(out) & antibiogram != na],
|
||||
function(y) antimicrobials_equal(y = y, z = na,
|
||||
function(y) {
|
||||
antimicrobials_equal(
|
||||
y = y, z = na,
|
||||
ignore_I = ignore_I, points_threshold = points_threshold,
|
||||
type = type)))
|
||||
type = type
|
||||
)
|
||||
}
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
out <- out[order(new_order)]
|
||||
|
||||
@ -121,8 +121,10 @@
|
||||
#' ) %>%
|
||||
#' ggplot() +
|
||||
#' geom_col(aes(x = x, y = y, fill = z)) +
|
||||
#' scale_sir_colours(aesthetics = "fill",
|
||||
#' Value4 = "S", Value5 = "I", Value6 = "R")
|
||||
#' scale_sir_colours(
|
||||
#' aesthetics = "fill",
|
||||
#' Value4 = "S", Value5 = "I", Value6 = "R"
|
||||
#' )
|
||||
#' }
|
||||
#' if (require("ggplot2") && require("dplyr")) {
|
||||
#' # resistance of ciprofloxacine per age group
|
||||
|
||||
6
R/mdro.R
6
R/mdro.R
@ -799,11 +799,13 @@ mdro <- function(x = NULL,
|
||||
rows_not_to_change <- rows[!rows %in% c(rows_affected, rows_to_change)]
|
||||
rows_not_to_change <- rows_not_to_change[is.na(x[rows_not_to_change, "reason"])]
|
||||
if (is.null(reason)) {
|
||||
reason <- paste0(any_all,
|
||||
reason <- paste0(
|
||||
any_all,
|
||||
" of the required antibiotics ",
|
||||
ifelse(any_all == "any", "is", "are"),
|
||||
" R",
|
||||
ifelse(!isTRUE(combine_SI), " or I", ""))
|
||||
ifelse(!isTRUE(combine_SI), " or I", "")
|
||||
)
|
||||
}
|
||||
x[rows_to_change, "MDRO"] <<- to
|
||||
x[rows_to_change, "reason"] <<- reason
|
||||
|
||||
36
R/mic.R
36
R/mic.R
@ -39,18 +39,22 @@ VALID_MIC_LEVELS <- c(
|
||||
)
|
||||
VALID_MIC_LEVELS <- trimws(gsub("[.]?0+$", "", format(unique(sort(VALID_MIC_LEVELS)), scientific = FALSE), perl = TRUE))
|
||||
operators <- c("<", "<=", "", ">=", ">")
|
||||
VALID_MIC_LEVELS <- c(t(vapply(FUN.VALUE = character(length(VALID_MIC_LEVELS)),
|
||||
VALID_MIC_LEVELS <- c(t(vapply(
|
||||
FUN.VALUE = character(length(VALID_MIC_LEVELS)),
|
||||
c("<", "<=", "", ">=", ">"),
|
||||
paste0,
|
||||
VALID_MIC_LEVELS)))
|
||||
COMMON_MIC_VALUES <- c(0.0001, 0.0002, 0.0005,
|
||||
VALID_MIC_LEVELS
|
||||
)))
|
||||
COMMON_MIC_VALUES <- c(
|
||||
0.0001, 0.0002, 0.0005,
|
||||
0.001, 0.002, 0.004, 0.008,
|
||||
0.016, 0.032, 0.064,
|
||||
0.125, 0.25, 0.5,
|
||||
1, 2, 4, 8,
|
||||
16, 32, 64,
|
||||
128, 256, 512,
|
||||
1024, 2048, 4096)
|
||||
1024, 2048, 4096
|
||||
)
|
||||
|
||||
#' Transform Input to Minimum Inhibitory Concentrations (MIC)
|
||||
#'
|
||||
@ -165,7 +169,8 @@ as.mic <- function(x, na.rm = FALSE, keep_operators = "all") {
|
||||
if (!identical(levels(x), VALID_MIC_LEVELS)) {
|
||||
# might be from an older AMR version - just update MIC factor levels
|
||||
x <- set_clean_class(factor(as.character(x), levels = VALID_MIC_LEVELS, ordered = TRUE),
|
||||
new_class = c("mic", "ordered", "factor"))
|
||||
new_class = c("mic", "ordered", "factor")
|
||||
)
|
||||
}
|
||||
return(x)
|
||||
}
|
||||
@ -265,7 +270,8 @@ as.mic <- function(x, na.rm = FALSE, keep_operators = "all") {
|
||||
}
|
||||
|
||||
set_clean_class(factor(x, levels = VALID_MIC_LEVELS, ordered = TRUE),
|
||||
new_class = c("mic", "ordered", "factor"))
|
||||
new_class = c("mic", "ordered", "factor")
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname as.mic
|
||||
@ -294,10 +300,12 @@ rescale_mic <- function(x, mic_range, keep_operators = "edges", as.mic = TRUE) {
|
||||
} else if (is.mic(mic_range)) {
|
||||
mic_range <- as.character(mic_range)
|
||||
}
|
||||
stop_ifnot(all(mic_range %in% c(VALID_MIC_LEVELS, NA)),
|
||||
stop_ifnot(
|
||||
all(mic_range %in% c(VALID_MIC_LEVELS, NA)),
|
||||
"Values in `mic_range` must be valid MIC values. ",
|
||||
"The allowed range is ", format(as.double(as.mic(VALID_MIC_LEVELS)[1]), scientific = FALSE), " to ", format(as.double(as.mic(VALID_MIC_LEVELS)[length(VALID_MIC_LEVELS)]), scientific = FALSE), ". ",
|
||||
"Unvalid: ", vector_and(mic_range[!mic_range %in% c(VALID_MIC_LEVELS, NA)], quotes = FALSE), ".")
|
||||
"Unvalid: ", vector_and(mic_range[!mic_range %in% c(VALID_MIC_LEVELS, NA)], quotes = FALSE), "."
|
||||
)
|
||||
|
||||
x <- as.mic(x)
|
||||
if (is.null(mic_range)) {
|
||||
@ -328,7 +336,8 @@ rescale_mic <- function(x, mic_range, keep_operators = "edges", as.mic = TRUE) {
|
||||
expanded <- plotrange_as_table(x,
|
||||
expand = TRUE,
|
||||
keep_operators = ifelse(keep_operators == "edges", "none", keep_operators),
|
||||
mic_range = mic_range)
|
||||
mic_range = mic_range
|
||||
)
|
||||
if (keep_operators == "edges") {
|
||||
names(expanded)[1] <- paste0("<=", names(expanded)[1])
|
||||
names(expanded)[length(expanded)] <- paste0(">=", names(expanded)[length(expanded)])
|
||||
@ -336,7 +345,8 @@ rescale_mic <- function(x, mic_range, keep_operators = "edges", as.mic = TRUE) {
|
||||
# MICs contain all MIC levels, so strip this to only existing levels and their intermediate values
|
||||
out <- factor(names(expanded),
|
||||
levels = names(expanded),
|
||||
ordered = TRUE)
|
||||
ordered = TRUE
|
||||
)
|
||||
# and only keep the ones in the data
|
||||
if (keep_operators == "edges") {
|
||||
out <- out[match(x, as.double(as.mic(out, keep_operators = "all")))]
|
||||
@ -402,7 +412,8 @@ all_valid_mics <- function(x) {
|
||||
pillar_shaft.mic <- function(x, ...) {
|
||||
if (!identical(levels(x), VALID_MIC_LEVELS) && message_not_thrown_before("pillar_shaft.mic")) {
|
||||
warning_(AMR_env$sup_1_icon, " These columns contain an outdated or altered structure - convert with `as.mic()` to update",
|
||||
call = FALSE)
|
||||
call = FALSE
|
||||
)
|
||||
}
|
||||
crude_numbers <- as.double(x)
|
||||
operators <- gsub("[^<=>]+", "", as.character(x))
|
||||
@ -649,5 +660,6 @@ Summary.mic <- function(..., na.rm = FALSE) {
|
||||
# NextMethod() cannot be called from an anonymous function (`...`), so we get() the generic directly:
|
||||
fn <- get(.Generic, envir = .GenericCallEnv)
|
||||
fn(as.double(c(...)),
|
||||
na.rm = na.rm)
|
||||
na.rm = na.rm
|
||||
)
|
||||
}
|
||||
|
||||
25
R/mo.R
25
R/mo.R
@ -594,9 +594,11 @@ mo_reset_session <- function() {
|
||||
#' @rdname as.mo
|
||||
#' @export
|
||||
mo_cleaning_regex <- function() {
|
||||
parts_to_remove <- c("e?spp([^a-z]+|$)", "e?ssp([^a-z]+|$)", "e?ss([^a-z]+|$)", "e?sp([^a-z]+|$)", "e?subsp", "sube?species", "e?species",
|
||||
parts_to_remove <- c(
|
||||
"e?spp([^a-z]+|$)", "e?ssp([^a-z]+|$)", "e?ss([^a-z]+|$)", "e?sp([^a-z]+|$)", "e?subsp", "sube?species", "e?species",
|
||||
"biovar[a-z]*", "biotype", "serovar[a-z]*", "var([^a-z]+|$)", "serogr.?up[a-z]*",
|
||||
"titer", "dummy", "Ig[ADEGM]", " ?[a-z-]+[-](resistant|susceptible) ?")
|
||||
"titer", "dummy", "Ig[ADEGM]", " ?[a-z-]+[-](resistant|susceptible) ?"
|
||||
)
|
||||
|
||||
paste0(
|
||||
"(",
|
||||
@ -605,7 +607,8 @@ mo_cleaning_regex <- function() {
|
||||
"([({]|\\[).+([})]|\\])",
|
||||
"|(^| )(",
|
||||
paste0(parts_to_remove[order(1 - nchar(parts_to_remove))], collapse = "|"),
|
||||
"))")
|
||||
"))"
|
||||
)
|
||||
}
|
||||
|
||||
# UNDOCUMENTED METHODS ----------------------------------------------------
|
||||
@ -660,9 +663,13 @@ pillar_shaft.mo <- function(x, ...) {
|
||||
|
||||
# add the names to the bugs as mouse-over!
|
||||
if (tryCatch(isTRUE(getExportedValue("ansi_has_hyperlink_support", ns = asNamespace("cli"))()), error = function(e) FALSE)) {
|
||||
out[!x %in% c("UNKNOWN", NA)] <- font_url(url = paste0(x[!x %in% c("UNKNOWN", NA)], ": ",
|
||||
mo_name(x[!x %in% c("UNKNOWN", NA)], keep_synonyms = TRUE)),
|
||||
txt = out[!x %in% c("UNKNOWN", NA)])
|
||||
out[!x %in% c("UNKNOWN", NA)] <- font_url(
|
||||
url = paste0(
|
||||
x[!x %in% c("UNKNOWN", NA)], ": ",
|
||||
mo_name(x[!x %in% c("UNKNOWN", NA)], keep_synonyms = TRUE)
|
||||
),
|
||||
txt = out[!x %in% c("UNKNOWN", NA)]
|
||||
)
|
||||
}
|
||||
|
||||
# make it always fit exactly
|
||||
@ -1277,8 +1284,10 @@ repair_reference_df <- function(reference_df) {
|
||||
}
|
||||
|
||||
get_mo_uncertainties <- function() {
|
||||
remember <- list(uncertainties = AMR_env$mo_uncertainties,
|
||||
failures = AMR_env$mo_failures)
|
||||
remember <- list(
|
||||
uncertainties = AMR_env$mo_uncertainties,
|
||||
failures = AMR_env$mo_failures
|
||||
)
|
||||
# empty them, otherwise e.g. mo_shortname("Chlamydophila psittaci") will give 3 notes
|
||||
AMR_env$mo_uncertainties <- NULL
|
||||
AMR_env$mo_failures <- NULL
|
||||
|
||||
@ -108,10 +108,12 @@
|
||||
#' mo_url("Klebsiella pneumoniae")
|
||||
#' mo_is_yeast(c("Candida", "Trichophyton", "Klebsiella"))
|
||||
#'
|
||||
#' mo_group_members(c("Streptococcus group A",
|
||||
#' mo_group_members(c(
|
||||
#' "Streptococcus group A",
|
||||
#' "Streptococcus group C",
|
||||
#' "Streptococcus group G",
|
||||
#' "Streptococcus group L"))
|
||||
#' "Streptococcus group L"
|
||||
#' ))
|
||||
#'
|
||||
#'
|
||||
#' # scientific reference -----------------------------------------------------
|
||||
@ -442,11 +444,14 @@ mo_pathogenicity <- function(x, language = get_AMR_locale(), keep_synonyms = get
|
||||
kngd <- AMR_env$MO_lookup$kingdom[match(x.mo, AMR_env$MO_lookup$mo)]
|
||||
rank <- AMR_env$MO_lookup$rank[match(x.mo, AMR_env$MO_lookup$mo)]
|
||||
|
||||
out <- factor(case_when_AMR(prev <= 1.15 & kngd == "Bacteria" & rank != "genus" ~ "Pathogenic",
|
||||
out <- factor(
|
||||
case_when_AMR(
|
||||
prev <= 1.15 & kngd == "Bacteria" & rank != "genus" ~ "Pathogenic",
|
||||
prev < 2 & kngd == "Fungi" ~ "Potentially pathogenic",
|
||||
prev == 2 & kngd == "Bacteria" ~ "Non-pathogenic",
|
||||
kngd == "Bacteria" ~ "Potentially pathogenic",
|
||||
TRUE ~ "Unknown"),
|
||||
TRUE ~ "Unknown"
|
||||
),
|
||||
levels = c("Pathogenic", "Potentially pathogenic", "Non-pathogenic", "Unknown"),
|
||||
ordered = TRUE
|
||||
)
|
||||
@ -872,8 +877,10 @@ mo_info <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("A
|
||||
|
||||
info <- lapply(x, function(y) {
|
||||
c(
|
||||
list(mo = as.character(y),
|
||||
rank = mo_rank(y, language = language, keep_synonyms = keep_synonyms)),
|
||||
list(
|
||||
mo = as.character(y),
|
||||
rank = mo_rank(y, language = language, keep_synonyms = keep_synonyms)
|
||||
),
|
||||
mo_taxonomy(y, language = language, keep_synonyms = keep_synonyms),
|
||||
list(
|
||||
status = mo_status(y, language = language, keep_synonyms = keep_synonyms),
|
||||
@ -988,7 +995,6 @@ mo_validate <- function(x, property, language, keep_synonyms = keep_synonyms, ..
|
||||
} else {
|
||||
x <- AMR_env$MO_lookup[[property]][match(x, AMR_env$MO_lookup$mo)]
|
||||
}
|
||||
|
||||
} else {
|
||||
# get microorganisms data set, but remove synonyms if keep_synonyms is FALSE
|
||||
mo_data_check <- AMR_env$MO_lookup[which(AMR_env$MO_lookup$status %in% if (isTRUE(keep_synonyms)) c("synonym", "accepted") else "accepted"), , drop = FALSE]
|
||||
|
||||
84
R/plotting.R
84
R/plotting.R
@ -80,7 +80,6 @@
|
||||
#' some_disk_values <- random_disk(size = 100, mo = "Escherichia coli", ab = "cipro")
|
||||
#' some_sir_values <- random_sir(50, prob_SIR = c(0.55, 0.05, 0.30))
|
||||
#'
|
||||
#'
|
||||
#' \donttest{
|
||||
#' # Plotting using ggplot2's autoplot() for MIC, disk, and SIR -----------
|
||||
#' if (require("ggplot2")) {
|
||||
@ -92,17 +91,23 @@
|
||||
#' }
|
||||
#' if (require("ggplot2")) {
|
||||
#' # support for 20 languages, various guidelines, and many options
|
||||
#' autoplot(some_disk_values, mo = "Escherichia coli", ab = "cipro",
|
||||
#' autoplot(some_disk_values,
|
||||
#' mo = "Escherichia coli", ab = "cipro",
|
||||
#' guideline = "CLSI 2024", language = "no",
|
||||
#' title = "Disk diffusion from the North")
|
||||
#' title = "Disk diffusion from the North"
|
||||
#' )
|
||||
#' }
|
||||
#'
|
||||
#'
|
||||
#' # Plotting using scale_x_mic() -----------------------------------------
|
||||
#' if (require("ggplot2")) {
|
||||
#' mic_plot <- ggplot(data.frame(mics = as.mic(c(0.25, "<=4", 4, 8, 32, ">=32")),
|
||||
#' counts = c(1, 1, 2, 2, 3, 3)),
|
||||
#' aes(mics, counts)) +
|
||||
#' mic_plot <- ggplot(
|
||||
#' data.frame(
|
||||
#' mics = as.mic(c(0.25, "<=4", 4, 8, 32, ">=32")),
|
||||
#' counts = c(1, 1, 2, 2, 3, 3)
|
||||
#' ),
|
||||
#' aes(mics, counts)
|
||||
#' ) +
|
||||
#' geom_col()
|
||||
#' mic_plot +
|
||||
#' labs(title = "without scale_x_mic()")
|
||||
@ -133,17 +138,25 @@
|
||||
#' some_groups <- sample(LETTERS[1:5], 20, replace = TRUE)
|
||||
#'
|
||||
#' if (require("ggplot2")) {
|
||||
#' ggplot(data.frame(mic = some_mic_values,
|
||||
#' group = some_groups),
|
||||
#' aes(group, mic)) +
|
||||
#' ggplot(
|
||||
#' data.frame(
|
||||
#' mic = some_mic_values,
|
||||
#' group = some_groups
|
||||
#' ),
|
||||
#' aes(group, mic)
|
||||
#' ) +
|
||||
#' geom_boxplot() +
|
||||
#' geom_violin(linetype = 2, colour = "grey", fill = NA) +
|
||||
#' scale_y_mic()
|
||||
#' }
|
||||
#' if (require("ggplot2")) {
|
||||
#' ggplot(data.frame(mic = some_mic_values,
|
||||
#' group = some_groups),
|
||||
#' aes(group, mic)) +
|
||||
#' ggplot(
|
||||
#' data.frame(
|
||||
#' mic = some_mic_values,
|
||||
#' group = some_groups
|
||||
#' ),
|
||||
#' aes(group, mic)
|
||||
#' ) +
|
||||
#' geom_boxplot() +
|
||||
#' geom_violin(linetype = 2, colour = "grey", fill = NA) +
|
||||
#' scale_y_mic(mic_range = c(NA, 0.25))
|
||||
@ -152,9 +165,13 @@
|
||||
#'
|
||||
#' # Plotting using scale_x_sir() -----------------------------------------
|
||||
#' if (require("ggplot2")) {
|
||||
#' ggplot(data.frame(x = c("I", "R", "S"),
|
||||
#' y = c(45,323, 573)),
|
||||
#' aes(x, y)) +
|
||||
#' ggplot(
|
||||
#' data.frame(
|
||||
#' x = c("I", "R", "S"),
|
||||
#' y = c(45, 323, 573)
|
||||
#' ),
|
||||
#' aes(x, y)
|
||||
#' ) +
|
||||
#' geom_col() +
|
||||
#' scale_x_sir()
|
||||
#' }
|
||||
@ -162,12 +179,17 @@
|
||||
#'
|
||||
#' # Plotting using scale_y_mic() and scale_colour_sir() ------------------
|
||||
#' if (require("ggplot2")) {
|
||||
#' plain <- ggplot(data.frame(mic = some_mic_values,
|
||||
#' plain <- ggplot(
|
||||
#' data.frame(
|
||||
#' mic = some_mic_values,
|
||||
#' group = some_groups,
|
||||
#' sir = as.sir(some_mic_values,
|
||||
#' mo = "E. coli",
|
||||
#' ab = "cipro")),
|
||||
#' aes(x = group, y = mic, colour = sir)) +
|
||||
#' ab = "cipro"
|
||||
#' )
|
||||
#' ),
|
||||
#' aes(x = group, y = mic, colour = sir)
|
||||
#' ) +
|
||||
#' theme_minimal() +
|
||||
#' geom_boxplot(fill = NA, colour = "grey") +
|
||||
#' geom_jitter(width = 0.25)
|
||||
@ -183,8 +205,10 @@
|
||||
#' if (require("ggplot2")) {
|
||||
#' plain +
|
||||
#' scale_y_mic(mic_range = c(0.005, 32), name = "Our MICs!") +
|
||||
#' scale_colour_sir(language = "pt",
|
||||
#' name = "Support in 20 languages")
|
||||
#' scale_colour_sir(
|
||||
#' language = "pt",
|
||||
#' name = "Support in 20 languages"
|
||||
#' )
|
||||
#' }
|
||||
#' }
|
||||
#'
|
||||
@ -203,7 +227,8 @@ NULL
|
||||
|
||||
create_scale_mic <- function(aest, keep_operators, mic_range = NULL, ...) {
|
||||
ggplot_fn <- getExportedValue(paste0("scale_", aest, "_continuous"),
|
||||
ns = asNamespace("ggplot2"))
|
||||
ns = asNamespace("ggplot2")
|
||||
)
|
||||
args <- list(...)
|
||||
breaks_set <- args$breaks
|
||||
limits_set <- args$limits
|
||||
@ -338,20 +363,27 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) {
|
||||
ggplot_fn <- ggplot2::scale_x_discrete
|
||||
} else {
|
||||
ggplot_fn <- ggplot2::scale_discrete_manual
|
||||
args <- c(args,
|
||||
list(aesthetics = aesthetics,
|
||||
values = c(S = colours_SIR[1],
|
||||
args <- c(
|
||||
args,
|
||||
list(
|
||||
aesthetics = aesthetics,
|
||||
values = c(
|
||||
S = colours_SIR[1],
|
||||
SDD = colours_SIR[2],
|
||||
I = colours_SIR[2],
|
||||
R = colours_SIR[3],
|
||||
NI = "grey30")))
|
||||
NI = "grey30"
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
scale <- do.call(ggplot_fn, args)
|
||||
|
||||
scale$labels <- function(x) {
|
||||
stop_ifnot(all(x %in% c(levels(NA_sir_), NA)),
|
||||
"Apply `scale_", aesthetics[1], "_sir()` to a variable of class 'sir', see `?as.sir`.",
|
||||
call = FALSE)
|
||||
call = FALSE
|
||||
)
|
||||
x <- as.character(as.sir(x))
|
||||
if (!is.null(language)) {
|
||||
x[x == "S"] <- "(S) Susceptible"
|
||||
|
||||
109
R/sir.R
109
R/sir.R
@ -198,23 +198,35 @@
|
||||
#' mutate_if(is.mic, as.sir,
|
||||
#' mo = "bacteria",
|
||||
#' ab = "antibiotic",
|
||||
#' guideline = "CLSI")
|
||||
#' guideline = "CLSI"
|
||||
#' )
|
||||
#' df_long %>%
|
||||
#' mutate(across(where(is.mic),
|
||||
#' function(x) as.sir(x,
|
||||
#' mutate(across(
|
||||
#' where(is.mic),
|
||||
#' function(x) {
|
||||
#' as.sir(x,
|
||||
#' mo = "bacteria",
|
||||
#' ab = "antibiotic",
|
||||
#' guideline = "CLSI")))
|
||||
#' guideline = "CLSI"
|
||||
#' )
|
||||
#' }
|
||||
#' ))
|
||||
#' df_wide %>%
|
||||
#' # given certain columns, e.g. from 'cipro' to 'genta'
|
||||
#' mutate_at(vars(cipro:genta), as.sir,
|
||||
#' mo = "bacteria",
|
||||
#' guideline = "CLSI")
|
||||
#' guideline = "CLSI"
|
||||
#' )
|
||||
#' df_wide %>%
|
||||
#' mutate(across(cipro:genta,
|
||||
#' function(x) as.sir(x,
|
||||
#' mutate(across(
|
||||
#' cipro:genta,
|
||||
#' function(x) {
|
||||
#' as.sir(x,
|
||||
#' mo = "bacteria",
|
||||
#' guideline = "CLSI")))
|
||||
#' guideline = "CLSI"
|
||||
#' )
|
||||
#' }
|
||||
#' ))
|
||||
#'
|
||||
#' # for veterinary breakpoints, add 'host':
|
||||
#' df_long$animal_species <- c("cats", "dogs", "horses", "cattle")
|
||||
@ -224,36 +236,52 @@
|
||||
#' mo = "bacteria",
|
||||
#' ab = "antibiotic",
|
||||
#' host = "animal_species",
|
||||
#' guideline = "CLSI")
|
||||
#' guideline = "CLSI"
|
||||
#' )
|
||||
#' df_long %>%
|
||||
#' mutate(across(where(is.mic),
|
||||
#' function(x) as.sir(x,
|
||||
#' mutate(across(
|
||||
#' where(is.mic),
|
||||
#' function(x) {
|
||||
#' as.sir(x,
|
||||
#' mo = "bacteria",
|
||||
#' ab = "antibiotic",
|
||||
#' host = "animal_species",
|
||||
#' guideline = "CLSI")))
|
||||
#' guideline = "CLSI"
|
||||
#' )
|
||||
#' }
|
||||
#' ))
|
||||
#' df_wide %>%
|
||||
#' mutate_at(vars(cipro:genta), as.sir,
|
||||
#' mo = "bacteria",
|
||||
#' ab = "antibiotic",
|
||||
#' host = "animal_species",
|
||||
#' guideline = "CLSI")
|
||||
#' guideline = "CLSI"
|
||||
#' )
|
||||
#' df_wide %>%
|
||||
#' mutate(across(cipro:genta,
|
||||
#' function(x) as.sir(x,
|
||||
#' mutate(across(
|
||||
#' cipro:genta,
|
||||
#' function(x) {
|
||||
#' as.sir(x,
|
||||
#' mo = "bacteria",
|
||||
#' host = "animal_species",
|
||||
#' guideline = "CLSI")))
|
||||
#' guideline = "CLSI"
|
||||
#' )
|
||||
#' }
|
||||
#' ))
|
||||
#'
|
||||
#' # to include information about urinary tract infections (UTI)
|
||||
#' data.frame(mo = "E. coli",
|
||||
#' data.frame(
|
||||
#' mo = "E. coli",
|
||||
#' nitrofuratoin = c("<= 2", 32),
|
||||
#' from_the_bladder = c(TRUE, FALSE)) %>%
|
||||
#' from_the_bladder = c(TRUE, FALSE)
|
||||
#' ) %>%
|
||||
#' as.sir(uti = "from_the_bladder")
|
||||
#'
|
||||
#' data.frame(mo = "E. coli",
|
||||
#' data.frame(
|
||||
#' mo = "E. coli",
|
||||
#' nitrofuratoin = c("<= 2", 32),
|
||||
#' specimen = c("urine", "blood")) %>%
|
||||
#' specimen = c("urine", "blood")
|
||||
#' ) %>%
|
||||
#' as.sir() # automatically determines urine isolates
|
||||
#'
|
||||
#' df_wide %>%
|
||||
@ -326,16 +354,19 @@ as_sir_structure <- function(x,
|
||||
method = NULL,
|
||||
ref_tbl = NULL,
|
||||
ref_breakpoints = NULL) {
|
||||
out <- structure(factor(as.character(unlist(unname(x))),
|
||||
out <- structure(
|
||||
factor(as.character(unlist(unname(x))),
|
||||
levels = c("S", "SDD", "I", "R", "NI"),
|
||||
ordered = TRUE),
|
||||
ordered = TRUE
|
||||
),
|
||||
guideline = guideline,
|
||||
mo = mo,
|
||||
ab = ab,
|
||||
method = method,
|
||||
ref_tbl = ref_tbl,
|
||||
ref_breakpoints = ref_breakpoints,
|
||||
class = c("sir", "ordered", "factor"))
|
||||
class = c("sir", "ordered", "factor")
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname as.sir
|
||||
@ -1107,20 +1138,26 @@ as_sir_method <- function(method_short,
|
||||
same_ab <- generalise_antibiotic_name(ab) == generalise_antibiotic_name(agent_name)
|
||||
same_ab.bak <- generalise_antibiotic_name(ab.bak) == generalise_antibiotic_name(agent_name)
|
||||
agent_formatted[same_ab.bak] <- paste0(agent_formatted[same_ab.bak], " (", ab[same_ab.bak], ")")
|
||||
agent_formatted[!same_ab.bak & !same_ab] <- paste0(agent_formatted[!same_ab.bak & !same_ab],
|
||||
agent_formatted[!same_ab.bak & !same_ab] <- paste0(
|
||||
agent_formatted[!same_ab.bak & !same_ab],
|
||||
" (", ifelse(ab.bak[!same_ab.bak & !same_ab] == ab[!same_ab.bak & !same_ab],
|
||||
"",
|
||||
paste0(ab[!same_ab.bak & !same_ab], ", ")),
|
||||
paste0(ab[!same_ab.bak & !same_ab], ", ")
|
||||
),
|
||||
agent_name[!same_ab.bak & !same_ab],
|
||||
")")
|
||||
")"
|
||||
)
|
||||
# this intro text will also be printed in the progress bar if the `progress` package is installed
|
||||
intro_txt <- paste0("Interpreting ", method_long, ": ", ifelse(isTRUE(list(...)$is_data.frame), "column ", ""),
|
||||
intro_txt <- paste0(
|
||||
"Interpreting ", method_long, ": ", ifelse(isTRUE(list(...)$is_data.frame), "column ", ""),
|
||||
ifelse(length(unique(agent_formatted)) == 1, unique(agent_formatted), paste0(vector_and(agent_formatted, quotes = FALSE, sort = FALSE))),
|
||||
mo_var_found,
|
||||
ifelse(identical(reference_data, AMR::clinical_breakpoints),
|
||||
paste0(", ", font_bold(guideline_coerced)),
|
||||
""),
|
||||
"... ")
|
||||
""
|
||||
),
|
||||
"... "
|
||||
)
|
||||
|
||||
# prepare used arguments ----
|
||||
method <- method_short
|
||||
@ -1203,9 +1240,12 @@ as_sir_method <- function(method_short,
|
||||
# apparently no breakpoints found
|
||||
message(
|
||||
paste0(font_rose_bg(" WARNING "), "\n"),
|
||||
font_black(paste0(" ", AMR_env$bullet_icon, " No ", guideline_coerced, " ", method_coerced, " breakpoints available for ",
|
||||
font_black(paste0(
|
||||
" ", AMR_env$bullet_icon, " No ", guideline_coerced, " ", method_coerced, " breakpoints available for ",
|
||||
suppressMessages(suppressWarnings(ab_name(unique(ab_coerced), language = NULL, tolower = TRUE))),
|
||||
" (", unique(ab_coerced), ")."), collapse = "\n"))
|
||||
" (", unique(ab_coerced), ")."
|
||||
), collapse = "\n")
|
||||
)
|
||||
|
||||
load_mo_uncertainties(metadata_mo)
|
||||
return(rep(NA_sir_, nrow(df)))
|
||||
@ -1331,20 +1371,17 @@ as_sir_method <- function(method_short,
|
||||
# vancomycin can take human breakpoints in these hosts
|
||||
breakpoints_current <- breakpoints_current %pm>% subset(host == "human")
|
||||
notes_current <- c(notes_current, paste0("Using ", font_bold("human"), " breakpoints for ", ab_formatted, " based on CLSI VET09."))
|
||||
|
||||
} else if (host_current %in% c("dogs", "cats") && (mo_current_genus %in% c("B_AMYCS", "B_NOCRD", "B_CMPYL", "B_CRYNB", "B_ENTRC", "B_MYCBC", "B_PSDMN", "B_AERMN") | mo_current_class == "B_[CLS]_BTPRTBCT" | mo_current == "B_LISTR_MNCY")) {
|
||||
# dog breakpoints if no canine/feline
|
||||
# TODO do we still have dogs breakpoints at this point???
|
||||
breakpoints_current <- breakpoints_current %pm>% subset(host == "human") # WRONG
|
||||
notes_current <- c(notes_current, paste0("Using ", font_bold("human"), " breakpoints for ", mo_formatted, " based on CLSI VET09."))
|
||||
|
||||
} else {
|
||||
# no specific CLSI solution for this, so only filter on current host (if no breakpoints available -> too bad)
|
||||
breakpoints_current <- breakpoints_current %pm>%
|
||||
subset(host == host_current)
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
if (NROW(breakpoints_current) == 0) {
|
||||
@ -1383,7 +1420,9 @@ as_sir_method <- function(method_short,
|
||||
# this will put UTI = FALSE first, then UTI = NA, then UTI = TRUE
|
||||
pm_mutate(uti_index = ifelse(!is.na(uti) & uti == FALSE, 1,
|
||||
ifelse(is.na(uti), 2,
|
||||
3))) %pm>%
|
||||
3
|
||||
)
|
||||
)) %pm>%
|
||||
# be as specific as possible (i.e. prefer species over genus):
|
||||
pm_arrange(rank_index, uti_index)
|
||||
} else if (uti_current == TRUE) {
|
||||
|
||||
@ -254,7 +254,6 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
|
||||
if (message_not_thrown_before("sir_calc_df", combine_SI, entire_session = TRUE)) {
|
||||
message_("Note that `sir_calc_df()` will also count dose-dependent susceptibility, 'SDD', as 'SI' when `combine_SI = TRUE`. This note will be shown once for this session.", as_note = FALSE)
|
||||
}
|
||||
|
||||
}
|
||||
data[, i] <- gsub("(I|S|SDD)", "SI", data[, i, drop = TRUE])
|
||||
}
|
||||
|
||||
@ -42,15 +42,18 @@
|
||||
#' @examples
|
||||
#' # filter to the top 3 species:
|
||||
#' top_n_microorganisms(example_isolates,
|
||||
#' n = 3)
|
||||
#' n = 3
|
||||
#' )
|
||||
#'
|
||||
#' # filter to any species in the top 5 genera:
|
||||
#' top_n_microorganisms(example_isolates,
|
||||
#' n = 5, property = "genus")
|
||||
#' n = 5, property = "genus"
|
||||
#' )
|
||||
#'
|
||||
#' # filter to the top 3 species in each of the top 5 genera:
|
||||
#' top_n_microorganisms(example_isolates,
|
||||
#' n = 5, property = "genus", n_for_each = 3)
|
||||
#' n = 5, property = "genus", n_for_each = 3
|
||||
#' )
|
||||
top_n_microorganisms <- function(x, n, property = "fullname", n_for_each = NULL, col_mo = NULL, ...) {
|
||||
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
|
||||
meet_criteria(n, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE, is_positive = TRUE)
|
||||
|
||||
@ -627,12 +627,15 @@ suppressMessages(set_AMR_locale("English"))
|
||||
usethis::ui_info("Checking URLs for redirects")
|
||||
invisible(urlchecker::url_update("."))
|
||||
|
||||
# Style pkg ---------------------------------------------------------------
|
||||
usethis::ui_info("Styling package")
|
||||
styler::style_pkg(include_roxygen_examples = FALSE,
|
||||
exclude_dirs = list.dirs(full.names = FALSE, recursive = FALSE)[!list.dirs(full.names = FALSE, recursive = FALSE) %in% c("R", "tests")])
|
||||
|
||||
# Document pkg ------------------------------------------------------------
|
||||
usethis::ui_info("Documenting package")
|
||||
suppressMessages(devtools::document(quiet = TRUE))
|
||||
|
||||
|
||||
# Finished ----------------------------------------------------------------
|
||||
usethis::ui_done("All done")
|
||||
suppressMessages(reset_AMR_locale())
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
This knowledge base contains all context you must know about the AMR package for R. You are a GPT trained to be an assistant for the AMR package in R. You are an incredible R specialist, especially trained in this package and in the tidyverse.
|
||||
|
||||
First and foremost, you are trained on version 2.1.1.9160. Remember this whenever someone asks which AMR package version you’re at.
|
||||
First and foremost, you are trained on version 2.1.1.9163. Remember this whenever someone asks which AMR package version you’re at.
|
||||
|
||||
Below are the contents of the file, the file, and all the files (documentation) in the package. Every file content is split using 100 hypens.
|
||||
----------------------------------------------------------------------------------------------------
|
||||
@ -1984,12 +1984,14 @@ antibiogram(example_isolates,
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = aminoglycosides(),
|
||||
ab_transform = "atc",
|
||||
mo_transform = "gramstain")
|
||||
mo_transform = "gramstain"
|
||||
)
|
||||
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = carbapenems(),
|
||||
ab_transform = "name",
|
||||
mo_transform = "name")
|
||||
mo_transform = "name"
|
||||
)
|
||||
|
||||
|
||||
# Combined antibiogram -------------------------------------------------
|
||||
@ -1997,14 +1999,16 @@ antibiogram(example_isolates,
|
||||
# combined antibiotics yield higher empiric coverage
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
|
||||
mo_transform = "gramstain")
|
||||
mo_transform = "gramstain"
|
||||
)
|
||||
|
||||
# names of antibiotics do not need to resemble columns exactly:
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c("Cipro", "cipro + genta"),
|
||||
mo_transform = "gramstain",
|
||||
ab_transform = "name",
|
||||
sep = " & ")
|
||||
sep = " & "
|
||||
)
|
||||
|
||||
|
||||
# Syndromic antibiogram ------------------------------------------------
|
||||
@ -2012,7 +2016,8 @@ antibiogram(example_isolates,
|
||||
# the data set could contain a filter for e.g. respiratory specimens
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c(aminoglycosides(), carbapenems()),
|
||||
syndromic_group = "ward")
|
||||
syndromic_group = "ward"
|
||||
)
|
||||
|
||||
# now define a data set with only E. coli
|
||||
ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ]
|
||||
@ -2025,7 +2030,8 @@ antibiogram(ex1,
|
||||
syndromic_group = ifelse(ex1$ward == "ICU",
|
||||
"UCI", "No UCI"
|
||||
),
|
||||
language = "es")
|
||||
language = "es"
|
||||
)
|
||||
|
||||
|
||||
# WISCA antibiogram ----------------------------------------------------
|
||||
@ -2034,7 +2040,8 @@ antibiogram(ex1,
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
|
||||
syndromic_group = "ward",
|
||||
wisca = TRUE)
|
||||
wisca = TRUE
|
||||
)
|
||||
|
||||
|
||||
# Print the output for R Markdown / Quarto -----------------------------
|
||||
@ -2042,7 +2049,8 @@ antibiogram(example_isolates,
|
||||
ureido <- antibiogram(example_isolates,
|
||||
antibiotics = ureidopenicillins(),
|
||||
syndromic_group = "ward",
|
||||
wisca = TRUE)
|
||||
wisca = TRUE
|
||||
)
|
||||
|
||||
# in an Rmd file, you would just need to return `ureido` in a chunk,
|
||||
# but to be explicit here:
|
||||
@ -2055,11 +2063,13 @@ if (requireNamespace("knitr")) {
|
||||
|
||||
ab1 <- antibiogram(example_isolates,
|
||||
antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
|
||||
mo_transform = "gramstain")
|
||||
mo_transform = "gramstain"
|
||||
)
|
||||
ab2 <- antibiogram(example_isolates,
|
||||
antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
|
||||
mo_transform = "gramstain",
|
||||
syndromic_group = "ward")
|
||||
syndromic_group = "ward"
|
||||
)
|
||||
|
||||
if (requireNamespace("ggplot2")) {
|
||||
ggplot2::autoplot(ab1)
|
||||
@ -2181,8 +2191,6 @@ THE PART HEREAFTER CONTAINS CONTENTS FROM FILE 'man/antimicrobial_selectors.Rd':
|
||||
% Please edit documentation in R/amr_selectors.R
|
||||
\name{antimicrobial_selectors}
|
||||
\alias{antimicrobial_selectors}
|
||||
\alias{amr_class}
|
||||
\alias{amr_selector}
|
||||
\alias{aminoglycosides}
|
||||
\alias{aminopenicillins}
|
||||
\alias{antifungals}
|
||||
@ -2214,17 +2222,13 @@ THE PART HEREAFTER CONTAINS CONTENTS FROM FILE 'man/antimicrobial_selectors.Rd':
|
||||
\alias{tetracyclines}
|
||||
\alias{trimethoprims}
|
||||
\alias{ureidopenicillins}
|
||||
\alias{amr_class}
|
||||
\alias{amr_selector}
|
||||
\alias{administrable_per_os}
|
||||
\alias{administrable_iv}
|
||||
\alias{not_intrinsic_resistant}
|
||||
\title{Antimicrobial Selectors}
|
||||
\usage{
|
||||
amr_class(amr_class, only_sir_columns = FALSE, only_treatable = TRUE,
|
||||
return_all = TRUE, ...)
|
||||
|
||||
amr_selector(filter, only_sir_columns = FALSE, only_treatable = TRUE,
|
||||
return_all = TRUE, ...)
|
||||
|
||||
aminoglycosides(only_sir_columns = FALSE, only_treatable = TRUE,
|
||||
return_all = TRUE, ...)
|
||||
|
||||
@ -2293,6 +2297,12 @@ trimethoprims(only_sir_columns = FALSE, return_all = TRUE, ...)
|
||||
|
||||
ureidopenicillins(only_sir_columns = FALSE, return_all = TRUE, ...)
|
||||
|
||||
amr_class(amr_class, only_sir_columns = FALSE, only_treatable = TRUE,
|
||||
return_all = TRUE, ...)
|
||||
|
||||
amr_selector(filter, only_sir_columns = FALSE, only_treatable = TRUE,
|
||||
return_all = TRUE, ...)
|
||||
|
||||
administrable_per_os(only_sir_columns = FALSE, return_all = TRUE, ...)
|
||||
|
||||
administrable_iv(only_sir_columns = FALSE, return_all = TRUE, ...)
|
||||
@ -2301,8 +2311,6 @@ not_intrinsic_resistant(only_sir_columns = FALSE, col_mo = NULL,
|
||||
version_expertrules = 3.3, ...)
|
||||
}
|
||||
\arguments{
|
||||
\item{amr_class}{an antimicrobial class or a part of it, such as \code{"carba"} and \code{"carbapenems"}. The columns \code{group}, \code{atc_group1} and \code{atc_group2} of the \link{antibiotics} data set will be searched (case-insensitive) for this value.}
|
||||
|
||||
\item{only_sir_columns}{a \link{logical} to indicate whether only columns of class \code{sir} must be selected (default is \code{FALSE}), see \code{\link[=as.sir]{as.sir()}}}
|
||||
|
||||
\item{only_treatable}{a \link{logical} to indicate whether antimicrobial drugs should be excluded that are only for laboratory tests (default is \code{TRUE}), such as gentamicin-high (\code{GEH}) and imipenem/EDTA (\code{IPE})}
|
||||
@ -2311,6 +2319,8 @@ not_intrinsic_resistant(only_sir_columns = FALSE, col_mo = NULL,
|
||||
|
||||
\item{...}{ignored, only in place to allow future extensions}
|
||||
|
||||
\item{amr_class}{an antimicrobial class or a part of it, such as \code{"carba"} and \code{"carbapenems"}. The columns \code{group}, \code{atc_group1} and \code{atc_group2} of the \link{antibiotics} data set will be searched (case-insensitive) for this value.}
|
||||
|
||||
\item{filter}{an \link{expression} to be evaluated in the \link{antibiotics} data set, such as \code{name \%like\% "trim"}}
|
||||
|
||||
\item{col_mo}{column name of the names or codes of the microorganisms (see \code{\link[=as.mo]{as.mo()}}) - the default is the first column of class \code{\link{mo}}. Values will be coerced using \code{\link[=as.mo]{as.mo()}}.}
|
||||
@ -2339,10 +2349,10 @@ All columns in the data in which these functions are called will be searched for
|
||||
|
||||
The \code{\link[=amr_class]{amr_class()}} function can be used to filter/select on a manually defined antimicrobial class. It searches for results in the \link{antibiotics} data set within the columns \code{group}, \code{atc_group1} and \code{atc_group2}.
|
||||
|
||||
The \code{\link[=amr_selector]{amr_selector()}} function can be used to internally filter the \link{antibiotics} data set on any results, see \emph{Examples}. It allows for filtering on a (part of) a certain name, and/or a group name or even a minimum of DDDs for oral treatment. This function yields the highest flexibility, but is also the least user-friendly, since it requires a hard-coded filter to set.
|
||||
|
||||
The \code{\link[=administrable_per_os]{administrable_per_os()}} and \code{\link[=administrable_iv]{administrable_iv()}} functions also rely on the \link{antibiotics} data set - antimicrobials will be matched where a DDD (defined daily dose) for resp. oral and IV treatment is available in the \link{antibiotics} data set.
|
||||
|
||||
The \code{\link[=amr_selector]{amr_selector()}} function can be used to internally filter the \link{antibiotics} data set on any results, see \emph{Examples}. It allows for filtering on a (part of) a certain name, and/or a group name or even a minimum of DDDs for oral treatment. This function yields the highest flexibility, but is also the least user-friendly, since it requires a hard-coded filter to set.
|
||||
|
||||
The \code{\link[=not_intrinsic_resistant]{not_intrinsic_resistant()}} function can be used to only select antimicrobials that pose no intrinsic resistance for the microorganisms in the data set. For example, if a data set contains only microorganism codes or names of \emph{E. coli} and \emph{K. pneumoniae} and contains a column "vancomycin", this column will be removed (or rather, unselected) using this function. It currently applies \href{https://www.eucast.org/expert_rules_and_expected_phenotypes}{'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes' v3.3} (2021) to determine intrinsic resistance, using the \code{\link[=eucast_rules]{eucast_rules()}} function internally. Because of this determination, this function is quite slow in terms of performance.
|
||||
}
|
||||
\section{Full list of supported (antimicrobial) classes}{
|
||||
@ -3540,23 +3550,35 @@ if (require("dplyr")) {
|
||||
mutate_if(is.mic, as.sir,
|
||||
mo = "bacteria",
|
||||
ab = "antibiotic",
|
||||
guideline = "CLSI")
|
||||
guideline = "CLSI"
|
||||
)
|
||||
df_long \%>\%
|
||||
mutate(across(where(is.mic),
|
||||
function(x) as.sir(x,
|
||||
mutate(across(
|
||||
where(is.mic),
|
||||
function(x) {
|
||||
as.sir(x,
|
||||
mo = "bacteria",
|
||||
ab = "antibiotic",
|
||||
guideline = "CLSI")))
|
||||
guideline = "CLSI"
|
||||
)
|
||||
}
|
||||
))
|
||||
df_wide \%>\%
|
||||
# given certain columns, e.g. from 'cipro' to 'genta'
|
||||
mutate_at(vars(cipro:genta), as.sir,
|
||||
mo = "bacteria",
|
||||
guideline = "CLSI")
|
||||
guideline = "CLSI"
|
||||
)
|
||||
df_wide \%>\%
|
||||
mutate(across(cipro:genta,
|
||||
function(x) as.sir(x,
|
||||
mutate(across(
|
||||
cipro:genta,
|
||||
function(x) {
|
||||
as.sir(x,
|
||||
mo = "bacteria",
|
||||
guideline = "CLSI")))
|
||||
guideline = "CLSI"
|
||||
)
|
||||
}
|
||||
))
|
||||
|
||||
# for veterinary breakpoints, add 'host':
|
||||
df_long$animal_species <- c("cats", "dogs", "horses", "cattle")
|
||||
@ -3566,36 +3588,52 @@ if (require("dplyr")) {
|
||||
mo = "bacteria",
|
||||
ab = "antibiotic",
|
||||
host = "animal_species",
|
||||
guideline = "CLSI")
|
||||
guideline = "CLSI"
|
||||
)
|
||||
df_long \%>\%
|
||||
mutate(across(where(is.mic),
|
||||
function(x) as.sir(x,
|
||||
mutate(across(
|
||||
where(is.mic),
|
||||
function(x) {
|
||||
as.sir(x,
|
||||
mo = "bacteria",
|
||||
ab = "antibiotic",
|
||||
host = "animal_species",
|
||||
guideline = "CLSI")))
|
||||
guideline = "CLSI"
|
||||
)
|
||||
}
|
||||
))
|
||||
df_wide \%>\%
|
||||
mutate_at(vars(cipro:genta), as.sir,
|
||||
mo = "bacteria",
|
||||
ab = "antibiotic",
|
||||
host = "animal_species",
|
||||
guideline = "CLSI")
|
||||
guideline = "CLSI"
|
||||
)
|
||||
df_wide \%>\%
|
||||
mutate(across(cipro:genta,
|
||||
function(x) as.sir(x,
|
||||
mutate(across(
|
||||
cipro:genta,
|
||||
function(x) {
|
||||
as.sir(x,
|
||||
mo = "bacteria",
|
||||
host = "animal_species",
|
||||
guideline = "CLSI")))
|
||||
guideline = "CLSI"
|
||||
)
|
||||
}
|
||||
))
|
||||
|
||||
# to include information about urinary tract infections (UTI)
|
||||
data.frame(mo = "E. coli",
|
||||
data.frame(
|
||||
mo = "E. coli",
|
||||
nitrofuratoin = c("<= 2", 32),
|
||||
from_the_bladder = c(TRUE, FALSE)) \%>\%
|
||||
from_the_bladder = c(TRUE, FALSE)
|
||||
) \%>\%
|
||||
as.sir(uti = "from_the_bladder")
|
||||
|
||||
data.frame(mo = "E. coli",
|
||||
data.frame(
|
||||
mo = "E. coli",
|
||||
nitrofuratoin = c("<= 2", 32),
|
||||
specimen = c("urine", "blood")) \%>\%
|
||||
specimen = c("urine", "blood")
|
||||
) \%>\%
|
||||
as.sir() # automatically determines urine isolates
|
||||
|
||||
df_wide \%>\%
|
||||
@ -5624,8 +5662,10 @@ if (require("ggplot2") && require("dplyr")) {
|
||||
) \%>\%
|
||||
ggplot() +
|
||||
geom_col(aes(x = x, y = y, fill = z)) +
|
||||
scale_sir_colours(aesthetics = "fill",
|
||||
Value4 = "S", Value5 = "I", Value6 = "R")
|
||||
scale_sir_colours(
|
||||
aesthetics = "fill",
|
||||
Value4 = "S", Value5 = "I", Value6 = "R"
|
||||
)
|
||||
}
|
||||
if (require("ggplot2") && require("dplyr")) {
|
||||
# resistance of ciprofloxacine per age group
|
||||
@ -7031,10 +7071,12 @@ mo_rank("Klebsiella pneumoniae")
|
||||
mo_url("Klebsiella pneumoniae")
|
||||
mo_is_yeast(c("Candida", "Trichophyton", "Klebsiella"))
|
||||
|
||||
mo_group_members(c("Streptococcus group A",
|
||||
mo_group_members(c(
|
||||
"Streptococcus group A",
|
||||
"Streptococcus group C",
|
||||
"Streptococcus group G",
|
||||
"Streptococcus group L"))
|
||||
"Streptococcus group L"
|
||||
))
|
||||
|
||||
|
||||
# scientific reference -----------------------------------------------------
|
||||
@ -7547,7 +7589,6 @@ some_mic_values <- random_mic(size = 100)
|
||||
some_disk_values <- random_disk(size = 100, mo = "Escherichia coli", ab = "cipro")
|
||||
some_sir_values <- random_sir(50, prob_SIR = c(0.55, 0.05, 0.30))
|
||||
|
||||
|
||||
\donttest{
|
||||
# Plotting using ggplot2's autoplot() for MIC, disk, and SIR -----------
|
||||
if (require("ggplot2")) {
|
||||
@ -7559,17 +7600,23 @@ if (require("ggplot2")) {
|
||||
}
|
||||
if (require("ggplot2")) {
|
||||
# support for 20 languages, various guidelines, and many options
|
||||
autoplot(some_disk_values, mo = "Escherichia coli", ab = "cipro",
|
||||
autoplot(some_disk_values,
|
||||
mo = "Escherichia coli", ab = "cipro",
|
||||
guideline = "CLSI 2024", language = "no",
|
||||
title = "Disk diffusion from the North")
|
||||
title = "Disk diffusion from the North"
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
# Plotting using scale_x_mic() -----------------------------------------
|
||||
if (require("ggplot2")) {
|
||||
mic_plot <- ggplot(data.frame(mics = as.mic(c(0.25, "<=4", 4, 8, 32, ">=32")),
|
||||
counts = c(1, 1, 2, 2, 3, 3)),
|
||||
aes(mics, counts)) +
|
||||
mic_plot <- ggplot(
|
||||
data.frame(
|
||||
mics = as.mic(c(0.25, "<=4", 4, 8, 32, ">=32")),
|
||||
counts = c(1, 1, 2, 2, 3, 3)
|
||||
),
|
||||
aes(mics, counts)
|
||||
) +
|
||||
geom_col()
|
||||
mic_plot +
|
||||
labs(title = "without scale_x_mic()")
|
||||
@ -7600,17 +7647,25 @@ if (require("ggplot2")) {
|
||||
some_groups <- sample(LETTERS[1:5], 20, replace = TRUE)
|
||||
|
||||
if (require("ggplot2")) {
|
||||
ggplot(data.frame(mic = some_mic_values,
|
||||
group = some_groups),
|
||||
aes(group, mic)) +
|
||||
ggplot(
|
||||
data.frame(
|
||||
mic = some_mic_values,
|
||||
group = some_groups
|
||||
),
|
||||
aes(group, mic)
|
||||
) +
|
||||
geom_boxplot() +
|
||||
geom_violin(linetype = 2, colour = "grey", fill = NA) +
|
||||
scale_y_mic()
|
||||
}
|
||||
if (require("ggplot2")) {
|
||||
ggplot(data.frame(mic = some_mic_values,
|
||||
group = some_groups),
|
||||
aes(group, mic)) +
|
||||
ggplot(
|
||||
data.frame(
|
||||
mic = some_mic_values,
|
||||
group = some_groups
|
||||
),
|
||||
aes(group, mic)
|
||||
) +
|
||||
geom_boxplot() +
|
||||
geom_violin(linetype = 2, colour = "grey", fill = NA) +
|
||||
scale_y_mic(mic_range = c(NA, 0.25))
|
||||
@ -7619,9 +7674,13 @@ if (require("ggplot2")) {
|
||||
|
||||
# Plotting using scale_x_sir() -----------------------------------------
|
||||
if (require("ggplot2")) {
|
||||
ggplot(data.frame(x = c("I", "R", "S"),
|
||||
y = c(45,323, 573)),
|
||||
aes(x, y)) +
|
||||
ggplot(
|
||||
data.frame(
|
||||
x = c("I", "R", "S"),
|
||||
y = c(45, 323, 573)
|
||||
),
|
||||
aes(x, y)
|
||||
) +
|
||||
geom_col() +
|
||||
scale_x_sir()
|
||||
}
|
||||
@ -7629,12 +7688,17 @@ if (require("ggplot2")) {
|
||||
|
||||
# Plotting using scale_y_mic() and scale_colour_sir() ------------------
|
||||
if (require("ggplot2")) {
|
||||
plain <- ggplot(data.frame(mic = some_mic_values,
|
||||
plain <- ggplot(
|
||||
data.frame(
|
||||
mic = some_mic_values,
|
||||
group = some_groups,
|
||||
sir = as.sir(some_mic_values,
|
||||
mo = "E. coli",
|
||||
ab = "cipro")),
|
||||
aes(x = group, y = mic, colour = sir)) +
|
||||
ab = "cipro"
|
||||
)
|
||||
),
|
||||
aes(x = group, y = mic, colour = sir)
|
||||
) +
|
||||
theme_minimal() +
|
||||
geom_boxplot(fill = NA, colour = "grey") +
|
||||
geom_jitter(width = 0.25)
|
||||
@ -7650,8 +7714,10 @@ if (require("ggplot2")) {
|
||||
if (require("ggplot2")) {
|
||||
plain +
|
||||
scale_y_mic(mic_range = c(0.005, 32), name = "Our MICs!") +
|
||||
scale_colour_sir(language = "pt",
|
||||
name = "Support in 20 languages")
|
||||
scale_colour_sir(
|
||||
language = "pt",
|
||||
name = "Support in 20 languages"
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
@ -8247,15 +8313,18 @@ This function is useful for preprocessing data before creating \link[=antibiogra
|
||||
\examples{
|
||||
# filter to the top 3 species:
|
||||
top_n_microorganisms(example_isolates,
|
||||
n = 3)
|
||||
n = 3
|
||||
)
|
||||
|
||||
# filter to any species in the top 5 genera:
|
||||
top_n_microorganisms(example_isolates,
|
||||
n = 5, property = "genus")
|
||||
n = 5, property = "genus"
|
||||
)
|
||||
|
||||
# filter to the top 3 species in each of the top 5 genera:
|
||||
top_n_microorganisms(example_isolates,
|
||||
n = 5, property = "genus", n_for_each = 3)
|
||||
n = 5, property = "genus", n_for_each = 3
|
||||
)
|
||||
}
|
||||
\seealso{
|
||||
\code{\link[=mo_property]{mo_property()}}, \code{\link[=as.mo]{as.mo()}}, \code{\link[=antibiogram]{antibiogram()}}
|
||||
@ -343,12 +343,14 @@ antibiogram(example_isolates,
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = aminoglycosides(),
|
||||
ab_transform = "atc",
|
||||
mo_transform = "gramstain")
|
||||
mo_transform = "gramstain"
|
||||
)
|
||||
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = carbapenems(),
|
||||
ab_transform = "name",
|
||||
mo_transform = "name")
|
||||
mo_transform = "name"
|
||||
)
|
||||
|
||||
|
||||
# Combined antibiogram -------------------------------------------------
|
||||
@ -356,14 +358,16 @@ antibiogram(example_isolates,
|
||||
# combined antibiotics yield higher empiric coverage
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
|
||||
mo_transform = "gramstain")
|
||||
mo_transform = "gramstain"
|
||||
)
|
||||
|
||||
# names of antibiotics do not need to resemble columns exactly:
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c("Cipro", "cipro + genta"),
|
||||
mo_transform = "gramstain",
|
||||
ab_transform = "name",
|
||||
sep = " & ")
|
||||
sep = " & "
|
||||
)
|
||||
|
||||
|
||||
# Syndromic antibiogram ------------------------------------------------
|
||||
@ -371,7 +375,8 @@ antibiogram(example_isolates,
|
||||
# the data set could contain a filter for e.g. respiratory specimens
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c(aminoglycosides(), carbapenems()),
|
||||
syndromic_group = "ward")
|
||||
syndromic_group = "ward"
|
||||
)
|
||||
|
||||
# now define a data set with only E. coli
|
||||
ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ]
|
||||
@ -384,7 +389,8 @@ antibiogram(ex1,
|
||||
syndromic_group = ifelse(ex1$ward == "ICU",
|
||||
"UCI", "No UCI"
|
||||
),
|
||||
language = "es")
|
||||
language = "es"
|
||||
)
|
||||
|
||||
|
||||
# WISCA antibiogram ----------------------------------------------------
|
||||
@ -393,7 +399,8 @@ antibiogram(ex1,
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
|
||||
syndromic_group = "ward",
|
||||
wisca = TRUE)
|
||||
wisca = TRUE
|
||||
)
|
||||
|
||||
|
||||
# Print the output for R Markdown / Quarto -----------------------------
|
||||
@ -401,7 +408,8 @@ antibiogram(example_isolates,
|
||||
ureido <- antibiogram(example_isolates,
|
||||
antibiotics = ureidopenicillins(),
|
||||
syndromic_group = "ward",
|
||||
wisca = TRUE)
|
||||
wisca = TRUE
|
||||
)
|
||||
|
||||
# in an Rmd file, you would just need to return `ureido` in a chunk,
|
||||
# but to be explicit here:
|
||||
@ -414,11 +422,13 @@ if (requireNamespace("knitr")) {
|
||||
|
||||
ab1 <- antibiogram(example_isolates,
|
||||
antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
|
||||
mo_transform = "gramstain")
|
||||
mo_transform = "gramstain"
|
||||
)
|
||||
ab2 <- antibiogram(example_isolates,
|
||||
antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
|
||||
mo_transform = "gramstain",
|
||||
syndromic_group = "ward")
|
||||
syndromic_group = "ward"
|
||||
)
|
||||
|
||||
if (requireNamespace("ggplot2")) {
|
||||
ggplot2::autoplot(ab1)
|
||||
|
||||
@ -2,8 +2,6 @@
|
||||
% Please edit documentation in R/amr_selectors.R
|
||||
\name{antimicrobial_selectors}
|
||||
\alias{antimicrobial_selectors}
|
||||
\alias{amr_class}
|
||||
\alias{amr_selector}
|
||||
\alias{aminoglycosides}
|
||||
\alias{aminopenicillins}
|
||||
\alias{antifungals}
|
||||
@ -35,17 +33,13 @@
|
||||
\alias{tetracyclines}
|
||||
\alias{trimethoprims}
|
||||
\alias{ureidopenicillins}
|
||||
\alias{amr_class}
|
||||
\alias{amr_selector}
|
||||
\alias{administrable_per_os}
|
||||
\alias{administrable_iv}
|
||||
\alias{not_intrinsic_resistant}
|
||||
\title{Antimicrobial Selectors}
|
||||
\usage{
|
||||
amr_class(amr_class, only_sir_columns = FALSE, only_treatable = TRUE,
|
||||
return_all = TRUE, ...)
|
||||
|
||||
amr_selector(filter, only_sir_columns = FALSE, only_treatable = TRUE,
|
||||
return_all = TRUE, ...)
|
||||
|
||||
aminoglycosides(only_sir_columns = FALSE, only_treatable = TRUE,
|
||||
return_all = TRUE, ...)
|
||||
|
||||
@ -114,6 +108,12 @@ trimethoprims(only_sir_columns = FALSE, return_all = TRUE, ...)
|
||||
|
||||
ureidopenicillins(only_sir_columns = FALSE, return_all = TRUE, ...)
|
||||
|
||||
amr_class(amr_class, only_sir_columns = FALSE, only_treatable = TRUE,
|
||||
return_all = TRUE, ...)
|
||||
|
||||
amr_selector(filter, only_sir_columns = FALSE, only_treatable = TRUE,
|
||||
return_all = TRUE, ...)
|
||||
|
||||
administrable_per_os(only_sir_columns = FALSE, return_all = TRUE, ...)
|
||||
|
||||
administrable_iv(only_sir_columns = FALSE, return_all = TRUE, ...)
|
||||
@ -122,8 +122,6 @@ not_intrinsic_resistant(only_sir_columns = FALSE, col_mo = NULL,
|
||||
version_expertrules = 3.3, ...)
|
||||
}
|
||||
\arguments{
|
||||
\item{amr_class}{an antimicrobial class or a part of it, such as \code{"carba"} and \code{"carbapenems"}. The columns \code{group}, \code{atc_group1} and \code{atc_group2} of the \link{antibiotics} data set will be searched (case-insensitive) for this value.}
|
||||
|
||||
\item{only_sir_columns}{a \link{logical} to indicate whether only columns of class \code{sir} must be selected (default is \code{FALSE}), see \code{\link[=as.sir]{as.sir()}}}
|
||||
|
||||
\item{only_treatable}{a \link{logical} to indicate whether antimicrobial drugs should be excluded that are only for laboratory tests (default is \code{TRUE}), such as gentamicin-high (\code{GEH}) and imipenem/EDTA (\code{IPE})}
|
||||
@ -132,6 +130,8 @@ not_intrinsic_resistant(only_sir_columns = FALSE, col_mo = NULL,
|
||||
|
||||
\item{...}{ignored, only in place to allow future extensions}
|
||||
|
||||
\item{amr_class}{an antimicrobial class or a part of it, such as \code{"carba"} and \code{"carbapenems"}. The columns \code{group}, \code{atc_group1} and \code{atc_group2} of the \link{antibiotics} data set will be searched (case-insensitive) for this value.}
|
||||
|
||||
\item{filter}{an \link{expression} to be evaluated in the \link{antibiotics} data set, such as \code{name \%like\% "trim"}}
|
||||
|
||||
\item{col_mo}{column name of the names or codes of the microorganisms (see \code{\link[=as.mo]{as.mo()}}) - the default is the first column of class \code{\link{mo}}. Values will be coerced using \code{\link[=as.mo]{as.mo()}}.}
|
||||
@ -160,10 +160,10 @@ All columns in the data in which these functions are called will be searched for
|
||||
|
||||
The \code{\link[=amr_class]{amr_class()}} function can be used to filter/select on a manually defined antimicrobial class. It searches for results in the \link{antibiotics} data set within the columns \code{group}, \code{atc_group1} and \code{atc_group2}.
|
||||
|
||||
The \code{\link[=amr_selector]{amr_selector()}} function can be used to internally filter the \link{antibiotics} data set on any results, see \emph{Examples}. It allows for filtering on a (part of) a certain name, and/or a group name or even a minimum of DDDs for oral treatment. This function yields the highest flexibility, but is also the least user-friendly, since it requires a hard-coded filter to set.
|
||||
|
||||
The \code{\link[=administrable_per_os]{administrable_per_os()}} and \code{\link[=administrable_iv]{administrable_iv()}} functions also rely on the \link{antibiotics} data set - antimicrobials will be matched where a DDD (defined daily dose) for resp. oral and IV treatment is available in the \link{antibiotics} data set.
|
||||
|
||||
The \code{\link[=amr_selector]{amr_selector()}} function can be used to internally filter the \link{antibiotics} data set on any results, see \emph{Examples}. It allows for filtering on a (part of) a certain name, and/or a group name or even a minimum of DDDs for oral treatment. This function yields the highest flexibility, but is also the least user-friendly, since it requires a hard-coded filter to set.
|
||||
|
||||
The \code{\link[=not_intrinsic_resistant]{not_intrinsic_resistant()}} function can be used to only select antimicrobials that pose no intrinsic resistance for the microorganisms in the data set. For example, if a data set contains only microorganism codes or names of \emph{E. coli} and \emph{K. pneumoniae} and contains a column "vancomycin", this column will be removed (or rather, unselected) using this function. It currently applies \href{https://www.eucast.org/expert_rules_and_expected_phenotypes}{'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes' v3.3} (2021) to determine intrinsic resistance, using the \code{\link[=eucast_rules]{eucast_rules()}} function internally. Because of this determination, this function is quite slow in terms of performance.
|
||||
}
|
||||
\section{Full list of supported (antimicrobial) classes}{
|
||||
|
||||
@ -265,23 +265,35 @@ if (require("dplyr")) {
|
||||
mutate_if(is.mic, as.sir,
|
||||
mo = "bacteria",
|
||||
ab = "antibiotic",
|
||||
guideline = "CLSI")
|
||||
guideline = "CLSI"
|
||||
)
|
||||
df_long \%>\%
|
||||
mutate(across(where(is.mic),
|
||||
function(x) as.sir(x,
|
||||
mutate(across(
|
||||
where(is.mic),
|
||||
function(x) {
|
||||
as.sir(x,
|
||||
mo = "bacteria",
|
||||
ab = "antibiotic",
|
||||
guideline = "CLSI")))
|
||||
guideline = "CLSI"
|
||||
)
|
||||
}
|
||||
))
|
||||
df_wide \%>\%
|
||||
# given certain columns, e.g. from 'cipro' to 'genta'
|
||||
mutate_at(vars(cipro:genta), as.sir,
|
||||
mo = "bacteria",
|
||||
guideline = "CLSI")
|
||||
guideline = "CLSI"
|
||||
)
|
||||
df_wide \%>\%
|
||||
mutate(across(cipro:genta,
|
||||
function(x) as.sir(x,
|
||||
mutate(across(
|
||||
cipro:genta,
|
||||
function(x) {
|
||||
as.sir(x,
|
||||
mo = "bacteria",
|
||||
guideline = "CLSI")))
|
||||
guideline = "CLSI"
|
||||
)
|
||||
}
|
||||
))
|
||||
|
||||
# for veterinary breakpoints, add 'host':
|
||||
df_long$animal_species <- c("cats", "dogs", "horses", "cattle")
|
||||
@ -291,36 +303,52 @@ if (require("dplyr")) {
|
||||
mo = "bacteria",
|
||||
ab = "antibiotic",
|
||||
host = "animal_species",
|
||||
guideline = "CLSI")
|
||||
guideline = "CLSI"
|
||||
)
|
||||
df_long \%>\%
|
||||
mutate(across(where(is.mic),
|
||||
function(x) as.sir(x,
|
||||
mutate(across(
|
||||
where(is.mic),
|
||||
function(x) {
|
||||
as.sir(x,
|
||||
mo = "bacteria",
|
||||
ab = "antibiotic",
|
||||
host = "animal_species",
|
||||
guideline = "CLSI")))
|
||||
guideline = "CLSI"
|
||||
)
|
||||
}
|
||||
))
|
||||
df_wide \%>\%
|
||||
mutate_at(vars(cipro:genta), as.sir,
|
||||
mo = "bacteria",
|
||||
ab = "antibiotic",
|
||||
host = "animal_species",
|
||||
guideline = "CLSI")
|
||||
guideline = "CLSI"
|
||||
)
|
||||
df_wide \%>\%
|
||||
mutate(across(cipro:genta,
|
||||
function(x) as.sir(x,
|
||||
mutate(across(
|
||||
cipro:genta,
|
||||
function(x) {
|
||||
as.sir(x,
|
||||
mo = "bacteria",
|
||||
host = "animal_species",
|
||||
guideline = "CLSI")))
|
||||
guideline = "CLSI"
|
||||
)
|
||||
}
|
||||
))
|
||||
|
||||
# to include information about urinary tract infections (UTI)
|
||||
data.frame(mo = "E. coli",
|
||||
data.frame(
|
||||
mo = "E. coli",
|
||||
nitrofuratoin = c("<= 2", 32),
|
||||
from_the_bladder = c(TRUE, FALSE)) \%>\%
|
||||
from_the_bladder = c(TRUE, FALSE)
|
||||
) \%>\%
|
||||
as.sir(uti = "from_the_bladder")
|
||||
|
||||
data.frame(mo = "E. coli",
|
||||
data.frame(
|
||||
mo = "E. coli",
|
||||
nitrofuratoin = c("<= 2", 32),
|
||||
specimen = c("urine", "blood")) \%>\%
|
||||
specimen = c("urine", "blood")
|
||||
) \%>\%
|
||||
as.sir() # automatically determines urine isolates
|
||||
|
||||
df_wide \%>\%
|
||||
|
||||
@ -139,8 +139,10 @@ if (require("ggplot2") && require("dplyr")) {
|
||||
) \%>\%
|
||||
ggplot() +
|
||||
geom_col(aes(x = x, y = y, fill = z)) +
|
||||
scale_sir_colours(aesthetics = "fill",
|
||||
Value4 = "S", Value5 = "I", Value6 = "R")
|
||||
scale_sir_colours(
|
||||
aesthetics = "fill",
|
||||
Value4 = "S", Value5 = "I", Value6 = "R"
|
||||
)
|
||||
}
|
||||
if (require("ggplot2") && require("dplyr")) {
|
||||
# resistance of ciprofloxacine per age group
|
||||
|
||||
@ -262,10 +262,12 @@ mo_rank("Klebsiella pneumoniae")
|
||||
mo_url("Klebsiella pneumoniae")
|
||||
mo_is_yeast(c("Candida", "Trichophyton", "Klebsiella"))
|
||||
|
||||
mo_group_members(c("Streptococcus group A",
|
||||
mo_group_members(c(
|
||||
"Streptococcus group A",
|
||||
"Streptococcus group C",
|
||||
"Streptococcus group G",
|
||||
"Streptococcus group L"))
|
||||
"Streptococcus group L"
|
||||
))
|
||||
|
||||
|
||||
# scientific reference -----------------------------------------------------
|
||||
|
||||
64
man/plot.Rd
64
man/plot.Rd
@ -201,7 +201,6 @@ some_mic_values <- random_mic(size = 100)
|
||||
some_disk_values <- random_disk(size = 100, mo = "Escherichia coli", ab = "cipro")
|
||||
some_sir_values <- random_sir(50, prob_SIR = c(0.55, 0.05, 0.30))
|
||||
|
||||
|
||||
\donttest{
|
||||
# Plotting using ggplot2's autoplot() for MIC, disk, and SIR -----------
|
||||
if (require("ggplot2")) {
|
||||
@ -213,17 +212,23 @@ if (require("ggplot2")) {
|
||||
}
|
||||
if (require("ggplot2")) {
|
||||
# support for 20 languages, various guidelines, and many options
|
||||
autoplot(some_disk_values, mo = "Escherichia coli", ab = "cipro",
|
||||
autoplot(some_disk_values,
|
||||
mo = "Escherichia coli", ab = "cipro",
|
||||
guideline = "CLSI 2024", language = "no",
|
||||
title = "Disk diffusion from the North")
|
||||
title = "Disk diffusion from the North"
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
# Plotting using scale_x_mic() -----------------------------------------
|
||||
if (require("ggplot2")) {
|
||||
mic_plot <- ggplot(data.frame(mics = as.mic(c(0.25, "<=4", 4, 8, 32, ">=32")),
|
||||
counts = c(1, 1, 2, 2, 3, 3)),
|
||||
aes(mics, counts)) +
|
||||
mic_plot <- ggplot(
|
||||
data.frame(
|
||||
mics = as.mic(c(0.25, "<=4", 4, 8, 32, ">=32")),
|
||||
counts = c(1, 1, 2, 2, 3, 3)
|
||||
),
|
||||
aes(mics, counts)
|
||||
) +
|
||||
geom_col()
|
||||
mic_plot +
|
||||
labs(title = "without scale_x_mic()")
|
||||
@ -254,17 +259,25 @@ if (require("ggplot2")) {
|
||||
some_groups <- sample(LETTERS[1:5], 20, replace = TRUE)
|
||||
|
||||
if (require("ggplot2")) {
|
||||
ggplot(data.frame(mic = some_mic_values,
|
||||
group = some_groups),
|
||||
aes(group, mic)) +
|
||||
ggplot(
|
||||
data.frame(
|
||||
mic = some_mic_values,
|
||||
group = some_groups
|
||||
),
|
||||
aes(group, mic)
|
||||
) +
|
||||
geom_boxplot() +
|
||||
geom_violin(linetype = 2, colour = "grey", fill = NA) +
|
||||
scale_y_mic()
|
||||
}
|
||||
if (require("ggplot2")) {
|
||||
ggplot(data.frame(mic = some_mic_values,
|
||||
group = some_groups),
|
||||
aes(group, mic)) +
|
||||
ggplot(
|
||||
data.frame(
|
||||
mic = some_mic_values,
|
||||
group = some_groups
|
||||
),
|
||||
aes(group, mic)
|
||||
) +
|
||||
geom_boxplot() +
|
||||
geom_violin(linetype = 2, colour = "grey", fill = NA) +
|
||||
scale_y_mic(mic_range = c(NA, 0.25))
|
||||
@ -273,9 +286,13 @@ if (require("ggplot2")) {
|
||||
|
||||
# Plotting using scale_x_sir() -----------------------------------------
|
||||
if (require("ggplot2")) {
|
||||
ggplot(data.frame(x = c("I", "R", "S"),
|
||||
y = c(45,323, 573)),
|
||||
aes(x, y)) +
|
||||
ggplot(
|
||||
data.frame(
|
||||
x = c("I", "R", "S"),
|
||||
y = c(45, 323, 573)
|
||||
),
|
||||
aes(x, y)
|
||||
) +
|
||||
geom_col() +
|
||||
scale_x_sir()
|
||||
}
|
||||
@ -283,12 +300,17 @@ if (require("ggplot2")) {
|
||||
|
||||
# Plotting using scale_y_mic() and scale_colour_sir() ------------------
|
||||
if (require("ggplot2")) {
|
||||
plain <- ggplot(data.frame(mic = some_mic_values,
|
||||
plain <- ggplot(
|
||||
data.frame(
|
||||
mic = some_mic_values,
|
||||
group = some_groups,
|
||||
sir = as.sir(some_mic_values,
|
||||
mo = "E. coli",
|
||||
ab = "cipro")),
|
||||
aes(x = group, y = mic, colour = sir)) +
|
||||
ab = "cipro"
|
||||
)
|
||||
),
|
||||
aes(x = group, y = mic, colour = sir)
|
||||
) +
|
||||
theme_minimal() +
|
||||
geom_boxplot(fill = NA, colour = "grey") +
|
||||
geom_jitter(width = 0.25)
|
||||
@ -304,8 +326,10 @@ if (require("ggplot2")) {
|
||||
if (require("ggplot2")) {
|
||||
plain +
|
||||
scale_y_mic(mic_range = c(0.005, 32), name = "Our MICs!") +
|
||||
scale_colour_sir(language = "pt",
|
||||
name = "Support in 20 languages")
|
||||
scale_colour_sir(
|
||||
language = "pt",
|
||||
name = "Support in 20 languages"
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -29,15 +29,18 @@ This function is useful for preprocessing data before creating \link[=antibiogra
|
||||
\examples{
|
||||
# filter to the top 3 species:
|
||||
top_n_microorganisms(example_isolates,
|
||||
n = 3)
|
||||
n = 3
|
||||
)
|
||||
|
||||
# filter to any species in the top 5 genera:
|
||||
top_n_microorganisms(example_isolates,
|
||||
n = 5, property = "genus")
|
||||
n = 5, property = "genus"
|
||||
)
|
||||
|
||||
# filter to the top 3 species in each of the top 5 genera:
|
||||
top_n_microorganisms(example_isolates,
|
||||
n = 5, property = "genus", n_for_each = 3)
|
||||
n = 5, property = "genus", n_for_each = 3
|
||||
)
|
||||
}
|
||||
\seealso{
|
||||
\code{\link[=mo_property]{mo_property()}}, \code{\link[=as.mo]{as.mo()}}, \code{\link[=antibiogram]{antibiogram()}}
|
||||
|
||||
@ -33,8 +33,11 @@ library(AMR)
|
||||
# add functions from the tinytest package (which we use for older R versions)
|
||||
expect_inherits <- function(x, y, ...) {
|
||||
expect(inherits(x, y),
|
||||
failure_message = paste0("object has class ", paste0(class(x), collapse = "/"),
|
||||
", required is class ", paste0(y, collapse = "/")))
|
||||
failure_message = paste0(
|
||||
"object has class ", paste0(class(x), collapse = "/"),
|
||||
", required is class ", paste0(y, collapse = "/")
|
||||
)
|
||||
)
|
||||
}
|
||||
expect_stdout <- expect_output
|
||||
|
||||
|
||||
@ -80,15 +80,19 @@ expect_equal(
|
||||
# based on Levenshtein distance
|
||||
expect_identical(ab_name("ceftazidim/avibactam", language = NULL), "Ceftazidime/avibactam")
|
||||
|
||||
expect_identical(as.character(as.ab(c("gentamicine High Level",
|
||||
expect_identical(
|
||||
as.character(as.ab(c(
|
||||
"gentamicine High Level",
|
||||
"gentamicine High",
|
||||
"gentamicine (High Level)",
|
||||
"gentamicine (High)",
|
||||
"gentamicine HL",
|
||||
"gentamicine H-L",
|
||||
"gentamicine (HL)",
|
||||
"gentamicine (H-L)"))),
|
||||
rep("GEH", 8))
|
||||
"gentamicine (H-L)"
|
||||
))),
|
||||
rep("GEH", 8)
|
||||
)
|
||||
|
||||
# assigning and subsetting
|
||||
x <- antibiotics$ab
|
||||
|
||||
@ -96,4 +96,3 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
||||
set_ab_names(NIT:VAN) %>%
|
||||
colnames())))
|
||||
}
|
||||
|
||||
|
||||
@ -35,7 +35,8 @@ expect_equal(
|
||||
c(39, 34, 29)
|
||||
)
|
||||
|
||||
expect_equal(age(
|
||||
expect_equal(
|
||||
age(
|
||||
x = c("2019-01-01", "2019-04-01", "2019-07-01"),
|
||||
reference = "2019-09-01",
|
||||
exact = TRUE
|
||||
|
||||
@ -31,19 +31,22 @@
|
||||
# Traditional antibiogram ----------------------------------------------
|
||||
|
||||
ab1 <- antibiogram(example_isolates,
|
||||
antibiotics = c(aminoglycosides(), carbapenems()))
|
||||
antibiotics = c(aminoglycosides(), carbapenems())
|
||||
)
|
||||
|
||||
ab2 <- antibiogram(example_isolates,
|
||||
antibiotics = aminoglycosides(),
|
||||
ab_transform = "atc",
|
||||
mo_transform = "gramstain",
|
||||
add_total_n = TRUE)
|
||||
add_total_n = TRUE
|
||||
)
|
||||
|
||||
ab3 <- antibiogram(example_isolates,
|
||||
antibiotics = carbapenems(),
|
||||
ab_transform = "ab",
|
||||
mo_transform = "name",
|
||||
formatting_type = 1)
|
||||
formatting_type = 1
|
||||
)
|
||||
|
||||
expect_inherits(ab1, "antibiogram")
|
||||
expect_inherits(ab2, "antibiogram")
|
||||
@ -58,14 +61,16 @@ expect_equal(ab3$MEM, c(52, NA, 100, 100, NA))
|
||||
# combined antibiotics yield higher empiric coverage
|
||||
ab4 <- antibiogram(example_isolates,
|
||||
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
|
||||
mo_transform = "gramstain")
|
||||
mo_transform = "gramstain"
|
||||
)
|
||||
|
||||
ab5 <- antibiogram(example_isolates,
|
||||
antibiotics = c("TZP", "TZP+TOB"),
|
||||
mo_transform = "gramstain",
|
||||
ab_transform = "name",
|
||||
sep = " & ",
|
||||
add_total_n = FALSE)
|
||||
add_total_n = FALSE
|
||||
)
|
||||
|
||||
expect_inherits(ab4, "antibiogram")
|
||||
expect_inherits(ab5, "antibiogram")
|
||||
@ -78,7 +83,8 @@ expect_equal(colnames(ab5), c("Pathogen", "Piperacillin/tazobactam", "Piperacill
|
||||
ab6 <- antibiogram(example_isolates,
|
||||
antibiotics = c(aminoglycosides(), carbapenems()),
|
||||
syndromic_group = "ward",
|
||||
ab_transform = NULL)
|
||||
ab_transform = NULL
|
||||
)
|
||||
|
||||
# with a custom language, though this will be determined automatically
|
||||
# (i.e., this table will be in Dutch on Dutch systems)
|
||||
@ -87,9 +93,11 @@ ab7 <- antibiogram(ex1,
|
||||
antibiotics = aminoglycosides(),
|
||||
ab_transform = "name",
|
||||
syndromic_group = ifelse(ex1$ward == "ICU",
|
||||
"IC", "Geen IC"),
|
||||
"IC", "Geen IC"
|
||||
),
|
||||
language = "nl",
|
||||
add_total_n = TRUE)
|
||||
add_total_n = TRUE
|
||||
)
|
||||
|
||||
expect_inherits(ab6, "antibiogram")
|
||||
expect_inherits(ab7, "antibiogram")
|
||||
@ -101,7 +109,8 @@ expect_equal(colnames(ab7), c("Syndroomgroep", "Pathogeen (N min-max)", "Amikaci
|
||||
# the data set could contain a filter for e.g. respiratory specimens
|
||||
ab8 <- suppressWarnings(antibiogram(example_isolates,
|
||||
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
|
||||
wisca = TRUE))
|
||||
wisca = TRUE
|
||||
))
|
||||
|
||||
expect_inherits(ab8, "antibiogram")
|
||||
expect_equal(colnames(ab8), c("Piperacillin/tazobactam", "Piperacillin/tazobactam + Gentamicin", "Piperacillin/tazobactam + Tobramycin"))
|
||||
|
||||
@ -33,9 +33,11 @@ expect_message(as.ab("testab", info = TRUE))
|
||||
|
||||
suppressMessages(
|
||||
add_custom_antimicrobials(
|
||||
data.frame(ab = "TESTAB",
|
||||
data.frame(
|
||||
ab = "TESTAB",
|
||||
name = "Test Antibiotic",
|
||||
group = "Test Group")
|
||||
group = "Test Group"
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
@ -27,14 +27,18 @@
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
expect_identical(as.mo("Enterobacter asburiae/cloacae"),
|
||||
as.mo("Enterobacter asburiae"))
|
||||
expect_identical(
|
||||
as.mo("Enterobacter asburiae/cloacae"),
|
||||
as.mo("Enterobacter asburiae")
|
||||
)
|
||||
|
||||
suppressMessages(
|
||||
add_custom_microorganisms(
|
||||
data.frame(mo = "ENT_ASB_CLO",
|
||||
data.frame(
|
||||
mo = "ENT_ASB_CLO",
|
||||
genus = "Enterobacter",
|
||||
species = "asburiae/cloacae")
|
||||
species = "asburiae/cloacae"
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
@ -44,8 +48,12 @@ expect_identical(mo_gramstain("ENT_ASB_CLO", language = NULL), "Gram-negative")
|
||||
|
||||
if (getRversion() >= "3.3.0") {
|
||||
# until R 3.2, abbreviate() used a completely different algorithm, making these tests unreproducible
|
||||
expect_identical(paste("B", AMR:::abbreviate_mo("Klebsiella"), AMR:::abbreviate_mo("pneumoniae", 4), sep = "_"),
|
||||
as.character(as.mo("Klebsiella pneumoniae")))
|
||||
expect_identical(paste("B", AMR:::abbreviate_mo("Aerococcus"), AMR:::abbreviate_mo("urinae", 4), sep = "_"),
|
||||
as.character(as.mo("Aerococcus urinae")))
|
||||
expect_identical(
|
||||
paste("B", AMR:::abbreviate_mo("Klebsiella"), AMR:::abbreviate_mo("pneumoniae", 4), sep = "_"),
|
||||
as.character(as.mo("Klebsiella pneumoniae"))
|
||||
)
|
||||
expect_identical(
|
||||
paste("B", AMR:::abbreviate_mo("Aerococcus"), AMR:::abbreviate_mo("urinae", 4), sep = "_"),
|
||||
as.character(as.mo("Aerococcus urinae"))
|
||||
)
|
||||
}
|
||||
|
||||
@ -117,7 +117,8 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
||||
}
|
||||
|
||||
# azithromycin and clarythromycin must be equal to Erythromycin
|
||||
a <- suppressWarnings(as.sir(eucast_rules(data.frame(
|
||||
a <- suppressWarnings(as.sir(eucast_rules(
|
||||
data.frame(
|
||||
mo = example_isolates$mo,
|
||||
ERY = example_isolates$ERY,
|
||||
AZM = as.sir("R"),
|
||||
@ -160,7 +161,8 @@ expect_stdout(suppressWarnings(eucast_rules(example_isolates, verbose = TRUE, ru
|
||||
# AmpC de-repressed cephalo mutants
|
||||
|
||||
expect_identical(
|
||||
eucast_rules(data.frame(
|
||||
eucast_rules(
|
||||
data.frame(
|
||||
mo = c("Escherichia coli", "Enterobacter cloacae"),
|
||||
cefotax = as.sir(c("S", "S"))
|
||||
),
|
||||
@ -171,7 +173,8 @@ expect_identical(
|
||||
)
|
||||
|
||||
expect_identical(
|
||||
eucast_rules(data.frame(
|
||||
eucast_rules(
|
||||
data.frame(
|
||||
mo = c("Escherichia coli", "Enterobacter cloacae"),
|
||||
cefotax = as.sir(c("S", "S"))
|
||||
),
|
||||
@ -182,7 +185,8 @@ expect_identical(
|
||||
)
|
||||
|
||||
expect_identical(
|
||||
eucast_rules(data.frame(
|
||||
eucast_rules(
|
||||
data.frame(
|
||||
mo = c("Escherichia coli", "Enterobacter cloacae"),
|
||||
cefotax = as.sir(c("S", "S"))
|
||||
),
|
||||
@ -208,7 +212,8 @@ expect_stdout(print(c(x, x)))
|
||||
expect_stdout(print(as.list(x, x)))
|
||||
|
||||
# this custom rules makes 8 changes
|
||||
expect_equal(nrow(eucast_rules(example_isolates,
|
||||
expect_equal(
|
||||
nrow(eucast_rules(example_isolates,
|
||||
rules = "custom",
|
||||
custom_rules = x,
|
||||
info = FALSE,
|
||||
|
||||
@ -46,17 +46,28 @@ expect_equal(
|
||||
)
|
||||
|
||||
# for phenotype determination
|
||||
expect_equal(AMR:::duplicated_antibiogram("SSSS", points_threshold = 2, ignore_I = TRUE, type = "points"),
|
||||
FALSE)
|
||||
expect_equal(AMR:::duplicated_antibiogram(c("RRR", "SSS"),
|
||||
points_threshold = 2, ignore_I = TRUE, type = "points"),
|
||||
c(FALSE, FALSE))
|
||||
expect_equal(AMR:::duplicated_antibiogram(c("RRR", "RRR", "SSS"),
|
||||
points_threshold = 2, ignore_I = TRUE, type = "points"),
|
||||
c(FALSE, TRUE, FALSE))
|
||||
expect_equal(AMR:::duplicated_antibiogram(c("RRR", "RSS", "SSS", "RSS", "RRR", "RRR", "SSS", "RSS", "RSR", "RRR"),
|
||||
points_threshold = 2, ignore_I = TRUE, type = "points"),
|
||||
c(FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, TRUE))
|
||||
expect_equal(
|
||||
AMR:::duplicated_antibiogram("SSSS", points_threshold = 2, ignore_I = TRUE, type = "points"),
|
||||
FALSE
|
||||
)
|
||||
expect_equal(
|
||||
AMR:::duplicated_antibiogram(c("RRR", "SSS"),
|
||||
points_threshold = 2, ignore_I = TRUE, type = "points"
|
||||
),
|
||||
c(FALSE, FALSE)
|
||||
)
|
||||
expect_equal(
|
||||
AMR:::duplicated_antibiogram(c("RRR", "RRR", "SSS"),
|
||||
points_threshold = 2, ignore_I = TRUE, type = "points"
|
||||
),
|
||||
c(FALSE, TRUE, FALSE)
|
||||
)
|
||||
expect_equal(
|
||||
AMR:::duplicated_antibiogram(c("RRR", "RSS", "SSS", "RSS", "RRR", "RRR", "SSS", "RSS", "RSR", "RRR"),
|
||||
points_threshold = 2, ignore_I = TRUE, type = "points"
|
||||
),
|
||||
c(FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, TRUE)
|
||||
)
|
||||
|
||||
# Phenotype-based, using key antimicrobials
|
||||
expect_equal(
|
||||
@ -89,7 +100,9 @@ expect_true(
|
||||
col_icu = example_isolates$ward == "ICU",
|
||||
info = TRUE,
|
||||
icu_exclude = TRUE
|
||||
), na.rm = TRUE) < 950
|
||||
),
|
||||
na.rm = TRUE
|
||||
) < 950
|
||||
)
|
||||
|
||||
# set 1500 random observations to be of specimen type 'Urine'
|
||||
|
||||
@ -44,14 +44,18 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE) &&
|
||||
as.double()
|
||||
)
|
||||
|
||||
expect_inherits(example_isolates %>%
|
||||
expect_inherits(
|
||||
example_isolates %>%
|
||||
select(AMC, CIP) %>%
|
||||
ggplot_sir(x = "interpretation", facet = "antibiotic"),
|
||||
"gg")
|
||||
expect_inherits(example_isolates %>%
|
||||
"gg"
|
||||
)
|
||||
expect_inherits(
|
||||
example_isolates %>%
|
||||
select(AMC, CIP) %>%
|
||||
ggplot_sir(x = "antibiotic", facet = "interpretation"),
|
||||
"gg")
|
||||
"gg"
|
||||
)
|
||||
|
||||
expect_equal(
|
||||
(example_isolates %>%
|
||||
|
||||
@ -55,7 +55,8 @@ expect_equal(
|
||||
|
||||
# test Dutch P. aeruginosa MDRO
|
||||
expect_equal(
|
||||
as.character(mdro(data.frame(
|
||||
as.character(mdro(
|
||||
data.frame(
|
||||
mo = as.mo("P. aeruginosa"),
|
||||
cfta = "S",
|
||||
cipr = "S",
|
||||
@ -72,7 +73,8 @@ expect_equal(
|
||||
"Negative"
|
||||
)
|
||||
expect_equal(
|
||||
as.character(mdro(data.frame(
|
||||
as.character(mdro(
|
||||
data.frame(
|
||||
mo = as.mo("P. aeruginosa"),
|
||||
cefta = "R",
|
||||
cipr = "R",
|
||||
|
||||
@ -176,4 +176,3 @@ expect_true(as.mic("32") <= as.mic(32))
|
||||
expect_false(as.mic("32") <= as.mic("<32"))
|
||||
expect_true(as.mic("32") <= as.mic("<=32"))
|
||||
expect_false(as.mic("32") < as.mic("<=32"))
|
||||
|
||||
|
||||
@ -78,8 +78,10 @@ current_grampos_classes <- c(
|
||||
"Thermoleophilia",
|
||||
"Thermolithobacteria"
|
||||
)
|
||||
expect_identical(sort(unique(microorganisms[which(microorganisms$phylum %in% current_grampos_phyla), "class", drop = TRUE])),
|
||||
current_grampos_classes)
|
||||
expect_identical(
|
||||
sort(unique(microorganisms[which(microorganisms$phylum %in% current_grampos_phyla), "class", drop = TRUE])),
|
||||
current_grampos_classes
|
||||
)
|
||||
|
||||
expect_equal(mo_species("Escherichia coli"), "coli")
|
||||
expect_equal(mo_subspecies("Escherichia coli"), "")
|
||||
@ -103,11 +105,15 @@ expect_inherits(mo_info(c("Escherichia coli", "Staphylococcus aureus")), "list")
|
||||
expect_true(length(mo_group_members("B_HACEK")) > 1)
|
||||
expect_inherits(mo_group_members(c("Candida albicans", "Escherichia coli")), "list")
|
||||
|
||||
expect_identical(mo_oxygen_tolerance(c("Klebsiella pneumoniae", "Clostridioides difficile")),
|
||||
c("facultative anaerobe", "anaerobe"))
|
||||
expect_identical(
|
||||
mo_oxygen_tolerance(c("Klebsiella pneumoniae", "Clostridioides difficile")),
|
||||
c("facultative anaerobe", "anaerobe")
|
||||
)
|
||||
|
||||
expect_equal(as.character(table(mo_pathogenicity(example_isolates$mo))),
|
||||
c("1911", "72", "1", "16"))
|
||||
expect_equal(
|
||||
as.character(table(mo_pathogenicity(example_isolates$mo))),
|
||||
c("1911", "72", "1", "16")
|
||||
)
|
||||
|
||||
expect_equal(mo_ref("Escherichia coli"), "Castellani et al., 1919")
|
||||
expect_equal(mo_authors("Escherichia coli"), "Castellani et al.")
|
||||
@ -118,8 +124,10 @@ expect_true(mo_url("Candida albicans") %like% "mycobank.org")
|
||||
expect_true(mo_url("Escherichia coli") %like% "lpsn.dsmz.de")
|
||||
|
||||
# test integrity of getting back full names
|
||||
expect_identical(microorganisms$fullname[microorganisms$fullname %unlike% "(Fungi|{)"],
|
||||
suppressWarnings(mo_fullname(microorganisms$fullname[microorganisms$fullname %unlike% "(Fungi|{)"], language = "en", keep_synonyms = TRUE)))
|
||||
expect_identical(
|
||||
microorganisms$fullname[microorganisms$fullname %unlike% "(Fungi|{)"],
|
||||
suppressWarnings(mo_fullname(microorganisms$fullname[microorganisms$fullname %unlike% "(Fungi|{)"], language = "en", keep_synonyms = TRUE))
|
||||
)
|
||||
|
||||
# check languages
|
||||
expect_equal(mo_type("Escherichia coli", language = "de"), "Bakterien")
|
||||
@ -169,8 +177,10 @@ expect_identical(
|
||||
|
||||
expect_true("Escherichia blattae" %in% mo_synonyms("Shimwellia blattae"))
|
||||
expect_true(is.list(mo_synonyms(rep("Shimwellia blattae", 2))))
|
||||
expect_identical(mo_current(c("Escherichia blattae", "Escherichia coli")),
|
||||
c("Shimwellia blattae", "Escherichia coli"))
|
||||
expect_identical(
|
||||
mo_current(c("Escherichia blattae", "Escherichia coli")),
|
||||
c("Shimwellia blattae", "Escherichia coli")
|
||||
)
|
||||
|
||||
expect_identical(mo_ref("Chlamydia psittaci"), "Garcia-Lopez et al., 2019")
|
||||
expect_identical(mo_ref("Chlamydophila psittaci", keep_synonyms = TRUE), "Everett et al., 1999")
|
||||
|
||||
@ -27,7 +27,8 @@
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
resistance_data <- structure(list(
|
||||
resistance_data <- structure(
|
||||
list(
|
||||
order = c("Bacillales", "Enterobacterales", "Enterobacterales"),
|
||||
genus = c("Staphylococcus", "Escherichia", "Klebsiella"),
|
||||
AMC = c(0.00425, 0.13062, 0.10344),
|
||||
@ -38,7 +39,8 @@ resistance_data <- structure(list(
|
||||
),
|
||||
class = c("grouped_df", "tbl_df", "tbl", "data.frame"),
|
||||
row.names = c(NA, -3L),
|
||||
groups = structure(list(
|
||||
groups = structure(
|
||||
list(
|
||||
order = c("Bacillales", "Enterobacterales"),
|
||||
.rows = list(1L, 2:3)
|
||||
),
|
||||
|
||||
@ -38,7 +38,8 @@ if (AMR:::pkg_is_available("ggplot2", also_load = TRUE)) {
|
||||
scale_obj <- getExportedValue("ggplot2", scale_fn_name)()
|
||||
for (method in expected_methods) {
|
||||
expect_true(is.function(scale_obj[[method]]) || method %in% names(scale_obj),
|
||||
info = paste0("Method '", method, "' is missing in ggplot2::", scale_fn_name))
|
||||
info = paste0("Method '", method, "' is missing in ggplot2::", scale_fn_name)
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
@ -50,38 +51,64 @@ if (AMR:::pkg_is_available("ggplot2", also_load = TRUE)) {
|
||||
scale_obj <- getExportedValue("ggplot2", scale_fn_name)(aesthetics = aest)
|
||||
for (method in expected_methods) {
|
||||
expect_true(is.function(scale_obj[[method]]) || method %in% names(scale_obj),
|
||||
info = paste0("Method '", method, "' is missing in ggplot2::", scale_fn_name))
|
||||
info = paste0("Method '", method, "' is missing in ggplot2::", scale_fn_name)
|
||||
)
|
||||
}
|
||||
}
|
||||
for (method in expected_methods) {
|
||||
expect_true(is.function(ggplot2::scale_x_discrete()[[method]]) || method %in% names(ggplot2::scale_x_discrete()),
|
||||
info = paste0("Method '", method, "' is missing in ggplot2::", "scale_x_discrete"))
|
||||
info = paste0("Method '", method, "' is missing in ggplot2::", "scale_x_discrete")
|
||||
)
|
||||
}
|
||||
|
||||
expect_inherits(ggplot(data.frame(count = c(1,2,3, 4),
|
||||
sir = c("S", "I", "R", "SDD")),
|
||||
aes(x = sir, y = count, fill = sir)) +
|
||||
expect_inherits(
|
||||
ggplot(
|
||||
data.frame(
|
||||
count = c(1, 2, 3, 4),
|
||||
sir = c("S", "I", "R", "SDD")
|
||||
),
|
||||
aes(x = sir, y = count, fill = sir)
|
||||
) +
|
||||
geom_col() +
|
||||
scale_x_sir(eucast_I = F, language = "el") +
|
||||
scale_fill_sir(eucast_I = T, language = "nl"),
|
||||
"gg")
|
||||
expect_inherits(ggplot(data.frame(mic = as.mic(c(2,4,8, 16)),
|
||||
sir = as.sir(c("S", "I", "R", "SDD"))),
|
||||
aes(x = sir, y = mic)) +
|
||||
"gg"
|
||||
)
|
||||
expect_inherits(
|
||||
ggplot(
|
||||
data.frame(
|
||||
mic = as.mic(c(2, 4, 8, 16)),
|
||||
sir = as.sir(c("S", "I", "R", "SDD"))
|
||||
),
|
||||
aes(x = sir, y = mic)
|
||||
) +
|
||||
geom_point() +
|
||||
scale_y_mic(),
|
||||
"gg")
|
||||
expect_inherits(ggplot(data.frame(mic = as.mic(c(2,4,8, 16)),
|
||||
sir = as.sir(c("S", "I", "R", "SDD"))),
|
||||
aes(x = sir, y = mic)) +
|
||||
"gg"
|
||||
)
|
||||
expect_inherits(
|
||||
ggplot(
|
||||
data.frame(
|
||||
mic = as.mic(c(2, 4, 8, 16)),
|
||||
sir = as.sir(c("S", "I", "R", "SDD"))
|
||||
),
|
||||
aes(x = sir, y = mic)
|
||||
) +
|
||||
geom_col() +
|
||||
scale_y_mic(),
|
||||
"gg")
|
||||
expect_inherits(ggplot(data.frame(mic = as.mic(c(2,4,8, 16)),
|
||||
sir = as.sir(c("S", "I", "R", "SDD"))),
|
||||
aes(x = sir, y = mic)) +
|
||||
"gg"
|
||||
)
|
||||
expect_inherits(
|
||||
ggplot(
|
||||
data.frame(
|
||||
mic = as.mic(c(2, 4, 8, 16)),
|
||||
sir = as.sir(c("S", "I", "R", "SDD"))
|
||||
),
|
||||
aes(x = sir, y = mic)
|
||||
) +
|
||||
geom_col() +
|
||||
scale_y_mic(mic_range = c(4, 16)) +
|
||||
scale_x_sir(),
|
||||
"gg")
|
||||
"gg"
|
||||
)
|
||||
}
|
||||
|
||||
@ -125,28 +125,44 @@ expect_equal(as.sir(c("", "-", NA, "NULL")), c(NA_sir_, NA_sir_, NA_sir_, NA_sir
|
||||
# Human -------------------------------------------------------------------
|
||||
|
||||
mics <- as.mic(2^c(-4:6)) # 0.0625 to 64 in factors of 2
|
||||
expect_identical(as.character(as.sir(mics, mo = "Enterobacterales", ab = "AMC", guideline = "EUCAST 2022",
|
||||
uti = FALSE, include_PKPD = FALSE)),
|
||||
c("S", "S", "S", "S", "S", "S", "S", "S", "R", "R", "R"))
|
||||
expect_identical(as.character(as.sir(mics, mo = "Enterobacterales", ab = "AMC", guideline = "EUCAST 2022",
|
||||
uti = TRUE, include_PKPD = FALSE)),
|
||||
c("S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "R"))
|
||||
expect_identical(as.character(as.sir(mics, mo = "Escherichia coli", ab = "AMC", guideline = "EUCAST 2022",
|
||||
uti = FALSE, include_PKPD = FALSE)),
|
||||
c("S", "S", "S", "S", "S", "S", "S", "S", "R", "R", "R"))
|
||||
expect_identical(
|
||||
as.character(as.sir(mics,
|
||||
mo = "Enterobacterales", ab = "AMC", guideline = "EUCAST 2022",
|
||||
uti = FALSE, include_PKPD = FALSE
|
||||
)),
|
||||
c("S", "S", "S", "S", "S", "S", "S", "S", "R", "R", "R")
|
||||
)
|
||||
expect_identical(
|
||||
as.character(as.sir(mics,
|
||||
mo = "Enterobacterales", ab = "AMC", guideline = "EUCAST 2022",
|
||||
uti = TRUE, include_PKPD = FALSE
|
||||
)),
|
||||
c("S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "R")
|
||||
)
|
||||
expect_identical(
|
||||
as.character(as.sir(mics,
|
||||
mo = "Escherichia coli", ab = "AMC", guideline = "EUCAST 2022",
|
||||
uti = FALSE, include_PKPD = FALSE
|
||||
)),
|
||||
c("S", "S", "S", "S", "S", "S", "S", "S", "R", "R", "R")
|
||||
)
|
||||
|
||||
# test SIR using dplyr's mutate_if(...) and mutate(across(...))
|
||||
out1 <- as.sir(as.mic(c(0.256, 0.5, 1, 2)), mo = "Escherichia coli", ab = "ertapenem", guideline = "EUCAST 2023")
|
||||
expect_identical(out1, as.sir(c("S", "S", "R", "R")))
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
||||
out2 <- data.frame(mo = "Escherichia coli",
|
||||
out2 <- data.frame(
|
||||
mo = "Escherichia coli",
|
||||
ab = "ertapenem",
|
||||
some_mics = as.mic(c(0.256, 0.5, 1, 2))) %>%
|
||||
some_mics = as.mic(c(0.256, 0.5, 1, 2))
|
||||
) %>%
|
||||
mutate(across(where(is.mic), function(x) as.sir(x, mo = "mo", ab = "ab", guideline = "EUCAST 2023"))) %>%
|
||||
pull(some_mics)
|
||||
out3 <- data.frame(mo = "Escherichia coli",
|
||||
out3 <- data.frame(
|
||||
mo = "Escherichia coli",
|
||||
ab = "ertapenem",
|
||||
some_mics = as.mic(c(0.256, 0.5, 1, 2))) %>%
|
||||
some_mics = as.mic(c(0.256, 0.5, 1, 2))
|
||||
) %>%
|
||||
mutate_if(is.mic, as.sir, mo = "mo", ab = "ab", guideline = "EUCAST 2023") %>%
|
||||
pull(some_mics)
|
||||
|
||||
@ -155,7 +171,8 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
||||
}
|
||||
|
||||
# S. pneumoniae/ampicillin in EUCAST 2020: 0.5-2 ug/ml (R is only > 2)
|
||||
expect_equal(suppressMessages(
|
||||
expect_equal(
|
||||
suppressMessages(
|
||||
as.character(
|
||||
as.sir(
|
||||
x = as.mic(c(0.125, 0.5, 1, 2, 4)),
|
||||
@ -163,11 +180,13 @@ expect_equal(suppressMessages(
|
||||
ab = "AMP",
|
||||
guideline = "EUCAST 2020"
|
||||
)
|
||||
)),
|
||||
)
|
||||
),
|
||||
c("S", "S", "I", "I", "R")
|
||||
)
|
||||
# S. pneumoniae/amoxicillin in CLSI 2019: 2-8 ug/ml (R is 8 and > 8)
|
||||
expect_equal(suppressMessages(
|
||||
expect_equal(
|
||||
suppressMessages(
|
||||
as.character(
|
||||
as.sir(
|
||||
x = as.mic(c(1, 2, 4, 8, 16)),
|
||||
@ -175,7 +194,8 @@ expect_equal(suppressMessages(
|
||||
ab = "AMX",
|
||||
guideline = "CLSI 2019"
|
||||
)
|
||||
)),
|
||||
)
|
||||
),
|
||||
c("S", "S", "I", "R", "R")
|
||||
)
|
||||
|
||||
@ -247,14 +267,22 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
||||
group_by(mo) %>%
|
||||
attributes() %>%
|
||||
.$groups
|
||||
expect_equal(nrow(groups),
|
||||
90)
|
||||
expect_equal(class(groups$.rows),
|
||||
c("vctrs_list_of", "vctrs_vctr", "list"))
|
||||
expect_equal(groups$.rows[[1]],
|
||||
c(101, 524, 1368))
|
||||
expect_equal(example_isolates[c(101, 524, 1368), "mo", drop = TRUE],
|
||||
rep(groups$mo[1], 3))
|
||||
expect_equal(
|
||||
nrow(groups),
|
||||
90
|
||||
)
|
||||
expect_equal(
|
||||
class(groups$.rows),
|
||||
c("vctrs_list_of", "vctrs_vctr", "list")
|
||||
)
|
||||
expect_equal(
|
||||
groups$.rows[[1]],
|
||||
c(101, 524, 1368)
|
||||
)
|
||||
expect_equal(
|
||||
example_isolates[c(101, 524, 1368), "mo", drop = TRUE],
|
||||
rep(groups$mo[1], 3)
|
||||
)
|
||||
}
|
||||
# frequency tables
|
||||
if (AMR:::pkg_is_available("cleaner")) {
|
||||
@ -295,11 +323,15 @@ expect_message(as.sir(data.frame(
|
||||
)))
|
||||
|
||||
# SDD vs I in CLSI 2024
|
||||
expect_identical(as.sir(as.mic(2 ^ c(-2:4)), mo = "Enterococcus faecium", ab = "Dapto", guideline = "CLSI 2024"),
|
||||
as.sir(c("SDD", "SDD", "SDD", "SDD", "SDD", "R", "R")))
|
||||
expect_identical(as.sir(as.mic(2 ^ c(-2:2)), mo = "Enterococcus faecium", ab = "Cipro
|
||||
expect_identical(
|
||||
as.sir(as.mic(2^c(-2:4)), mo = "Enterococcus faecium", ab = "Dapto", guideline = "CLSI 2024"),
|
||||
as.sir(c("SDD", "SDD", "SDD", "SDD", "SDD", "R", "R"))
|
||||
)
|
||||
expect_identical(
|
||||
as.sir(as.mic(2^c(-2:2)), mo = "Enterococcus faecium", ab = "Cipro
|
||||
", guideline = "CLSI 2024"),
|
||||
as.sir(c("S", "S", "S", "I", "R")))
|
||||
as.sir(c("S", "S", "S", "I", "R"))
|
||||
)
|
||||
|
||||
|
||||
# Veterinary --------------------------------------------------------------
|
||||
@ -307,15 +339,19 @@ expect_identical(as.sir(as.mic(2 ^ c(-2:2)), mo = "Enterococcus faecium", ab = "
|
||||
sir_history <- sir_interpretation_history(clean = TRUE)
|
||||
|
||||
mics <- as.mic(2^c(-4:6)) # 0.0625 to 64 in factors of 2
|
||||
vet <- data.frame(animal = c(rep("cat", 3), rep("dogs", 3), "canine", "equine", "horse", "cattle", "bird"),
|
||||
vet <- data.frame(
|
||||
animal = c(rep("cat", 3), rep("dogs", 3), "canine", "equine", "horse", "cattle", "bird"),
|
||||
PRA = mics,
|
||||
FLR = mics,
|
||||
mo = mo_name(rep(c("B_ESCHR_COLI", "B_PSTRL_MLTC", "B_MNNHM_HMLY"), 4)[-1]))
|
||||
mo = mo_name(rep(c("B_ESCHR_COLI", "B_PSTRL_MLTC", "B_MNNHM_HMLY"), 4)[-1])
|
||||
)
|
||||
|
||||
out_vet <- as.sir(vet, host = vet$animal, guideline = "CLSI 2023")
|
||||
# host column name instead of values
|
||||
expect_identical(out_vet,
|
||||
as.sir(vet, host = "animal", guideline = "CLSI 2023"))
|
||||
expect_identical(
|
||||
out_vet,
|
||||
as.sir(vet, host = "animal", guideline = "CLSI 2023")
|
||||
)
|
||||
|
||||
# check outcomes
|
||||
expect_identical(out_vet$PRA, as.sir(c("S", NA, "S", NA, NA, "R", NA, NA, NA, "I", NA)))
|
||||
@ -326,11 +362,15 @@ expect_identical(out_vet$PRA, rep(NA_sir_, 11))
|
||||
expect_identical(out_vet$FLR, as.sir(c("S", "S", NA, "S", "S", NA, "I", "R", NA, "R", "R")))
|
||||
|
||||
sir_history <- sir_interpretation_history()
|
||||
expect_identical(sort(sir_history$host),
|
||||
c("cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats",
|
||||
expect_identical(
|
||||
sort(sir_history$host),
|
||||
c(
|
||||
"cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats",
|
||||
"cats", "cats", "cats", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "dogs",
|
||||
"dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs",
|
||||
"horse", "horse", "horse", "horse", "horse", "horse", "horse", "horse", "horse", "poultry","poultry","poultry","poultry"))
|
||||
"horse", "horse", "horse", "horse", "horse", "horse", "horse", "horse", "horse", "poultry", "poultry", "poultry", "poultry"
|
||||
)
|
||||
)
|
||||
|
||||
# ECOFF -------------------------------------------------------------------
|
||||
|
||||
@ -340,4 +380,3 @@ expect_equal(
|
||||
)
|
||||
# old method
|
||||
expect_warning(as.sir(as.mic(2), "E. coli", "ampicillin", guideline = "EUCAST 2020", ecoff = TRUE))
|
||||
|
||||
|
||||
@ -29,11 +29,13 @@
|
||||
|
||||
# extra tests for {vctrs} pkg support
|
||||
if (AMR:::pkg_is_available("tibble")) {
|
||||
test <- tibble::tibble(ab = as.ab("CIP"),
|
||||
test <- tibble::tibble(
|
||||
ab = as.ab("CIP"),
|
||||
mo = as.mo("Escherichia coli"),
|
||||
mic = as.mic(2),
|
||||
disk = as.disk(20),
|
||||
sir = as.sir("S"))
|
||||
sir = as.sir("S")
|
||||
)
|
||||
check1 <- lapply(test, class)
|
||||
test[1, "ab"] <- "GEN"
|
||||
test[1, "mo"] <- "B_KLBSL_PNMN"
|
||||
@ -46,8 +48,10 @@ if (AMR:::pkg_is_available("tibble")) {
|
||||
check2 <- lapply(test, class)
|
||||
expect_identical(check1, check2)
|
||||
|
||||
test <- tibble::tibble(cipro = as.sir("S"),
|
||||
variable = "test")
|
||||
test <- tibble::tibble(
|
||||
cipro = as.sir("S"),
|
||||
variable = "test"
|
||||
)
|
||||
expect_equal(nrow(test[quinolones() == "S", ]), 1)
|
||||
expect_equal(nrow(test[quinolones() == "R", ]), 0)
|
||||
}
|
||||
|
||||
@ -146,14 +146,16 @@ for (i in seq_len(length(import_functions))) {
|
||||
fn <- names(import_functions)[i]
|
||||
pkg <- unname(import_functions[i])
|
||||
expect_true(pkg %in% suggests,
|
||||
info = paste0("package `", pkg, "` is not in Suggests"))
|
||||
info = paste0("package `", pkg, "` is not in Suggests")
|
||||
)
|
||||
# function should exist in foreign pkg namespace
|
||||
if (AMR:::pkg_is_available(pkg,
|
||||
also_load = FALSE,
|
||||
min_version = if (pkg == "dplyr") "1.0.0" else NULL
|
||||
)) {
|
||||
expect_true(!is.null(AMR:::import_fn(name = fn, pkg = pkg, error_on_fail = FALSE)),
|
||||
info = paste0("Function does not exist (anymore): function `", pkg, "::", fn, "()`"))
|
||||
info = paste0("Function does not exist (anymore): function `", pkg, "::", fn, "()`")
|
||||
)
|
||||
} else if (pkg != "rstudioapi") {
|
||||
warning("Package '", pkg, "' not available")
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user