1
0
mirror of https://github.com/msberends/AMR.git synced 2024-12-25 07:26:12 +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 Package: AMR
Version: 1.8.2.9120 Version: 1.8.2.9121
Date: 2023-02-12 Date: 2023-02-12
Title: Antimicrobial Resistance Data Analysis Title: Antimicrobial Resistance Data Analysis
Description: Functions to simplify and standardise antimicrobial resistance (AMR) Description: Functions to simplify and standardise antimicrobial resistance (AMR)

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!)* *(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 out
} }
rbind2 <- function (...) { rbind2 <- function(...) {
# this is just rbind(), but then with the functionality of dplyr::bind_rows(), # this is just rbind(), but then with the functionality of dplyr::bind_rows(),
# to allow differences in available columns # to allow differences in available columns
l <- list(...) l <- list(...)

View File

@ -29,7 +29,7 @@
#' Options for the AMR package #' 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: #' @section Options:
#' * `AMR_custom_ab` \cr Allows to use custom antimicrobial drugs with this package. This is explained in [add_custom_antimicrobials()]. #' * `AMR_custom_ab` \cr Allows to use custom antimicrobial drugs with this package. This is explained in [add_custom_antimicrobials()].
#' * `AMR_custom_mo` \cr Allows to use custom microorganisms with this package. This is explained in [add_custom_microorganisms()]. #' * `AMR_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_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_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()]. #' * `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: #' @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: #' 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 #' ```r
#' utils::file.edit("~/.Rprofile") #' utils::file.edit("~/.Rprofile")
#' ``` #' ```
#' #'
#' In this file, you can set options such as: #' In this file, you can set options such as:
#' #'
#' ```r #' ```r
#' options(AMR_locale = "pt") #' options(AMR_locale = "pt")
#' options(AMR_include_PKPD = TRUE) #' options(AMR_include_PKPD = TRUE)
#' ``` #' ```
#' #'
#' to add Portuguese language support of antibiotics, and allow PK/PD rules when interpreting MIC values with [as.sir()]. #' to add Portuguese language support of antibiotics, and allow PK/PD rules when interpreting MIC values with [as.sir()].
#' #'
#' ### Share Options Within Team #' ### 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: #' 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. #' 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: #' 2. For each user, open the `.Rprofile` file using `utils::file.edit("~/.Rprofile")` and put in there:
#' #'
#' ```r #' ```r
#' source("X:/team_folder/R_options.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. #' 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. #' Now the team settings are configured in only one place, and can be maintained there.
#' @keywords internal #' @keywords internal
#' @name AMR-options #' @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 # save to package env to save time for next time
if (isTRUE(initial_search)) { 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 <- 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( data.frame(
x = x, x = x,
ab = x_new, ab = x_new,
x_bak = x_bak[match(x, x_bak_clean)], x_bak = x_bak[match(x, x_bak_clean)],
stringsAsFactors = FALSE stringsAsFactors = FALSE
))) )
))
} }
# take failed ATC codes apart from rest # 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 (is.data.frame(data)) {
if (tryCatch(length(c(...)) > 1, error = function(e) TRUE)) { if (tryCatch(length(c(...)) > 1, error = function(e) TRUE)) {
df <- tryCatch(suppressWarnings(pm_select(data, ...)), df <- tryCatch(suppressWarnings(pm_select(data, ...)),
error = function(e) { error = function(e) {
data[, c(...), drop = FALSE] data[, c(...), drop = FALSE]
}) }
)
} else if (tryCatch(is.character(c(...)), error = function(e) FALSE)) { } else if (tryCatch(is.character(c(...)), error = function(e) FALSE)) {
df <- data[, c(...), drop = FALSE] df <- data[, c(...), drop = FALSE]
} else { } else {

View File

@ -46,62 +46,62 @@
#' @param object an [antibiogram()] object #' @param object an [antibiogram()] object
#' @param ... method extensions #' @param ... method extensions
#' @details This function returns a table with values between 0 and 100 for *susceptibility*, not resistance. #' @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. #' **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()]: #' 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** #' 1. **Traditional Antibiogram**
#' #'
#' Case example: Susceptibility of *Pseudomonas aeruginosa* to piperacillin/tazobactam (TZP) #' Case example: Susceptibility of *Pseudomonas aeruginosa* to piperacillin/tazobactam (TZP)
#' #'
#' Code example: #' Code example:
#' #'
#' ```r #' ```r
#' antibiogram(your_data, #' antibiogram(your_data,
#' antibiotics = "TZP") #' antibiotics = "TZP")
#' ``` #' ```
#' #'
#' 2. **Combination Antibiogram** #' 2. **Combination Antibiogram**
#' #'
#' Case example: Additional susceptibility of *Pseudomonas aeruginosa* to TZP + tobramycin versus TZP alone #' Case example: Additional susceptibility of *Pseudomonas aeruginosa* to TZP + tobramycin versus TZP alone
#' #'
#' Code example: #' Code example:
#' #'
#' ```r #' ```r
#' antibiogram(your_data, #' antibiogram(your_data,
#' antibiotics = c("TZP", "TZP+TOB", "TZP+GEN")) #' antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"))
#' ``` #' ```
#' #'
#' 3. **Syndromic Antibiogram** #' 3. **Syndromic Antibiogram**
#' #'
#' Case example: Susceptibility of *Pseudomonas aeruginosa* to TZP among respiratory specimens (obtained among ICU patients only) #' Case example: Susceptibility of *Pseudomonas aeruginosa* to TZP among respiratory specimens (obtained among ICU patients only)
#' #'
#' Code example: #' Code example:
#' #'
#' ```r #' ```r
#' antibiogram(your_data, #' antibiogram(your_data,
#' antibiotics = penicillins(), #' antibiotics = penicillins(),
#' syndromic_group = "ward") #' syndromic_group = "ward")
#' ``` #' ```
#' #'
#' 4. **Weighted-Incidence Syndromic Combination Antibiogram (WISCA)** #' 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 #' 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: #' Code example:
#' #'
#' ```r #' ```r
#' antibiogram(your_data, #' antibiogram(your_data,
#' antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"), #' antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
#' syndromic_group = ifelse(your_data$age >= 65 & your_data$gender == "Male", #' syndromic_group = ifelse(your_data$age >= 65 & your_data$gender == "Male",
#' "Group 1", "Group 2")) #' "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()`. #' 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: #' 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 #' only_all_tested = FALSE only_all_tested = TRUE
@ -120,99 +120,111 @@
#' <NA> <NA> - - - - #' <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} #' * 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} #' * 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/>. #' * **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 #' @rdname antibiogram
#' @name antibiogram #' @name antibiogram
#' @export #' @export
#' @examples #' @examples
#' # example_isolates is a data set available in the AMR package. #' # example_isolates is a data set available in the AMR package.
#' # run ?example_isolates for more info. #' # run ?example_isolates for more info.
#' example_isolates #' example_isolates
#' #'
#' #'
#' # Traditional antibiogram ---------------------------------------------- #' # Traditional antibiogram ----------------------------------------------
#' #'
#' antibiogram(example_isolates, #' antibiogram(example_isolates,
#' antibiotics = c(aminoglycosides(), carbapenems())) #' antibiotics = c(aminoglycosides(), carbapenems())
#' #' )
#'
#' antibiogram(example_isolates, #' antibiogram(example_isolates,
#' antibiotics = aminoglycosides(), #' antibiotics = aminoglycosides(),
#' ab_transform = "atc", #' ab_transform = "atc",
#' mo_transform = "gramstain") #' mo_transform = "gramstain"
#' #' )
#'
#' antibiogram(example_isolates, #' antibiogram(example_isolates,
#' antibiotics = carbapenems(), #' antibiotics = carbapenems(),
#' ab_transform = "name", #' ab_transform = "name",
#' mo_transform = "name") #' mo_transform = "name"
#' #' )
#' #'
#'
#' # Combined antibiogram ------------------------------------------------- #' # Combined antibiogram -------------------------------------------------
#' #'
#' # combined antibiotics yield higher empiric coverage #' # combined antibiotics yield higher empiric coverage
#' antibiogram(example_isolates, #' antibiogram(example_isolates,
#' antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"), #' antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
#' mo_transform = "gramstain") #' mo_transform = "gramstain"
#' #' )
#'
#' antibiogram(example_isolates, #' antibiogram(example_isolates,
#' antibiotics = c("TZP", "TZP+TOB"), #' antibiotics = c("TZP", "TZP+TOB"),
#' mo_transform = "gramstain", #' mo_transform = "gramstain",
#' ab_transform = "name", #' ab_transform = "name",
#' sep = " & ") #' sep = " & "
#' #' )
#' #'
#'
#' # Syndromic antibiogram ------------------------------------------------ #' # Syndromic antibiogram ------------------------------------------------
#' #'
#' # the data set could contain a filter for e.g. respiratory specimens #' # the data set could contain a filter for e.g. respiratory specimens
#' antibiogram(example_isolates, #' antibiogram(example_isolates,
#' antibiotics = c(aminoglycosides(), carbapenems()), #' antibiotics = c(aminoglycosides(), carbapenems()),
#' syndromic_group = "ward") #' syndromic_group = "ward"
#' #' )
#'
#' # now define a data set with only E. coli #' # now define a data set with only E. coli
#' ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ] #' ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ]
#' #'
#' # with a custom language, though this will be determined automatically #' # with a custom language, though this will be determined automatically
#' # (i.e., this table will be in Spanish on Spanish systems) #' # (i.e., this table will be in Spanish on Spanish systems)
#' antibiogram(ex1, #' antibiogram(ex1,
#' antibiotics = aminoglycosides(), #' antibiotics = aminoglycosides(),
#' ab_transform = "name", #' ab_transform = "name",
#' syndromic_group = ifelse(ex1$ward == "ICU", #' syndromic_group = ifelse(ex1$ward == "ICU",
#' "UCI", "No UCI"), #' "UCI", "No UCI"
#' language = "es") #' ),
#' #' language = "es"
#' #' )
#'
#'
#' # Weighted-incidence syndromic combination antibiogram (WISCA) --------- #' # Weighted-incidence syndromic combination antibiogram (WISCA) ---------
#' #'
#' # the data set could contain a filter for e.g. respiratory specimens #' # the data set could contain a filter for e.g. respiratory specimens
#' antibiogram(example_isolates, #' antibiogram(example_isolates,
#' antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"), #' antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"),
#' mo_transform = "gramstain", #' mo_transform = "gramstain",
#' minimum = 10, # this should be >= 30, but now just as example #' minimum = 10, # this should be >= 30, but now just as example
#' syndromic_group = ifelse(example_isolates$age >= 65 & #' syndromic_group = ifelse(example_isolates$age >= 65 &
#' example_isolates$gender == "M", #' example_isolates$gender == "M",
#' "WISCA Group 1", "WISCA Group 2")) #' "WISCA Group 1", "WISCA Group 2"
#' #' )
#' #' )
#'
#'
#' # Generate plots with ggplot2 or base R -------------------------------- #' # Generate plots with ggplot2 or base R --------------------------------
#' #'
#' ab1 <- antibiogram(example_isolates, #' ab1 <- antibiogram(example_isolates,
#' antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"), #' antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
#' mo_transform = "gramstain") #' mo_transform = "gramstain"
#' )
#' ab2 <- antibiogram(example_isolates, #' ab2 <- antibiogram(example_isolates,
#' antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"), #' antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
#' mo_transform = "gramstain", #' mo_transform = "gramstain",
#' syndromic_group = "ward") #' syndromic_group = "ward"
#' #' )
#'
#' plot(ab1) #' plot(ab1)
#' #'
#' if (requireNamespace("ggplot2")) { #' if (requireNamespace("ggplot2")) {
#' ggplot2::autoplot(ab1) #' ggplot2::autoplot(ab1)
#' } #' }
#' #'
#' plot(ab2) #' plot(ab2)
#' #'
#' if (requireNamespace("ggplot2")) { #' if (requireNamespace("ggplot2")) {
#' ggplot2::autoplot(ab2) #' 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(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(combine_SI, allow_class = "logical", has_length = 1)
meet_criteria(sep, allow_class = "character", has_length = 1) meet_criteria(sep, allow_class = "character", has_length = 1)
# try to find columns based on type # try to find columns based on type
if (is.null(col_mo)) { if (is.null(col_mo)) {
col_mo <- search_type_in_df(x = x, type = "mo", info = interactive()) col_mo <- search_type_in_df(x = x, type = "mo", info = interactive())
@ -274,7 +286,7 @@ antibiogram <- function(x,
} else { } else {
has_syndromic_group <- FALSE has_syndromic_group <- FALSE
} }
# get antibiotics # get antibiotics
if (tryCatch(is.character(antibiotics), error = function(e) FALSE)) { if (tryCatch(is.character(antibiotics), error = function(e) FALSE)) {
antibiotics <- strsplit(gsub(" ", "", antibiotics), "+", fixed = TRUE) 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 # determine whether this new column should contain S, I, R, or NA
if (isTRUE(combine_SI)) { if (isTRUE(combine_SI)) {
S_values <- c("S", "I") S_values <- c("S", "I")
}else { } else {
S_values <- "S" S_values <- "S"
} }
other_values <- setdiff(c("S", "I", "R"), S_values) other_values <- setdiff(c("S", "I", "R"), S_values)
@ -307,8 +319,10 @@ antibiogram <- function(x,
if (isTRUE(only_all_tested)) { 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)) 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 { } 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")), x[new_colname] <- as.sir(vapply(
USE.NAMES = FALSE)) 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 antibiotics[[i]] <- new_colname
@ -317,32 +331,34 @@ antibiogram <- function(x,
} else { } else {
antibiotics <- colnames(suppressWarnings(x[, antibiotics, drop = FALSE])) antibiotics <- colnames(suppressWarnings(x[, antibiotics, drop = FALSE]))
} }
if (isTRUE(has_syndromic_group)) { if (isTRUE(has_syndromic_group)) {
out <- x %pm>% out <- x %pm>%
pm_select(.syndromic_group, .mo, antibiotics) %pm>% pm_select(.syndromic_group, .mo, antibiotics) %pm>%
pm_group_by(.syndromic_group) pm_group_by(.syndromic_group)
} else { } else {
out <- x %pm>% out <- x %pm>%
pm_select(.mo, antibiotics) pm_select(.mo, antibiotics)
} }
# get numbers of S, I, R (per group) # get numbers of S, I, R (per group)
out <- out %pm>% out <- out %pm>%
bug_drug_combinations(col_mo = ".mo", bug_drug_combinations(
FUN = function(x) x) col_mo = ".mo",
FUN = function(x) x
)
counts <- out counts <- out
# regroup for summarising # regroup for summarising
if (isTRUE(has_syndromic_group)) { if (isTRUE(has_syndromic_group)) {
colnames(out)[1] <- "syndromic_group" colnames(out)[1] <- "syndromic_group"
out <- out %pm>% out <- out %pm>%
pm_group_by(syndromic_group, mo, ab) pm_group_by(syndromic_group, mo, ab)
} else { } else {
out <- out %pm>% out <- out %pm>%
pm_group_by(mo, ab) pm_group_by(mo, ab)
} }
if (isTRUE(combine_SI)) { if (isTRUE(combine_SI)) {
out$numerator <- out$S + out$I out$numerator <- out$S + out$I
} else { } else {
@ -351,13 +367,13 @@ antibiogram <- function(x,
out$minimum <- minimum out$minimum <- minimum
if (any(out$total < out$minimum, na.rm = TRUE)) { 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) 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) subset(total >= minimum)
} }
out <- out %pm>% out <- out %pm>%
pm_summarise(SI = numerator / total) pm_summarise(SI = numerator / total)
# transform names of antibiotics # transform names of antibiotics
ab_naming_function <- function(x, t, l, s) { ab_naming_function <- function(x, t, l, s) {
x <- strsplit(x, s, fixed = TRUE) x <- strsplit(x, s, fixed = TRUE)
@ -379,24 +395,24 @@ antibiogram <- function(x,
out out
} }
out$ab <- ab_naming_function(out$ab, t = ab_transform, l = language, s = sep) out$ab <- ab_naming_function(out$ab, t = ab_transform, l = language, s = sep)
# transform long to wide # transform long to wide
long_to_wide <- function(object, digs) { long_to_wide <- function(object, digs) {
object$SI <- round(object$SI * 100, digits = digs) object$SI <- round(object$SI * 100, digits = digs)
object <- object %pm>% object <- object %pm>%
# an unclassed data.frame is required for stats::reshape() # 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") stats::reshape(direction = "wide", idvar = "mo", timevar = "ab", v.names = "SI")
colnames(object) <- gsub("^SI?[.]", "", colnames(object)) colnames(object) <- gsub("^SI?[.]", "", colnames(object))
return(object) return(object)
} }
# ungroup for long -> wide transformation # ungroup for long -> wide transformation
attr(out, "pm_groups") <- NULL attr(out, "pm_groups") <- NULL
attr(out, "groups") <- NULL attr(out, "groups") <- NULL
class(out) <- class(out)[!class(out) %in% c("grouped_df", "grouped_data")] class(out) <- class(out)[!class(out) %in% c("grouped_df", "grouped_data")]
long <- out long <- out
if (isTRUE(has_syndromic_group)) { if (isTRUE(has_syndromic_group)) {
grps <- unique(out$syndromic_group) grps <- unique(out$syndromic_group)
for (i in seq_len(length(grps))) { for (i in seq_len(length(grps))) {
@ -404,8 +420,10 @@ antibiogram <- function(x,
if (i == 1) { if (i == 1) {
new_df <- long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits) new_df <- long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits)
} else { } else {
new_df <- rbind2(new_df, new_df <- rbind2(
long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits)) new_df,
long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits)
)
} }
} }
# sort rows # 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] 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) colnames(new_df)[1] <- translate_AMR("Pathogen", language = language)
} }
# add total N if indicated # add total N if indicated
if (isTRUE(add_total_n)) { if (isTRUE(add_total_n)) {
if (isTRUE(has_syndromic_group)) { if (isTRUE(has_syndromic_group)) {
@ -442,10 +460,11 @@ antibiogram <- function(x,
new_df[[edit_col]] <- paste0(new_df[[edit_col]], " (", count_group, ")") 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)") 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"), structure(as_original_data_class(new_df, class(x), extra_class = "antibiogram"),
long = long, long = long,
combine_SI = combine_SI) combine_SI = combine_SI
)
} }
#' @export #' @export
@ -458,22 +477,24 @@ plot.antibiogram <- function(x, ...) {
df$syndromic_group <- NULL df$syndromic_group <- NULL
df <- df[order(df$mo), , drop = FALSE] df <- df[order(df$mo), , drop = FALSE]
} }
mo_levels = unique(df$mo) mo_levels <- unique(df$mo)
mfrow_old <- graphics::par()$mfrow mfrow_old <- graphics::par()$mfrow
sqrt_levels <- sqrt(length(mo_levels)) sqrt_levels <- sqrt(length(mo_levels))
graphics::par(mfrow = c(ceiling(sqrt_levels), floor(sqrt_levels))) graphics::par(mfrow = c(ceiling(sqrt_levels), floor(sqrt_levels)))
for (i in seq_along(mo_levels)) { for (i in seq_along(mo_levels)) {
mo <- mo_levels[i] mo <- mo_levels[i]
df_sub <- df[df$mo == mo, , drop = FALSE] df_sub <- df[df$mo == mo, , drop = FALSE]
barplot(height = df_sub$SI * 100, barplot(
xlab = NULL, height = df_sub$SI * 100,
ylab = ifelse(isTRUE(attributes(x)$combine_SI), "%SI", "%S"), xlab = NULL,
names.arg = df_sub$ab, ylab = ifelse(isTRUE(attributes(x)$combine_SI), "%SI", "%S"),
col = "#aaaaaa", names.arg = df_sub$ab,
beside = TRUE, col = "#aaaaaa",
main = mo, beside = TRUE,
legend = NULL) main = mo,
legend = NULL
)
} }
graphics::par(mfrow = mfrow_old) graphics::par(mfrow = mfrow_old)
} }
@ -490,22 +511,28 @@ barplot.antibiogram <- function(height, ...) {
autoplot.antibiogram <- function(object, ...) { autoplot.antibiogram <- function(object, ...) {
df <- attributes(object)$long df <- attributes(object)$long
ggplot2::ggplot(df) + ggplot2::ggplot(df) +
ggplot2::geom_col(ggplot2::aes(x = ab, ggplot2::geom_col(
y = SI * 100, ggplot2::aes(
fill = if ("syndromic_group" %in% colnames(df)) { x = ab,
syndromic_group y = SI * 100,
} else { fill = if ("syndromic_group" %in% colnames(df)) {
NULL syndromic_group
}), } else {
position = ggplot2::position_dodge2(preserve = "single")) + NULL
}
),
position = ggplot2::position_dodge2(preserve = "single")
) +
ggplot2::facet_wrap("mo") + ggplot2::facet_wrap("mo") +
ggplot2::labs(y = ifelse(isTRUE(attributes(object)$combine_SI), "%SI", "%S"), ggplot2::labs(
x = NULL, y = ifelse(isTRUE(attributes(object)$combine_SI), "%SI", "%S"),
fill = if ("syndromic_group" %in% colnames(df)) { x = NULL,
colnames(object)[1] fill = if ("syndromic_group" %in% colnames(df)) {
} else { colnames(object)[1]
NULL } else {
}) NULL
}
)
} }
#' @export #' @export
@ -515,8 +542,8 @@ autoplot.antibiogram <- function(object, ...) {
print.antibiogram <- function(x, as_kable = !interactive(), ...) { print.antibiogram <- function(x, as_kable = !interactive(), ...) {
meet_criteria(as_kable, allow_class = "logical", has_length = 1) meet_criteria(as_kable, allow_class = "logical", has_length = 1)
if (isTRUE(as_kable) && if (isTRUE(as_kable) &&
# be sure not to run kable in pkgdown for our website generation # be sure not to run kable in pkgdown for our website generation
!identical(Sys.getenv("IN_PKGDOWN"), "true")) { !identical(Sys.getenv("IN_PKGDOWN"), "true")) {
stop_ifnot_installed("knitr") stop_ifnot_installed("knitr")
kable <- import_fn("kable", "knitr", error_on_fail = TRUE) kable <- import_fn("kable", "knitr", error_on_fail = TRUE)
kable(x, ...) 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 # save to package env to save time for next time
if (isTRUE(initial_search)) { 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 <- 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( data.frame(
x = x, x = x,
av = x_new, av = x_new,
x_bak = x_bak[match(x, x_bak_clean)], x_bak = x_bak[match(x, x_bak_clean)],
stringsAsFactors = FALSE stringsAsFactors = FALSE
))) )
))
} }
# take failed ATC codes apart from rest # take failed ATC codes apart from rest

View File

@ -47,7 +47,7 @@
#' # example_isolates is a data set available in the AMR package. #' # example_isolates is a data set available in the AMR package.
#' # run ?example_isolates for more info. #' # run ?example_isolates for more info.
#' example_isolates #' example_isolates
#' #'
#' \donttest{ #' \donttest{
#' x <- bug_drug_combinations(example_isolates) #' x <- bug_drug_combinations(example_isolates)
#' head(x) #' 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)) 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' # save changes to data set 'verbose_info'
track_changes$verbose_info <- rbind2(track_changes$verbose_info, track_changes$verbose_info <- rbind2(
verbose_new) track_changes$verbose_info,
verbose_new
)
# count adds and changes # count adds and changes
track_changes$added <- track_changes$added + verbose_new %pm>% track_changes$added <- track_changes$added + verbose_new %pm>%
pm_filter(is.na(old)) %pm>% pm_filter(is.na(old)) %pm>%

View File

@ -480,7 +480,7 @@ first_isolate <- function(x = NULL,
), ),
use.names = FALSE use.names = FALSE
) )
if (!is.null(col_keyantimicrobials)) { if (!is.null(col_keyantimicrobials)) {
# with key antibiotics # with key antibiotics
x$other_key_ab <- !antimicrobials_equal( x$other_key_ab <- !antimicrobials_equal(
@ -501,20 +501,20 @@ first_isolate <- function(x = NULL,
x$newvar_genus_species != "" & x$newvar_genus_species != "" &
(x$other_pat_or_mo | x$more_than_episode_ago) (x$other_pat_or_mo | x$more_than_episode_ago)
} }
# first one as TRUE # first one as TRUE
x[row.start, "newvar_first_isolate"] <- TRUE x[row.start, "newvar_first_isolate"] <- TRUE
# no tests that should be included, or ICU # no tests that should be included, or ICU
if (!is.null(col_testcode)) { if (!is.null(col_testcode)) {
x[which(x[, col_testcode] %in% tolower(testcodes_exclude)), "newvar_first_isolate"] <- FALSE x[which(x[, col_testcode] %in% tolower(testcodes_exclude)), "newvar_first_isolate"] <- FALSE
} }
if (!is.null(col_icu)) { if (!is.null(col_icu)) {
if (icu_exclude == TRUE) { if (icu_exclude == TRUE) {
if (isTRUE(info)) { if (isTRUE(info)) {
message_("Excluding ", format(sum(col_icu, na.rm = TRUE), big.mark = " "), " isolates from ICU.", message_("Excluding ", format(sum(col_icu, na.rm = TRUE), big.mark = " "), " isolates from ICU.",
add_fn = font_black, add_fn = font_black,
as_note = FALSE as_note = FALSE
) )
} }
x[which(col_icu), "newvar_first_isolate"] <- 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 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 #' @param ... ignored, only in place to allow future extensions
#' @details The functions [get_episode()] and [is_new_episode()] differ in this way when setting `episode_days` to 365: #' @details 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()` | #' | person_id | date | `get_episode()` | `is_new_episode()` |
#' |:---------:|:----------:|:---------------:|:------------------:| #' |:---------:|:----------:|:---------------:|:------------------:|
#' | A | 2019-01-01 | 1 | TRUE | #' | A | 2019-01-01 | 1 | TRUE |
@ -44,7 +44,7 @@
#' | B | 2008-01-01 | 1 | TRUE | #' | B | 2008-01-01 | 1 | TRUE |
#' | B | 2008-01-01 | 1 | FALSE | #' | B | 2008-01-01 | 1 | FALSE |
#' | C | 2020-01-01 | 1 | TRUE | #' | 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. #' 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. #' 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), ] #' df[which(get_episode(df$date, 60) == 3), ]
#' #'
#' # the functions also work for less than a day, e.g. to include one per hour: #' # the functions also work for less than a day, e.g. to include one per hour:
#' get_episode(c(Sys.time(), #' get_episode(
#' Sys.time() + 60 * 60), #' c(
#' episode_days = 1 / 24) #' Sys.time(),
#' Sys.time() + 60 * 60
#' ),
#' episode_days = 1 / 24
#' )
#' #'
#' \donttest{ #' \donttest{
#' if (require("dplyr")) { #' if (require("dplyr")) {
@ -84,10 +88,10 @@
#' )) %>% #' )) %>%
#' group_by(patient, condition) %>% #' group_by(patient, condition) %>%
#' mutate(new_episode = is_new_episode(date, 365)) %>% #' mutate(new_episode = is_new_episode(date, 365)) %>%
#' select(patient, date, condition, new_episode) %>% #' select(patient, date, condition, new_episode) %>%
#' arrange(patient, condition, date) #' arrange(patient, condition, date)
#' } #' }
#' #'
#' if (require("dplyr")) { #' if (require("dplyr")) {
#' df %>% #' df %>%
#' group_by(ward, patient) %>% #' group_by(ward, patient) %>%
@ -95,10 +99,10 @@
#' patient, #' patient,
#' new_index = get_episode(date, 60), #' new_index = get_episode(date, 60),
#' new_logical = is_new_episode(date, 60) #' new_logical = is_new_episode(date, 60)
#' ) %>% #' ) %>%
#' arrange(patient, ward, date) #' arrange(patient, ward, date)
#' } #' }
#' #'
#' if (require("dplyr")) { #' if (require("dplyr")) {
#' df %>% #' df %>%
#' group_by(ward) %>% #' group_by(ward) %>%
@ -109,7 +113,7 @@
#' n_episodes_30 = sum(is_new_episode(date, episode_days = 30)) #' n_episodes_30 = sum(is_new_episode(date, episode_days = 30))
#' ) #' )
#' } #' }
#' #'
#' # grouping on patients and microorganisms leads to the same #' # grouping on patients and microorganisms leads to the same
#' # results as first_isolate() when using 'episode-based': #' # results as first_isolate() when using 'episode-based':
#' if (require("dplyr")) { #' if (require("dplyr")) {
@ -126,11 +130,10 @@
#' #'
#' identical(x, y) #' identical(x, y)
#' } #' }
#' #'
#' # but is_new_episode() has a lot more flexibility than first_isolate(), #' # but is_new_episode() has a lot more flexibility than first_isolate(),
#' # since you can now group on anything that seems relevant: #' # since you can now group on anything that seems relevant:
#' if (require("dplyr")) { #' if (require("dplyr")) {
#'
#' df %>% #' df %>%
#' group_by(patient, mo, ward) %>% #' group_by(patient, mo, ward) %>%
#' mutate(flag_episode = is_new_episode(date, 365)) %>% #' 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, ...) { exec_episode <- function(x, episode_days, ...) {
x <- as.double(as.POSIXct(x)) # as.POSIXct() required for Date classes 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 # since x is now in seconds, get seconds from episode_days as well
episode_seconds <- episode_days * 60 * 60 * 24 episode_seconds <- episode_days * 60 * 60 * 24
if (length(x) == 1) { # this will also match 1 NA, which is fine if (length(x) == 1) { # this will also match 1 NA, which is fine
return(1) return(1)
} else if (length(x) == 2 && !all(is.na(x))) { } else if (length(x) == 2 && !all(is.na(x))) {
@ -166,7 +169,7 @@ exec_episode <- function(x, episode_days, ...) {
return(c(1, 1)) return(c(1, 1))
} }
} }
# we asked on StackOverflow: # we asked on StackOverflow:
# https://stackoverflow.com/questions/42122245/filter-one-row-every-year # https://stackoverflow.com/questions/42122245/filter-one-row-every-year
run_episodes <- function(x, episode_seconds) { run_episodes <- function(x, episode_seconds) {
@ -183,7 +186,7 @@ exec_episode <- function(x, episode_days, ...) {
} }
indices indices
} }
ord <- order(x) ord <- order(x)
out <- run_episodes(x[ord], episode_seconds)[order(ord)] 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 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_ result_mo <- NA_character_
} else { } else {
result_mo <- AMR_env$MO_lookup$mo[match(top_hits[1], AMR_env$MO_lookup$fullname)] 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( data.frame(
original_input = x_search, original_input = x_search,
input = x_search_cleaned, 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), minimum_matching_score = ifelse(is.null(minimum_matching_score), "NULL", minimum_matching_score),
keep_synonyms = keep_synonyms, keep_synonyms = keep_synonyms,
stringsAsFactors = FALSE stringsAsFactors = FALSE
)) )
)
# save to package env to save time for next time # 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( data.frame(
x = paste(x_search, minimum_matching_score), x = paste(x_search, minimum_matching_score),
mo = result_mo, mo = result_mo,
stringsAsFactors = FALSE stringsAsFactors = FALSE
))) )
))
} }
# the actual result: # the actual result:
as.character(result_mo) 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)) 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() add_MO_lookup_to_AMR_env()
col_red <- function(x) font_rose_bg(font_black(x, collapse = NULL), collapse = NULL) 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_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_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) col_green <- function(x) font_green_bg(font_black(x, collapse = NULL), collapse = NULL)
if (has_colour()) { if (has_colour()) {
cat(word_wrap("Colour keys: ", cat(word_wrap("Colour keys: ",
col_red(" 0.000-0.499 "), col_red(" 0.000-0.499 "),
@ -814,7 +818,7 @@ print.mo_uncertainties <- function(x, ...) {
add_fn = font_blue add_fn = font_blue
), font_green_bg(" "), "\n", sep = "") ), font_green_bg(" "), "\n", sep = "")
} }
score_set_colour <- function(text, scores) { score_set_colour <- function(text, scores) {
# set colours to scores # set colours to scores
text[scores >= 0.7] <- col_green(text[scores >= 0.7]) 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. #' 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: #' @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: #' 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: #' Please note that, in combination therapies, for `only_all_tested = TRUE` applies that:
#' #'
#' ``` #' ```
#' count_S() + count_I() + count_R() = count_all() #' count_S() + count_I() + count_R() = count_all()
#' proportion_S() + proportion_I() + proportion_R() = 1 #' proportion_S() + proportion_I() + proportion_R() = 1
#' ``` #' ```
#' #'
#' and that, in combination therapies, for `only_all_tested = FALSE` applies that: #' and that, in combination therapies, for `only_all_tested = FALSE` applies that:
#' #'
#' ``` #' ```
#' count_S() + count_I() + count_R() >= count_all() #' count_S() + count_I() + count_R() >= count_all()
#' proportion_S() + proportion_I() + proportion_R() >= 1 #' proportion_S() + proportion_I() + proportion_R() >= 1
@ -103,8 +103,8 @@
#' # example_isolates is a data set available in the AMR package. #' # example_isolates is a data set available in the AMR package.
#' # run ?example_isolates for more info. #' # run ?example_isolates for more info.
#' example_isolates #' example_isolates
#' #'
#' #'
#' # base R ------------------------------------------------------------ #' # base R ------------------------------------------------------------
#' # determines %R #' # determines %R
#' resistance(example_isolates$AMX) #' resistance(example_isolates$AMX)

View File

@ -30,7 +30,7 @@
#' Translate MIC and Disk Diffusion to SIR, or Clean Existing SIR Data #' 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`. #' @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. #' All breakpoints used for interpretation are publicly available in the [clinical_breakpoints] data set.
#' @rdname as.sir #' @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) #' @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( lapply(
# starting from last row, since more general translations are on top, such as 'Group' # starting with longest pattern, since more general translations are shorter, such as 'Group'
rev(seq_len(nrow(df_trans))), order(nchar(df_trans$pattern), decreasing = TRUE),
function(i) { function(i) {
from_unique_translated <<- gsub( from_unique_translated <<- gsub(
pattern = df_trans$pattern[i], 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$"] 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 # 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 # add commit to intro part
gsub("{commit}", commit, ., fixed = TRUE) %>% gsub("{commit}", commit, ., fixed = TRUE) %>%
# add date to intro part # add date to intro part
@ -56,7 +56,6 @@ for (use in has_usemethods) {
} }
# add pm_ prefix # add pm_ prefix
contents[relevant_row - 1] <- paste0("pm_", contents[relevant_row - 1]) contents[relevant_row - 1] <- paste0("pm_", contents[relevant_row - 1])
} }
# correct for NextMethod # correct for NextMethod
contents <- gsub("NextMethod\\(\"(.*)\"\\)", "\\1.data.frame(...)", contents) 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(.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 <- 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[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? # who needs US spelling?
contents <- contents[contents %unlike% "summarize"] contents <- contents[contents %unlike% "summarize"]

View File

@ -1,26 +1,30 @@
snomed2 <- microorganisms %>%
snomed2 <- microorganisms %>% filter(mo %in% c("B_SLMNL_TYPH", "B_SLMNL_HMRM", "B_SLMNL_PRTY")) %>% filter(mo %in% c("B_SLMNL_TYPH", "B_SLMNL_HMRM", "B_SLMNL_PRTY")) %>%
pull(snomed) pull(snomed)
new_typhi <- microorganisms %>% new_typhi <- microorganisms %>%
filter(mo == "B_SLMNL_THSS") %>% filter(mo == "B_SLMNL_THSS") %>%
slice(c(1,1, 1)) %>% slice(c(1, 1, 1)) %>%
mutate(mo = c("B_SLMNL_TYPH", "B_SLMNL_HMRM", "B_SLMNL_PRTY"), mutate(
fullname = c("Salmonella Typhi", "Salmonella Typhimurium", "Salmonella Paratyphi"), mo = c("B_SLMNL_TYPH", "B_SLMNL_HMRM", "B_SLMNL_PRTY"),
subspecies = c("Typhi", "Typhimurium", "Paratyphi"), fullname = c("Salmonella Typhi", "Salmonella Typhimurium", "Salmonella Paratyphi"),
snomed = snomed2) subspecies = c("Typhi", "Typhimurium", "Paratyphi"),
snomed = snomed2
)
new_groupa <- microorganisms %>% new_groupa <- microorganisms %>%
filter(mo == "B_SLMNL_GRPB") %>% filter(mo == "B_SLMNL_GRPB") %>%
mutate(mo = "B_SLMNL_GRPA", mutate(
fullname = gsub("roup B", "roup A", fullname), mo = "B_SLMNL_GRPA",
species = gsub("roup B", "roup A", species)) fullname = gsub("roup B", "roup A", fullname),
species = gsub("roup B", "roup A", species)
)
microorganisms$mo <- as.character(microorganisms$mo) microorganisms$mo <- as.character(microorganisms$mo)
microorganisms <- microorganisms %>% microorganisms <- microorganisms %>%
filter(!mo %in% c("B_SLMNL_TYPH", "B_SLMNL_HMRM", "B_SLMNL_PRTY")) %>% filter(!mo %in% c("B_SLMNL_TYPH", "B_SLMNL_HMRM", "B_SLMNL_PRTY")) %>%
bind_rows(new_typhi, new_groupa) %>% bind_rows(new_typhi, new_groupa) %>%
arrange(fullname) arrange(fullname)
microorganisms$lpsn_parent[which(microorganisms$genus == "Salmonella" & microorganisms$rank == "species")] <- "516547" 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/ # # how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== # # ==================================================================== #
expect_identical(as.mo("Enterobacter asburiae/cloacae"),
as.mo("Enterobacter asburiae"))
suppressMessages( # Traditional antibiogram ----------------------------------------------
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/ #
# ==================================================================== #
# ab1 <- antibiogram(example_isolates,
# antibiotics = c(aminoglycosides(), carbapenems()))
# # Traditional antibiogram ----------------------------------------------
# ab2 <- antibiogram(example_isolates,
# ab1 <- antibiogram(example_isolates, antibiotics = aminoglycosides(),
# antibiotics = c(aminoglycosides(), carbapenems())) ab_transform = "atc",
# mo_transform = "gramstain")
# ab2 <- antibiogram(example_isolates,
# antibiotics = aminoglycosides(), ab3 <- antibiogram(example_isolates,
# ab_transform = "atc", antibiotics = carbapenems(),
# mo_transform = "gramstain") ab_transform = "name",
# mo_transform = "name")
# ab3 <- antibiogram(example_isolates,
# antibiotics = carbapenems(), expect_inherits(ab1, "antibiogram")
# ab_transform = "name", expect_inherits(ab2, "antibiogram")
# mo_transform = "name") expect_inherits(ab3, "antibiogram")
# expect_equal(colnames(ab1), c("Pathogen (N min-max)", "AMK", "GEN", "IPM", "KAN", "MEM", "TOB"))
# expect_inherits(ab1, "antibiogram") expect_equal(colnames(ab2), c("Pathogen (N min-max)", "J01GB01", "J01GB03", "J01GB04", "J01GB06"))
# expect_inherits(ab2, "antibiogram") expect_equal(colnames(ab3), c("Pathogen (N min-max)", "Imipenem", "Meropenem"))
# expect_inherits(ab3, "antibiogram") expect_equal(ab3$Meropenem, c(52, NA, 100, 100, NA))
# 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")) # Combined antibiogram -------------------------------------------------
# expect_equal(colnames(ab3), c("Pathogen (N min-max)", "Imipenem", "Meropenem"))
# expect_equal(ab3$Meropenem, c(52, NA, 100, 100, NA)) # combined antibiotics yield higher empiric coverage
# ab4 <- antibiogram(example_isolates,
# # Combined antibiogram ------------------------------------------------- antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
# mo_transform = "gramstain")
# # combined antibiotics yield higher empiric coverage
# ab4 <- antibiogram(example_isolates, ab5 <- antibiogram(example_isolates,
# antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"), antibiotics = c("TZP", "TZP+TOB"),
# mo_transform = "gramstain") mo_transform = "gramstain",
# ab_transform = "name",
# ab5 <- antibiogram(example_isolates, sep = " & ",
# antibiotics = c("TZP", "TZP+TOB"), add_total_n = FALSE)
# mo_transform = "gramstain",
# ab_transform = "name", expect_inherits(ab4, "antibiogram")
# sep = " & ", expect_inherits(ab5, "antibiogram")
# add_total_n = FALSE) 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"))
# expect_inherits(ab4, "antibiogram")
# expect_inherits(ab5, "antibiogram") # Syndromic 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")) # the data set could contain a filter for e.g. respiratory specimens
# ab6 <- antibiogram(example_isolates,
# # Syndromic antibiogram ------------------------------------------------ antibiotics = c(aminoglycosides(), carbapenems()),
# syndromic_group = "ward")
# # the data set could contain a filter for e.g. respiratory specimens
# ab6 <- antibiogram(example_isolates, # with a custom language, though this will be determined automatically
# antibiotics = c(aminoglycosides(), carbapenems()), # (i.e., this table will be in Spanish on Spanish systems)
# syndromic_group = "ward") ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ]
# ab7 <- antibiogram(ex1,
# # with a custom language, though this will be determined automatically antibiotics = aminoglycosides(),
# # (i.e., this table will be in Spanish on Spanish systems) ab_transform = "name",
# ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ] syndromic_group = ifelse(ex1$ward == "ICU",
# ab7 <- antibiogram(ex1, "UCI", "No UCI"),
# antibiotics = aminoglycosides(), language = "es")
# ab_transform = "name",
# syndromic_group = ifelse(ex1$ward == "ICU", expect_inherits(ab6, "antibiogram")
# "UCI", "No UCI"), expect_inherits(ab7, "antibiogram")
# language = "es") 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"))
# expect_inherits(ab6, "antibiogram")
# expect_inherits(ab7, "antibiogram") # Weighted-incidence syndromic combination antibiogram (WISCA) ---------
# 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")) # the data set could contain a filter for e.g. respiratory specimens
# ab8 <- antibiogram(example_isolates,
# # Weighted-incidence syndromic combination antibiogram (WISCA) --------- antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"),
# mo_transform = "gramstain",
# # the data set could contain a filter for e.g. respiratory specimens minimum = 10, # this should be >= 30, but now just as example
# ab8 <- antibiogram(example_isolates, syndromic_group = ifelse(example_isolates$age >= 65 &
# antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"), example_isolates$gender == "M",
# mo_transform = "gramstain", "WISCA Group 1", "WISCA Group 2"))
# minimum = 10, # this should be >= 30, but now just as example
# syndromic_group = ifelse(example_isolates$age >= 65 & expect_inherits(ab8, "antibiogram")
# example_isolates$gender == "M", expect_equal(colnames(ab8), c("Syndromic Group", "Pathogen (N min-max)", "AMC", "AMC + CIP", "TZP", "TZP + TOB"))
# "WISCA Group 1", "WISCA Group 2"))
# # Generate plots with ggplot2 or base R --------------------------------
# expect_inherits(ab8, "antibiogram")
# expect_equal(colnames(ab8), c("Syndromic Group", "Pathogen (N min-max)", "AMC", "AMC + CIP", "TZP", "TZP + TOB")) pdf(NULL) # prevent Rplots.pdf being created
#
# # Generate plots with ggplot2 or base R -------------------------------- expect_silent(plot(ab1))
# expect_silent(plot(ab2))
# pdf(NULL) # prevent Rplots.pdf being created expect_silent(plot(ab3))
# expect_silent(plot(ab4))
# expect_silent(plot(ab1)) expect_silent(plot(ab5))
# expect_silent(plot(ab2)) expect_silent(plot(ab6))
# expect_silent(plot(ab3)) expect_silent(plot(ab7))
# expect_silent(plot(ab4)) expect_silent(plot(ab8))
# expect_silent(plot(ab5))
# expect_silent(plot(ab6)) if (AMR:::pkg_is_available("ggplot2")) {
# expect_silent(plot(ab7)) expect_inherits(autoplot(ab1), "gg")
# expect_silent(plot(ab8)) expect_inherits(autoplot(ab2), "gg")
# expect_inherits(autoplot(ab3), "gg")
# if (AMR:::pkg_is_available("ggplot2")) { expect_inherits(autoplot(ab4), "gg")
# expect_inherits(autoplot(ab1), "gg") expect_inherits(autoplot(ab5), "gg")
# expect_inherits(autoplot(ab2), "gg") expect_inherits(autoplot(ab6), "gg")
# expect_inherits(autoplot(ab3), "gg") expect_inherits(autoplot(ab7), "gg")
# expect_inherits(autoplot(ab4), "gg") expect_inherits(autoplot(ab8), "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 # too few characters
expect_warning(as.mo("ab")) expect_warning(as.mo("ab"))
expect_equal( expect_identical(
suppressWarnings(as.character(as.mo(c("Qq species", "", "MRSA", "K. pneu rhino", "esco")))), 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") 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")) expect_warning(c(x[1], "test"))
# ignoring patterns # ignoring patterns
expect_equal( expect_identical(
as.character(as.mo(c("E. coli", "E. coli ignorethis"), ignore_pattern = "this")), as.character(as.mo(c("E. coli", "E. coli ignorethis"), ignore_pattern = "this")),
c("B_ESCHR_COLI", NA) 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_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", "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", "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", "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", "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 ---------------------------------------------- # Traditional antibiogram ----------------------------------------------
antibiogram(example_isolates, antibiogram(example_isolates,
antibiotics = c(aminoglycosides(), carbapenems())) antibiotics = c(aminoglycosides(), carbapenems())
)
antibiogram(example_isolates, antibiogram(example_isolates,
antibiotics = aminoglycosides(), antibiotics = aminoglycosides(),
ab_transform = "atc", ab_transform = "atc",
mo_transform = "gramstain") mo_transform = "gramstain"
)
antibiogram(example_isolates, antibiogram(example_isolates,
antibiotics = carbapenems(), antibiotics = carbapenems(),
ab_transform = "name", ab_transform = "name",
mo_transform = "name") mo_transform = "name"
)
# Combined antibiogram ------------------------------------------------- # Combined antibiogram -------------------------------------------------
# combined antibiotics yield higher empiric coverage # combined antibiotics yield higher empiric coverage
antibiogram(example_isolates, antibiogram(example_isolates,
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"), antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
mo_transform = "gramstain") mo_transform = "gramstain"
)
antibiogram(example_isolates, antibiogram(example_isolates,
antibiotics = c("TZP", "TZP+TOB"), antibiotics = c("TZP", "TZP+TOB"),
mo_transform = "gramstain", mo_transform = "gramstain",
ab_transform = "name", ab_transform = "name",
sep = " & ") sep = " & "
)
# Syndromic antibiogram ------------------------------------------------ # Syndromic antibiogram ------------------------------------------------
# the data set could contain a filter for e.g. respiratory specimens # the data set could contain a filter for e.g. respiratory specimens
antibiogram(example_isolates, antibiogram(example_isolates,
antibiotics = c(aminoglycosides(), carbapenems()), antibiotics = c(aminoglycosides(), carbapenems()),
syndromic_group = "ward") syndromic_group = "ward"
)
# now define a data set with only E. coli # now define a data set with only E. coli
ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ] ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ]
@ -193,35 +199,41 @@ ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ]
# with a custom language, though this will be determined automatically # with a custom language, though this will be determined automatically
# (i.e., this table will be in Spanish on Spanish systems) # (i.e., this table will be in Spanish on Spanish systems)
antibiogram(ex1, antibiogram(ex1,
antibiotics = aminoglycosides(), antibiotics = aminoglycosides(),
ab_transform = "name", ab_transform = "name",
syndromic_group = ifelse(ex1$ward == "ICU", syndromic_group = ifelse(ex1$ward == "ICU",
"UCI", "No UCI"), "UCI", "No UCI"
language = "es") ),
language = "es"
)
# Weighted-incidence syndromic combination antibiogram (WISCA) --------- # Weighted-incidence syndromic combination antibiogram (WISCA) ---------
# the data set could contain a filter for e.g. respiratory specimens # the data set could contain a filter for e.g. respiratory specimens
antibiogram(example_isolates, antibiogram(example_isolates,
antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"), antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"),
mo_transform = "gramstain", mo_transform = "gramstain",
minimum = 10, # this should be >= 30, but now just as example minimum = 10, # this should be >= 30, but now just as example
syndromic_group = ifelse(example_isolates$age >= 65 & syndromic_group = ifelse(example_isolates$age >= 65 &
example_isolates$gender == "M", example_isolates$gender == "M",
"WISCA Group 1", "WISCA Group 2")) "WISCA Group 1", "WISCA Group 2"
)
)
# Generate plots with ggplot2 or base R -------------------------------- # Generate plots with ggplot2 or base R --------------------------------
ab1 <- antibiogram(example_isolates, ab1 <- antibiogram(example_isolates,
antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"), antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
mo_transform = "gramstain") mo_transform = "gramstain"
)
ab2 <- antibiogram(example_isolates, ab2 <- antibiogram(example_isolates,
antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"), antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
mo_transform = "gramstain", mo_transform = "gramstain",
syndromic_group = "ward") syndromic_group = "ward"
)
plot(ab1) plot(ab1)
if (requireNamespace("ggplot2")) { 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), ] df[which(get_episode(df$date, 60) == 3), ]
# the functions also work for less than a day, e.g. to include one per hour: # the functions also work for less than a day, e.g. to include one per hour:
get_episode(c(Sys.time(), get_episode(
Sys.time() + 60 * 60), c(
episode_days = 1 / 24) Sys.time(),
Sys.time() + 60 * 60
),
episode_days = 1 / 24
)
\donttest{ \donttest{
if (require("dplyr")) { if (require("dplyr")) {
@ -71,7 +75,7 @@ if (require("dplyr")) {
)) \%>\% )) \%>\%
group_by(patient, condition) \%>\% group_by(patient, condition) \%>\%
mutate(new_episode = is_new_episode(date, 365)) \%>\% mutate(new_episode = is_new_episode(date, 365)) \%>\%
select(patient, date, condition, new_episode) \%>\% select(patient, date, condition, new_episode) \%>\%
arrange(patient, condition, date) arrange(patient, condition, date)
} }
@ -82,7 +86,7 @@ if (require("dplyr")) {
patient, patient,
new_index = get_episode(date, 60), new_index = get_episode(date, 60),
new_logical = is_new_episode(date, 60) new_logical = is_new_episode(date, 60)
) \%>\% ) \%>\%
arrange(patient, ward, date) arrange(patient, ward, date)
} }
@ -117,7 +121,6 @@ if (require("dplyr")) {
# but is_new_episode() has a lot more flexibility than first_isolate(), # but is_new_episode() has a lot more flexibility than first_isolate(),
# since you can now group on anything that seems relevant: # since you can now group on anything that seems relevant:
if (require("dplyr")) { if (require("dplyr")) {
df \%>\% df \%>\%
group_by(patient, mo, ward) \%>\% group_by(patient, mo, ward) \%>\%
mutate(flag_episode = is_new_episode(date, 365)) \%>\% mutate(flag_episode = is_new_episode(date, 365)) \%>\%