1
0
mirror of https://github.com/msberends/AMR.git synced 2024-12-24 18:46:14 +01:00

unit tests

This commit is contained in:
dr. M.S. (Matthijs) Berends 2023-02-12 17:10:48 +01:00
parent 68abb00c59
commit 45a9697c84
23 changed files with 438 additions and 406 deletions

View File

@ -1,5 +1,5 @@
Package: AMR
Version: 1.8.2.9120
Version: 1.8.2.9121
Date: 2023-02-12
Title: Antimicrobial Resistance Data Analysis
Description: Functions to simplify and standardise antimicrobial resistance (AMR)

View File

@ -1,4 +1,4 @@
# AMR 1.8.2.9120
# AMR 1.8.2.9121
*(this beta version will eventually become v2.0! We're happy to reach a new major milestone soon!)*

View File

@ -163,7 +163,7 @@ quick_case_when <- function(...) {
out
}
rbind2 <- function (...) {
rbind2 <- function(...) {
# this is just rbind(), but then with the functionality of dplyr::bind_rows(),
# to allow differences in available columns
l <- list(...)

View File

@ -29,7 +29,7 @@
#' Options for the AMR package
#'
#' This is an overview of all the package-specific [options()] you can set in the `AMR` package.
#' This is an overview of all the package-specific [options()] you can set in the `AMR` package.
#' @section Options:
#' * `AMR_custom_ab` \cr Allows to use custom antimicrobial drugs with this package. This is explained in [add_custom_antimicrobials()].
#' * `AMR_custom_mo` \cr Allows to use custom microorganisms with this package. This is explained in [add_custom_microorganisms()].
@ -41,37 +41,37 @@
#' * `AMR_keep_synonyms` \cr A [logical] to use in [as.mo()] and all [`mo_*`][mo_property()] functions, to indicate if old, previously valid taxonomic names must be preserved and not be corrected to currently accepted names.
#' * `AMR_locale` \cr A language to use for the `AMR` package, can be one of these supported language names or ISO-639-1 codes: `r vector_or(paste0(sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), " (" , LANGUAGES_SUPPORTED, ")"), quotes = FALSE, sort = FALSE)`.
#' * `AMR_mo_source` \cr A file location for a manual code list to be used in [as.mo()] and all [`mo_*`][mo_property()] functions. This is explained in [set_mo_source()].
#'
#'
#' @section Saving Settings Between Sessions:
#' Settings in \R are not saved globally and are thus lost when \R is exited. You can save your options to your own `.Rprofile` file, which is a user-specific file. You can edit it using:
#'
#'
#' ```r
#' utils::file.edit("~/.Rprofile")
#' ```
#'
#'
#' In this file, you can set options such as:
#'
#'
#' ```r
#' options(AMR_locale = "pt")
#' options(AMR_include_PKPD = TRUE)
#' ```
#'
#'
#' to add Portuguese language support of antibiotics, and allow PK/PD rules when interpreting MIC values with [as.sir()].
#'
#'
#' ### Share Options Within Team
#'
#'
#' For a more global approach, e.g. within a data team, save an options file to a remote file location, such as a shared network drive. This would work in this way:
#'
#'
#' 1. Save a plain text file to e.g. "X:/team_folder/R_options.R" and fill it with preferred settings.
#'
#'
#' 2. For each user, open the `.Rprofile` file using `utils::file.edit("~/.Rprofile")` and put in there:
#'
#'
#' ```r
#' source("X:/team_folder/R_options.R")
#' ```
#'
#'
#' 3. Reload R/RStudio and check the settings with [getOption()], e.g. `getOption("AMR_locale")` if you have set that value.
#'
#'
#' Now the team settings are configured in only one place, and can be maintained there.
#' @keywords internal
#' @name AMR-options

6
R/ab.R
View File

@ -495,13 +495,15 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
# save to package env to save time for next time
if (isTRUE(initial_search)) {
AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(!AMR_env$ab_previously_coerced$x %in% x), , drop = FALSE]
AMR_env$ab_previously_coerced <- unique(rbind2(AMR_env$ab_previously_coerced,
AMR_env$ab_previously_coerced <- unique(rbind2(
AMR_env$ab_previously_coerced,
data.frame(
x = x,
ab = x_new,
x_bak = x_bak[match(x, x_bak_clean)],
stringsAsFactors = FALSE
)))
)
))
}
# take failed ATC codes apart from rest

View File

@ -361,9 +361,10 @@ set_ab_names <- function(data, ..., property = "name", language = get_AMR_locale
if (is.data.frame(data)) {
if (tryCatch(length(c(...)) > 1, error = function(e) TRUE)) {
df <- tryCatch(suppressWarnings(pm_select(data, ...)),
error = function(e) {
data[, c(...), drop = FALSE]
})
error = function(e) {
data[, c(...), drop = FALSE]
}
)
} else if (tryCatch(is.character(c(...)), error = function(e) FALSE)) {
df <- data[, c(...), drop = FALSE]
} else {

View File

@ -46,62 +46,62 @@
#' @param object an [antibiogram()] object
#' @param ... method extensions
#' @details This function returns a table with values between 0 and 100 for *susceptibility*, not resistance.
#'
#'
#' **Remember that you should filter your data to let it contain only first isolates!** This is needed to exclude duplicates and to reduce selection bias. Use [first_isolate()] to determine them in your data set with one of the four available algorithms.
#'
#'
#' There are four antibiogram types, as proposed by Klinker *et al.* (2021, \doi{10.1177/20499361211011373}), and they are all supported by [antibiogram()]:
#'
#'
#' 1. **Traditional Antibiogram**
#'
#'
#' Case example: Susceptibility of *Pseudomonas aeruginosa* to piperacillin/tazobactam (TZP)
#'
#'
#' Code example:
#'
#'
#' ```r
#' antibiogram(your_data,
#' antibiotics = "TZP")
#' ```
#'
#'
#' 2. **Combination Antibiogram**
#'
#'
#' Case example: Additional susceptibility of *Pseudomonas aeruginosa* to TZP + tobramycin versus TZP alone
#'
#'
#' Code example:
#'
#'
#' ```r
#' antibiogram(your_data,
#' antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"))
#' ```
#'
#'
#' 3. **Syndromic Antibiogram**
#'
#'
#' Case example: Susceptibility of *Pseudomonas aeruginosa* to TZP among respiratory specimens (obtained among ICU patients only)
#'
#'
#' Code example:
#'
#'
#' ```r
#' antibiogram(your_data,
#' antibiotics = penicillins(),
#' syndromic_group = "ward")
#' ```
#'
#'
#' 4. **Weighted-Incidence Syndromic Combination Antibiogram (WISCA)**
#'
#'
#' Case example: Susceptibility of *Pseudomonas aeruginosa* to TZP among respiratory specimens (obtained among ICU patients only) for male patients age >=65 years with heart failure
#'
#'
#' Code example:
#'
#'
#' ```r
#' antibiogram(your_data,
#' antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
#' syndromic_group = ifelse(your_data$age >= 65 & your_data$gender == "Male",
#' "Group 1", "Group 2"))
#' ```
#'
#'
#' All types of antibiograms can be generated with the functions as described on this page, and can be plotted (using [ggplot2::autoplot()] or base \R [plot()]/[barplot()]) or printed into R Markdown / Quarto formats for reports. Use functions from specific 'table reporting' packages to transform the output of [antibiogram()] to your needs, e.g. `flextable::as_flextable()` or `gt::gt()`.
#'
#'
#' Note that for combination antibiograms, it is important to realise that susceptibility can be calculated in two ways, which can be set with the `only_all_tested` argument (defaults to `FALSE`). See this example for two antibiotics, Drug A and Drug B, about how [antibiogram()] works to calculate the %SI:
#'
#'
#' ```
#' --------------------------------------------------------------------
#' only_all_tested = FALSE only_all_tested = TRUE
@ -120,99 +120,111 @@
#' <NA> <NA> - - - -
#' --------------------------------------------------------------------
#' ```
#' @source
#' @source
#' * Klinker KP *et al.* (2021). **Antimicrobial stewardship and antibiograms: importance of moving beyond traditional antibiograms**. *Therapeutic Advances in Infectious Disease*, May 5;8:20499361211011373; \doi{10.1177/20499361211011373}
#' * Barbieri E *et al.* (2021). **Development of a Weighted-Incidence Syndromic Combination Antibiogram (WISCA) to guide the choice of the empiric antibiotic treatment for urinary tract infection in paediatric patients: a Bayesian approach** *Antimicrobial Resistance & Infection Control* May 1;10(1):74; \doi{10.1186/s13756-021-00939-2}
#' * **M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 5th Edition**, 2022, *Clinical and Laboratory Standards Institute (CLSI)*. <https://clsi.org/standards/products/microbiology/documents/m39/>.
#' @rdname antibiogram
#' @name antibiogram
#' @export
#' @examples
#' @examples
#' # example_isolates is a data set available in the AMR package.
#' # run ?example_isolates for more info.
#' example_isolates
#'
#'
#'
#'
#' # Traditional antibiogram ----------------------------------------------
#'
#'
#' antibiogram(example_isolates,
#' antibiotics = c(aminoglycosides(), carbapenems()))
#'
#' antibiotics = c(aminoglycosides(), carbapenems())
#' )
#'
#' antibiogram(example_isolates,
#' antibiotics = aminoglycosides(),
#' ab_transform = "atc",
#' mo_transform = "gramstain")
#'
#' antibiotics = aminoglycosides(),
#' ab_transform = "atc",
#' mo_transform = "gramstain"
#' )
#'
#' antibiogram(example_isolates,
#' antibiotics = carbapenems(),
#' ab_transform = "name",
#' mo_transform = "name")
#'
#'
#' antibiotics = carbapenems(),
#' ab_transform = "name",
#' mo_transform = "name"
#' )
#'
#'
#' # Combined antibiogram -------------------------------------------------
#'
#'
#' # combined antibiotics yield higher empiric coverage
#' antibiogram(example_isolates,
#' antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
#' mo_transform = "gramstain")
#'
#' antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
#' mo_transform = "gramstain"
#' )
#'
#' antibiogram(example_isolates,
#' antibiotics = c("TZP", "TZP+TOB"),
#' mo_transform = "gramstain",
#' ab_transform = "name",
#' sep = " & ")
#'
#'
#' antibiotics = c("TZP", "TZP+TOB"),
#' mo_transform = "gramstain",
#' ab_transform = "name",
#' sep = " & "
#' )
#'
#'
#' # Syndromic antibiogram ------------------------------------------------
#'
#'
#' # the data set could contain a filter for e.g. respiratory specimens
#' antibiogram(example_isolates,
#' antibiotics = c(aminoglycosides(), carbapenems()),
#' syndromic_group = "ward")
#'
#' antibiotics = c(aminoglycosides(), carbapenems()),
#' syndromic_group = "ward"
#' )
#'
#' # now define a data set with only E. coli
#' ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ]
#'
#'
#' # with a custom language, though this will be determined automatically
#' # (i.e., this table will be in Spanish on Spanish systems)
#' antibiogram(ex1,
#' antibiotics = aminoglycosides(),
#' ab_transform = "name",
#' syndromic_group = ifelse(ex1$ward == "ICU",
#' "UCI", "No UCI"),
#' language = "es")
#'
#'
#' antibiotics = aminoglycosides(),
#' ab_transform = "name",
#' syndromic_group = ifelse(ex1$ward == "ICU",
#' "UCI", "No UCI"
#' ),
#' language = "es"
#' )
#'
#'
#' # Weighted-incidence syndromic combination antibiogram (WISCA) ---------
#'
#'
#' # the data set could contain a filter for e.g. respiratory specimens
#' antibiogram(example_isolates,
#' antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"),
#' mo_transform = "gramstain",
#' minimum = 10, # this should be >= 30, but now just as example
#' syndromic_group = ifelse(example_isolates$age >= 65 &
#' example_isolates$gender == "M",
#' "WISCA Group 1", "WISCA Group 2"))
#'
#'
#' antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"),
#' mo_transform = "gramstain",
#' minimum = 10, # this should be >= 30, but now just as example
#' syndromic_group = ifelse(example_isolates$age >= 65 &
#' example_isolates$gender == "M",
#' "WISCA Group 1", "WISCA Group 2"
#' )
#' )
#'
#'
#' # Generate plots with ggplot2 or base R --------------------------------
#'
#'
#' ab1 <- antibiogram(example_isolates,
#' antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
#' mo_transform = "gramstain")
#' antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
#' mo_transform = "gramstain"
#' )
#' ab2 <- antibiogram(example_isolates,
#' antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
#' mo_transform = "gramstain",
#' syndromic_group = "ward")
#'
#' antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
#' mo_transform = "gramstain",
#' syndromic_group = "ward"
#' )
#'
#' plot(ab1)
#'
#'
#' if (requireNamespace("ggplot2")) {
#' ggplot2::autoplot(ab1)
#' }
#'
#'
#' plot(ab2)
#'
#'
#' if (requireNamespace("ggplot2")) {
#' ggplot2::autoplot(ab2)
#' }
@ -241,7 +253,7 @@ antibiogram <- function(x,
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
meet_criteria(sep, allow_class = "character", has_length = 1)
# try to find columns based on type
if (is.null(col_mo)) {
col_mo <- search_type_in_df(x = x, type = "mo", info = interactive())
@ -274,7 +286,7 @@ antibiogram <- function(x,
} else {
has_syndromic_group <- FALSE
}
# get antibiotics
if (tryCatch(is.character(antibiotics), error = function(e) FALSE)) {
antibiotics <- strsplit(gsub(" ", "", antibiotics), "+", fixed = TRUE)
@ -299,7 +311,7 @@ antibiogram <- function(x,
# determine whether this new column should contain S, I, R, or NA
if (isTRUE(combine_SI)) {
S_values <- c("S", "I")
}else {
} else {
S_values <- "S"
}
other_values <- setdiff(c("S", "I", "R"), S_values)
@ -307,8 +319,10 @@ antibiogram <- function(x,
if (isTRUE(only_all_tested)) {
x[new_colname] <- as.sir(vapply(FUN.VALUE = character(1), x_transposed, function(x) ifelse(anyNA(x), NA_character_, ifelse(any(x %in% S_values), "S", "R")), USE.NAMES = FALSE))
} else {
x[new_colname] <- as.sir(vapply(FUN.VALUE = character(1), x_transposed, function(x) ifelse(any(x %in% S_values, na.rm = TRUE), "S", ifelse(anyNA(x), NA_character_, "R")),
USE.NAMES = FALSE))
x[new_colname] <- as.sir(vapply(
FUN.VALUE = character(1), x_transposed, function(x) ifelse(any(x %in% S_values, na.rm = TRUE), "S", ifelse(anyNA(x), NA_character_, "R")),
USE.NAMES = FALSE
))
}
}
antibiotics[[i]] <- new_colname
@ -317,32 +331,34 @@ antibiogram <- function(x,
} else {
antibiotics <- colnames(suppressWarnings(x[, antibiotics, drop = FALSE]))
}
if (isTRUE(has_syndromic_group)) {
out <- x %pm>%
pm_select(.syndromic_group, .mo, antibiotics) %pm>%
out <- x %pm>%
pm_select(.syndromic_group, .mo, antibiotics) %pm>%
pm_group_by(.syndromic_group)
} else {
out <- x %pm>%
out <- x %pm>%
pm_select(.mo, antibiotics)
}
# get numbers of S, I, R (per group)
out <- out %pm>%
bug_drug_combinations(col_mo = ".mo",
FUN = function(x) x)
out <- out %pm>%
bug_drug_combinations(
col_mo = ".mo",
FUN = function(x) x
)
counts <- out
# regroup for summarising
if (isTRUE(has_syndromic_group)) {
colnames(out)[1] <- "syndromic_group"
out <- out %pm>%
out <- out %pm>%
pm_group_by(syndromic_group, mo, ab)
} else {
out <- out %pm>%
out <- out %pm>%
pm_group_by(mo, ab)
}
if (isTRUE(combine_SI)) {
out$numerator <- out$S + out$I
} else {
@ -351,13 +367,13 @@ antibiogram <- function(x,
out$minimum <- minimum
if (any(out$total < out$minimum, na.rm = TRUE)) {
message_("NOTE: ", sum(out$total < out$minimum, na.rm = TRUE), " combinations had less than `minimum = ", minimum, "` results and were ignored", add_fn = font_red)
out <- out %pm>%
out <- out %pm>%
subset(total >= minimum)
}
out <- out %pm>%
pm_summarise(SI = numerator / total)
# transform names of antibiotics
ab_naming_function <- function(x, t, l, s) {
x <- strsplit(x, s, fixed = TRUE)
@ -379,24 +395,24 @@ antibiogram <- function(x,
out
}
out$ab <- ab_naming_function(out$ab, t = ab_transform, l = language, s = sep)
# transform long to wide
long_to_wide <- function(object, digs) {
object$SI <- round(object$SI * 100, digits = digs)
object <- object %pm>%
# an unclassed data.frame is required for stats::reshape()
as.data.frame(stringsAsFactors = FALSE) %pm>%
as.data.frame(stringsAsFactors = FALSE) %pm>%
stats::reshape(direction = "wide", idvar = "mo", timevar = "ab", v.names = "SI")
colnames(object) <- gsub("^SI?[.]", "", colnames(object))
return(object)
}
# ungroup for long -> wide transformation
attr(out, "pm_groups") <- NULL
attr(out, "groups") <- NULL
class(out) <- class(out)[!class(out) %in% c("grouped_df", "grouped_data")]
long <- out
if (isTRUE(has_syndromic_group)) {
grps <- unique(out$syndromic_group)
for (i in seq_len(length(grps))) {
@ -404,8 +420,10 @@ antibiogram <- function(x,
if (i == 1) {
new_df <- long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits)
} else {
new_df <- rbind2(new_df,
long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits))
new_df <- rbind2(
new_df,
long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits)
)
}
}
# sort rows
@ -421,7 +439,7 @@ antibiogram <- function(x,
new_df <- new_df[, c("mo", sort(colnames(new_df)[colnames(new_df) != "mo"])), drop = FALSE]
colnames(new_df)[1] <- translate_AMR("Pathogen", language = language)
}
# add total N if indicated
if (isTRUE(add_total_n)) {
if (isTRUE(has_syndromic_group)) {
@ -442,10 +460,11 @@ antibiogram <- function(x,
new_df[[edit_col]] <- paste0(new_df[[edit_col]], " (", count_group, ")")
colnames(new_df)[edit_col] <- paste(colnames(new_df)[edit_col], "(N min-max)")
}
structure(as_original_data_class(new_df, class(x), extra_class = "antibiogram"),
long = long,
combine_SI = combine_SI)
long = long,
combine_SI = combine_SI
)
}
#' @export
@ -458,22 +477,24 @@ plot.antibiogram <- function(x, ...) {
df$syndromic_group <- NULL
df <- df[order(df$mo), , drop = FALSE]
}
mo_levels = unique(df$mo)
mo_levels <- unique(df$mo)
mfrow_old <- graphics::par()$mfrow
sqrt_levels <- sqrt(length(mo_levels))
graphics::par(mfrow = c(ceiling(sqrt_levels), floor(sqrt_levels)))
for (i in seq_along(mo_levels)) {
mo <- mo_levels[i]
df_sub <- df[df$mo == mo, , drop = FALSE]
barplot(height = df_sub$SI * 100,
xlab = NULL,
ylab = ifelse(isTRUE(attributes(x)$combine_SI), "%SI", "%S"),
names.arg = df_sub$ab,
col = "#aaaaaa",
beside = TRUE,
main = mo,
legend = NULL)
barplot(
height = df_sub$SI * 100,
xlab = NULL,
ylab = ifelse(isTRUE(attributes(x)$combine_SI), "%SI", "%S"),
names.arg = df_sub$ab,
col = "#aaaaaa",
beside = TRUE,
main = mo,
legend = NULL
)
}
graphics::par(mfrow = mfrow_old)
}
@ -490,22 +511,28 @@ barplot.antibiogram <- function(height, ...) {
autoplot.antibiogram <- function(object, ...) {
df <- attributes(object)$long
ggplot2::ggplot(df) +
ggplot2::geom_col(ggplot2::aes(x = ab,
y = SI * 100,
fill = if ("syndromic_group" %in% colnames(df)) {
syndromic_group
} else {
NULL
}),
position = ggplot2::position_dodge2(preserve = "single")) +
ggplot2::geom_col(
ggplot2::aes(
x = ab,
y = SI * 100,
fill = if ("syndromic_group" %in% colnames(df)) {
syndromic_group
} else {
NULL
}
),
position = ggplot2::position_dodge2(preserve = "single")
) +
ggplot2::facet_wrap("mo") +
ggplot2::labs(y = ifelse(isTRUE(attributes(object)$combine_SI), "%SI", "%S"),
x = NULL,
fill = if ("syndromic_group" %in% colnames(df)) {
colnames(object)[1]
} else {
NULL
})
ggplot2::labs(
y = ifelse(isTRUE(attributes(object)$combine_SI), "%SI", "%S"),
x = NULL,
fill = if ("syndromic_group" %in% colnames(df)) {
colnames(object)[1]
} else {
NULL
}
)
}
#' @export
@ -515,8 +542,8 @@ autoplot.antibiogram <- function(object, ...) {
print.antibiogram <- function(x, as_kable = !interactive(), ...) {
meet_criteria(as_kable, allow_class = "logical", has_length = 1)
if (isTRUE(as_kable) &&
# be sure not to run kable in pkgdown for our website generation
!identical(Sys.getenv("IN_PKGDOWN"), "true")) {
# be sure not to run kable in pkgdown for our website generation
!identical(Sys.getenv("IN_PKGDOWN"), "true")) {
stop_ifnot_installed("knitr")
kable <- import_fn("kable", "knitr", error_on_fail = TRUE)
kable(x, ...)

6
R/av.R
View File

@ -461,13 +461,15 @@ as.av <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
# save to package env to save time for next time
if (isTRUE(initial_search)) {
AMR_env$av_previously_coerced <- AMR_env$av_previously_coerced[which(!AMR_env$av_previously_coerced$x %in% x), , drop = FALSE]
AMR_env$av_previously_coerced <- unique(rbind2(AMR_env$av_previously_coerced,
AMR_env$av_previously_coerced <- unique(rbind2(
AMR_env$av_previously_coerced,
data.frame(
x = x,
av = x_new,
x_bak = x_bak[match(x, x_bak_clean)],
stringsAsFactors = FALSE
)))
)
))
}
# take failed ATC codes apart from rest

View File

@ -47,7 +47,7 @@
#' # example_isolates is a data set available in the AMR package.
#' # run ?example_isolates for more info.
#' example_isolates
#'
#'
#' \donttest{
#' x <- bug_drug_combinations(example_isolates)
#' head(x)

View File

@ -1161,8 +1161,10 @@ edit_sir <- function(x,
)
verbose_new <- verbose_new %pm>% pm_filter(old != new | is.na(old) | is.na(new) & !is.na(old))
# save changes to data set 'verbose_info'
track_changes$verbose_info <- rbind2(track_changes$verbose_info,
verbose_new)
track_changes$verbose_info <- rbind2(
track_changes$verbose_info,
verbose_new
)
# count adds and changes
track_changes$added <- track_changes$added + verbose_new %pm>%
pm_filter(is.na(old)) %pm>%

View File

@ -480,7 +480,7 @@ first_isolate <- function(x = NULL,
),
use.names = FALSE
)
if (!is.null(col_keyantimicrobials)) {
# with key antibiotics
x$other_key_ab <- !antimicrobials_equal(
@ -501,20 +501,20 @@ first_isolate <- function(x = NULL,
x$newvar_genus_species != "" &
(x$other_pat_or_mo | x$more_than_episode_ago)
}
# first one as TRUE
x[row.start, "newvar_first_isolate"] <- TRUE
# no tests that should be included, or ICU
if (!is.null(col_testcode)) {
x[which(x[, col_testcode] %in% tolower(testcodes_exclude)), "newvar_first_isolate"] <- FALSE
}
if (!is.null(col_icu)) {
if (icu_exclude == TRUE) {
if (isTRUE(info)) {
message_("Excluding ", format(sum(col_icu, na.rm = TRUE), big.mark = " "), " isolates from ICU.",
add_fn = font_black,
as_note = FALSE
add_fn = font_black,
as_note = FALSE
)
}
x[which(col_icu), "newvar_first_isolate"] <- FALSE

View File

@ -34,8 +34,8 @@
#' @param episode_days required episode length in days, can also be less than a day or `Inf`, see *Details*
#' @param ... ignored, only in place to allow future extensions
#' @details The functions [get_episode()] and [is_new_episode()] differ in this way when setting `episode_days` to 365:
#'
#'
#'
#'
#' | person_id | date | `get_episode()` | `is_new_episode()` |
#' |:---------:|:----------:|:---------------:|:------------------:|
#' | A | 2019-01-01 | 1 | TRUE |
@ -44,7 +44,7 @@
#' | B | 2008-01-01 | 1 | TRUE |
#' | B | 2008-01-01 | 1 | FALSE |
#' | C | 2020-01-01 | 1 | TRUE |
#'
#'
#' Dates are first sorted from old to new. The oldest date will mark the start of the first episode. After this date, the next date will be marked that is at least `episode_days` days later than the start of the first episode. From that second marked date on, the next date will be marked that is at least `episode_days` days later than the start of the second episode which will be the start of the third episode, and so on. Before the vector is being returned, the original order will be restored.
#'
#' The [first_isolate()] function is a wrapper around the [is_new_episode()] function, but is more efficient for data sets containing microorganism codes or names and allows for different isolate selection methods.
@ -68,9 +68,13 @@
#' df[which(get_episode(df$date, 60) == 3), ]
#'
#' # the functions also work for less than a day, e.g. to include one per hour:
#' get_episode(c(Sys.time(),
#' Sys.time() + 60 * 60),
#' episode_days = 1 / 24)
#' get_episode(
#' c(
#' Sys.time(),
#' Sys.time() + 60 * 60
#' ),
#' episode_days = 1 / 24
#' )
#'
#' \donttest{
#' if (require("dplyr")) {
@ -84,10 +88,10 @@
#' )) %>%
#' group_by(patient, condition) %>%
#' mutate(new_episode = is_new_episode(date, 365)) %>%
#' select(patient, date, condition, new_episode) %>%
#' select(patient, date, condition, new_episode) %>%
#' arrange(patient, condition, date)
#' }
#'
#'
#' if (require("dplyr")) {
#' df %>%
#' group_by(ward, patient) %>%
@ -95,10 +99,10 @@
#' patient,
#' new_index = get_episode(date, 60),
#' new_logical = is_new_episode(date, 60)
#' ) %>%
#' ) %>%
#' arrange(patient, ward, date)
#' }
#'
#'
#' if (require("dplyr")) {
#' df %>%
#' group_by(ward) %>%
@ -109,7 +113,7 @@
#' n_episodes_30 = sum(is_new_episode(date, episode_days = 30))
#' )
#' }
#'
#'
#' # grouping on patients and microorganisms leads to the same
#' # results as first_isolate() when using 'episode-based':
#' if (require("dplyr")) {
@ -126,11 +130,10 @@
#'
#' identical(x, y)
#' }
#'
#'
#' # but is_new_episode() has a lot more flexibility than first_isolate(),
#' # since you can now group on anything that seems relevant:
#' if (require("dplyr")) {
#'
#' df %>%
#' group_by(patient, mo, ward) %>%
#' mutate(flag_episode = is_new_episode(date, 365)) %>%
@ -153,10 +156,10 @@ is_new_episode <- function(x, episode_days, ...) {
exec_episode <- function(x, episode_days, ...) {
x <- as.double(as.POSIXct(x)) # as.POSIXct() required for Date classes
# since x is now in seconds, get seconds from episode_days as well
episode_seconds <- episode_days * 60 * 60 * 24
if (length(x) == 1) { # this will also match 1 NA, which is fine
return(1)
} else if (length(x) == 2 && !all(is.na(x))) {
@ -166,7 +169,7 @@ exec_episode <- function(x, episode_days, ...) {
return(c(1, 1))
}
}
# we asked on StackOverflow:
# https://stackoverflow.com/questions/42122245/filter-one-row-every-year
run_episodes <- function(x, episode_seconds) {
@ -183,7 +186,7 @@ exec_episode <- function(x, episode_days, ...) {
}
indices
}
ord <- order(x)
out <- run_episodes(x[ord], episode_seconds)[order(ord)]
out[is.na(x) & ord != 1] <- NA # every NA expect for the first must remain NA

20
R/mo.R
View File

@ -325,7 +325,8 @@ as.mo <- function(x,
result_mo <- NA_character_
} else {
result_mo <- AMR_env$MO_lookup$mo[match(top_hits[1], AMR_env$MO_lookup$fullname)]
AMR_env$mo_uncertainties <- rbind2(AMR_env$mo_uncertainties,
AMR_env$mo_uncertainties <- rbind2(
AMR_env$mo_uncertainties,
data.frame(
original_input = x_search,
input = x_search_cleaned,
@ -335,14 +336,17 @@ as.mo <- function(x,
minimum_matching_score = ifelse(is.null(minimum_matching_score), "NULL", minimum_matching_score),
keep_synonyms = keep_synonyms,
stringsAsFactors = FALSE
))
)
)
# save to package env to save time for next time
AMR_env$mo_previously_coerced <- unique(rbind2(AMR_env$mo_previously_coerced,
AMR_env$mo_previously_coerced <- unique(rbind2(
AMR_env$mo_previously_coerced,
data.frame(
x = paste(x_search, minimum_matching_score),
mo = result_mo,
stringsAsFactors = FALSE
)))
)
))
}
# the actual result:
as.character(result_mo)
@ -797,14 +801,14 @@ print.mo_uncertainties <- function(x, ...) {
}
cat(word_wrap("Matching scores are based on the resemblance between the input and the full taxonomic name, and the pathogenicity in humans. See `?mo_matching_score`.\n\n", add_fn = font_blue))
add_MO_lookup_to_AMR_env()
col_red <- function(x) font_rose_bg(font_black(x, collapse = NULL), collapse = NULL)
col_orange <- function(x) font_orange_bg(font_black(x, collapse = NULL), collapse = NULL)
col_yellow <- function(x) font_yellow_bg(font_black(x, collapse = NULL), collapse = NULL)
col_green <- function(x) font_green_bg(font_black(x, collapse = NULL), collapse = NULL)
if (has_colour()) {
cat(word_wrap("Colour keys: ",
col_red(" 0.000-0.499 "),
@ -814,7 +818,7 @@ print.mo_uncertainties <- function(x, ...) {
add_fn = font_blue
), font_green_bg(" "), "\n", sep = "")
}
score_set_colour <- function(text, scores) {
# set colours to scores
text[scores >= 0.7] <- col_green(text[scores >= 0.7])

View File

@ -56,7 +56,7 @@
#' The function [proportion_df()] takes any variable from `data` that has an [`sir`] class (created with [as.sir()]) and calculates the proportions S, I, and R. It also supports grouped variables. The function [sir_df()] works exactly like [proportion_df()], but adds the number of isolates.
#' @section Combination Therapy:
#' When using more than one variable for `...` (= combination therapy), use `only_all_tested` to only count isolates that are tested for all antibiotics/variables that you test them for. See this example for two antibiotics, Drug A and Drug B, about how [susceptibility()] works to calculate the %SI:
#'
#'
#'
#' ```
#' --------------------------------------------------------------------
@ -78,14 +78,14 @@
#' ```
#'
#' Please note that, in combination therapies, for `only_all_tested = TRUE` applies that:
#'
#'
#' ```
#' count_S() + count_I() + count_R() = count_all()
#' proportion_S() + proportion_I() + proportion_R() = 1
#' ```
#'
#'
#' and that, in combination therapies, for `only_all_tested = FALSE` applies that:
#'
#'
#' ```
#' count_S() + count_I() + count_R() >= count_all()
#' proportion_S() + proportion_I() + proportion_R() >= 1
@ -103,8 +103,8 @@
#' # example_isolates is a data set available in the AMR package.
#' # run ?example_isolates for more info.
#' example_isolates
#'
#'
#'
#'
#' # base R ------------------------------------------------------------
#' # determines %R
#' resistance(example_isolates$AMX)

View File

@ -30,7 +30,7 @@
#' Translate MIC and Disk Diffusion to SIR, or Clean Existing SIR Data
#'
#' @description Interpret minimum inhibitory concentration (MIC) values and disk diffusion diameters according to EUCAST or CLSI, or clean up existing SIR values. This transforms the input to a new class [`sir`], which is an ordered [factor] with levels `S < I < R`.
#'
#'
#' All breakpoints used for interpretation are publicly available in the [clinical_breakpoints] data set.
#' @rdname as.sir
#' @param x vector of values (for class [`mic`]: MIC values in mg/L, for class [`disk`]: a disk diffusion radius in millimetres)

View File

@ -246,8 +246,8 @@ translate_into_language <- function(from,
}
lapply(
# starting from last row, since more general translations are on top, such as 'Group'
rev(seq_len(nrow(df_trans))),
# starting with longest pattern, since more general translations are shorter, such as 'Group'
order(nchar(df_trans$pattern), decreasing = TRUE),
function(i) {
from_unique_translated <<- gsub(
pattern = df_trans$pattern[i],

View File

@ -19,7 +19,7 @@ files <- files[files %unlike% "(zzz|init)[.]R$"]
files <- files[files %unlike% "/(between|coalesce|cumulative|fill|glimpse|group_cols|na_if|near|nest_by|check_filter|poorman-package|print|recode|reconstruct|replace_na|replace_with|rownames|slice|union_all|unite|window_rank|with_groups)[.]R$"]
# add our prepend file, containing info about the source of the data
intro <- readLines("data-raw/poorman_prepend.R") %>%
intro <- readLines("data-raw/poorman_prepend.R") %>%
# add commit to intro part
gsub("{commit}", commit, ., fixed = TRUE) %>%
# add date to intro part
@ -56,7 +56,6 @@ for (use in has_usemethods) {
}
# add pm_ prefix
contents[relevant_row - 1] <- paste0("pm_", contents[relevant_row - 1])
}
# correct for NextMethod
contents <- gsub("NextMethod\\(\"(.*)\"\\)", "\\1.data.frame(...)", contents)
@ -92,7 +91,7 @@ contents <- contents[trimws(contents) != ""]
contents <- gsub("if (!missing(.before))", "if (!missing(.before) && !is.null(.before))", contents, fixed = TRUE)
contents <- gsub("if (!missing(.after))", "if (!missing(.after) && !is.null(.after))", contents, fixed = TRUE)
contents[which(contents %like% "reshape\\($") + 1] <- gsub("data", "as.data.frame(data, stringsAsFactors = FALSE)", contents[which(contents %like% "reshape\\($") + 1])
contents <- gsub('pm_relocate(.data = long, values_to, .after = -1)', 'pm_relocate(.data = long, "value", .after = -1)', contents, fixed = TRUE)
contents <- gsub("pm_relocate(.data = long, values_to, .after = -1)", 'pm_relocate(.data = long, "value", .after = -1)', contents, fixed = TRUE)
# who needs US spelling?
contents <- contents[contents %unlike% "summarize"]

View File

@ -1,26 +1,30 @@
snomed2 <- microorganisms %>% filter(mo %in% c("B_SLMNL_TYPH", "B_SLMNL_HMRM", "B_SLMNL_PRTY")) %>%
snomed2 <- microorganisms %>%
filter(mo %in% c("B_SLMNL_TYPH", "B_SLMNL_HMRM", "B_SLMNL_PRTY")) %>%
pull(snomed)
new_typhi <- microorganisms %>%
filter(mo == "B_SLMNL_THSS") %>%
slice(c(1,1, 1)) %>%
mutate(mo = c("B_SLMNL_TYPH", "B_SLMNL_HMRM", "B_SLMNL_PRTY"),
fullname = c("Salmonella Typhi", "Salmonella Typhimurium", "Salmonella Paratyphi"),
subspecies = c("Typhi", "Typhimurium", "Paratyphi"),
snomed = snomed2)
filter(mo == "B_SLMNL_THSS") %>%
slice(c(1, 1, 1)) %>%
mutate(
mo = c("B_SLMNL_TYPH", "B_SLMNL_HMRM", "B_SLMNL_PRTY"),
fullname = c("Salmonella Typhi", "Salmonella Typhimurium", "Salmonella Paratyphi"),
subspecies = c("Typhi", "Typhimurium", "Paratyphi"),
snomed = snomed2
)
new_groupa <- microorganisms %>%
filter(mo == "B_SLMNL_GRPB") %>%
mutate(mo = "B_SLMNL_GRPA",
fullname = gsub("roup B", "roup A", fullname),
species = gsub("roup B", "roup A", species))
filter(mo == "B_SLMNL_GRPB") %>%
mutate(
mo = "B_SLMNL_GRPA",
fullname = gsub("roup B", "roup A", fullname),
species = gsub("roup B", "roup A", species)
)
microorganisms$mo <- as.character(microorganisms$mo)
microorganisms <- microorganisms %>%
filter(!mo %in% c("B_SLMNL_TYPH", "B_SLMNL_HMRM", "B_SLMNL_PRTY")) %>%
bind_rows(new_typhi, new_groupa) %>%
filter(!mo %in% c("B_SLMNL_TYPH", "B_SLMNL_HMRM", "B_SLMNL_PRTY")) %>%
bind_rows(new_typhi, new_groupa) %>%
arrange(fullname)
microorganisms$lpsn_parent[which(microorganisms$genus == "Salmonella" & microorganisms$rank == "species")] <- "516547"

View File

@ -27,149 +27,105 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_identical(as.mo("Enterobacter asburiae/cloacae"),
as.mo("Enterobacter asburiae"))
suppressMessages(
add_custom_microorganisms(
data.frame(mo = "ENT_ASB_CLO",
genus = "Enterobacter",
species = "asburiae/cloacae")
)
)
expect_identical(as.character(as.mo("ENT_ASB_CLO")), "ENT_ASB_CLO")
expect_identical(mo_name("ENT_ASB_CLO"), "Enterobacter asburiae/cloacae")
expect_identical(mo_gramstain("ENT_ASB_CLO", language = NULL), "Gram-negative")
# ==================================================================== #
# TITLE #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen and the University Medical #
# Center Groningen in The Netherlands, in collaboration with many #
# colleagues from around the world, see our website. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
# the Free Software Foundation. #
# We created this package for both routine data analysis and academic #
# research and it was publicly released in the hope that it will be #
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
# #
# Visit our website for the full manual and a complete tutorial about #
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
# Traditional antibiogram ----------------------------------------------
#
#
# # Traditional antibiogram ----------------------------------------------
#
# ab1 <- antibiogram(example_isolates,
# antibiotics = c(aminoglycosides(), carbapenems()))
#
# ab2 <- antibiogram(example_isolates,
# antibiotics = aminoglycosides(),
# ab_transform = "atc",
# mo_transform = "gramstain")
#
# ab3 <- antibiogram(example_isolates,
# antibiotics = carbapenems(),
# ab_transform = "name",
# mo_transform = "name")
#
# expect_inherits(ab1, "antibiogram")
# expect_inherits(ab2, "antibiogram")
# expect_inherits(ab3, "antibiogram")
# expect_equal(colnames(ab1), c("Pathogen (N min-max)", "AMK", "GEN", "IPM", "KAN", "MEM", "TOB"))
# expect_equal(colnames(ab2), c("Pathogen (N min-max)", "J01GB01", "J01GB03", "J01GB04", "J01GB06"))
# expect_equal(colnames(ab3), c("Pathogen (N min-max)", "Imipenem", "Meropenem"))
# expect_equal(ab3$Meropenem, c(52, NA, 100, 100, NA))
#
# # Combined antibiogram -------------------------------------------------
#
# # combined antibiotics yield higher empiric coverage
# ab4 <- antibiogram(example_isolates,
# antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
# mo_transform = "gramstain")
#
# ab5 <- antibiogram(example_isolates,
# antibiotics = c("TZP", "TZP+TOB"),
# mo_transform = "gramstain",
# ab_transform = "name",
# sep = " & ",
# add_total_n = FALSE)
#
# expect_inherits(ab4, "antibiogram")
# expect_inherits(ab5, "antibiogram")
# expect_equal(colnames(ab4), c("Pathogen (N min-max)", "TZP", "TZP + GEN", "TZP + TOB"))
# expect_equal(colnames(ab5), c("Pathogen", "Piperacillin/tazobactam", "Piperacillin/tazobactam & Tobramycin"))
#
# # Syndromic antibiogram ------------------------------------------------
#
# # the data set could contain a filter for e.g. respiratory specimens
# ab6 <- antibiogram(example_isolates,
# antibiotics = c(aminoglycosides(), carbapenems()),
# syndromic_group = "ward")
#
# # with a custom language, though this will be determined automatically
# # (i.e., this table will be in Spanish on Spanish systems)
# ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ]
# ab7 <- antibiogram(ex1,
# antibiotics = aminoglycosides(),
# ab_transform = "name",
# syndromic_group = ifelse(ex1$ward == "ICU",
# "UCI", "No UCI"),
# language = "es")
#
# expect_inherits(ab6, "antibiogram")
# expect_inherits(ab7, "antibiogram")
# expect_equal(colnames(ab6), c("Syndromic Group", "Pathogen (N min-max)", "AMK", "GEN", "IPM", "KAN", "MEM", "TOB"))
# expect_equal(colnames(ab7), c("Grupo sindrómico", "Patógeno (N min-max)", "Amikacina", "Gentamicina", "Tobramicina"))
#
# # Weighted-incidence syndromic combination antibiogram (WISCA) ---------
#
# # the data set could contain a filter for e.g. respiratory specimens
# ab8 <- antibiogram(example_isolates,
# antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"),
# mo_transform = "gramstain",
# minimum = 10, # this should be >= 30, but now just as example
# syndromic_group = ifelse(example_isolates$age >= 65 &
# example_isolates$gender == "M",
# "WISCA Group 1", "WISCA Group 2"))
#
# expect_inherits(ab8, "antibiogram")
# expect_equal(colnames(ab8), c("Syndromic Group", "Pathogen (N min-max)", "AMC", "AMC + CIP", "TZP", "TZP + TOB"))
#
# # Generate plots with ggplot2 or base R --------------------------------
#
# pdf(NULL) # prevent Rplots.pdf being created
#
# expect_silent(plot(ab1))
# expect_silent(plot(ab2))
# expect_silent(plot(ab3))
# expect_silent(plot(ab4))
# expect_silent(plot(ab5))
# expect_silent(plot(ab6))
# expect_silent(plot(ab7))
# expect_silent(plot(ab8))
#
# if (AMR:::pkg_is_available("ggplot2")) {
# expect_inherits(autoplot(ab1), "gg")
# expect_inherits(autoplot(ab2), "gg")
# expect_inherits(autoplot(ab3), "gg")
# expect_inherits(autoplot(ab4), "gg")
# expect_inherits(autoplot(ab5), "gg")
# expect_inherits(autoplot(ab6), "gg")
# expect_inherits(autoplot(ab7), "gg")
# expect_inherits(autoplot(ab8), "gg")
# }
ab1 <- antibiogram(example_isolates,
antibiotics = c(aminoglycosides(), carbapenems()))
ab2 <- antibiogram(example_isolates,
antibiotics = aminoglycosides(),
ab_transform = "atc",
mo_transform = "gramstain")
ab3 <- antibiogram(example_isolates,
antibiotics = carbapenems(),
ab_transform = "name",
mo_transform = "name")
expect_inherits(ab1, "antibiogram")
expect_inherits(ab2, "antibiogram")
expect_inherits(ab3, "antibiogram")
expect_equal(colnames(ab1), c("Pathogen (N min-max)", "AMK", "GEN", "IPM", "KAN", "MEM", "TOB"))
expect_equal(colnames(ab2), c("Pathogen (N min-max)", "J01GB01", "J01GB03", "J01GB04", "J01GB06"))
expect_equal(colnames(ab3), c("Pathogen (N min-max)", "Imipenem", "Meropenem"))
expect_equal(ab3$Meropenem, c(52, NA, 100, 100, NA))
# Combined antibiogram -------------------------------------------------
# combined antibiotics yield higher empiric coverage
ab4 <- antibiogram(example_isolates,
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
mo_transform = "gramstain")
ab5 <- antibiogram(example_isolates,
antibiotics = c("TZP", "TZP+TOB"),
mo_transform = "gramstain",
ab_transform = "name",
sep = " & ",
add_total_n = FALSE)
expect_inherits(ab4, "antibiogram")
expect_inherits(ab5, "antibiogram")
expect_equal(colnames(ab4), c("Pathogen (N min-max)", "TZP", "TZP + GEN", "TZP + TOB"))
expect_equal(colnames(ab5), c("Pathogen", "Piperacillin/tazobactam", "Piperacillin/tazobactam & Tobramycin"))
# Syndromic antibiogram ------------------------------------------------
# the data set could contain a filter for e.g. respiratory specimens
ab6 <- antibiogram(example_isolates,
antibiotics = c(aminoglycosides(), carbapenems()),
syndromic_group = "ward")
# with a custom language, though this will be determined automatically
# (i.e., this table will be in Spanish on Spanish systems)
ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ]
ab7 <- antibiogram(ex1,
antibiotics = aminoglycosides(),
ab_transform = "name",
syndromic_group = ifelse(ex1$ward == "ICU",
"UCI", "No UCI"),
language = "es")
expect_inherits(ab6, "antibiogram")
expect_inherits(ab7, "antibiogram")
expect_equal(colnames(ab6), c("Syndromic Group", "Pathogen (N min-max)", "AMK", "GEN", "IPM", "KAN", "MEM", "TOB"))
expect_equal(colnames(ab7), c("Grupo sindrómico", "Patógeno (N min-max)", "Amikacina", "Gentamicina", "Tobramicina"))
# Weighted-incidence syndromic combination antibiogram (WISCA) ---------
# the data set could contain a filter for e.g. respiratory specimens
ab8 <- antibiogram(example_isolates,
antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"),
mo_transform = "gramstain",
minimum = 10, # this should be >= 30, but now just as example
syndromic_group = ifelse(example_isolates$age >= 65 &
example_isolates$gender == "M",
"WISCA Group 1", "WISCA Group 2"))
expect_inherits(ab8, "antibiogram")
expect_equal(colnames(ab8), c("Syndromic Group", "Pathogen (N min-max)", "AMC", "AMC + CIP", "TZP", "TZP + TOB"))
# Generate plots with ggplot2 or base R --------------------------------
pdf(NULL) # prevent Rplots.pdf being created
expect_silent(plot(ab1))
expect_silent(plot(ab2))
expect_silent(plot(ab3))
expect_silent(plot(ab4))
expect_silent(plot(ab5))
expect_silent(plot(ab6))
expect_silent(plot(ab7))
expect_silent(plot(ab8))
if (AMR:::pkg_is_available("ggplot2")) {
expect_inherits(autoplot(ab1), "gg")
expect_inherits(autoplot(ab2), "gg")
expect_inherits(autoplot(ab3), "gg")
expect_inherits(autoplot(ab4), "gg")
expect_inherits(autoplot(ab5), "gg")
expect_inherits(autoplot(ab6), "gg")
expect_inherits(autoplot(ab7), "gg")
expect_inherits(autoplot(ab8), "gg")
}

View File

@ -123,7 +123,7 @@ expect_identical(as.character(as.mo(" ")), NA_character_)
# too few characters
expect_warning(as.mo("ab"))
expect_equal(
expect_identical(
suppressWarnings(as.character(as.mo(c("Qq species", "", "MRSA", "K. pneu rhino", "esco")))),
c("UNKNOWN", NA_character_, "B_STPHY_AURS", "B_KLBSL_PNMN_RHNS", "B_ESCHR_COLI")
)
@ -317,7 +317,7 @@ expect_warning(x[[1]] <- "invalid code")
expect_warning(c(x[1], "test"))
# ignoring patterns
expect_equal(
expect_identical(
as.character(as.mo(c("E. coli", "E. coli ignorethis"), ignore_pattern = "this")),
c("B_ESCHR_COLI", NA)
)

View File

@ -28,9 +28,26 @@
# ==================================================================== #
expect_identical(mo_genus("B_GRAMP", language = "pt"), "(Gram positivos desconhecidos)")
expect_identical(mo_fullname("CoNS", "en"), "Coagulase-negative Staphylococcus (CoNS)")
expect_identical(mo_fullname("CoNS", "cs"), "Koaguláza-negativní stafylokok (KNS)")
expect_identical(mo_fullname("CoNS", "da"), "Koagulase-negative stafylokokker (KNS)")
expect_identical(mo_fullname("CoNS", "de"), "Koagulase-negative Staphylococcus (KNS)")
expect_identical(mo_fullname("CoNS", "nl"), "Coagulase-negatieve Staphylococcus (CNS)")
expect_identical(mo_fullname("CoNS", "el"), "Σταφυλόκοκκος με αρνητική πηκτικότητα (CoNS)")
expect_identical(mo_fullname("CoNS", "en"), "Coagulase-negative Staphylococcus (CoNS)")
expect_identical(mo_fullname("CoNS", "es"), "Staphylococcus coagulasa negativo (SCN)")
expect_identical(mo_fullname("CoNS", "fi"), "Koagulaasinegatiivinen stafylokokki (KNS)")
expect_identical(mo_fullname("CoNS", "fr"), "Staphylococcus à coagulase négative (CoNS)")
expect_identical(mo_fullname("CoNS", "it"), "Staphylococcus negativo coagulasi (CoNS)")
expect_identical(mo_fullname("CoNS", "ja"), "コアグラーゼ陰性ブドウ球菌 (グラム陰性)")
expect_identical(mo_fullname("CoNS", "nl"), "Coagulase-negatieve Staphylococcus (CNS)")
expect_identical(mo_fullname("CoNS", "no"), "Koagulase-negative stafylokokker (KNS)")
expect_identical(mo_fullname("CoNS", "pl"), "Staphylococcus koagulazoujemny (CoNS)")
expect_identical(mo_fullname("CoNS", "pt"), "Staphylococcus coagulase negativo (CoNS)")
expect_identical(mo_fullname("CoNS", "ro"), "Stafilococ coagulazo-negativ (SCN)")
expect_identical(mo_fullname("CoNS", "ru"), "Коагулазоотрицательный стафилококк (КОС)")
expect_identical(mo_fullname("CoNS", "sv"), "Koagulasnegativa stafylokocker (KNS)")
expect_identical(mo_fullname("CoNS", "tr"), "Koagülaz-negatif Stafilokok (KNS)")
expect_identical(mo_fullname("CoNS", "uk"), "Коагулазонегативний стафілокок (КНС)")
expect_identical(mo_fullname("CoNS", "zh"), "凝固酶阴性葡萄球菌 (CoNS)")
expect_error(mo_fullname("CoNS", "aa"))

View File

@ -153,39 +153,45 @@ example_isolates
# Traditional antibiogram ----------------------------------------------
antibiogram(example_isolates,
antibiotics = c(aminoglycosides(), carbapenems()))
antibiotics = c(aminoglycosides(), carbapenems())
)
antibiogram(example_isolates,
antibiotics = aminoglycosides(),
ab_transform = "atc",
mo_transform = "gramstain")
antibiotics = aminoglycosides(),
ab_transform = "atc",
mo_transform = "gramstain"
)
antibiogram(example_isolates,
antibiotics = carbapenems(),
ab_transform = "name",
mo_transform = "name")
antibiotics = carbapenems(),
ab_transform = "name",
mo_transform = "name"
)
# Combined antibiogram -------------------------------------------------
# combined antibiotics yield higher empiric coverage
antibiogram(example_isolates,
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
mo_transform = "gramstain")
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
mo_transform = "gramstain"
)
antibiogram(example_isolates,
antibiotics = c("TZP", "TZP+TOB"),
mo_transform = "gramstain",
ab_transform = "name",
sep = " & ")
antibiotics = c("TZP", "TZP+TOB"),
mo_transform = "gramstain",
ab_transform = "name",
sep = " & "
)
# Syndromic antibiogram ------------------------------------------------
# the data set could contain a filter for e.g. respiratory specimens
antibiogram(example_isolates,
antibiotics = c(aminoglycosides(), carbapenems()),
syndromic_group = "ward")
antibiotics = c(aminoglycosides(), carbapenems()),
syndromic_group = "ward"
)
# now define a data set with only E. coli
ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ]
@ -193,35 +199,41 @@ ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ]
# with a custom language, though this will be determined automatically
# (i.e., this table will be in Spanish on Spanish systems)
antibiogram(ex1,
antibiotics = aminoglycosides(),
ab_transform = "name",
syndromic_group = ifelse(ex1$ward == "ICU",
"UCI", "No UCI"),
language = "es")
antibiotics = aminoglycosides(),
ab_transform = "name",
syndromic_group = ifelse(ex1$ward == "ICU",
"UCI", "No UCI"
),
language = "es"
)
# Weighted-incidence syndromic combination antibiogram (WISCA) ---------
# the data set could contain a filter for e.g. respiratory specimens
antibiogram(example_isolates,
antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"),
mo_transform = "gramstain",
minimum = 10, # this should be >= 30, but now just as example
syndromic_group = ifelse(example_isolates$age >= 65 &
example_isolates$gender == "M",
"WISCA Group 1", "WISCA Group 2"))
antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"),
mo_transform = "gramstain",
minimum = 10, # this should be >= 30, but now just as example
syndromic_group = ifelse(example_isolates$age >= 65 &
example_isolates$gender == "M",
"WISCA Group 1", "WISCA Group 2"
)
)
# Generate plots with ggplot2 or base R --------------------------------
ab1 <- antibiogram(example_isolates,
antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
mo_transform = "gramstain")
antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
mo_transform = "gramstain"
)
ab2 <- antibiogram(example_isolates,
antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
mo_transform = "gramstain",
syndromic_group = "ward")
antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
mo_transform = "gramstain",
syndromic_group = "ward"
)
plot(ab1)
if (requireNamespace("ggplot2")) {

View File

@ -55,9 +55,13 @@ is_new_episode(df$date, episode_days = 60) # TRUE/FALSE
df[which(get_episode(df$date, 60) == 3), ]
# the functions also work for less than a day, e.g. to include one per hour:
get_episode(c(Sys.time(),
Sys.time() + 60 * 60),
episode_days = 1 / 24)
get_episode(
c(
Sys.time(),
Sys.time() + 60 * 60
),
episode_days = 1 / 24
)
\donttest{
if (require("dplyr")) {
@ -71,7 +75,7 @@ if (require("dplyr")) {
)) \%>\%
group_by(patient, condition) \%>\%
mutate(new_episode = is_new_episode(date, 365)) \%>\%
select(patient, date, condition, new_episode) \%>\%
select(patient, date, condition, new_episode) \%>\%
arrange(patient, condition, date)
}
@ -82,7 +86,7 @@ if (require("dplyr")) {
patient,
new_index = get_episode(date, 60),
new_logical = is_new_episode(date, 60)
) \%>\%
) \%>\%
arrange(patient, ward, date)
}
@ -117,7 +121,6 @@ if (require("dplyr")) {
# but is_new_episode() has a lot more flexibility than first_isolate(),
# since you can now group on anything that seems relevant:
if (require("dplyr")) {
df \%>\%
group_by(patient, mo, ward) \%>\%
mutate(flag_episode = is_new_episode(date, 365)) \%>\%