P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-09 21:01:58 +02:00
Code Releases Activity

(v2.1.1.9163) cleanup

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2025-02-27 14:04:29 +01:00
parent 68efddab3d
commit 07efc292bc
73 changed files with 2187 additions and 1715 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
.github/workflows/lintr.yaml vendored
View File

@ -56,9 +56,15 @@ jobs:
extra-packages: | extra-packages: |
any::lintr any::lintr
any::cyclocomp any::cyclocomp
any::roxygen2
any::devtools
any::usethis
- name: Lint - name: Lint
run: | 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")) # 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 # now get ALL linters, not just default ones
linters <- getNamespaceExports(asNamespace("lintr")) 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[!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"] linters <- linters[linters != "linter"]
# and the ones we find unnnecessary # 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 # put the functions in a list
linters_list <- lapply(linters, function(l) eval(parse(text = paste0("lintr::", l, "()")), envir = asNamespace("lintr"))) linters_list <- lapply(linters, function(l) eval(parse(text = paste0("lintr::", l, "()")), envir = asNamespace("lintr")))
names(linters_list) <- linters names(linters_list) <- linters

4
DESCRIPTION
View File

@ -1,6 +1,6 @@
Package: AMR Package: AMR
Version: 2.1.1.9160 Version: 2.1.1.9163
Date: 2025-02-26 Date: 2025-02-27
Title: Antimicrobial Resistance Data Analysis Title: Antimicrobial Resistance Data Analysis
Description: Functions to simplify and standardise antimicrobial resistance (AMR) Description: Functions to simplify and standardise antimicrobial resistance (AMR)
data analysis and to work with microbial and antimicrobial properties by data analysis and to work with microbial and antimicrobial properties by

6
NEWS.md
View File

@ -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).)* *(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 Amorolfine (`AMO`, D01AE16), which is now also part of the `antifungals()` selector
* Added Efflux (`EFF`), to allow mapping to AMRFinderPlus * Added Efflux (`EFF`), to allow mapping to AMRFinderPlus
* Added Tigemonam (`TNM`), a monobactam * Added Tigemonam (`TNM`), a monobactam
* Added over 1,500 trade names
* MICs * MICs
* Added as valid levels: 4096, 6 powers of 0.0625, and 5 powers of 192 (192, 384, 576, 768, 960) * 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 * 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) * `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 ATC codes from WHOCC
* Updated all antibiotic DDDs 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()` * Fix for using a manual value for `mo_transform` in `antibiogram()`
* Fixed a bug for when `antibiogram()` returns an empty data set * 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) * 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.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 * 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 * 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 * Fixed a bug for `sir_confidence_interval()` when there are no isolates available

2
PythonPackage/AMR/AMR.egg-info/PKG-INFO
View File

@ -1,6 +1,6 @@
Metadata-Version: 2.2 Metadata-Version: 2.2
Name: AMR Name: AMR
Version: 2.1.1.9160 Version: 2.1.1.9163
Summary: A Python wrapper for the AMR R package Summary: A Python wrapper for the AMR R package
Home-page: https://github.com/msberends/AMR Home-page: https://github.com/msberends/AMR
Author: Matthijs Berends Author: Matthijs Berends

4
PythonPackage/AMR/AMR/__init__.py
View File

@ -28,8 +28,6 @@ from .functions import age_groups
from .functions import antibiogram from .functions import antibiogram
from .functions import wisca from .functions import wisca
from .functions import retrieve_wisca_parameters from .functions import retrieve_wisca_parameters
from .functions import amr_class
from .functions import amr_selector
from .functions import aminoglycosides from .functions import aminoglycosides
from .functions import aminopenicillins from .functions import aminopenicillins
from .functions import antifungals from .functions import antifungals
@ -61,6 +59,8 @@ from .functions import streptogramins
from .functions import tetracyclines from .functions import tetracyclines
from .functions import trimethoprims from .functions import trimethoprims
from .functions import ureidopenicillins from .functions import ureidopenicillins
from .functions import amr_class
from .functions import amr_selector
from .functions import administrable_per_os from .functions import administrable_per_os
from .functions import administrable_iv from .functions import administrable_iv
from .functions import not_intrinsic_resistant from .functions import not_intrinsic_resistant

12
PythonPackage/AMR/AMR/functions.py
View File

@ -114,12 +114,6 @@ def wisca(x, *args, **kwargs):
def retrieve_wisca_parameters(wisca_model, *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""" """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)) 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): 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""" """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)) 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): 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""" """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)) 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): 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""" """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)) return convert_to_python(amr_r.administrable_per_os(only_sir_columns = False, *args, **kwargs))

BIN
PythonPackage/AMR/dist/amr-2.1.1.9160-py3-none-any.whl vendored
View File

Binary file not shown.

BIN
PythonPackage/AMR/dist/amr-2.1.1.9160.tar.gz vendored
View File

Binary file not shown.

BIN
PythonPackage/AMR/dist/amr-2.1.1.9163-py3-none-any.whl vendored Normal file
View File

Binary file not shown.

BIN
PythonPackage/AMR/dist/amr-2.1.1.9163.tar.gz vendored Normal file
View File

Binary file not shown.

2
PythonPackage/AMR/setup.py
View File

