diff --git a/DESCRIPTION b/DESCRIPTION index 3416b11d..126d69e7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -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) diff --git a/NEWS.md b/NEWS.md index 2eaeb069..6fe9460b 100755 --- a/NEWS.md +++ b/NEWS.md @@ -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!)* diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index de25b120..519a3c0d 100755 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -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(...) diff --git a/R/aa_options.R b/R/aa_options.R index 633690c0..1123f06f 100755 --- a/R/aa_options.R +++ b/R/aa_options.R @@ -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 diff --git a/R/ab.R b/R/ab.R index 49f32f1f..404a1138 100755 --- a/R/ab.R +++ b/R/ab.R @@ -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 diff --git a/R/ab_property.R b/R/ab_property.R index ebcf13d2..bc107550 100755 --- a/R/ab_property.R +++ b/R/ab_property.R @@ -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 { diff --git a/R/antibiogram.R b/R/antibiogram.R index 12ace335..b3bca975 100755 --- a/R/antibiogram.R +++ b/R/antibiogram.R @@ -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 @@ #' - - - - #' -------------------------------------------------------------------- #' ``` -#' @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)*. . #' @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, ...) diff --git a/R/av.R b/R/av.R index 616f5936..7bb40fa8 100755 --- a/R/av.R +++ b/R/av.R @@ -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 diff --git a/R/bug_drug_combinations.R b/R/bug_drug_combinations.R index 536e9dac..f4b7f641 100755 --- a/R/bug_drug_combinations.R +++ b/R/bug_drug_combinations.R @@ -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) diff --git a/R/eucast_rules.R b/R/eucast_rules.R index da92f779..05995079 100755 --- a/R/eucast_rules.R +++ b/R/eucast_rules.R @@ -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>% diff --git a/R/first_isolate.R b/R/first_isolate.R index 59fd2b4c..a2967f7a 100755 --- a/R/first_isolate.R +++ b/R/first_isolate.R @@ -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 diff --git a/R/get_episode.R b/R/get_episode.R index 4c3c5c6b..caf77a5b 100755 --- a/R/get_episode.R +++ b/R/get_episode.R @@ -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 diff --git a/R/mo.R b/R/mo.R index d1f86c1f..341359ce 100755 --- a/R/mo.R +++ b/R/mo.R @@ -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]) diff --git a/R/proportion.R b/R/proportion.R index 1f90dae3..e8347dce 100755 --- a/R/proportion.R +++ b/R/proportion.R @@ -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) diff --git a/R/sir.R b/R/sir.R index abcd2250..596371e2 100755 --- a/R/sir.R +++ b/R/sir.R @@ -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) diff --git a/R/translate.R b/R/translate.R index af22b864..75c0746f 100755 --- a/R/translate.R +++ b/R/translate.R @@ -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], diff --git a/data-raw/reproduction_of_poorman.R b/data-raw/reproduction_of_poorman.R index fd925b21..11237603 100644 --- a/data-raw/reproduction_of_poorman.R +++ b/data-raw/reproduction_of_poorman.R @@ -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"] diff --git a/data-raw/salonella_fix.R b/data-raw/salonella_fix.R index 02030e09..ccd73d02 100644 --- a/data-raw/salonella_fix.R +++ b/data-raw/salonella_fix.R @@ -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" diff --git a/inst/tinytest/test-antibiogram.R b/inst/tinytest/test-antibiogram.R index 9b3c6ff2..8c925279 100644 --- a/inst/tinytest/test-antibiogram.R +++ b/inst/tinytest/test-antibiogram.R @@ -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") +} diff --git a/inst/tinytest/test-mo.R b/inst/tinytest/test-mo.R index cf1a1fe2..01c130db 100644 --- a/inst/tinytest/test-mo.R +++ b/inst/tinytest/test-mo.R @@ -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) ) diff --git a/inst/tinytest/test-get_locale.R b/inst/tinytest/test-translate.R similarity index 66% rename from inst/tinytest/test-get_locale.R rename to inst/tinytest/test-translate.R index 228d02b2..b041a904 100644 --- a/inst/tinytest/test-get_locale.R +++ b/inst/tinytest/test-translate.R @@ -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")) diff --git a/man/antibiogram.Rd b/man/antibiogram.Rd index 734773a4..a082a621 100644 --- a/man/antibiogram.Rd +++ b/man/antibiogram.Rd @@ -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")) { diff --git a/man/get_episode.Rd b/man/get_episode.Rd index 76874194..192cec3c 100644 --- a/man/get_episode.Rd +++ b/man/get_episode.Rd @@ -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)) \%>\%