@ -2,7 +2,7 @@ from setuptools import setup, find_packages
setup( setup(
name='AMR', name='AMR',
version='2.1.1.9160', version='2.1.1.9163',
packages=find_packages(), packages=find_packages(),
install_requires=[ install_requires=[
'rpy2', 'rpy2',

38
R/aa_helper_functions.R
View File

@ -512,21 +512,31 @@ word_wrap <- function(...,
# format backticks # format backticks
if (pkg_is_available("cli") && if (pkg_is_available("cli") &&
tryCatch(isTRUE(getExportedValue("ansi_has_hyperlink_support", ns = asNamespace("cli"))()), error = function(e) FALSE) && 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("isAvailable", ns = asNamespace("rstudioapi"))(), error = function(e) {
tryCatch(getExportedValue("versionInfo", ns = asNamespace("rstudioapi"))()$version > "2023.6.0.0", error = function(e) return(FALSE))) { 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. # 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]] parts <- strsplit(msg, "`", fixed = TRUE)[[1]]
cmds <- parts %in% paste0(ls(envir = asNamespace("AMR")), "()") cmds <- parts %in% paste0(ls(envir = asNamespace("AMR")), "()")
# functions with a dot are not allowed: https://github.com/rstudio/rstudio/issues/11273#issuecomment-1156193252 # 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 # 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)), parts[cmds & parts %like% "[.]"] <- font_url(
txt = parts[cmds & parts %like% "[.]"]) url = paste0("ide:help:AMR::", gsub("()", "", parts[cmds & parts %like% "[.]"], fixed = TRUE)),
txt = parts[cmds & parts %like% "[.]"]
)
# otherwise, give a 'click to run' popup # otherwise, give a 'click to run' popup
parts[cmds & parts %unlike% "[.]"] <- font_url(url = paste0("ide:run:AMR::", parts[cmds & parts %unlike% "[.]"]), parts[cmds & parts %unlike% "[.]"] <- font_url(
txt = parts[cmds & parts %unlike% "[.]"]) url = paste0("ide:run:AMR::", parts[cmds & parts %unlike% "[.]"]),
txt = parts[cmds & parts %unlike% "[.]"]
)
# text starting with `?` must also lead to the help page # 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)), parts[parts %like% "^[?]"] <- font_url(
txt = parts[parts %like% "^[?]"]) url = paste0("ide:help:AMR::", gsub("()", "", gsub("^[?]", "", parts[parts %like% "^[?]"]), fixed = TRUE)),
txt = parts[parts %like% "^[?]"]
)
msg <- paste0(parts, collapse = "`") msg <- paste0(parts, collapse = "`")
} }
msg <- gsub("`(.+?)`", font_grey_bg("\\1"), msg) 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) { ascertain_sir_classes <- function(x, obj_name) {
sirs <- vapply(FUN.VALUE = logical(1), x, is.sir) sirs <- vapply(FUN.VALUE = logical(1), x, is.sir)
if (!any(sirs, na.rm = TRUE)) { 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. ", "` 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) sirs_eligible <- is_sir_eligible(x)
for (col in colnames(x)[sirs_eligible]) { for (col in colnames(x)[sirs_eligible]) {
x[[col]] <- as.sir(x[[col]]) 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 # a close()-method was also added, see below for that
pb <- progress_bar$new( pb <- progress_bar$new(
show_after = 0, show_after = 0,
format = paste0(title, format = paste0(
ifelse(only_bar_percent == TRUE, "[:bar] :percent", "[:bar] :percent (:current/:total,:eta)")), title,
ifelse(only_bar_percent == TRUE, "[:bar] :percent", "[:bar] :percent (:current/:total,:eta)")
),
clear = clear, clear = clear,
total = n total = n
) )

48
R/ab.R
View File

@ -327,7 +327,6 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
# More uncertain results ---- # More uncertain results ----
if (fast_mode == FALSE) { if (fast_mode == FALSE) {
ab_df <- AMR_env$AB_lookup ab_df <- AMR_env$AB_lookup
ab_df$length_name <- nchar(ab_df$generalised_name) ab_df$length_name <- nchar(ab_df$generalised_name)
# now retrieve Levensthein distance for name, synonyms, and translated names # 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, ignore.case = FALSE,
fixed = TRUE, fixed = TRUE,
costs = c(insertions = 1, deletions = 1, substitutions = 2), costs = c(insertions = 1, deletions = 1, substitutions = 2),
counts = FALSE)) counts = FALSE
ab_df$lev_syn <- vapply(FUN.VALUE = double(1), ))
ab_df$lev_syn <- vapply(
FUN.VALUE = double(1),
ab_df$generalised_synonyms, ab_df$generalised_synonyms,
function(y) ifelse(length(y[nchar(y) >= 5]) == 0, function(y) {
ifelse(length(y[nchar(y) >= 5]) == 0,
999, 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, fixed = TRUE,
costs = c(insertions = 1, deletions = 1, substitutions = 2), costs = c(insertions = 1, deletions = 1, substitutions = 2),
counts = FALSE)), na.rm = TRUE)), counts = FALSE
USE.NAMES = FALSE) )), na.rm = TRUE)
)
},
USE.NAMES = FALSE
)
if (!is.null(language) && language != "en") { if (!is.null(language) && language != "en") {
ab_df$trans <- generalise_antibiotic_name(translate_AMR(ab_df$name, language = language)) 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, ab_df$lev_trans <- as.double(utils::adist(x[i], ab_df$trans,
ignore.case = FALSE, ignore.case = FALSE,
fixed = TRUE, fixed = TRUE,
costs = c(insertions = 1, deletions = 1, substitutions = 2), costs = c(insertions = 1, deletions = 1, substitutions = 2),
counts = FALSE)) counts = FALSE
))
} else { } else {
ab_df$lev_trans <- ab_df$lev_name 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( paste0(
'"', x_uncertain, '" (assumed ', '"', 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), 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)], ")"), ", ", AMR_env$ab_previously_coerced$ab[which(AMR_env$ab_previously_coerced$x_bak %in% x_uncertain)], ")"
quotes = FALSE) ),
quotes = FALSE
)
} else { } else {
examples <- paste0(nr2char(length(x_uncertain)), " antimicrobials") examples <- paste0(nr2char(length(x_uncertain)), " antimicrobials")
} }
message_("Antimicrobial translation was uncertain for ", examples, message_(
". If required, use `add_custom_antimicrobials()` to add custom entries.") "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! # add the names to the drugs as mouse-over!
if (tryCatch(isTRUE(getExportedValue("ansi_has_hyperlink_support", ns = asNamespace("cli"))()), error = function(e) FALSE)) { 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)])), out[!is.na(x)] <- font_url(
txt = out[!is.na(x)]) 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) create_pillar_column(out, align = "left", min_width = 4)
@ -494,12 +508,14 @@ type_sum.ab <- function(x, ...) {
print.ab <- function(x, ...) { print.ab <- function(x, ...) {
if (!is.null(attributes(x)$amr_selector)) { if (!is.null(attributes(x)$amr_selector)) {
function_name <- 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(", function_name, "())\n",
" ", AMR_env$bullet_icon, " your_data %>% select(column_a, column_b, ", 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 %>% filter(any(", function_name, "() == \"R\"))\n",
" ", AMR_env$bullet_icon, " your_data[, ", function_name, "()]\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") cat("Class 'ab'\n")
print(as.character(x), quote = FALSE) print(as.character(x), quote = FALSE)

108
R/amr_selectors.R
View File

@ -231,57 +231,6 @@
#' dt[any(carbapenems() == "S"), penicillins(), with = FALSE] #' 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, ...) { 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_sir_columns, allow_class = "logical", has_length = 1)
meet_criteria(only_treatable, 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 #' @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. #' @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 #' @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, ...) { administrable_per_os <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1) meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
meet_criteria(return_all, 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, only_sir_columns = only_sir_columns,
sort = FALSE, sort = FALSE,
fn = function_name, fn = function_name,
return_all = return_all) return_all = return_all
)
} }
# untreatable drugs # untreatable drugs
@ -772,7 +773,8 @@ amr_select_exec <- function(function_name,
#' @noRd #' @noRd
print.amr_selector <- function(x, ...) { 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`.", 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") cat("Class 'amr_selector'\n")
print(as.character(x), quote = FALSE) print(as.character(x), quote = FALSE)
} }

96
R/antibiogram.R
View File

@ -307,12 +307,14 @@
#' antibiogram(example_isolates, #' antibiogram(example_isolates,
#' antibiotics = aminoglycosides(), #' antibiotics = aminoglycosides(),
#' ab_transform = "atc", #' ab_transform = "atc",
#' mo_transform = "gramstain") #' mo_transform = "gramstain"
#' )
#' #'
#' antibiogram(example_isolates, #' antibiogram(example_isolates,
#' antibiotics = carbapenems(), #' antibiotics = carbapenems(),
#' ab_transform = "name", #' ab_transform = "name",
#' mo_transform = "name") #' mo_transform = "name"
#' )
#' #'
#' #'
#' # Combined antibiogram ------------------------------------------------- #' # Combined antibiogram -------------------------------------------------
@ -320,14 +322,16 @@
#' # combined antibiotics yield higher empiric coverage #' # combined antibiotics yield higher empiric coverage
#' antibiogram(example_isolates, #' antibiogram(example_isolates,
#' antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"), #' antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
#' mo_transform = "gramstain") #' mo_transform = "gramstain"
#' )
#' #'
#' # names of antibiotics do not need to resemble columns exactly: #' # names of antibiotics do not need to resemble columns exactly:
#' antibiogram(example_isolates, #' antibiogram(example_isolates,
#' antibiotics = c("Cipro", "cipro + genta"), #' antibiotics = c("Cipro", "cipro + genta"),
#' mo_transform = "gramstain", #' mo_transform = "gramstain",
#' ab_transform = "name", #' ab_transform = "name",
#' sep = " & ") #' sep = " & "
#' )
#' #'
#' #'
#' # Syndromic antibiogram ------------------------------------------------ #' # Syndromic antibiogram ------------------------------------------------
@ -335,7 +339,8 @@
#' # the data set could contain a filter for e.g. respiratory specimens #' # the data set could contain a filter for e.g. respiratory specimens
#' antibiogram(example_isolates, #' antibiogram(example_isolates,
#' antibiotics = c(aminoglycosides(), carbapenems()), #' antibiotics = c(aminoglycosides(), carbapenems()),
#' syndromic_group = "ward") #' syndromic_group = "ward"
#' )
#' #'
#' # now define a data set with only E. coli #' # now define a data set with only E. coli
#' ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ] #' ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ]
@ -348,7 +353,8 @@
#' syndromic_group = ifelse(ex1$ward == "ICU", #' syndromic_group = ifelse(ex1$ward == "ICU",
#' "UCI", "No UCI" #' "UCI", "No UCI"
#' ), #' ),
#' language = "es") #' language = "es"
#' )
#' #'
#' #'
#' # WISCA antibiogram ---------------------------------------------------- #' # WISCA antibiogram ----------------------------------------------------
@ -357,7 +363,8 @@
#' antibiogram(example_isolates, #' antibiogram(example_isolates,
#' antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"), #' antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
#' syndromic_group = "ward", #' syndromic_group = "ward",
#' wisca = TRUE) #' wisca = TRUE
#' )
#' #'
#' #'
#' # Print the output for R Markdown / Quarto ----------------------------- #' # Print the output for R Markdown / Quarto -----------------------------
@ -365,7 +372,8 @@
#' ureido <- antibiogram(example_isolates, #' ureido <- antibiogram(example_isolates,
#' antibiotics = ureidopenicillins(), #' antibiotics = ureidopenicillins(),
#' syndromic_group = "ward", #' syndromic_group = "ward",
#' wisca = TRUE) #' wisca = TRUE
#' )
#' #'
#' # in an Rmd file, you would just need to return `ureido` in a chunk, #' # in an Rmd file, you would just need to return `ureido` in a chunk,
#' # but to be explicit here: #' # but to be explicit here:
@ -378,11 +386,13 @@
#' #'
#' ab1 <- antibiogram(example_isolates, #' ab1 <- antibiogram(example_isolates,
#' antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"), #' antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
#' mo_transform = "gramstain") #' mo_transform = "gramstain"
#' )
#' ab2 <- antibiogram(example_isolates, #' ab2 <- antibiogram(example_isolates,
#' antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"), #' antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
#' mo_transform = "gramstain", #' mo_transform = "gramstain",
#' syndromic_group = "ward") #' syndromic_group = "ward"
#' )
#' #'
#' if (requireNamespace("ggplot2")) { #' if (requireNamespace("ggplot2")) {
#' ggplot2::autoplot(ab1) #' ggplot2::autoplot(ab1)
@ -639,12 +649,14 @@ antibiogram.default <- function(x,
} }
long_numeric <- out %pm>% long_numeric <- out %pm>%
pm_summarise(coverage = p_susceptible, pm_summarise(
coverage = p_susceptible,
lower_ci = lower_ci, lower_ci = lower_ci,
upper_ci = upper_ci, upper_ci = upper_ci,
n_total = n_total, n_total = n_total,
n_tested = n_tested, n_tested = n_tested,
n_susceptible = n_susceptible) n_susceptible = n_susceptible
)
wisca_parameters <- data.frame() wisca_parameters <- data.frame()
@ -660,12 +672,14 @@ antibiogram.default <- function(x,
pm_group_by(ab) pm_group_by(ab)
} }
out_wisca <- out_wisca %pm>% out_wisca <- out_wisca %pm>%
pm_summarise(coverage = NA_real_, pm_summarise(
coverage = NA_real_,
lower_ci = NA_real_, lower_ci = NA_real_,
upper_ci = NA_real_, upper_ci = NA_real_,
n_total = sum(n_total, na.rm = TRUE), n_total = sum(n_total, na.rm = TRUE),
n_tested = sum(n_tested, 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 out_wisca$p_susceptible <- out_wisca$n_susceptible / out_wisca$n_tested
if (isTRUE(has_syndromic_group)) { if (isTRUE(has_syndromic_group)) {
@ -688,17 +702,19 @@ antibiogram.default <- function(x,
out_current <- out[i, , drop = FALSE] out_current <- out[i, , drop = FALSE]
priors <- calculate_priors(out_current, combine_SI = combine_SI) priors <- calculate_priors(out_current, combine_SI = combine_SI)
out$gamma_posterior[i] = priors$gamma_posterior out$gamma_posterior[i] <- priors$gamma_posterior
out$beta_posterior1[i] = priors$beta_posterior_1 out$beta_posterior1[i] <- priors$beta_posterior_1
out$beta_posterior2[i] = priors$beta_posterior_2 out$beta_posterior2[i] <- priors$beta_posterior_2
} }
wisca_parameters <- out 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, n_min = 25,
print = info, 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)) on.exit(close(progress))
# run WISCA # run WISCA
@ -930,7 +946,8 @@ antibiogram.default <- function(x,
conf_interval = conf_interval, conf_interval = conf_interval,
formatting_type = formatting_type, formatting_type = formatting_type,
wisca_parameters = as_original_data_class(wisca_parameters, class(x)), 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 rownames(out) <- NULL
out 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) 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 groups <- attributes(x)$groups
n_groups <- NROW(groups) n_groups <- NROW(groups)
progress <- progress_ticker(n = n_groups, progress <- progress_ticker(
n = n_groups,
n_min = 5, n_min = 5,
print = info, print = info,
title = paste("Calculating AMR for", n_groups, "groups")) title = paste("Calculating AMR for", n_groups, "groups")
)
on.exit(close(progress)) on.exit(close(progress))
out <- NULL out <- NULL
@ -994,7 +1013,8 @@ antibiogram.grouped_df <- function(x,
simulations = simulations, simulations = simulations,
conf_interval = conf_interval, conf_interval = conf_interval,
interval_side = interval_side, interval_side = interval_side,
info = FALSE) info = FALSE
)
new_wisca_parameters <- attributes(new_out)$wisca_parameters new_wisca_parameters <- attributes(new_out)$wisca_parameters
new_long_numeric <- attributes(new_out)$long_numeric new_long_numeric <- attributes(new_out)$long_numeric
@ -1045,7 +1065,8 @@ antibiogram.grouped_df <- function(x,
conf_interval = conf_interval, conf_interval = conf_interval,
formatting_type = formatting_type, formatting_type = formatting_type,
wisca_parameters = as_original_data_class(wisca_parameters, class(x)), 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 rownames(out) <- NULL
out out
} }
@ -1069,7 +1090,8 @@ wisca <- function(x,
conf_interval = 0.95, conf_interval = 0.95,
interval_side = "two-tailed", interval_side = "two-tailed",
info = interactive()) { info = interactive()) {
antibiogram(x = x, antibiogram(
x = x,
antibiotics = antibiotics, antibiotics = antibiotics,
ab_transform = ab_transform, ab_transform = ab_transform,
mo_transform = NULL, mo_transform = NULL,
@ -1087,7 +1109,8 @@ wisca <- function(x,
simulations = simulations, simulations = simulations,
conf_interval = conf_interval, conf_interval = conf_interval,
interval_side = interval_side, interval_side = interval_side,
info = info) info = info
)
} }
#' @export #' @export
@ -1137,9 +1160,11 @@ tbl_format_footer.antibiogram <- function(x, ...) {
if (NROW(x) == 0) { if (NROW(x) == 0) {
return(footer) 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 ", "# 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 #' @export
@ -1148,7 +1173,8 @@ plot.antibiogram <- function(x, ...) {
df <- attributes(x)$long_numeric df <- attributes(x)$long_numeric
if (!"mo" %in% colnames(df)) { 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.", 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)) { if ("syndromic_group" %in% colnames(df)) {
# barplot in base R does not support facets - paste columns together # barplot in base R does not support facets - paste columns together
@ -1203,7 +1229,8 @@ autoplot.antibiogram <- function(object, ...) {
df <- attributes(object)$long_numeric df <- attributes(object)$long_numeric
if (!"mo" %in% colnames(df)) { 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.", 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, out <- ggplot2::ggplot(df,
mapping = ggplot2::aes( mapping = ggplot2::aes(
@ -1214,7 +1241,8 @@ autoplot.antibiogram <- function(object, ...) {
} else { } else {
NULL NULL
} }
)) + )
) +
ggplot2::geom_col(position = ggplot2::position_dodge2(preserve = "single")) + ggplot2::geom_col(position = ggplot2::position_dodge2(preserve = "single")) +
ggplot2::facet_wrap("mo") + ggplot2::facet_wrap("mo") +
ggplot2::labs( ggplot2::labs(
@ -1228,9 +1256,11 @@ autoplot.antibiogram <- function(object, ...) {
) )
if (isTRUE(attributes(object)$wisca)) { if (isTRUE(attributes(object)$wisca)) {
out <- out + 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"), position = ggplot2::position_dodge2(preserve = "single"),
width = 0.5) width = 0.5
)
} }
out out
} }

6
R/bug_drug_combinations.R
View File

@ -127,13 +127,15 @@ bug_drug_combinations <- function(x,
# turn and merge everything # turn and merge everything
pivot <- lapply(x_mo_filter, function(x) { pivot <- lapply(x_mo_filter, function(x) {
m <- as.matrix(table(as.sir(x), useNA = "always")) m <- as.matrix(table(as.sir(x), useNA = "always"))
data.frame(S = m["S", ], data.frame(
S = m["S", ],
SDD = m["SDD", ], SDD = m["SDD", ],
I = m["I", ], I = m["I", ],
R = m["R", ], R = m["R", ],
NI = m["NI", ], NI = m["NI", ],
na = m[which(is.na(rownames(m))), ], na = m[which(is.na(rownames(m))), ],
stringsAsFactors = FALSE) stringsAsFactors = FALSE
)
}) })
merged <- do.call(rbind_AMR, pivot) merged <- do.call(rbind_AMR, pivot)
out_group <- data.frame( out_group <- data.frame(

6
R/custom_eucast_rules.R
View File

@ -178,8 +178,10 @@ custom_eucast_rules <- function(...) {
result_group[j] <- paste0(result_group[j], "s") result_group[j] <- paste0(result_group[j], "s")
} }
if (paste0("AB_", toupper(result_group[j])) %in% DEFINED_AB_GROUPS) { if (paste0("AB_", toupper(result_group[j])) %in% DEFINED_AB_GROUPS) {
result_group_agents <- c(result_group_agents, result_group_agents <- c(
eval(parse(text = paste0("AB_", toupper(result_group[j]))), envir = asNamespace("AMR"))) result_group_agents,
eval(parse(text = paste0("AB_", toupper(result_group[j]))), envir = asNamespace("AMR"))
)
} else { } else {
out_group <- tryCatch( out_group <- tryCatch(
suppressWarnings(as.ab(result_group[j], suppressWarnings(as.ab(result_group[j],

21
R/custom_microorganisms.R
View File

@ -252,8 +252,11 @@ add_custom_microorganisms <- function(x) {
paste(abbreviate_mo(x$genus, 5), paste(abbreviate_mo(x$genus, 5),
abbreviate_mo(x$species, 4, hyphen_as_space = TRUE), abbreviate_mo(x$species, 4, hyphen_as_space = TRUE),
abbreviate_mo(x$subspecies, 4, hyphen_as_space = TRUE), abbreviate_mo(x$subspecies, 4, hyphen_as_space = TRUE),
sep = "_"), sep = "_"
whitespace = "_")) ),
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") 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 ---- # add to package ----
@ -309,19 +312,25 @@ abbreviate_mo <- function(x, minlength = 5, prefix = "", hyphen_as_space = FALSE
} }
# keep a starting Latin ae # keep a starting Latin ae
suppressWarnings( suppressWarnings(
gsub("(\u00C6|\u00E6)+", gsub(
"(\u00C6|\u00E6)+",
"AE", "AE",
toupper( toupper(
paste0(prefix, paste0(
prefix,
abbreviate( abbreviate(
gsub("^ae", gsub("^ae",
"\u00E6\u00E6", "\u00E6\u00E6",
x, x,
ignore.case = TRUE), ignore.case = TRUE
),
minlength = minlength, minlength = minlength,
use.classes = TRUE, use.classes = TRUE,
method = "both.sides", method = "both.sides",
... ...
)))) )
)
)
)
) )
} }

6
R/eucast_rules.R
View File

@ -462,10 +462,12 @@ eucast_rules <- function(x,
if (isTRUE(info)) { if (isTRUE(info)) {
cat(paste0("\n", font_grey(strrep("-", 0.95 * getOption("width", 100))), "\n")) cat(paste0("\n", font_grey(strrep("-", 0.95 * getOption("width", 100))), "\n"))
cat(word_wrap( cat(word_wrap(
paste0("Rules by the ", paste0(
"Rules by the ",
font_bold(paste0("AMR package v", utils::packageDescription("AMR")$Version)), font_bold(paste0("AMR package v", utils::packageDescription("AMR")$Version)),
" (", format(as.Date(utils::packageDescription("AMR")$Date), format = "%Y"), " (", format(as.Date(utils::packageDescription("AMR")$Date), format = "%Y"),
"), see `?eucast_rules`\n") "), see `?eucast_rules`\n"
)
)) ))
cat("\n\n") cat("\n\n")
} }

25
R/first_isolate.R
View File

@ -517,7 +517,8 @@ first_isolate <- function(x = NULL,
if (icu_exclude == TRUE) { if (icu_exclude == TRUE) {
if (isTRUE(info)) { 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.", 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 x[which(x$newvar_is_icu), "newvar_first_isolate"] <- FALSE
} else if (isTRUE(info)) { } else if (isTRUE(info)) {
@ -673,10 +674,12 @@ duplicated_antibiogram <- function(antibiogram, points_threshold, ignore_I, type
return(FALSE) return(FALSE)
} }
# first sort on data availability - count the dots and order that ascending so that highest availability of SIR is on top # 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, antibiogram,
function(x) sum(strsplit(x, "", fixed = TRUE)[[1]] == "."), function(x) sum(strsplit(x, "", fixed = TRUE)[[1]] == "."),
USE.NAMES = FALSE) USE.NAMES = FALSE
)
new_order <- order(number_dots, antibiogram) new_order <- order(number_dots, antibiogram)
antibiogram.bak <- antibiogram antibiogram.bak <- antibiogram
antibiogram <- antibiogram[new_order] antibiogram <- antibiogram[new_order]
@ -685,7 +688,8 @@ duplicated_antibiogram <- function(antibiogram, points_threshold, ignore_I, type
out[1] <- FALSE out[1] <- FALSE
out[2] <- antimicrobials_equal(antibiogram[1], antibiogram[2], out[2] <- antimicrobials_equal(antibiogram[1], antibiogram[2],
ignore_I = ignore_I, points_threshold = points_threshold, ignore_I = ignore_I, points_threshold = points_threshold,
type = type) type = type
)
if (length(antibiogram) == 2) { if (length(antibiogram) == 2) {
# fast return, no further check required # fast return, no further check required
return(out) return(out)
@ -702,11 +706,18 @@ duplicated_antibiogram <- function(antibiogram, points_threshold, ignore_I, type
for (na in antibiogram[is.na(out)]) { for (na in antibiogram[is.na(out)]) {
# check if this antibiogram has any change with other antibiograms # check if this antibiogram has any change with other antibiograms
out[which(antibiogram == na)] <- all( out[which(antibiogram == na)] <- all(
vapply(FUN.VALUE = logical(1), vapply(
FUN.VALUE = logical(1),
antibiogram[!is.na(out) & antibiogram != na], 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, ignore_I = ignore_I, points_threshold = points_threshold,
type = type))) type = type
)
}
)
)
} }
out <- out[order(new_order)] out <- out[order(new_order)]

6
R/ggplot_sir.R
View File

@ -121,8 +121,10 @@
#' ) %>% #' ) %>%
#' ggplot() + #' ggplot() +
#' geom_col(aes(x = x, y = y, fill = z)) + #' geom_col(aes(x = x, y = y, fill = z)) +
#' scale_sir_colours(aesthetics = "fill", #' scale_sir_colours(
#' Value4 = "S", Value5 = "I", Value6 = "R") #' aesthetics = "fill",
#' Value4 = "S", Value5 = "I", Value6 = "R"
#' )
#' } #' }
#' if (require("ggplot2") && require("dplyr")) { #' if (require("ggplot2") && require("dplyr")) {
#' # resistance of ciprofloxacine per age group #' # resistance of ciprofloxacine per age group

6
R/mdro.R
View File

@ -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[!rows %in% c(rows_affected, rows_to_change)]
rows_not_to_change <- rows_not_to_change[is.na(x[rows_not_to_change, "reason"])] rows_not_to_change <- rows_not_to_change[is.na(x[rows_not_to_change, "reason"])]
if (is.null(reason)) { if (is.null(reason)) {
reason <- paste0(any_all, reason <- paste0(
any_all,
" of the required antibiotics ", " of the required antibiotics ",
ifelse(any_all == "any", "is", "are"), ifelse(any_all == "any", "is", "are"),
" R", " R",
ifelse(!isTRUE(combine_SI), " or I", "")) ifelse(!isTRUE(combine_SI), " or I", "")
)
} }
x[rows_to_change, "MDRO"] <<- to x[rows_to_change, "MDRO"] <<- to
x[rows_to_change, "reason"] <<- reason x[rows_to_change, "reason"] <<- reason

36
R/mic.R
View File

@ -39,18 +39,22 @@ VALID_MIC_LEVELS <- c(
) )
VALID_MIC_LEVELS <- trimws(gsub("[.]?0+$", "", format(unique(sort(VALID_MIC_LEVELS)), scientific = FALSE), perl = TRUE)) VALID_MIC_LEVELS <- trimws(gsub("[.]?0+$", "", format(unique(sort(VALID_MIC_LEVELS)), scientific = FALSE), perl = TRUE))
operators <- c("<", "<=", "", ">=", ">") 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("<", "<=", "", ">=", ">"), c("<", "<=", "", ">=", ">"),
paste0, paste0,
VALID_MIC_LEVELS))) VALID_MIC_LEVELS
COMMON_MIC_VALUES <- c(0.0001, 0.0002, 0.0005, )))
COMMON_MIC_VALUES <- c(
0.0001, 0.0002, 0.0005,
0.001, 0.002, 0.004, 0.008, 0.001, 0.002, 0.004, 0.008,
0.016, 0.032, 0.064, 0.016, 0.032, 0.064,
0.125, 0.25, 0.5, 0.125, 0.25, 0.5,
1, 2, 4, 8, 1, 2, 4, 8,
16, 32, 64, 16, 32, 64,
128, 256, 512, 128, 256, 512,
1024, 2048, 4096) 1024, 2048, 4096
)
#' Transform Input to Minimum Inhibitory Concentrations (MIC) #' 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)) { if (!identical(levels(x), VALID_MIC_LEVELS)) {
# might be from an older AMR version - just update MIC factor 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), 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) 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), 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 #' @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)) { } else if (is.mic(mic_range)) {
mic_range <- as.character(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. ", "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), ". ", "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) x <- as.mic(x)
if (is.null(mic_range)) { 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, expanded <- plotrange_as_table(x,
expand = TRUE, expand = TRUE,
keep_operators = ifelse(keep_operators == "edges", "none", keep_operators), keep_operators = ifelse(keep_operators == "edges", "none", keep_operators),
mic_range = mic_range) mic_range = mic_range
)
if (keep_operators == "edges") { if (keep_operators == "edges") {
names(expanded)[1] <- paste0("<=", names(expanded)[1]) names(expanded)[1] <- paste0("<=", names(expanded)[1])
names(expanded)[length(expanded)] <- paste0(">=", names(expanded)[length(expanded)]) 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 # MICs contain all MIC levels, so strip this to only existing levels and their intermediate values
out <- factor(names(expanded), out <- factor(names(expanded),
levels = names(expanded), levels = names(expanded),
ordered = TRUE) ordered = TRUE
)
# and only keep the ones in the data # and only keep the ones in the data
if (keep_operators == "edges") { if (keep_operators == "edges") {
out <- out[match(x, as.double(as.mic(out, keep_operators = "all")))] 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, ...) { pillar_shaft.mic <- function(x, ...) {
if (!identical(levels(x), VALID_MIC_LEVELS) && message_not_thrown_before("pillar_shaft.mic")) { 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", 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) crude_numbers <- as.double(x)
operators <- gsub("[^<=>]+", "", as.character(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: # NextMethod() cannot be called from an anonymous function (`...`), so we get() the generic directly:
fn <- get(.Generic, envir = .GenericCallEnv) fn <- get(.Generic, envir = .GenericCallEnv)
fn(as.double(c(...)), fn(as.double(c(...)),
na.rm = na.rm) na.rm = na.rm
)
} }

25
R/mo.R
View File

@ -594,9 +594,11 @@ mo_reset_session <- function() {
#' @rdname as.mo #' @rdname as.mo
#' @export #' @export
mo_cleaning_regex <- function() { 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]*", "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( paste0(
"(", "(",
@ -605,7 +607,8 @@ mo_cleaning_regex <- function() {
"([({]|\\[).+([})]|\\])", "([({]|\\[).+([})]|\\])",
"|(^| )(", "|(^| )(",
paste0(parts_to_remove[order(1 - nchar(parts_to_remove))], collapse = "|"), paste0(parts_to_remove[order(1 - nchar(parts_to_remove))], collapse = "|"),
"))") "))"
)
} }
# UNDOCUMENTED METHODS ---------------------------------------------------- # UNDOCUMENTED METHODS ----------------------------------------------------
@ -660,9 +663,13 @@ pillar_shaft.mo <- function(x, ...) {
# add the names to the bugs as mouse-over! # add the names to the bugs as mouse-over!
if (tryCatch(isTRUE(getExportedValue("ansi_has_hyperlink_support", ns = asNamespace("cli"))()), error = function(e) FALSE)) { 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)], ": ", out[!x %in% c("UNKNOWN", NA)] <- font_url(
mo_name(x[!x %in% c("UNKNOWN", NA)], keep_synonyms = TRUE)), url = paste0(
txt = out[!x %in% c("UNKNOWN", NA)]) 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 # make it always fit exactly
@ -1277,8 +1284,10 @@ repair_reference_df <- function(reference_df) {
} }
get_mo_uncertainties <- function() { get_mo_uncertainties <- function() {
remember <- list(uncertainties = AMR_env$mo_uncertainties, remember <- list(
failures = AMR_env$mo_failures) uncertainties = AMR_env$mo_uncertainties,
failures = AMR_env$mo_failures
)
# empty them, otherwise e.g. mo_shortname("Chlamydophila psittaci") will give 3 notes # empty them, otherwise e.g. mo_shortname("Chlamydophila psittaci") will give 3 notes
AMR_env$mo_uncertainties <- NULL AMR_env$mo_uncertainties <- NULL
AMR_env$mo_failures <- NULL AMR_env$mo_failures <- NULL

20
R/mo_property.R
View File

@ -108,10 +108,12 @@
#' mo_url("Klebsiella pneumoniae") #' mo_url("Klebsiella pneumoniae")
#' mo_is_yeast(c("Candida", "Trichophyton", "Klebsiella")) #' 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 C",
#' "Streptococcus group G", #' "Streptococcus group G",
#' "Streptococcus group L")) #' "Streptococcus group L"
#' ))
#' #'
#' #'
#' # scientific reference ----------------------------------------------------- #' # 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)] 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)] 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 == "Fungi" ~ "Potentially pathogenic",
prev == 2 & kngd == "Bacteria" ~ "Non-pathogenic", prev == 2 & kngd == "Bacteria" ~ "Non-pathogenic",
kngd == "Bacteria" ~ "Potentially pathogenic", kngd == "Bacteria" ~ "Potentially pathogenic",
TRUE ~ "Unknown"), TRUE ~ "Unknown"
),
levels = c("Pathogenic", "Potentially pathogenic", "Non-pathogenic", "Unknown"), levels = c("Pathogenic", "Potentially pathogenic", "Non-pathogenic", "Unknown"),
ordered = TRUE ordered = TRUE
) )
@ -872,8 +877,10 @@ mo_info <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("A
info <- lapply(x, function(y) { info <- lapply(x, function(y) {
c( c(
list(mo = as.character(y), list(
rank = mo_rank(y, language = language, keep_synonyms = keep_synonyms)), mo = as.character(y),
rank = mo_rank(y, language = language, keep_synonyms = keep_synonyms)
),
mo_taxonomy(y, language = language, keep_synonyms = keep_synonyms), mo_taxonomy(y, language = language, keep_synonyms = keep_synonyms),
list( list(
status = mo_status(y, language = language, keep_synonyms = keep_synonyms), 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 { } else {
x <- AMR_env$MO_lookup[[property]][match(x, AMR_env$MO_lookup$mo)] x <- AMR_env$MO_lookup[[property]][match(x, AMR_env$MO_lookup$mo)]
} }
} else { } else {
# get microorganisms data set, but remove synonyms if keep_synonyms is FALSE # 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] 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
View File

@ -80,7 +80,6 @@
#' some_disk_values <- random_disk(size = 100, mo = "Escherichia coli", ab = "cipro") #' 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)) #' some_sir_values <- random_sir(50, prob_SIR = c(0.55, 0.05, 0.30))
#' #'
#'
#' \donttest{ #' \donttest{
#' # Plotting using ggplot2's autoplot() for MIC, disk, and SIR ----------- #' # Plotting using ggplot2's autoplot() for MIC, disk, and SIR -----------
#' if (require("ggplot2")) { #' if (require("ggplot2")) {
@ -92,17 +91,23 @@
#' } #' }
#' if (require("ggplot2")) { #' if (require("ggplot2")) {
#' # support for 20 languages, various guidelines, and many options #' # 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", #' guideline = "CLSI 2024", language = "no",
#' title = "Disk diffusion from the North") #' title = "Disk diffusion from the North"
#' )
#' } #' }
#' #'
#' #'
#' # Plotting using scale_x_mic() ----------------------------------------- #' # Plotting using scale_x_mic() -----------------------------------------
#' if (require("ggplot2")) { #' if (require("ggplot2")) {
#' mic_plot <- ggplot(data.frame(mics = as.mic(c(0.25, "<=4", 4, 8, 32, ">=32")), #' mic_plot <- ggplot(
#' counts = c(1, 1, 2, 2, 3, 3)), #' data.frame(
#' aes(mics, counts)) + #' mics = as.mic(c(0.25, "<=4", 4, 8, 32, ">=32")),
#' counts = c(1, 1, 2, 2, 3, 3)
#' ),
#' aes(mics, counts)
#' ) +
#' geom_col() #' geom_col()
#' mic_plot + #' mic_plot +
#' labs(title = "without scale_x_mic()") #' labs(title = "without scale_x_mic()")
@ -133,17 +138,25 @@
#' some_groups <- sample(LETTERS[1:5], 20, replace = TRUE) #' some_groups <- sample(LETTERS[1:5], 20, replace = TRUE)
#' #'
#' if (require("ggplot2")) { #' if (require("ggplot2")) {
#' ggplot(data.frame(mic = some_mic_values, #' ggplot(
#' group = some_groups), #' data.frame(
#' aes(group, mic)) + #' mic = some_mic_values,
#' group = some_groups
#' ),
#' aes(group, mic)
#' ) +
#' geom_boxplot() + #' geom_boxplot() +
#' geom_violin(linetype = 2, colour = "grey", fill = NA) + #' geom_violin(linetype = 2, colour = "grey", fill = NA) +
#' scale_y_mic() #' scale_y_mic()
#' } #' }
#' if (require("ggplot2")) { #' if (require("ggplot2")) {
#' ggplot(data.frame(mic = some_mic_values, #' ggplot(
#' group = some_groups), #' data.frame(
#' aes(group, mic)) + #' mic = some_mic_values,
#' group = some_groups
#' ),
#' aes(group, mic)
#' ) +
#' geom_boxplot() + #' geom_boxplot() +
#' geom_violin(linetype = 2, colour = "grey", fill = NA) + #' geom_violin(linetype = 2, colour = "grey", fill = NA) +
#' scale_y_mic(mic_range = c(NA, 0.25)) #' scale_y_mic(mic_range = c(NA, 0.25))
@ -152,9 +165,13 @@
#' #'
#' # Plotting using scale_x_sir() ----------------------------------------- #' # Plotting using scale_x_sir() -----------------------------------------
#' if (require("ggplot2")) { #' if (require("ggplot2")) {
#' ggplot(data.frame(x = c("I", "R", "S"), #' ggplot(
#' y = c(45,323, 573)), #' data.frame(
#' aes(x, y)) + #' x = c("I", "R", "S"),
#' y = c(45, 323, 573)
#' ),
#' aes(x, y)
#' ) +
#' geom_col() + #' geom_col() +
#' scale_x_sir() #' scale_x_sir()
#' } #' }
@ -162,12 +179,17 @@
#' #'
#' # Plotting using scale_y_mic() and scale_colour_sir() ------------------ #' # Plotting using scale_y_mic() and scale_colour_sir() ------------------
#' if (require("ggplot2")) { #' if (require("ggplot2")) {
#' plain <- ggplot(data.frame(mic = some_mic_values, #' plain <- ggplot(
#' data.frame(
#' mic = some_mic_values,
#' group = some_groups, #' group = some_groups,
#' sir = as.sir(some_mic_values, #' sir = as.sir(some_mic_values,
#' mo = "E. coli", #' mo = "E. coli",
#' ab = "cipro")), #' ab = "cipro"
#' aes(x = group, y = mic, colour = sir)) + #' )
#' ),
#' aes(x = group, y = mic, colour = sir)
#' ) +
#' theme_minimal() + #' theme_minimal() +
#' geom_boxplot(fill = NA, colour = "grey") + #' geom_boxplot(fill = NA, colour = "grey") +
#' geom_jitter(width = 0.25) #' geom_jitter(width = 0.25)
@ -183,8 +205,10 @@
#' if (require("ggplot2")) { #' if (require("ggplot2")) {
#' plain + #' plain +
#' scale_y_mic(mic_range = c(0.005, 32), name = "Our MICs!") + #' scale_y_mic(mic_range = c(0.005, 32), name = "Our MICs!") +
#' scale_colour_sir(language = "pt", #' scale_colour_sir(
#' name = "Support in 20 languages") #' language = "pt",
#' name = "Support in 20 languages"
#' )
#' } #' }
#' } #' }
#' #'
@ -203,7 +227,8 @@ NULL
create_scale_mic <- function(aest, keep_operators, mic_range = NULL, ...) { create_scale_mic <- function(aest, keep_operators, mic_range = NULL, ...) {
ggplot_fn <- getExportedValue(paste0("scale_", aest, "_continuous"), ggplot_fn <- getExportedValue(paste0("scale_", aest, "_continuous"),
ns = asNamespace("ggplot2")) ns = asNamespace("ggplot2")
)
args <- list(...) args <- list(...)
breaks_set <- args$breaks breaks_set <- args$breaks
limits_set <- args$limits limits_set <- args$limits
@ -338,20 +363,27 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) {
ggplot_fn <- ggplot2::scale_x_discrete ggplot_fn <- ggplot2::scale_x_discrete
} else { } else {
ggplot_fn <- ggplot2::scale_discrete_manual ggplot_fn <- ggplot2::scale_discrete_manual
args <- c(args, args <- c(
list(aesthetics = aesthetics, args,
values = c(S = colours_SIR[1], list(
aesthetics = aesthetics,
values = c(
S = colours_SIR[1],
SDD = colours_SIR[2], SDD = colours_SIR[2],
I = colours_SIR[2], I = colours_SIR[2],
R = colours_SIR[3], R = colours_SIR[3],
NI = "grey30"))) NI = "grey30"
)
)
)
} }
scale <- do.call(ggplot_fn, args) scale <- do.call(ggplot_fn, args)
scale$labels <- function(x) { scale$labels <- function(x) {
stop_ifnot(all(x %in% c(levels(NA_sir_), NA)), stop_ifnot(all(x %in% c(levels(NA_sir_), NA)),
"Apply `scale_", aesthetics[1], "_sir()` to a variable of class 'sir', see `?as.sir`.", "Apply `scale_", aesthetics[1], "_sir()` to a variable of class 'sir', see `?as.sir`.",
call = FALSE) call = FALSE
)
x <- as.character(as.sir(x)) x <- as.character(as.sir(x))
if (!is.null(language)) { if (!is.null(language)) {
x[x == "S"] <- "(S) Susceptible" x[x == "S"] <- "(S) Susceptible"

109
R/sir.R
View File

@ -198,23 +198,35 @@
#' mutate_if(is.mic, as.sir, #' mutate_if(is.mic, as.sir,
#' mo = "bacteria", #' mo = "bacteria",
#' ab = "antibiotic", #' ab = "antibiotic",
#' guideline = "CLSI") #' guideline = "CLSI"
#' )
#' df_long %>% #' df_long %>%
#' mutate(across(where(is.mic), #' mutate(across(
#' function(x) as.sir(x, #' where(is.mic),
#' function(x) {
#' as.sir(x,
#' mo = "bacteria", #' mo = "bacteria",
#' ab = "antibiotic", #' ab = "antibiotic",
#' guideline = "CLSI"))) #' guideline = "CLSI"
#' )
#' }
#' ))
#' df_wide %>% #' df_wide %>%
#' # given certain columns, e.g. from 'cipro' to 'genta' #' # given certain columns, e.g. from 'cipro' to 'genta'
#' mutate_at(vars(cipro:genta), as.sir, #' mutate_at(vars(cipro:genta), as.sir,
#' mo = "bacteria", #' mo = "bacteria",
#' guideline = "CLSI") #' guideline = "CLSI"
#' )
#' df_wide %>% #' df_wide %>%
#' mutate(across(cipro:genta, #' mutate(across(
#' function(x) as.sir(x, #' cipro:genta,
#' function(x) {
#' as.sir(x,
#' mo = "bacteria", #' mo = "bacteria",
#' guideline = "CLSI"))) #' guideline = "CLSI"
#' )
#' }
#' ))
#' #'
#' # for veterinary breakpoints, add 'host': #' # for veterinary breakpoints, add 'host':
#' df_long$animal_species <- c("cats", "dogs", "horses", "cattle") #' df_long$animal_species <- c("cats", "dogs", "horses", "cattle")
@ -224,36 +236,52 @@
#' mo = "bacteria", #' mo = "bacteria",
#' ab = "antibiotic", #' ab = "antibiotic",
#' host = "animal_species", #' host = "animal_species",
#' guideline = "CLSI") #' guideline = "CLSI"
#' )
#' df_long %>% #' df_long %>%
#' mutate(across(where(is.mic), #' mutate(across(
#' function(x) as.sir(x, #' where(is.mic),
#' function(x) {
#' as.sir(x,
#' mo = "bacteria", #' mo = "bacteria",
#' ab = "antibiotic", #' ab = "antibiotic",
#' host = "animal_species", #' host = "animal_species",
#' guideline = "CLSI"))) #' guideline = "CLSI"
#' )
#' }
#' ))
#' df_wide %>% #' df_wide %>%
#' mutate_at(vars(cipro:genta), as.sir, #' mutate_at(vars(cipro:genta), as.sir,
#' mo = "bacteria", #' mo = "bacteria",
#' ab = "antibiotic", #' ab = "antibiotic",
#' host = "animal_species", #' host = "animal_species",
#' guideline = "CLSI") #' guideline = "CLSI"
#' )
#' df_wide %>% #' df_wide %>%
#' mutate(across(cipro:genta, #' mutate(across(
#' function(x) as.sir(x, #' cipro:genta,
#' function(x) {
#' as.sir(x,
#' mo = "bacteria", #' mo = "bacteria",
#' host = "animal_species", #' host = "animal_species",
#' guideline = "CLSI"))) #' guideline = "CLSI"
#' )
#' }
#' ))
#' #'
#' # to include information about urinary tract infections (UTI) #' # to include information about urinary tract infections (UTI)
#' data.frame(mo = "E. coli", #' data.frame(
#' mo = "E. coli",
#' nitrofuratoin = c("<= 2", 32), #' nitrofuratoin = c("<= 2", 32),
#' from_the_bladder = c(TRUE, FALSE)) %>% #' from_the_bladder = c(TRUE, FALSE)
#' ) %>%
#' as.sir(uti = "from_the_bladder") #' as.sir(uti = "from_the_bladder")
#' #'
#' data.frame(mo = "E. coli", #' data.frame(
#' mo = "E. coli",
#' nitrofuratoin = c("<= 2", 32), #' nitrofuratoin = c("<= 2", 32),
#' specimen = c("urine", "blood")) %>% #' specimen = c("urine", "blood")
#' ) %>%
#' as.sir() # automatically determines urine isolates #' as.sir() # automatically determines urine isolates
#' #'
#' df_wide %>% #' df_wide %>%
@ -326,16 +354,19 @@ as_sir_structure <- function(x,
method = NULL, method = NULL,
ref_tbl = NULL, ref_tbl = NULL,
ref_breakpoints = 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"), levels = c("S", "SDD", "I", "R", "NI"),
ordered = TRUE), ordered = TRUE
),
guideline = guideline, guideline = guideline,
mo = mo, mo = mo,
ab = ab, ab = ab,
method = method, method = method,
ref_tbl = ref_tbl, ref_tbl = ref_tbl,
ref_breakpoints = ref_breakpoints, ref_breakpoints = ref_breakpoints,
class = c("sir", "ordered", "factor")) class = c("sir", "ordered", "factor")
)
} }
#' @rdname as.sir #' @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 <- generalise_antibiotic_name(ab) == generalise_antibiotic_name(agent_name)
same_ab.bak <- generalise_antibiotic_name(ab.bak) == 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] <- 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], " (", 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], agent_name[!same_ab.bak & !same_ab],
")") ")"
)
# this intro text will also be printed in the progress bar if the `progress` package is installed # 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))), ifelse(length(unique(agent_formatted)) == 1, unique(agent_formatted), paste0(vector_and(agent_formatted, quotes = FALSE, sort = FALSE))),
mo_var_found, mo_var_found,
ifelse(identical(reference_data, AMR::clinical_breakpoints), ifelse(identical(reference_data, AMR::clinical_breakpoints),
paste0(", ", font_bold(guideline_coerced)), paste0(", ", font_bold(guideline_coerced)),
""), ""
"... ") ),
"... "
)
# prepare used arguments ---- # prepare used arguments ----
method <- method_short method <- method_short
@ -1203,9 +1240,12 @@ as_sir_method <- function(method_short,
# apparently no breakpoints found # apparently no breakpoints found
message( message(
paste0(font_rose_bg(" WARNING "), "\n"), 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))), 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) load_mo_uncertainties(metadata_mo)
return(rep(NA_sir_, nrow(df))) return(rep(NA_sir_, nrow(df)))
@ -1331,20 +1371,17 @@ as_sir_method <- function(method_short,
# vancomycin can take human breakpoints in these hosts # vancomycin can take human breakpoints in these hosts
breakpoints_current <- breakpoints_current %pm>% subset(host == "human") 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.")) 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")) { } 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 # dog breakpoints if no canine/feline
# TODO do we still have dogs breakpoints at this point??? # TODO do we still have dogs breakpoints at this point???
breakpoints_current <- breakpoints_current %pm>% subset(host == "human") # WRONG 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.")) notes_current <- c(notes_current, paste0("Using ", font_bold("human"), " breakpoints for ", mo_formatted, " based on CLSI VET09."))
} else { } else {
# no specific CLSI solution for this, so only filter on current host (if no breakpoints available -> too bad) # no specific CLSI solution for this, so only filter on current host (if no breakpoints available -> too bad)
breakpoints_current <- breakpoints_current %pm>% breakpoints_current <- breakpoints_current %pm>%
subset(host == host_current) subset(host == host_current)
} }
} }
} }
if (NROW(breakpoints_current) == 0) { 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 # this will put UTI = FALSE first, then UTI = NA, then UTI = TRUE
pm_mutate(uti_index = ifelse(!is.na(uti) & uti == FALSE, 1, pm_mutate(uti_index = ifelse(!is.na(uti) & uti == FALSE, 1,
ifelse(is.na(uti), 2, ifelse(is.na(uti), 2,
3))) %pm>% 3
)
)) %pm>%
# be as specific as possible (i.e. prefer species over genus): # be as specific as possible (i.e. prefer species over genus):
pm_arrange(rank_index, uti_index) pm_arrange(rank_index, uti_index)
} else if (uti_current == TRUE) { } else if (uti_current == TRUE) {

1
R/sir_calc.R
View File

@ -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)) { 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) 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]) data[, i] <- gsub("(I|S|SDD)", "SI", data[, i, drop = TRUE])
} }

9
R/top_n_microorganisms.R
View File

@ -42,15 +42,18 @@
#' @examples #' @examples
#' # filter to the top 3 species: #' # filter to the top 3 species:
#' top_n_microorganisms(example_isolates, #' top_n_microorganisms(example_isolates,
#' n = 3) #' n = 3
#' )
#' #'
#' # filter to any species in the top 5 genera: #' # filter to any species in the top 5 genera:
#' top_n_microorganisms(example_isolates, #' 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: #' # filter to the top 3 species in each of the top 5 genera:
#' top_n_microorganisms(example_isolates, #' 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, ...) { 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(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) meet_criteria(n, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE, is_positive = TRUE)

5
data-raw/_pre_commit_checks.R
View File

@ -627,12 +627,15 @@ suppressMessages(set_AMR_locale("English"))
usethis::ui_info("Checking URLs for redirects") usethis::ui_info("Checking URLs for redirects")
invisible(urlchecker::url_update(".")) 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 ------------------------------------------------------------ # Document pkg ------------------------------------------------------------
usethis::ui_info("Documenting package") usethis::ui_info("Documenting package")
suppressMessages(devtools::document(quiet = TRUE)) suppressMessages(devtools::document(quiet = TRUE))
# Finished ---------------------------------------------------------------- # Finished ----------------------------------------------------------------
usethis::ui_done("All done") usethis::ui_done("All done")
suppressMessages(reset_AMR_locale()) suppressMessages(reset_AMR_locale())

209
data-raw/gpt_training_text_v2.1.1.9160.txt → data-raw/gpt_training_text_v2.1.1.9163.txt
View File

@ -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. 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. 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, antibiogram(example_isolates,
antibiotics = aminoglycosides(), antibiotics = aminoglycosides(),
ab_transform = "atc", ab_transform = "atc",
mo_transform = "gramstain") mo_transform = "gramstain"
)
antibiogram(example_isolates, antibiogram(example_isolates,
antibiotics = carbapenems(), antibiotics = carbapenems(),
ab_transform = "name", ab_transform = "name",
mo_transform = "name") mo_transform = "name"
)
# Combined antibiogram ------------------------------------------------- # Combined antibiogram -------------------------------------------------
@ -1997,14 +1999,16 @@ antibiogram(example_isolates,
# combined antibiotics yield higher empiric coverage # combined antibiotics yield higher empiric coverage
antibiogram(example_isolates, antibiogram(example_isolates,
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"), antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
mo_transform = "gramstain") mo_transform = "gramstain"
)
# names of antibiotics do not need to resemble columns exactly: # names of antibiotics do not need to resemble columns exactly:
antibiogram(example_isolates, antibiogram(example_isolates,
antibiotics = c("Cipro", "cipro + genta"), antibiotics = c("Cipro", "cipro + genta"),
mo_transform = "gramstain", mo_transform = "gramstain",
ab_transform = "name", ab_transform = "name",
sep = " & ") sep = " & "
)
# Syndromic antibiogram ------------------------------------------------ # Syndromic antibiogram ------------------------------------------------
@ -2012,7 +2016,8 @@ antibiogram(example_isolates,
# the data set could contain a filter for e.g. respiratory specimens # the data set could contain a filter for e.g. respiratory specimens
antibiogram(example_isolates, antibiogram(example_isolates,
antibiotics = c(aminoglycosides(), carbapenems()), antibiotics = c(aminoglycosides(), carbapenems()),
syndromic_group = "ward") syndromic_group = "ward"
)
# now define a data set with only E. coli # now define a data set with only E. coli
ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ] ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ]
@ -2025,7 +2030,8 @@ antibiogram(ex1,
syndromic_group = ifelse(ex1$ward == "ICU", syndromic_group = ifelse(ex1$ward == "ICU",
"UCI", "No UCI" "UCI", "No UCI"
), ),
language = "es") language = "es"
)
# WISCA antibiogram ---------------------------------------------------- # WISCA antibiogram ----------------------------------------------------
@ -2034,7 +2040,8 @@ antibiogram(ex1,
antibiogram(example_isolates, antibiogram(example_isolates,
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"), antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
syndromic_group = "ward", syndromic_group = "ward",
wisca = TRUE) wisca = TRUE
)
# Print the output for R Markdown / Quarto ----------------------------- # Print the output for R Markdown / Quarto -----------------------------
@ -2042,7 +2049,8 @@ antibiogram(example_isolates,
ureido <- antibiogram(example_isolates, ureido <- antibiogram(example_isolates,
antibiotics = ureidopenicillins(), antibiotics = ureidopenicillins(),
syndromic_group = "ward", syndromic_group = "ward",
wisca = TRUE) wisca = TRUE
)
# in an Rmd file, you would just need to return `ureido` in a chunk, # in an Rmd file, you would just need to return `ureido` in a chunk,
# but to be explicit here: # but to be explicit here:
@ -2055,11 +2063,13 @@ if (requireNamespace("knitr")) {
ab1 <- antibiogram(example_isolates, ab1 <- antibiogram(example_isolates,
antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"), antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
mo_transform = "gramstain") mo_transform = "gramstain"
)
ab2 <- antibiogram(example_isolates, ab2 <- antibiogram(example_isolates,
antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"), antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
mo_transform = "gramstain", mo_transform = "gramstain",
syndromic_group = "ward") syndromic_group = "ward"
)
if (requireNamespace("ggplot2")) { if (requireNamespace("ggplot2")) {
ggplot2::autoplot(ab1) 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 % Please edit documentation in R/amr_selectors.R
\name{antimicrobial_selectors} \name{antimicrobial_selectors}
\alias{antimicrobial_selectors} \alias{antimicrobial_selectors}
\alias{amr_class}
\alias{amr_selector}
\alias{aminoglycosides} \alias{aminoglycosides}
\alias{aminopenicillins} \alias{aminopenicillins}
\alias{antifungals} \alias{antifungals}
@ -2214,17 +2222,13 @@ THE PART HEREAFTER CONTAINS CONTENTS FROM FILE 'man/antimicrobial_selectors.Rd':
\alias{tetracyclines} \alias{tetracyclines}
\alias{trimethoprims} \alias{trimethoprims}
\alias{ureidopenicillins} \alias{ureidopenicillins}
\alias{amr_class}
\alias{amr_selector}
\alias{administrable_per_os} \alias{administrable_per_os}
\alias{administrable_iv} \alias{administrable_iv}
\alias{not_intrinsic_resistant} \alias{not_intrinsic_resistant}
\title{Antimicrobial Selectors} \title{Antimicrobial Selectors}
\usage{ \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, aminoglycosides(only_sir_columns = FALSE, only_treatable = TRUE,
return_all = TRUE, ...) return_all = TRUE, ...)
@ -2293,6 +2297,12 @@ trimethoprims(only_sir_columns = FALSE, return_all = TRUE, ...)
ureidopenicillins(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_per_os(only_sir_columns = FALSE, return_all = TRUE, ...)
administrable_iv(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, ...) version_expertrules = 3.3, ...)
} }
\arguments{ \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_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})} \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{...}{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{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()}}.} \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_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[=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. 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}{ \section{Full list of supported (antimicrobial) classes}{
@ -3540,23 +3550,35 @@ if (require("dplyr")) {
mutate_if(is.mic, as.sir, mutate_if(is.mic, as.sir,
mo = "bacteria", mo = "bacteria",
ab = "antibiotic", ab = "antibiotic",
guideline = "CLSI") guideline = "CLSI"
)
df_long \%>\% df_long \%>\%
mutate(across(where(is.mic), mutate(across(
function(x) as.sir(x, where(is.mic),
function(x) {
as.sir(x,
mo = "bacteria", mo = "bacteria",
ab = "antibiotic", ab = "antibiotic",
guideline = "CLSI"))) guideline = "CLSI"
)
}
))
df_wide \%>\% df_wide \%>\%
# given certain columns, e.g. from 'cipro' to 'genta' # given certain columns, e.g. from 'cipro' to 'genta'
mutate_at(vars(cipro:genta), as.sir, mutate_at(vars(cipro:genta), as.sir,
mo = "bacteria", mo = "bacteria",
guideline = "CLSI") guideline = "CLSI"
)
df_wide \%>\% df_wide \%>\%
mutate(across(cipro:genta, mutate(across(
function(x) as.sir(x, cipro:genta,
function(x) {
as.sir(x,
mo = "bacteria", mo = "bacteria",
guideline = "CLSI"))) guideline = "CLSI"
)
}
))
# for veterinary breakpoints, add 'host': # for veterinary breakpoints, add 'host':
df_long$animal_species <- c("cats", "dogs", "horses", "cattle") df_long$animal_species <- c("cats", "dogs", "horses", "cattle")
@ -3566,36 +3588,52 @@ if (require("dplyr")) {
mo = "bacteria", mo = "bacteria",
ab = "antibiotic", ab = "antibiotic",
host = "animal_species", host = "animal_species",
guideline = "CLSI") guideline = "CLSI"
)
df_long \%>\% df_long \%>\%
mutate(across(where(is.mic), mutate(across(
function(x) as.sir(x, where(is.mic),
function(x) {
as.sir(x,
mo = "bacteria", mo = "bacteria",
ab = "antibiotic", ab = "antibiotic",
host = "animal_species", host = "animal_species",
guideline = "CLSI"))) guideline = "CLSI"
)
}
))
df_wide \%>\% df_wide \%>\%
mutate_at(vars(cipro:genta), as.sir, mutate_at(vars(cipro:genta), as.sir,
mo = "bacteria", mo = "bacteria",
ab = "antibiotic", ab = "antibiotic",
host = "animal_species", host = "animal_species",
guideline = "CLSI") guideline = "CLSI"
)
df_wide \%>\% df_wide \%>\%
mutate(across(cipro:genta, mutate(across(
function(x) as.sir(x, cipro:genta,
function(x) {
as.sir(x,
mo = "bacteria", mo = "bacteria",
host = "animal_species", host = "animal_species",
guideline = "CLSI"))) guideline = "CLSI"
)
}
))
# to include information about urinary tract infections (UTI) # to include information about urinary tract infections (UTI)
data.frame(mo = "E. coli", data.frame(
mo = "E. coli",
nitrofuratoin = c("<= 2", 32), nitrofuratoin = c("<= 2", 32),
from_the_bladder = c(TRUE, FALSE)) \%>\% from_the_bladder = c(TRUE, FALSE)
) \%>\%
as.sir(uti = "from_the_bladder") as.sir(uti = "from_the_bladder")
data.frame(mo = "E. coli", data.frame(
mo = "E. coli",
nitrofuratoin = c("<= 2", 32), nitrofuratoin = c("<= 2", 32),
specimen = c("urine", "blood")) \%>\% specimen = c("urine", "blood")
) \%>\%
as.sir() # automatically determines urine isolates as.sir() # automatically determines urine isolates
df_wide \%>\% df_wide \%>\%
@ -5624,8 +5662,10 @@ if (require("ggplot2") && require("dplyr")) {
) \%>\% ) \%>\%
ggplot() + ggplot() +
geom_col(aes(x = x, y = y, fill = z)) + geom_col(aes(x = x, y = y, fill = z)) +
scale_sir_colours(aesthetics = "fill", scale_sir_colours(
Value4 = "S", Value5 = "I", Value6 = "R") aesthetics = "fill",
Value4 = "S", Value5 = "I", Value6 = "R"
)
} }
if (require("ggplot2") && require("dplyr")) { if (require("ggplot2") && require("dplyr")) {
# resistance of ciprofloxacine per age group # resistance of ciprofloxacine per age group
@ -7031,10 +7071,12 @@ mo_rank("Klebsiella pneumoniae")
mo_url("Klebsiella pneumoniae") mo_url("Klebsiella pneumoniae")
mo_is_yeast(c("Candida", "Trichophyton", "Klebsiella")) 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 C",
"Streptococcus group G", "Streptococcus group G",
"Streptococcus group L")) "Streptococcus group L"
))
# scientific reference ----------------------------------------------------- # 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_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)) some_sir_values <- random_sir(50, prob_SIR = c(0.55, 0.05, 0.30))
\donttest{ \donttest{
# Plotting using ggplot2's autoplot() for MIC, disk, and SIR ----------- # Plotting using ggplot2's autoplot() for MIC, disk, and SIR -----------
if (require("ggplot2")) { if (require("ggplot2")) {
@ -7559,17 +7600,23 @@ if (require("ggplot2")) {
} }
if (require("ggplot2")) { if (require("ggplot2")) {
# support for 20 languages, various guidelines, and many options # 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", guideline = "CLSI 2024", language = "no",
title = "Disk diffusion from the North") title = "Disk diffusion from the North"
)
} }
# Plotting using scale_x_mic() ----------------------------------------- # Plotting using scale_x_mic() -----------------------------------------
if (require("ggplot2")) { if (require("ggplot2")) {
mic_plot <- ggplot(data.frame(mics = as.mic(c(0.25, "<=4", 4, 8, 32, ">=32")), mic_plot <- ggplot(
counts = c(1, 1, 2, 2, 3, 3)), data.frame(
aes(mics, counts)) + mics = as.mic(c(0.25, "<=4", 4, 8, 32, ">=32")),
counts = c(1, 1, 2, 2, 3, 3)
),
aes(mics, counts)
) +
geom_col() geom_col()
mic_plot + mic_plot +
labs(title = "without scale_x_mic()") labs(title = "without scale_x_mic()")
@ -7600,17 +7647,25 @@ if (require("ggplot2")) {
some_groups <- sample(LETTERS[1:5], 20, replace = TRUE) some_groups <- sample(LETTERS[1:5], 20, replace = TRUE)
if (require("ggplot2")) { if (require("ggplot2")) {
ggplot(data.frame(mic = some_mic_values, ggplot(
group = some_groups), data.frame(
aes(group, mic)) + mic = some_mic_values,
group = some_groups
),
aes(group, mic)
) +
geom_boxplot() + geom_boxplot() +
geom_violin(linetype = 2, colour = "grey", fill = NA) + geom_violin(linetype = 2, colour = "grey", fill = NA) +
scale_y_mic() scale_y_mic()
} }
if (require("ggplot2")) { if (require("ggplot2")) {
ggplot(data.frame(mic = some_mic_values, ggplot(
group = some_groups), data.frame(
aes(group, mic)) + mic = some_mic_values,
group = some_groups
),
aes(group, mic)
) +
geom_boxplot() + geom_boxplot() +
geom_violin(linetype = 2, colour = "grey", fill = NA) + geom_violin(linetype = 2, colour = "grey", fill = NA) +
scale_y_mic(mic_range = c(NA, 0.25)) scale_y_mic(mic_range = c(NA, 0.25))
@ -7619,9 +7674,13 @@ if (require("ggplot2")) {
# Plotting using scale_x_sir() ----------------------------------------- # Plotting using scale_x_sir() -----------------------------------------
if (require("ggplot2")) { if (require("ggplot2")) {
ggplot(data.frame(x = c("I", "R", "S"), ggplot(
y = c(45,323, 573)), data.frame(
aes(x, y)) + x = c("I", "R", "S"),
y = c(45, 323, 573)
),
aes(x, y)
) +
geom_col() + geom_col() +
scale_x_sir() scale_x_sir()
} }
@ -7629,12 +7688,17 @@ if (require("ggplot2")) {
# Plotting using scale_y_mic() and scale_colour_sir() ------------------ # Plotting using scale_y_mic() and scale_colour_sir() ------------------
if (require("ggplot2")) { if (require("ggplot2")) {
plain <- ggplot(data.frame(mic = some_mic_values, plain <- ggplot(
data.frame(
mic = some_mic_values,
group = some_groups, group = some_groups,
sir = as.sir(some_mic_values, sir = as.sir(some_mic_values,
mo = "E. coli", mo = "E. coli",
ab = "cipro")), ab = "cipro"
aes(x = group, y = mic, colour = sir)) + )
),
aes(x = group, y = mic, colour = sir)
) +
theme_minimal() + theme_minimal() +
geom_boxplot(fill = NA, colour = "grey") + geom_boxplot(fill = NA, colour = "grey") +
geom_jitter(width = 0.25) geom_jitter(width = 0.25)
@ -7650,8 +7714,10 @@ if (require("ggplot2")) {
if (require("ggplot2")) { if (require("ggplot2")) {
plain + plain +
scale_y_mic(mic_range = c(0.005, 32), name = "Our MICs!") + scale_y_mic(mic_range = c(0.005, 32), name = "Our MICs!") +
scale_colour_sir(language = "pt", scale_colour_sir(
name = "Support in 20 languages") language = "pt",
name = "Support in 20 languages"
)
} }
} }
@ -8247,15 +8313,18 @@ This function is useful for preprocessing data before creating \link[=antibiogra
\examples{ \examples{
# filter to the top 3 species: # filter to the top 3 species:
top_n_microorganisms(example_isolates, top_n_microorganisms(example_isolates,
n = 3) n = 3
)
# filter to any species in the top 5 genera: # filter to any species in the top 5 genera:
top_n_microorganisms(example_isolates, 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: # filter to the top 3 species in each of the top 5 genera:
top_n_microorganisms(example_isolates, top_n_microorganisms(example_isolates,
n = 5, property = "genus", n_for_each = 3) n = 5, property = "genus", n_for_each = 3
)
} }
\seealso{ \seealso{
\code{\link[=mo_property]{mo_property()}}, \code{\link[=as.mo]{as.mo()}}, \code{\link[=antibiogram]{antibiogram()}} \code{\link[=mo_property]{mo_property()}}, \code{\link[=as.mo]{as.mo()}}, \code{\link[=antibiogram]{antibiogram()}}

30
man/antibiogram.Rd
View File

@ -343,12 +343,14 @@ antibiogram(example_isolates,
antibiogram(example_isolates, antibiogram(example_isolates,
antibiotics = aminoglycosides(), antibiotics = aminoglycosides(),
ab_transform = "atc", ab_transform = "atc",
mo_transform = "gramstain") mo_transform = "gramstain"
)
antibiogram(example_isolates, antibiogram(example_isolates,
antibiotics = carbapenems(), antibiotics = carbapenems(),
ab_transform = "name", ab_transform = "name",
mo_transform = "name") mo_transform = "name"
)
# Combined antibiogram ------------------------------------------------- # Combined antibiogram -------------------------------------------------
@ -356,14 +358,16 @@ antibiogram(example_isolates,
# combined antibiotics yield higher empiric coverage # combined antibiotics yield higher empiric coverage
antibiogram(example_isolates, antibiogram(example_isolates,
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"), antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
mo_transform = "gramstain") mo_transform = "gramstain"
)
# names of antibiotics do not need to resemble columns exactly: # names of antibiotics do not need to resemble columns exactly:
antibiogram(example_isolates, antibiogram(example_isolates,
antibiotics = c("Cipro", "cipro + genta"), antibiotics = c("Cipro", "cipro + genta"),
mo_transform = "gramstain", mo_transform = "gramstain",
ab_transform = "name", ab_transform = "name",
sep = " & ") sep = " & "
)
# Syndromic antibiogram ------------------------------------------------ # Syndromic antibiogram ------------------------------------------------
@ -371,7 +375,8 @@ antibiogram(example_isolates,
# the data set could contain a filter for e.g. respiratory specimens # the data set could contain a filter for e.g. respiratory specimens
antibiogram(example_isolates, antibiogram(example_isolates,
antibiotics = c(aminoglycosides(), carbapenems()), antibiotics = c(aminoglycosides(), carbapenems()),
syndromic_group = "ward") syndromic_group = "ward"
)
# now define a data set with only E. coli # now define a data set with only E. coli
ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ] ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ]
@ -384,7 +389,8 @@ antibiogram(ex1,
syndromic_group = ifelse(ex1$ward == "ICU", syndromic_group = ifelse(ex1$ward == "ICU",
"UCI", "No UCI" "UCI", "No UCI"
), ),
language = "es") language = "es"
)
# WISCA antibiogram ---------------------------------------------------- # WISCA antibiogram ----------------------------------------------------
@ -393,7 +399,8 @@ antibiogram(ex1,
antibiogram(example_isolates, antibiogram(example_isolates,
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"), antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
syndromic_group = "ward", syndromic_group = "ward",
wisca = TRUE) wisca = TRUE
)
# Print the output for R Markdown / Quarto ----------------------------- # Print the output for R Markdown / Quarto -----------------------------
@ -401,7 +408,8 @@ antibiogram(example_isolates,
ureido <- antibiogram(example_isolates, ureido <- antibiogram(example_isolates,
antibiotics = ureidopenicillins(), antibiotics = ureidopenicillins(),
syndromic_group = "ward", syndromic_group = "ward",
wisca = TRUE) wisca = TRUE
)
# in an Rmd file, you would just need to return `ureido` in a chunk, # in an Rmd file, you would just need to return `ureido` in a chunk,
# but to be explicit here: # but to be explicit here:
@ -414,11 +422,13 @@ if (requireNamespace("knitr")) {
ab1 <- antibiogram(example_isolates, ab1 <- antibiogram(example_isolates,
antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"), antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
mo_transform = "gramstain") mo_transform = "gramstain"
)
ab2 <- antibiogram(example_isolates, ab2 <- antibiogram(example_isolates,
antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"), antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
mo_transform = "gramstain", mo_transform = "gramstain",
syndromic_group = "ward") syndromic_group = "ward"
)
if (requireNamespace("ggplot2")) { if (requireNamespace("ggplot2")) {
ggplot2::autoplot(ab1) ggplot2::autoplot(ab1)

24
man/antimicrobial_selectors.Rd
View File

@ -2,8 +2,6 @@
% Please edit documentation in R/amr_selectors.R % Please edit documentation in R/amr_selectors.R
\name{antimicrobial_selectors} \name{antimicrobial_selectors}
\alias{antimicrobial_selectors} \alias{antimicrobial_selectors}
\alias{amr_class}
\alias{amr_selector}
\alias{aminoglycosides} \alias{aminoglycosides}
\alias{aminopenicillins} \alias{aminopenicillins}
\alias{antifungals} \alias{antifungals}
@ -35,17 +33,13 @@
\alias{tetracyclines} \alias{tetracyclines}
\alias{trimethoprims} \alias{trimethoprims}
\alias{ureidopenicillins} \alias{ureidopenicillins}
\alias{amr_class}
\alias{amr_selector}
\alias{administrable_per_os} \alias{administrable_per_os}
\alias{administrable_iv} \alias{administrable_iv}
\alias{not_intrinsic_resistant} \alias{not_intrinsic_resistant}
\title{Antimicrobial Selectors} \title{Antimicrobial Selectors}
\usage{ \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, aminoglycosides(only_sir_columns = FALSE, only_treatable = TRUE,
return_all = TRUE, ...) return_all = TRUE, ...)
@ -114,6 +108,12 @@ trimethoprims(only_sir_columns = FALSE, return_all = TRUE, ...)
ureidopenicillins(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_per_os(only_sir_columns = FALSE, return_all = TRUE, ...)
administrable_iv(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, ...) version_expertrules = 3.3, ...)
} }
\arguments{ \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_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})} \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{...}{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{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()}}.} \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_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[=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. 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}{ \section{Full list of supported (antimicrobial) classes}{

68
man/as.sir.Rd
View File

@ -265,23 +265,35 @@ if (require("dplyr")) {
mutate_if(is.mic, as.sir, mutate_if(is.mic, as.sir,
mo = "bacteria", mo = "bacteria",
ab = "antibiotic", ab = "antibiotic",
guideline = "CLSI") guideline = "CLSI"
)
df_long \%>\% df_long \%>\%
mutate(across(where(is.mic), mutate(across(
function(x) as.sir(x, where(is.mic),
function(x) {
as.sir(x,
mo = "bacteria", mo = "bacteria",
ab = "antibiotic", ab = "antibiotic",
guideline = "CLSI"))) guideline = "CLSI"
)
}
))
df_wide \%>\% df_wide \%>\%
# given certain columns, e.g. from 'cipro' to 'genta' # given certain columns, e.g. from 'cipro' to 'genta'
mutate_at(vars(cipro:genta), as.sir, mutate_at(vars(cipro:genta), as.sir,
mo = "bacteria", mo = "bacteria",
guideline = "CLSI") guideline = "CLSI"
)
df_wide \%>\% df_wide \%>\%
mutate(across(cipro:genta, mutate(across(
function(x) as.sir(x, cipro:genta,
function(x) {
as.sir(x,
mo = "bacteria", mo = "bacteria",
guideline = "CLSI"))) guideline = "CLSI"
)
}
))
# for veterinary breakpoints, add 'host': # for veterinary breakpoints, add 'host':
df_long$animal_species <- c("cats", "dogs", "horses", "cattle") df_long$animal_species <- c("cats", "dogs", "horses", "cattle")
@ -291,36 +303,52 @@ if (require("dplyr")) {
mo = "bacteria", mo = "bacteria",
ab = "antibiotic", ab = "antibiotic",
host = "animal_species", host = "animal_species",
guideline = "CLSI") guideline = "CLSI"
)
df_long \%>\% df_long \%>\%
mutate(across(where(is.mic), mutate(across(
function(x) as.sir(x, where(is.mic),
function(x) {
as.sir(x,
mo = "bacteria", mo = "bacteria",
ab = "antibiotic", ab = "antibiotic",
host = "animal_species", host = "animal_species",
guideline = "CLSI"))) guideline = "CLSI"
)
}
))
df_wide \%>\% df_wide \%>\%
mutate_at(vars(cipro:genta), as.sir, mutate_at(vars(cipro:genta), as.sir,
mo = "bacteria", mo = "bacteria",
ab = "antibiotic", ab = "antibiotic",
host = "animal_species", host = "animal_species",
guideline = "CLSI") guideline = "CLSI"
)
df_wide \%>\% df_wide \%>\%
mutate(across(cipro:genta, mutate(across(
function(x) as.sir(x, cipro:genta,
function(x) {
as.sir(x,
mo = "bacteria", mo = "bacteria",
host = "animal_species", host = "animal_species",
guideline = "CLSI"))) guideline = "CLSI"
)
}
))
# to include information about urinary tract infections (UTI) # to include information about urinary tract infections (UTI)
data.frame(mo = "E. coli", data.frame(
mo = "E. coli",
nitrofuratoin = c("<= 2", 32), nitrofuratoin = c("<= 2", 32),
from_the_bladder = c(TRUE, FALSE)) \%>\% from_the_bladder = c(TRUE, FALSE)
) \%>\%
as.sir(uti = "from_the_bladder") as.sir(uti = "from_the_bladder")
data.frame(mo = "E. coli", data.frame(
mo = "E. coli",
nitrofuratoin = c("<= 2", 32), nitrofuratoin = c("<= 2", 32),
specimen = c("urine", "blood")) \%>\% specimen = c("urine", "blood")
) \%>\%
as.sir() # automatically determines urine isolates as.sir() # automatically determines urine isolates
df_wide \%>\% df_wide \%>\%

6
man/ggplot_sir.Rd
View File

@ -139,8 +139,10 @@ if (require("ggplot2") && require("dplyr")) {
) \%>\% ) \%>\%
ggplot() + ggplot() +
geom_col(aes(x = x, y = y, fill = z)) + geom_col(aes(x = x, y = y, fill = z)) +
scale_sir_colours(aesthetics = "fill", scale_sir_colours(
Value4 = "S", Value5 = "I", Value6 = "R") aesthetics = "fill",
Value4 = "S", Value5 = "I", Value6 = "R"
)
} }
if (require("ggplot2") && require("dplyr")) { if (require("ggplot2") && require("dplyr")) {
# resistance of ciprofloxacine per age group # resistance of ciprofloxacine per age group

6
man/mo_property.Rd
View File

@ -262,10 +262,12 @@ mo_rank("Klebsiella pneumoniae")
mo_url("Klebsiella pneumoniae") mo_url("Klebsiella pneumoniae")
mo_is_yeast(c("Candida", "Trichophyton", "Klebsiella")) 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 C",
"Streptococcus group G", "Streptococcus group G",
"Streptococcus group L")) "Streptococcus group L"
))
# scientific reference ----------------------------------------------------- # scientific reference -----------------------------------------------------

64
man/plot.Rd
View File

@ -201,7 +201,6 @@ some_mic_values <- random_mic(size = 100)
some_disk_values <- random_disk(size = 100, mo = "Escherichia coli", ab = "cipro") 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)) some_sir_values <- random_sir(50, prob_SIR = c(0.55, 0.05, 0.30))
\donttest{ \donttest{
# Plotting using ggplot2's autoplot() for MIC, disk, and SIR ----------- # Plotting using ggplot2's autoplot() for MIC, disk, and SIR -----------
if (require("ggplot2")) { if (require("ggplot2")) {
@ -213,17 +212,23 @@ if (require("ggplot2")) {
} }
if (require("ggplot2")) { if (require("ggplot2")) {
# support for 20 languages, various guidelines, and many options # 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", guideline = "CLSI 2024", language = "no",
title = "Disk diffusion from the North") title = "Disk diffusion from the North"
)
} }
# Plotting using scale_x_mic() ----------------------------------------- # Plotting using scale_x_mic() -----------------------------------------
if (require("ggplot2")) { if (require("ggplot2")) {
mic_plot <- ggplot(data.frame(mics = as.mic(c(0.25, "<=4", 4, 8, 32, ">=32")), mic_plot <- ggplot(
counts = c(1, 1, 2, 2, 3, 3)), data.frame(
aes(mics, counts)) + mics = as.mic(c(0.25, "<=4", 4, 8, 32, ">=32")),
counts = c(1, 1, 2, 2, 3, 3)
),
aes(mics, counts)
) +
geom_col() geom_col()
mic_plot + mic_plot +
labs(title = "without scale_x_mic()") labs(title = "without scale_x_mic()")
@ -254,17 +259,25 @@ if (require("ggplot2")) {
some_groups <- sample(LETTERS[1:5], 20, replace = TRUE) some_groups <- sample(LETTERS[1:5], 20, replace = TRUE)
if (require("ggplot2")) { if (require("ggplot2")) {
ggplot(data.frame(mic = some_mic_values, ggplot(
group = some_groups), data.frame(
aes(group, mic)) + mic = some_mic_values,
group = some_groups
),
aes(group, mic)
) +
geom_boxplot() + geom_boxplot() +
geom_violin(linetype = 2, colour = "grey", fill = NA) + geom_violin(linetype = 2, colour = "grey", fill = NA) +
scale_y_mic() scale_y_mic()
} }
if (require("ggplot2")) { if (require("ggplot2")) {
ggplot(data.frame(mic = some_mic_values, ggplot(
group = some_groups), data.frame(
aes(group, mic)) + mic = some_mic_values,
group = some_groups
),
aes(group, mic)
) +
geom_boxplot() + geom_boxplot() +
geom_violin(linetype = 2, colour = "grey", fill = NA) + geom_violin(linetype = 2, colour = "grey", fill = NA) +
scale_y_mic(mic_range = c(NA, 0.25)) scale_y_mic(mic_range = c(NA, 0.25))
@ -273,9 +286,13 @@ if (require("ggplot2")) {
# Plotting using scale_x_sir() ----------------------------------------- # Plotting using scale_x_sir() -----------------------------------------
if (require("ggplot2")) { if (require("ggplot2")) {
ggplot(data.frame(x = c("I", "R", "S"), ggplot(
y = c(45,323, 573)), data.frame(
aes(x, y)) + x = c("I", "R", "S"),
y = c(45, 323, 573)
),
aes(x, y)
) +
geom_col() + geom_col() +
scale_x_sir() scale_x_sir()
} }
@ -283,12 +300,17 @@ if (require("ggplot2")) {
# Plotting using scale_y_mic() and scale_colour_sir() ------------------ # Plotting using scale_y_mic() and scale_colour_sir() ------------------
if (require("ggplot2")) { if (require("ggplot2")) {
plain <- ggplot(data.frame(mic = some_mic_values, plain <- ggplot(
data.frame(
mic = some_mic_values,
group = some_groups, group = some_groups,
sir = as.sir(some_mic_values, sir = as.sir(some_mic_values,
mo = "E. coli", mo = "E. coli",
ab = "cipro")), ab = "cipro"
aes(x = group, y = mic, colour = sir)) + )
),
aes(x = group, y = mic, colour = sir)
) +
theme_minimal() + theme_minimal() +
geom_boxplot(fill = NA, colour = "grey") + geom_boxplot(fill = NA, colour = "grey") +
geom_jitter(width = 0.25) geom_jitter(width = 0.25)
@ -304,8 +326,10 @@ if (require("ggplot2")) {
if (require("ggplot2")) { if (require("ggplot2")) {
plain + plain +
scale_y_mic(mic_range = c(0.005, 32), name = "Our MICs!") + scale_y_mic(mic_range = c(0.005, 32), name = "Our MICs!") +
scale_colour_sir(language = "pt", scale_colour_sir(
name = "Support in 20 languages") language = "pt",
name = "Support in 20 languages"
)
} }
} }

9
man/top_n_microorganisms.Rd
View File

@ -29,15 +29,18 @@ This function is useful for preprocessing data before creating \link[=antibiogra
\examples{ \examples{
# filter to the top 3 species: # filter to the top 3 species:
top_n_microorganisms(example_isolates, top_n_microorganisms(example_isolates,
n = 3) n = 3
)
# filter to any species in the top 5 genera: # filter to any species in the top 5 genera:
top_n_microorganisms(example_isolates, 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: # filter to the top 3 species in each of the top 5 genera:
top_n_microorganisms(example_isolates, top_n_microorganisms(example_isolates,
n = 5, property = "genus", n_for_each = 3) n = 5, property = "genus", n_for_each = 3
)
} }
\seealso{ \seealso{
\code{\link[=mo_property]{mo_property()}}, \code{\link[=as.mo]{as.mo()}}, \code{\link[=antibiogram]{antibiogram()}} \code{\link[=mo_property]{mo_property()}}, \code{\link[=as.mo]{as.mo()}}, \code{\link[=antibiogram]{antibiogram()}}

7
tests/testthat.R
View File

@ -33,8 +33,11 @@ library(AMR)
# add functions from the tinytest package (which we use for older R versions) # add functions from the tinytest package (which we use for older R versions)
expect_inherits <- function(x, y, ...) { expect_inherits <- function(x, y, ...) {
expect(inherits(x, y), expect(inherits(x, y),
failure_message = paste0("object has class ", paste0(class(x), collapse = "/"), failure_message = paste0(
", required is class ", paste0(y, collapse = "/"))) "object has class ", paste0(class(x), collapse = "/"),
", required is class ", paste0(y, collapse = "/")
)
)
} }
expect_stdout <- expect_output expect_stdout <- expect_output

10
tests/testthat/test-ab.R
View File

@ -80,15 +80,19 @@ expect_equal(
# based on Levenshtein distance # based on Levenshtein distance
expect_identical(ab_name("ceftazidim/avibactam", language = NULL), "Ceftazidime/avibactam") 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",
"gentamicine (High Level)", "gentamicine (High Level)",
"gentamicine (High)", "gentamicine (High)",
"gentamicine HL", "gentamicine HL",
"gentamicine H-L", "gentamicine H-L",
"gentamicine (HL)", "gentamicine (HL)",
"gentamicine (H-L)"))), "gentamicine (H-L)"
rep("GEH", 8)) ))),
rep("GEH", 8)
)
# assigning and subsetting # assigning and subsetting
x <- antibiotics$ab x <- antibiotics$ab

1
tests/testthat/test-ab_property.R
View File

@ -96,4 +96,3 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
set_ab_names(NIT:VAN) %>% set_ab_names(NIT:VAN) %>%
colnames()))) colnames())))
} }

3
tests/testthat/test-age.R
View File

@ -35,7 +35,8 @@ expect_equal(
c(39, 34, 29) c(39, 34, 29)
) )
expect_equal(age( expect_equal(
age(
x = c("2019-01-01", "2019-04-01", "2019-07-01"), x = c("2019-01-01", "2019-04-01", "2019-07-01"),
reference = "2019-09-01", reference = "2019-09-01",
exact = TRUE exact = TRUE

27
tests/testthat/test-antibiogram.R
View File

@ -31,19 +31,22 @@
# Traditional antibiogram ---------------------------------------------- # Traditional antibiogram ----------------------------------------------
ab1 <- antibiogram(example_isolates, ab1 <- antibiogram(example_isolates,
antibiotics = c(aminoglycosides(), carbapenems())) antibiotics = c(aminoglycosides(), carbapenems())
)
ab2 <- antibiogram(example_isolates, ab2 <- antibiogram(example_isolates,
antibiotics = aminoglycosides(), antibiotics = aminoglycosides(),
ab_transform = "atc", ab_transform = "atc",
mo_transform = "gramstain", mo_transform = "gramstain",
add_total_n = TRUE) add_total_n = TRUE
)
ab3 <- antibiogram(example_isolates, ab3 <- antibiogram(example_isolates,
antibiotics = carbapenems(), antibiotics = carbapenems(),
ab_transform = "ab", ab_transform = "ab",
mo_transform = "name", mo_transform = "name",
formatting_type = 1) formatting_type = 1
)
expect_inherits(ab1, "antibiogram") expect_inherits(ab1, "antibiogram")
expect_inherits(ab2, "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 # combined antibiotics yield higher empiric coverage
ab4 <- antibiogram(example_isolates, ab4 <- antibiogram(example_isolates,
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"), antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
mo_transform = "gramstain") mo_transform = "gramstain"
)
ab5 <- antibiogram(example_isolates, ab5 <- antibiogram(example_isolates,
antibiotics = c("TZP", "TZP+TOB"), antibiotics = c("TZP", "TZP+TOB"),
mo_transform = "gramstain", mo_transform = "gramstain",
ab_transform = "name", ab_transform = "name",
sep = " & ", sep = " & ",
add_total_n = FALSE) add_total_n = FALSE
)
expect_inherits(ab4, "antibiogram") expect_inherits(ab4, "antibiogram")
expect_inherits(ab5, "antibiogram") expect_inherits(ab5, "antibiogram")
@ -78,7 +83,8 @@ expect_equal(colnames(ab5), c("Pathogen", "Piperacillin/tazobactam", "Piperacill
ab6 <- antibiogram(example_isolates, ab6 <- antibiogram(example_isolates,
antibiotics = c(aminoglycosides(), carbapenems()), antibiotics = c(aminoglycosides(), carbapenems()),
syndromic_group = "ward", syndromic_group = "ward",
ab_transform = NULL) ab_transform = NULL
)
# with a custom language, though this will be determined automatically # with a custom language, though this will be determined automatically
# (i.e., this table will be in Dutch on Dutch systems) # (i.e., this table will be in Dutch on Dutch systems)
@ -87,9 +93,11 @@ ab7 <- antibiogram(ex1,
antibiotics = aminoglycosides(), antibiotics = aminoglycosides(),
ab_transform = "name", ab_transform = "name",
syndromic_group = ifelse(ex1$ward == "ICU", syndromic_group = ifelse(ex1$ward == "ICU",
"IC", "Geen IC"), "IC", "Geen IC"
),
language = "nl", language = "nl",
add_total_n = TRUE) add_total_n = TRUE
)
expect_inherits(ab6, "antibiogram") expect_inherits(ab6, "antibiogram")
expect_inherits(ab7, "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 # the data set could contain a filter for e.g. respiratory specimens
ab8 <- suppressWarnings(antibiogram(example_isolates, ab8 <- suppressWarnings(antibiogram(example_isolates,
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"), antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
wisca = TRUE)) wisca = TRUE
))
expect_inherits(ab8, "antibiogram") expect_inherits(ab8, "antibiogram")
expect_equal(colnames(ab8), c("Piperacillin/tazobactam", "Piperacillin/tazobactam + Gentamicin", "Piperacillin/tazobactam + Tobramycin")) expect_equal(colnames(ab8), c("Piperacillin/tazobactam", "Piperacillin/tazobactam + Gentamicin", "Piperacillin/tazobactam + Tobramycin"))

6
tests/testthat/test-custom_antimicrobials.R
View File

@ -33,9 +33,11 @@ expect_message(as.ab("testab", info = TRUE))
suppressMessages( suppressMessages(
add_custom_antimicrobials( add_custom_antimicrobials(
data.frame(ab = "TESTAB", data.frame(
ab = "TESTAB",
name = "Test Antibiotic", name = "Test Antibiotic",
group = "Test Group") group = "Test Group"
)
) )
) )

24
tests/testthat/test-custom_microorganisms.R
View File

@ -27,14 +27,18 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== # # ==================================================================== #
expect_identical(as.mo("Enterobacter asburiae/cloacae"), expect_identical(
as.mo("Enterobacter asburiae")) as.mo("Enterobacter asburiae/cloacae"),
as.mo("Enterobacter asburiae")
)
suppressMessages( suppressMessages(
add_custom_microorganisms( add_custom_microorganisms(
data.frame(mo = "ENT_ASB_CLO", data.frame(
mo = "ENT_ASB_CLO",
genus = "Enterobacter", 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") { if (getRversion() >= "3.3.0") {
# until R 3.2, abbreviate() used a completely different algorithm, making these tests unreproducible # 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 = "_"), expect_identical(
as.character(as.mo("Klebsiella pneumoniae"))) paste("B", AMR:::abbreviate_mo("Klebsiella"), AMR:::abbreviate_mo("pneumoniae", 4), sep = "_"),
expect_identical(paste("B", AMR:::abbreviate_mo("Aerococcus"), AMR:::abbreviate_mo("urinae", 4), sep = "_"), as.character(as.mo("Klebsiella pneumoniae"))
as.character(as.mo("Aerococcus urinae"))) )
expect_identical(
paste("B", AMR:::abbreviate_mo("Aerococcus"), AMR:::abbreviate_mo("urinae", 4), sep = "_"),
as.character(as.mo("Aerococcus urinae"))
)
} }

15
tests/testthat/test-eucast_rules.R
View File

@ -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 # 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, mo = example_isolates$mo,
ERY = example_isolates$ERY, ERY = example_isolates$ERY,
AZM = as.sir("R"), AZM = as.sir("R"),
@ -160,7 +161,8 @@ expect_stdout(suppressWarnings(eucast_rules(example_isolates, verbose = TRUE, ru
# AmpC de-repressed cephalo mutants # AmpC de-repressed cephalo mutants
expect_identical( expect_identical(
eucast_rules(data.frame( eucast_rules(
data.frame(
mo = c("Escherichia coli", "Enterobacter cloacae"), mo = c("Escherichia coli", "Enterobacter cloacae"),
cefotax = as.sir(c("S", "S")) cefotax = as.sir(c("S", "S"))
), ),
@ -171,7 +173,8 @@ expect_identical(
) )
expect_identical( expect_identical(
eucast_rules(data.frame( eucast_rules(
data.frame(
mo = c("Escherichia coli", "Enterobacter cloacae"), mo = c("Escherichia coli", "Enterobacter cloacae"),
cefotax = as.sir(c("S", "S")) cefotax = as.sir(c("S", "S"))
), ),
@ -182,7 +185,8 @@ expect_identical(
) )
expect_identical( expect_identical(
eucast_rules(data.frame( eucast_rules(
data.frame(
mo = c("Escherichia coli", "Enterobacter cloacae"), mo = c("Escherichia coli", "Enterobacter cloacae"),
cefotax = as.sir(c("S", "S")) cefotax = as.sir(c("S", "S"))
), ),
@ -208,7 +212,8 @@ expect_stdout(print(c(x, x)))
expect_stdout(print(as.list(x, x))) expect_stdout(print(as.list(x, x)))
# this custom rules makes 8 changes # this custom rules makes 8 changes
expect_equal(nrow(eucast_rules(example_isolates, expect_equal(
nrow(eucast_rules(example_isolates,
rules = "custom", rules = "custom",
custom_rules = x, custom_rules = x,
info = FALSE, info = FALSE,

37
tests/testthat/test-first_isolate.R
View File

@ -46,17 +46,28 @@ expect_equal(
) )
# for phenotype determination # for phenotype determination
expect_equal(AMR:::duplicated_antibiogram("SSSS", points_threshold = 2, ignore_I = TRUE, type = "points"), expect_equal(
FALSE) AMR:::duplicated_antibiogram("SSSS", points_threshold = 2, ignore_I = TRUE, type = "points"),
expect_equal(AMR:::duplicated_antibiogram(c("RRR", "SSS"), FALSE
points_threshold = 2, ignore_I = TRUE, type = "points"), )
c(FALSE, FALSE)) expect_equal(
expect_equal(AMR:::duplicated_antibiogram(c("RRR", "RRR", "SSS"), AMR:::duplicated_antibiogram(c("RRR", "SSS"),
points_threshold = 2, ignore_I = TRUE, type = "points"), 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"), c(FALSE, FALSE)
points_threshold = 2, ignore_I = TRUE, type = "points"), )
c(FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, TRUE)) 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 # Phenotype-based, using key antimicrobials
expect_equal( expect_equal(
@ -89,7 +100,9 @@ expect_true(
col_icu = example_isolates$ward == "ICU", col_icu = example_isolates$ward == "ICU",
info = TRUE, info = TRUE,
icu_exclude = TRUE icu_exclude = TRUE
), na.rm = TRUE) < 950 ),
na.rm = TRUE
) < 950
) )
# set 1500 random observations to be of specimen type 'Urine' # set 1500 random observations to be of specimen type 'Urine'

12
tests/testthat/test-ggplot_sir.R
View File

@ -44,14 +44,18 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE) &&
as.double() as.double()
) )
expect_inherits(example_isolates %>% expect_inherits(
example_isolates %>%
select(AMC, CIP) %>% select(AMC, CIP) %>%
ggplot_sir(x = "interpretation", facet = "antibiotic"), ggplot_sir(x = "interpretation", facet = "antibiotic"),
"gg") "gg"
expect_inherits(example_isolates %>% )
expect_inherits(
example_isolates %>%
select(AMC, CIP) %>% select(AMC, CIP) %>%
ggplot_sir(x = "antibiotic", facet = "interpretation"), ggplot_sir(x = "antibiotic", facet = "interpretation"),
"gg") "gg"
)
expect_equal( expect_equal(
(example_isolates %>% (example_isolates %>%

6
tests/testthat/test-mdro.R
View File

@ -55,7 +55,8 @@ expect_equal(
# test Dutch P. aeruginosa MDRO # test Dutch P. aeruginosa MDRO
expect_equal( expect_equal(
as.character(mdro(data.frame( as.character(mdro(
data.frame(
mo = as.mo("P. aeruginosa"), mo = as.mo("P. aeruginosa"),
cfta = "S", cfta = "S",
cipr = "S", cipr = "S",
@ -72,7 +73,8 @@ expect_equal(
"Negative" "Negative"
) )
expect_equal( expect_equal(
as.character(mdro(data.frame( as.character(mdro(
data.frame(
mo = as.mo("P. aeruginosa"), mo = as.mo("P. aeruginosa"),
cefta = "R", cefta = "R",
cipr = "R", cipr = "R",

1
tests/testthat/test-mic.R
View File

@ -176,4 +176,3 @@ expect_true(as.mic("32") <= as.mic(32))
expect_false(as.mic("32") <= as.mic("<32")) expect_false(as.mic("32") <= as.mic("<32"))
expect_true(as.mic("32") <= as.mic("<=32")) expect_true(as.mic("32") <= as.mic("<=32"))
expect_false(as.mic("32") < as.mic("<=32")) expect_false(as.mic("32") < as.mic("<=32"))

30
tests/testthat/test-mo_property.R
View File

@ -78,8 +78,10 @@ current_grampos_classes <- c(
"Thermoleophilia", "Thermoleophilia",
"Thermolithobacteria" "Thermolithobacteria"
) )
expect_identical(sort(unique(microorganisms[which(microorganisms$phylum %in% current_grampos_phyla), "class", drop = TRUE])), expect_identical(
current_grampos_classes) 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_species("Escherichia coli"), "coli")
expect_equal(mo_subspecies("Escherichia 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_true(length(mo_group_members("B_HACEK")) > 1)
expect_inherits(mo_group_members(c("Candida albicans", "Escherichia coli")), "list") expect_inherits(mo_group_members(c("Candida albicans", "Escherichia coli")), "list")
expect_identical(mo_oxygen_tolerance(c("Klebsiella pneumoniae", "Clostridioides difficile")), expect_identical(
c("facultative anaerobe", "anaerobe")) mo_oxygen_tolerance(c("Klebsiella pneumoniae", "Clostridioides difficile")),
c("facultative anaerobe", "anaerobe")
)
expect_equal(as.character(table(mo_pathogenicity(example_isolates$mo))), expect_equal(
c("1911", "72", "1", "16")) 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_ref("Escherichia coli"), "Castellani et al., 1919")
expect_equal(mo_authors("Escherichia coli"), "Castellani et al.") 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") expect_true(mo_url("Escherichia coli") %like% "lpsn.dsmz.de")
# test integrity of getting back full names # test integrity of getting back full names
expect_identical(microorganisms$fullname[microorganisms$fullname %unlike% "(Fungi|{)"], expect_identical(
suppressWarnings(mo_fullname(microorganisms$fullname[microorganisms$fullname %unlike% "(Fungi|{)"], language = "en", keep_synonyms = TRUE))) microorganisms$fullname[microorganisms$fullname %unlike% "(Fungi|{)"],
suppressWarnings(mo_fullname(microorganisms$fullname[microorganisms$fullname %unlike% "(Fungi|{)"], language = "en", keep_synonyms = TRUE))
)
# check languages # check languages
expect_equal(mo_type("Escherichia coli", language = "de"), "Bakterien") 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("Escherichia blattae" %in% mo_synonyms("Shimwellia blattae"))
expect_true(is.list(mo_synonyms(rep("Shimwellia blattae", 2)))) expect_true(is.list(mo_synonyms(rep("Shimwellia blattae", 2))))
expect_identical(mo_current(c("Escherichia blattae", "Escherichia coli")), expect_identical(
c("Shimwellia blattae", "Escherichia coli")) 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("Chlamydia psittaci"), "Garcia-Lopez et al., 2019")
expect_identical(mo_ref("Chlamydophila psittaci", keep_synonyms = TRUE), "Everett et al., 1999") expect_identical(mo_ref("Chlamydophila psittaci", keep_synonyms = TRUE), "Everett et al., 1999")

6
tests/testthat/test-pca.R
View File

@ -27,7 +27,8 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== # # ==================================================================== #
resistance_data <- structure(list( resistance_data <- structure(
list(
order = c("Bacillales", "Enterobacterales", "Enterobacterales"), order = c("Bacillales", "Enterobacterales", "Enterobacterales"),
genus = c("Staphylococcus", "Escherichia", "Klebsiella"), genus = c("Staphylococcus", "Escherichia", "Klebsiella"),
AMC = c(0.00425, 0.13062, 0.10344), 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"), class = c("grouped_df", "tbl_df", "tbl", "data.frame"),
row.names = c(NA, -3L), row.names = c(NA, -3L),
groups = structure(list( groups = structure(
list(
order = c("Bacillales", "Enterobacterales"), order = c("Bacillales", "Enterobacterales"),
.rows = list(1L, 2:3) .rows = list(1L, 2:3)
), ),

65
tests/testthat/test-plotting.R
View File

@ -38,7 +38,8 @@ if (AMR:::pkg_is_available("ggplot2", also_load = TRUE)) {
scale_obj <- getExportedValue("ggplot2", scale_fn_name)() scale_obj <- getExportedValue("ggplot2", scale_fn_name)()
for (method in expected_methods) { for (method in expected_methods) {
expect_true(is.function(scale_obj[[method]]) || method %in% names(scale_obj), 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) scale_obj <- getExportedValue("ggplot2", scale_fn_name)(aesthetics = aest)
for (method in expected_methods) { for (method in expected_methods) {
expect_true(is.function(scale_obj[[method]]) || method %in% names(scale_obj), 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) { for (method in expected_methods) {
expect_true(is.function(ggplot2::scale_x_discrete()[[method]]) || method %in% names(ggplot2::scale_x_discrete()), 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), expect_inherits(
sir = c("S", "I", "R", "SDD")), ggplot(
aes(x = sir, y = count, fill = sir)) + data.frame(
count = c(1, 2, 3, 4),
sir = c("S", "I", "R", "SDD")
),
aes(x = sir, y = count, fill = sir)
) +
geom_col() + geom_col() +
scale_x_sir(eucast_I = F, language = "el") + scale_x_sir(eucast_I = F, language = "el") +
scale_fill_sir(eucast_I = T, language = "nl"), scale_fill_sir(eucast_I = T, language = "nl"),
"gg") "gg"
expect_inherits(ggplot(data.frame(mic = as.mic(c(2,4,8, 16)), )
sir = as.sir(c("S", "I", "R", "SDD"))), expect_inherits(
aes(x = sir, y = mic)) + 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() + geom_point() +
scale_y_mic(), scale_y_mic(),
"gg") "gg"
expect_inherits(ggplot(data.frame(mic = as.mic(c(2,4,8, 16)), )
sir = as.sir(c("S", "I", "R", "SDD"))), expect_inherits(
aes(x = sir, y = mic)) + 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() + geom_col() +
scale_y_mic(), scale_y_mic(),
"gg") "gg"
expect_inherits(ggplot(data.frame(mic = as.mic(c(2,4,8, 16)), )
sir = as.sir(c("S", "I", "R", "SDD"))), expect_inherits(
aes(x = sir, y = mic)) + 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() + geom_col() +
scale_y_mic(mic_range = c(4, 16)) + scale_y_mic(mic_range = c(4, 16)) +
scale_x_sir(), scale_x_sir(),
"gg") "gg"
)
} }

113
tests/testthat/test-sir.R
View File

@ -125,28 +125,44 @@ expect_equal(as.sir(c("", "-", NA, "NULL")), c(NA_sir_, NA_sir_, NA_sir_, NA_sir
# Human ------------------------------------------------------------------- # Human -------------------------------------------------------------------
mics <- as.mic(2^c(-4:6)) # 0.0625 to 64 in factors of 2 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", expect_identical(
uti = FALSE, include_PKPD = FALSE)), as.character(as.sir(mics,
c("S", "S", "S", "S", "S", "S", "S", "S", "R", "R", "R")) mo = "Enterobacterales", ab = "AMC", guideline = "EUCAST 2022",
expect_identical(as.character(as.sir(mics, mo = "Enterobacterales", ab = "AMC", guideline = "EUCAST 2022", uti = FALSE, include_PKPD = FALSE
uti = TRUE, include_PKPD = FALSE)), )),
c("S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "R")) c("S", "S", "S", "S", "S", "S", "S", "S", "R", "R", "R")
expect_identical(as.character(as.sir(mics, mo = "Escherichia coli", ab = "AMC", guideline = "EUCAST 2022", )
uti = FALSE, include_PKPD = FALSE)), expect_identical(
c("S", "S", "S", "S", "S", "S", "S", "S", "R", "R", "R")) 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(...)) # 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") 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"))) expect_identical(out1, as.sir(c("S", "S", "R", "R")))
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) { 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", 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"))) %>% mutate(across(where(is.mic), function(x) as.sir(x, mo = "mo", ab = "ab", guideline = "EUCAST 2023"))) %>%
pull(some_mics) pull(some_mics)
out3 <- data.frame(mo = "Escherichia coli", out3 <- data.frame(
mo = "Escherichia coli",
ab = "ertapenem", 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") %>% mutate_if(is.mic, as.sir, mo = "mo", ab = "ab", guideline = "EUCAST 2023") %>%
pull(some_mics) 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) # S. pneumoniae/ampicillin in EUCAST 2020: 0.5-2 ug/ml (R is only > 2)
expect_equal(suppressMessages( expect_equal(
suppressMessages(
as.character( as.character(
as.sir( as.sir(
x = as.mic(c(0.125, 0.5, 1, 2, 4)), x = as.mic(c(0.125, 0.5, 1, 2, 4)),
@ -163,11 +180,13 @@ expect_equal(suppressMessages(
ab = "AMP", ab = "AMP",
guideline = "EUCAST 2020" guideline = "EUCAST 2020"
) )
)), )
),
c("S", "S", "I", "I", "R") c("S", "S", "I", "I", "R")
) )
# S. pneumoniae/amoxicillin in CLSI 2019: 2-8 ug/ml (R is 8 and > 8) # S. pneumoniae/amoxicillin in CLSI 2019: 2-8 ug/ml (R is 8 and > 8)
expect_equal(suppressMessages( expect_equal(
suppressMessages(
as.character( as.character(
as.sir( as.sir(
x = as.mic(c(1, 2, 4, 8, 16)), x = as.mic(c(1, 2, 4, 8, 16)),
@ -175,7 +194,8 @@ expect_equal(suppressMessages(
ab = "AMX", ab = "AMX",
guideline = "CLSI 2019" guideline = "CLSI 2019"
) )
)), )
),
c("S", "S", "I", "R", "R") 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) %>% group_by(mo) %>%
attributes() %>% attributes() %>%
.$groups .$groups
expect_equal(nrow(groups), expect_equal(
90) nrow(groups),
expect_equal(class(groups$.rows), 90
c("vctrs_list_of", "vctrs_vctr", "list")) )
expect_equal(groups$.rows[[1]], expect_equal(
c(101, 524, 1368)) class(groups$.rows),
expect_equal(example_isolates[c(101, 524, 1368), "mo", drop = TRUE], c("vctrs_list_of", "vctrs_vctr", "list")
rep(groups$mo[1], 3)) )
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 # frequency tables
if (AMR:::pkg_is_available("cleaner")) { if (AMR:::pkg_is_available("cleaner")) {
@ -295,11 +323,15 @@ expect_message(as.sir(data.frame(
))) )))
# SDD vs I in CLSI 2024 # SDD vs I in CLSI 2024
expect_identical(as.sir(as.mic(2 ^ c(-2:4)), mo = "Enterococcus faecium", ab = "Dapto", guideline = "CLSI 2024"), expect_identical(
as.sir(c("SDD", "SDD", "SDD", "SDD", "SDD", "R", "R"))) as.sir(as.mic(2^c(-2:4)), mo = "Enterococcus faecium", ab = "Dapto", guideline = "CLSI 2024"),
expect_identical(as.sir(as.mic(2 ^ c(-2:2)), mo = "Enterococcus faecium", ab = "Cipro 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"), ", guideline = "CLSI 2024"),
as.sir(c("S", "S", "S", "I", "R"))) as.sir(c("S", "S", "S", "I", "R"))
)
# Veterinary -------------------------------------------------------------- # 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) sir_history <- sir_interpretation_history(clean = TRUE)
mics <- as.mic(2^c(-4:6)) # 0.0625 to 64 in factors of 2 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, PRA = mics,
FLR = 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") out_vet <- as.sir(vet, host = vet$animal, guideline = "CLSI 2023")
# host column name instead of values # host column name instead of values
expect_identical(out_vet, expect_identical(
as.sir(vet, host = "animal", guideline = "CLSI 2023")) out_vet,
as.sir(vet, host = "animal", guideline = "CLSI 2023")
)
# check outcomes # check outcomes
expect_identical(out_vet$PRA, as.sir(c("S", NA, "S", NA, NA, "R", NA, NA, NA, "I", NA))) 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"))) expect_identical(out_vet$FLR, as.sir(c("S", "S", NA, "S", "S", NA, "I", "R", NA, "R", "R")))
sir_history <- sir_interpretation_history() sir_history <- sir_interpretation_history()
expect_identical(sort(sir_history$host), expect_identical(
c("cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", 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", "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", "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 ------------------------------------------------------------------- # ECOFF -------------------------------------------------------------------
@ -340,4 +380,3 @@ expect_equal(
) )
# old method # old method
expect_warning(as.sir(as.mic(2), "E. coli", "ampicillin", guideline = "EUCAST 2020", ecoff = TRUE)) expect_warning(as.sir(as.mic(2), "E. coli", "ampicillin", guideline = "EUCAST 2020", ecoff = TRUE))

12
tests/testthat/test-vctrs.R
View File

@ -29,11 +29,13 @@
# extra tests for {vctrs} pkg support # extra tests for {vctrs} pkg support
if (AMR:::pkg_is_available("tibble")) { 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"), mo = as.mo("Escherichia coli"),
mic = as.mic(2), mic = as.mic(2),
disk = as.disk(20), disk = as.disk(20),
sir = as.sir("S")) sir = as.sir("S")
)
check1 <- lapply(test, class) check1 <- lapply(test, class)
test[1, "ab"] <- "GEN" test[1, "ab"] <- "GEN"
test[1, "mo"] <- "B_KLBSL_PNMN" test[1, "mo"] <- "B_KLBSL_PNMN"
@ -46,8 +48,10 @@ if (AMR:::pkg_is_available("tibble")) {
check2 <- lapply(test, class) check2 <- lapply(test, class)
expect_identical(check1, check2) expect_identical(check1, check2)
test <- tibble::tibble(cipro = as.sir("S"), test <- tibble::tibble(
variable = "test") cipro = as.sir("S"),
variable = "test"
)
expect_equal(nrow(test[quinolones() == "S", ]), 1) expect_equal(nrow(test[quinolones() == "S", ]), 1)
expect_equal(nrow(test[quinolones() == "R", ]), 0) expect_equal(nrow(test[quinolones() == "R", ]), 0)
} }

6
tests/testthat/test-zzz.R
View File

@ -146,14 +146,16 @@ for (i in seq_len(length(import_functions))) {
fn <- names(import_functions)[i] fn <- names(import_functions)[i]
pkg <- unname(import_functions[i]) pkg <- unname(import_functions[i])
expect_true(pkg %in% suggests, 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 # function should exist in foreign pkg namespace
if (AMR:::pkg_is_available(pkg, if (AMR:::pkg_is_available(pkg,
also_load = FALSE, also_load = FALSE,
min_version = if (pkg == "dplyr") "1.0.0" else NULL 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)), 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") { } else if (pkg != "rstudioapi") {
warning("Package '", pkg, "' not available") warning("Package '", pkg, "' not available")
} }