mirror of https://github.com/msberends/AMR.git
unit tests
This commit is contained in:
parent
68abb00c59
commit
45a9697c84
|
|
@ -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)
|
||||
|
|
|
|||
2
NEWS.md
2
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!)*
|
||||
|
||||
|
|
|
|||
|
|
@ -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(...)
|
||||
|
|
|
|||
|
|
@ -29,7 +29,7 @@
|
|||
|
||||
#' Options for the AMR package
|
||||
#'
|
||||
#' This is an overview of all the package-specific [options()] you can set in the `AMR` package.
|
||||
#' This is an overview of all the package-specific [options()] you can set in the `AMR` package.
|
||||
#' @section Options:
|
||||
#' * `AMR_custom_ab` \cr Allows to use custom antimicrobial drugs with this package. This is explained in [add_custom_antimicrobials()].
|
||||
#' * `AMR_custom_mo` \cr Allows to use custom microorganisms with this package. This is explained in [add_custom_microorganisms()].
|
||||
|
|
@ -41,37 +41,37 @@
|
|||
#' * `AMR_keep_synonyms` \cr A [logical] to use in [as.mo()] and all [`mo_*`][mo_property()] functions, to indicate if old, previously valid taxonomic names must be preserved and not be corrected to currently accepted names.
|
||||
#' * `AMR_locale` \cr A language to use for the `AMR` package, can be one of these supported language names or ISO-639-1 codes: `r vector_or(paste0(sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), " (" , LANGUAGES_SUPPORTED, ")"), quotes = FALSE, sort = FALSE)`.
|
||||
#' * `AMR_mo_source` \cr A file location for a manual code list to be used in [as.mo()] and all [`mo_*`][mo_property()] functions. This is explained in [set_mo_source()].
|
||||
#'
|
||||
#'
|
||||
#' @section Saving Settings Between Sessions:
|
||||
#' Settings in \R are not saved globally and are thus lost when \R is exited. You can save your options to your own `.Rprofile` file, which is a user-specific file. You can edit it using:
|
||||
#'
|
||||
#'
|
||||
#' ```r
|
||||
#' utils::file.edit("~/.Rprofile")
|
||||
#' ```
|
||||
#'
|
||||
#'
|
||||
#' In this file, you can set options such as:
|
||||
#'
|
||||
#'
|
||||
#' ```r
|
||||
#' options(AMR_locale = "pt")
|
||||
#' options(AMR_include_PKPD = TRUE)
|
||||
#' ```
|
||||
#'
|
||||
#'
|
||||
#' to add Portuguese language support of antibiotics, and allow PK/PD rules when interpreting MIC values with [as.sir()].
|
||||
#'
|
||||
#'
|
||||
#' ### Share Options Within Team
|
||||
#'
|
||||
#'
|
||||
#' For a more global approach, e.g. within a data team, save an options file to a remote file location, such as a shared network drive. This would work in this way:
|
||||
#'
|
||||
#'
|
||||
#' 1. Save a plain text file to e.g. "X:/team_folder/R_options.R" and fill it with preferred settings.
|
||||
#'
|
||||
#'
|
||||
#' 2. For each user, open the `.Rprofile` file using `utils::file.edit("~/.Rprofile")` and put in there:
|
||||
#'
|
||||
#'
|
||||
#' ```r
|
||||
#' source("X:/team_folder/R_options.R")
|
||||
#' ```
|
||||
#'
|
||||
#'
|
||||
#' 3. Reload R/RStudio and check the settings with [getOption()], e.g. `getOption("AMR_locale")` if you have set that value.
|
||||
#'
|
||||
#'
|
||||
#' Now the team settings are configured in only one place, and can be maintained there.
|
||||
#' @keywords internal
|
||||
#' @name AMR-options
|
||||
|
|
|
|||
6
R/ab.R
6
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
|
||||
|
|
|
|||
|
|
@ -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 {
|
||||
|
|
|
|||
297
R/antibiogram.R
297
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 @@
|
|||
#' <NA> <NA> - - - -
|
||||
#' --------------------------------------------------------------------
|
||||
#' ```
|
||||
#' @source
|
||||
#' @source
|
||||
#' * Klinker KP *et al.* (2021). **Antimicrobial stewardship and antibiograms: importance of moving beyond traditional antibiograms**. *Therapeutic Advances in Infectious Disease*, May 5;8:20499361211011373; \doi{10.1177/20499361211011373}
|
||||
#' * Barbieri E *et al.* (2021). **Development of a Weighted-Incidence Syndromic Combination Antibiogram (WISCA) to guide the choice of the empiric antibiotic treatment for urinary tract infection in paediatric patients: a Bayesian approach** *Antimicrobial Resistance & Infection Control* May 1;10(1):74; \doi{10.1186/s13756-021-00939-2}
|
||||
#' * **M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 5th Edition**, 2022, *Clinical and Laboratory Standards Institute (CLSI)*. <https://clsi.org/standards/products/microbiology/documents/m39/>.
|
||||
#' @rdname antibiogram
|
||||
#' @name antibiogram
|
||||
#' @export
|
||||
#' @examples
|
||||
#' @examples
|
||||
#' # example_isolates is a data set available in the AMR package.
|
||||
#' # run ?example_isolates for more info.
|
||||
#' example_isolates
|
||||
#'
|
||||
#'
|
||||
#'
|
||||
#'
|
||||
#' # Traditional antibiogram ----------------------------------------------
|
||||
#'
|
||||
#'
|
||||
#' antibiogram(example_isolates,
|
||||
#' antibiotics = c(aminoglycosides(), carbapenems()))
|
||||
#'
|
||||
#' antibiotics = c(aminoglycosides(), carbapenems())
|
||||
#' )
|
||||
#'
|
||||
#' antibiogram(example_isolates,
|
||||
#' antibiotics = aminoglycosides(),
|
||||
#' ab_transform = "atc",
|
||||
#' mo_transform = "gramstain")
|
||||
#'
|
||||
#' antibiotics = aminoglycosides(),
|
||||
#' ab_transform = "atc",
|
||||
#' mo_transform = "gramstain"
|
||||
#' )
|
||||
#'
|
||||
#' antibiogram(example_isolates,
|
||||
#' antibiotics = carbapenems(),
|
||||
#' ab_transform = "name",
|
||||
#' mo_transform = "name")
|
||||
#'
|
||||
#'
|
||||
#' antibiotics = carbapenems(),
|
||||
#' ab_transform = "name",
|
||||
#' mo_transform = "name"
|
||||
#' )
|
||||
#'
|
||||
#'
|
||||
#' # Combined antibiogram -------------------------------------------------
|
||||
#'
|
||||
#'
|
||||
#' # combined antibiotics yield higher empiric coverage
|
||||
#' antibiogram(example_isolates,
|
||||
#' antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
|
||||
#' mo_transform = "gramstain")
|
||||
#'
|
||||
#' antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
|
||||
#' mo_transform = "gramstain"
|
||||
#' )
|
||||
#'
|
||||
#' antibiogram(example_isolates,
|
||||
#' antibiotics = c("TZP", "TZP+TOB"),
|
||||
#' mo_transform = "gramstain",
|
||||
#' ab_transform = "name",
|
||||
#' sep = " & ")
|
||||
#'
|
||||
#'
|
||||
#' antibiotics = c("TZP", "TZP+TOB"),
|
||||
#' mo_transform = "gramstain",
|
||||
#' ab_transform = "name",
|
||||
#' sep = " & "
|
||||
#' )
|
||||
#'
|
||||
#'
|
||||
#' # Syndromic antibiogram ------------------------------------------------
|
||||
#'
|
||||
#'
|
||||
#' # the data set could contain a filter for e.g. respiratory specimens
|
||||
#' antibiogram(example_isolates,
|
||||
#' antibiotics = c(aminoglycosides(), carbapenems()),
|
||||
#' syndromic_group = "ward")
|
||||
#'
|
||||
#' antibiotics = c(aminoglycosides(), carbapenems()),
|
||||
#' syndromic_group = "ward"
|
||||
#' )
|
||||
#'
|
||||
#' # now define a data set with only E. coli
|
||||
#' ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ]
|
||||
#'
|
||||
#'
|
||||
#' # with a custom language, though this will be determined automatically
|
||||
#' # (i.e., this table will be in Spanish on Spanish systems)
|
||||
#' antibiogram(ex1,
|
||||
#' antibiotics = aminoglycosides(),
|
||||
#' ab_transform = "name",
|
||||
#' syndromic_group = ifelse(ex1$ward == "ICU",
|
||||
#' "UCI", "No UCI"),
|
||||
#' language = "es")
|
||||
#'
|
||||
#'
|
||||
#' antibiotics = aminoglycosides(),
|
||||
#' ab_transform = "name",
|
||||
#' syndromic_group = ifelse(ex1$ward == "ICU",
|
||||
#' "UCI", "No UCI"
|
||||
#' ),
|
||||
#' language = "es"
|
||||
#' )
|
||||
#'
|
||||
#'
|
||||
#' # Weighted-incidence syndromic combination antibiogram (WISCA) ---------
|
||||
#'
|
||||
#'
|
||||
#' # the data set could contain a filter for e.g. respiratory specimens
|
||||
#' antibiogram(example_isolates,
|
||||
#' antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"),
|
||||
#' mo_transform = "gramstain",
|
||||
#' minimum = 10, # this should be >= 30, but now just as example
|
||||
#' syndromic_group = ifelse(example_isolates$age >= 65 &
|
||||
#' example_isolates$gender == "M",
|
||||
#' "WISCA Group 1", "WISCA Group 2"))
|
||||
#'
|
||||
#'
|
||||
#' antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"),
|
||||
#' mo_transform = "gramstain",
|
||||
#' minimum = 10, # this should be >= 30, but now just as example
|
||||
#' syndromic_group = ifelse(example_isolates$age >= 65 &
|
||||
#' example_isolates$gender == "M",
|
||||
#' "WISCA Group 1", "WISCA Group 2"
|
||||
#' )
|
||||
#' )
|
||||
#'
|
||||
#'
|
||||
#' # Generate plots with ggplot2 or base R --------------------------------
|
||||
#'
|
||||
#'
|
||||
#' ab1 <- antibiogram(example_isolates,
|
||||
#' antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
|
||||
#' mo_transform = "gramstain")
|
||||
#' antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
|
||||
#' mo_transform = "gramstain"
|
||||
#' )
|
||||
#' ab2 <- antibiogram(example_isolates,
|
||||
#' antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
|
||||
#' mo_transform = "gramstain",
|
||||
#' syndromic_group = "ward")
|
||||
#'
|
||||
#' antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
|
||||
#' mo_transform = "gramstain",
|
||||
#' syndromic_group = "ward"
|
||||
#' )
|
||||
#'
|
||||
#' plot(ab1)
|
||||
#'
|
||||
#'
|
||||
#' if (requireNamespace("ggplot2")) {
|
||||
#' ggplot2::autoplot(ab1)
|
||||
#' }
|
||||
#'
|
||||
#'
|
||||
#' plot(ab2)
|
||||
#'
|
||||
#'
|
||||
#' if (requireNamespace("ggplot2")) {
|
||||
#' ggplot2::autoplot(ab2)
|
||||
#' }
|
||||
|
|
@ -241,7 +253,7 @@ antibiogram <- function(x,
|
|||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(sep, allow_class = "character", has_length = 1)
|
||||
|
||||
|
||||
# try to find columns based on type
|
||||
if (is.null(col_mo)) {
|
||||
col_mo <- search_type_in_df(x = x, type = "mo", info = interactive())
|
||||
|
|
@ -274,7 +286,7 @@ antibiogram <- function(x,
|
|||
} else {
|
||||
has_syndromic_group <- FALSE
|
||||
}
|
||||
|
||||
|
||||
# get antibiotics
|
||||
if (tryCatch(is.character(antibiotics), error = function(e) FALSE)) {
|
||||
antibiotics <- strsplit(gsub(" ", "", antibiotics), "+", fixed = TRUE)
|
||||
|
|
@ -299,7 +311,7 @@ antibiogram <- function(x,
|
|||
# determine whether this new column should contain S, I, R, or NA
|
||||
if (isTRUE(combine_SI)) {
|
||||
S_values <- c("S", "I")
|
||||
}else {
|
||||
} else {
|
||||
S_values <- "S"
|
||||
}
|
||||
other_values <- setdiff(c("S", "I", "R"), S_values)
|
||||
|
|
@ -307,8 +319,10 @@ antibiogram <- function(x,
|
|||
if (isTRUE(only_all_tested)) {
|
||||
x[new_colname] <- as.sir(vapply(FUN.VALUE = character(1), x_transposed, function(x) ifelse(anyNA(x), NA_character_, ifelse(any(x %in% S_values), "S", "R")), USE.NAMES = FALSE))
|
||||
} else {
|
||||
x[new_colname] <- as.sir(vapply(FUN.VALUE = character(1), x_transposed, function(x) ifelse(any(x %in% S_values, na.rm = TRUE), "S", ifelse(anyNA(x), NA_character_, "R")),
|
||||
USE.NAMES = FALSE))
|
||||
x[new_colname] <- as.sir(vapply(
|
||||
FUN.VALUE = character(1), x_transposed, function(x) ifelse(any(x %in% S_values, na.rm = TRUE), "S", ifelse(anyNA(x), NA_character_, "R")),
|
||||
USE.NAMES = FALSE
|
||||
))
|
||||
}
|
||||
}
|
||||
antibiotics[[i]] <- new_colname
|
||||
|
|
@ -317,32 +331,34 @@ antibiogram <- function(x,
|
|||
} else {
|
||||
antibiotics <- colnames(suppressWarnings(x[, antibiotics, drop = FALSE]))
|
||||
}
|
||||
|
||||
|
||||
if (isTRUE(has_syndromic_group)) {
|
||||
out <- x %pm>%
|
||||
pm_select(.syndromic_group, .mo, antibiotics) %pm>%
|
||||
out <- x %pm>%
|
||||
pm_select(.syndromic_group, .mo, antibiotics) %pm>%
|
||||
pm_group_by(.syndromic_group)
|
||||
} else {
|
||||
out <- x %pm>%
|
||||
out <- x %pm>%
|
||||
pm_select(.mo, antibiotics)
|
||||
}
|
||||
|
||||
|
||||
# get numbers of S, I, R (per group)
|
||||
out <- out %pm>%
|
||||
bug_drug_combinations(col_mo = ".mo",
|
||||
FUN = function(x) x)
|
||||
out <- out %pm>%
|
||||
bug_drug_combinations(
|
||||
col_mo = ".mo",
|
||||
FUN = function(x) x
|
||||
)
|
||||
counts <- out
|
||||
|
||||
|
||||
# regroup for summarising
|
||||
if (isTRUE(has_syndromic_group)) {
|
||||
colnames(out)[1] <- "syndromic_group"
|
||||
out <- out %pm>%
|
||||
out <- out %pm>%
|
||||
pm_group_by(syndromic_group, mo, ab)
|
||||
} else {
|
||||
out <- out %pm>%
|
||||
out <- out %pm>%
|
||||
pm_group_by(mo, ab)
|
||||
}
|
||||
|
||||
|
||||
if (isTRUE(combine_SI)) {
|
||||
out$numerator <- out$S + out$I
|
||||
} else {
|
||||
|
|
@ -351,13 +367,13 @@ antibiogram <- function(x,
|
|||
out$minimum <- minimum
|
||||
if (any(out$total < out$minimum, na.rm = TRUE)) {
|
||||
message_("NOTE: ", sum(out$total < out$minimum, na.rm = TRUE), " combinations had less than `minimum = ", minimum, "` results and were ignored", add_fn = font_red)
|
||||
out <- out %pm>%
|
||||
out <- out %pm>%
|
||||
subset(total >= minimum)
|
||||
}
|
||||
|
||||
|
||||
out <- out %pm>%
|
||||
pm_summarise(SI = numerator / total)
|
||||
|
||||
|
||||
# transform names of antibiotics
|
||||
ab_naming_function <- function(x, t, l, s) {
|
||||
x <- strsplit(x, s, fixed = TRUE)
|
||||
|
|
@ -379,24 +395,24 @@ antibiogram <- function(x,
|
|||
out
|
||||
}
|
||||
out$ab <- ab_naming_function(out$ab, t = ab_transform, l = language, s = sep)
|
||||
|
||||
|
||||
# transform long to wide
|
||||
long_to_wide <- function(object, digs) {
|
||||
object$SI <- round(object$SI * 100, digits = digs)
|
||||
object <- object %pm>%
|
||||
# an unclassed data.frame is required for stats::reshape()
|
||||
as.data.frame(stringsAsFactors = FALSE) %pm>%
|
||||
as.data.frame(stringsAsFactors = FALSE) %pm>%
|
||||
stats::reshape(direction = "wide", idvar = "mo", timevar = "ab", v.names = "SI")
|
||||
colnames(object) <- gsub("^SI?[.]", "", colnames(object))
|
||||
return(object)
|
||||
}
|
||||
|
||||
|
||||
# ungroup for long -> wide transformation
|
||||
attr(out, "pm_groups") <- NULL
|
||||
attr(out, "groups") <- NULL
|
||||
class(out) <- class(out)[!class(out) %in% c("grouped_df", "grouped_data")]
|
||||
long <- out
|
||||
|
||||
|
||||
if (isTRUE(has_syndromic_group)) {
|
||||
grps <- unique(out$syndromic_group)
|
||||
for (i in seq_len(length(grps))) {
|
||||
|
|
@ -404,8 +420,10 @@ antibiogram <- function(x,
|
|||
if (i == 1) {
|
||||
new_df <- long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits)
|
||||
} else {
|
||||
new_df <- rbind2(new_df,
|
||||
long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits))
|
||||
new_df <- rbind2(
|
||||
new_df,
|
||||
long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits)
|
||||
)
|
||||
}
|
||||
}
|
||||
# sort rows
|
||||
|
|
@ -421,7 +439,7 @@ antibiogram <- function(x,
|
|||
new_df <- new_df[, c("mo", sort(colnames(new_df)[colnames(new_df) != "mo"])), drop = FALSE]
|
||||
colnames(new_df)[1] <- translate_AMR("Pathogen", language = language)
|
||||
}
|
||||
|
||||
|
||||
# add total N if indicated
|
||||
if (isTRUE(add_total_n)) {
|
||||
if (isTRUE(has_syndromic_group)) {
|
||||
|
|
@ -442,10 +460,11 @@ antibiogram <- function(x,
|
|||
new_df[[edit_col]] <- paste0(new_df[[edit_col]], " (", count_group, ")")
|
||||
colnames(new_df)[edit_col] <- paste(colnames(new_df)[edit_col], "(N min-max)")
|
||||
}
|
||||
|
||||
|
||||
structure(as_original_data_class(new_df, class(x), extra_class = "antibiogram"),
|
||||
long = long,
|
||||
combine_SI = combine_SI)
|
||||
long = long,
|
||||
combine_SI = combine_SI
|
||||
)
|
||||
}
|
||||
|
||||
#' @export
|
||||
|
|
@ -458,22 +477,24 @@ plot.antibiogram <- function(x, ...) {
|
|||
df$syndromic_group <- NULL
|
||||
df <- df[order(df$mo), , drop = FALSE]
|
||||
}
|
||||
mo_levels = unique(df$mo)
|
||||
mo_levels <- unique(df$mo)
|
||||
mfrow_old <- graphics::par()$mfrow
|
||||
sqrt_levels <- sqrt(length(mo_levels))
|
||||
graphics::par(mfrow = c(ceiling(sqrt_levels), floor(sqrt_levels)))
|
||||
for (i in seq_along(mo_levels)) {
|
||||
mo <- mo_levels[i]
|
||||
df_sub <- df[df$mo == mo, , drop = FALSE]
|
||||
|
||||
barplot(height = df_sub$SI * 100,
|
||||
xlab = NULL,
|
||||
ylab = ifelse(isTRUE(attributes(x)$combine_SI), "%SI", "%S"),
|
||||
names.arg = df_sub$ab,
|
||||
col = "#aaaaaa",
|
||||
beside = TRUE,
|
||||
main = mo,
|
||||
legend = NULL)
|
||||
|
||||
barplot(
|
||||
height = df_sub$SI * 100,
|
||||
xlab = NULL,
|
||||
ylab = ifelse(isTRUE(attributes(x)$combine_SI), "%SI", "%S"),
|
||||
names.arg = df_sub$ab,
|
||||
col = "#aaaaaa",
|
||||
beside = TRUE,
|
||||
main = mo,
|
||||
legend = NULL
|
||||
)
|
||||
}
|
||||
graphics::par(mfrow = mfrow_old)
|
||||
}
|
||||
|
|
@ -490,22 +511,28 @@ barplot.antibiogram <- function(height, ...) {
|
|||
autoplot.antibiogram <- function(object, ...) {
|
||||
df <- attributes(object)$long
|
||||
ggplot2::ggplot(df) +
|
||||
ggplot2::geom_col(ggplot2::aes(x = ab,
|
||||
y = SI * 100,
|
||||
fill = if ("syndromic_group" %in% colnames(df)) {
|
||||
syndromic_group
|
||||
} else {
|
||||
NULL
|
||||
}),
|
||||
position = ggplot2::position_dodge2(preserve = "single")) +
|
||||
ggplot2::geom_col(
|
||||
ggplot2::aes(
|
||||
x = ab,
|
||||
y = SI * 100,
|
||||
fill = if ("syndromic_group" %in% colnames(df)) {
|
||||
syndromic_group
|
||||
} else {
|
||||
NULL
|
||||
}
|
||||
),
|
||||
position = ggplot2::position_dodge2(preserve = "single")
|
||||
) +
|
||||
ggplot2::facet_wrap("mo") +
|
||||
ggplot2::labs(y = ifelse(isTRUE(attributes(object)$combine_SI), "%SI", "%S"),
|
||||
x = NULL,
|
||||
fill = if ("syndromic_group" %in% colnames(df)) {
|
||||
colnames(object)[1]
|
||||
} else {
|
||||
NULL
|
||||
})
|
||||
ggplot2::labs(
|
||||
y = ifelse(isTRUE(attributes(object)$combine_SI), "%SI", "%S"),
|
||||
x = NULL,
|
||||
fill = if ("syndromic_group" %in% colnames(df)) {
|
||||
colnames(object)[1]
|
||||
} else {
|
||||
NULL
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
#' @export
|
||||
|
|
@ -515,8 +542,8 @@ autoplot.antibiogram <- function(object, ...) {
|
|||
print.antibiogram <- function(x, as_kable = !interactive(), ...) {
|
||||
meet_criteria(as_kable, allow_class = "logical", has_length = 1)
|
||||
if (isTRUE(as_kable) &&
|
||||
# be sure not to run kable in pkgdown for our website generation
|
||||
!identical(Sys.getenv("IN_PKGDOWN"), "true")) {
|
||||
# be sure not to run kable in pkgdown for our website generation
|
||||
!identical(Sys.getenv("IN_PKGDOWN"), "true")) {
|
||||
stop_ifnot_installed("knitr")
|
||||
kable <- import_fn("kable", "knitr", error_on_fail = TRUE)
|
||||
kable(x, ...)
|
||||
|
|
|
|||
6
R/av.R
6
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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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>%
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -34,8 +34,8 @@
|
|||
#' @param episode_days required episode length in days, can also be less than a day or `Inf`, see *Details*
|
||||
#' @param ... ignored, only in place to allow future extensions
|
||||
#' @details The functions [get_episode()] and [is_new_episode()] differ in this way when setting `episode_days` to 365:
|
||||
#'
|
||||
#'
|
||||
#'
|
||||
#'
|
||||
#' | person_id | date | `get_episode()` | `is_new_episode()` |
|
||||
#' |:---------:|:----------:|:---------------:|:------------------:|
|
||||
#' | A | 2019-01-01 | 1 | TRUE |
|
||||
|
|
@ -44,7 +44,7 @@
|
|||
#' | B | 2008-01-01 | 1 | TRUE |
|
||||
#' | B | 2008-01-01 | 1 | FALSE |
|
||||
#' | C | 2020-01-01 | 1 | TRUE |
|
||||
#'
|
||||
#'
|
||||
#' Dates are first sorted from old to new. The oldest date will mark the start of the first episode. After this date, the next date will be marked that is at least `episode_days` days later than the start of the first episode. From that second marked date on, the next date will be marked that is at least `episode_days` days later than the start of the second episode which will be the start of the third episode, and so on. Before the vector is being returned, the original order will be restored.
|
||||
#'
|
||||
#' The [first_isolate()] function is a wrapper around the [is_new_episode()] function, but is more efficient for data sets containing microorganism codes or names and allows for different isolate selection methods.
|
||||
|
|
@ -68,9 +68,13 @@
|
|||
#' df[which(get_episode(df$date, 60) == 3), ]
|
||||
#'
|
||||
#' # the functions also work for less than a day, e.g. to include one per hour:
|
||||
#' get_episode(c(Sys.time(),
|
||||
#' Sys.time() + 60 * 60),
|
||||
#' episode_days = 1 / 24)
|
||||
#' get_episode(
|
||||
#' c(
|
||||
#' Sys.time(),
|
||||
#' Sys.time() + 60 * 60
|
||||
#' ),
|
||||
#' episode_days = 1 / 24
|
||||
#' )
|
||||
#'
|
||||
#' \donttest{
|
||||
#' if (require("dplyr")) {
|
||||
|
|
@ -84,10 +88,10 @@
|
|||
#' )) %>%
|
||||
#' group_by(patient, condition) %>%
|
||||
#' mutate(new_episode = is_new_episode(date, 365)) %>%
|
||||
#' select(patient, date, condition, new_episode) %>%
|
||||
#' select(patient, date, condition, new_episode) %>%
|
||||
#' arrange(patient, condition, date)
|
||||
#' }
|
||||
#'
|
||||
#'
|
||||
#' if (require("dplyr")) {
|
||||
#' df %>%
|
||||
#' group_by(ward, patient) %>%
|
||||
|
|
@ -95,10 +99,10 @@
|
|||
#' patient,
|
||||
#' new_index = get_episode(date, 60),
|
||||
#' new_logical = is_new_episode(date, 60)
|
||||
#' ) %>%
|
||||
#' ) %>%
|
||||
#' arrange(patient, ward, date)
|
||||
#' }
|
||||
#'
|
||||
#'
|
||||
#' if (require("dplyr")) {
|
||||
#' df %>%
|
||||
#' group_by(ward) %>%
|
||||
|
|
@ -109,7 +113,7 @@
|
|||
#' n_episodes_30 = sum(is_new_episode(date, episode_days = 30))
|
||||
#' )
|
||||
#' }
|
||||
#'
|
||||
#'
|
||||
#' # grouping on patients and microorganisms leads to the same
|
||||
#' # results as first_isolate() when using 'episode-based':
|
||||
#' if (require("dplyr")) {
|
||||
|
|
@ -126,11 +130,10 @@
|
|||
#'
|
||||
#' identical(x, y)
|
||||
#' }
|
||||
#'
|
||||
#'
|
||||
#' # but is_new_episode() has a lot more flexibility than first_isolate(),
|
||||
#' # since you can now group on anything that seems relevant:
|
||||
#' if (require("dplyr")) {
|
||||
#'
|
||||
#' df %>%
|
||||
#' group_by(patient, mo, ward) %>%
|
||||
#' mutate(flag_episode = is_new_episode(date, 365)) %>%
|
||||
|
|
@ -153,10 +156,10 @@ is_new_episode <- function(x, episode_days, ...) {
|
|||
|
||||
exec_episode <- function(x, episode_days, ...) {
|
||||
x <- as.double(as.POSIXct(x)) # as.POSIXct() required for Date classes
|
||||
|
||||
|
||||
# since x is now in seconds, get seconds from episode_days as well
|
||||
episode_seconds <- episode_days * 60 * 60 * 24
|
||||
|
||||
|
||||
if (length(x) == 1) { # this will also match 1 NA, which is fine
|
||||
return(1)
|
||||
} else if (length(x) == 2 && !all(is.na(x))) {
|
||||
|
|
@ -166,7 +169,7 @@ exec_episode <- function(x, episode_days, ...) {
|
|||
return(c(1, 1))
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# we asked on StackOverflow:
|
||||
# https://stackoverflow.com/questions/42122245/filter-one-row-every-year
|
||||
run_episodes <- function(x, episode_seconds) {
|
||||
|
|
@ -183,7 +186,7 @@ exec_episode <- function(x, episode_days, ...) {
|
|||
}
|
||||
indices
|
||||
}
|
||||
|
||||
|
||||
ord <- order(x)
|
||||
out <- run_episodes(x[ord], episode_seconds)[order(ord)]
|
||||
out[is.na(x) & ord != 1] <- NA # every NA expect for the first must remain NA
|
||||
|
|
|
|||
20
R/mo.R
20
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])
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
2
R/sir.R
2
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)
|
||||
|
|
|
|||
|
|
@ -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],
|
||||
|
|
|
|||
|
|
@ -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"]
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
)
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
|
|
@ -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")) {
|
||||
|
|
|
|||
|
|
@ -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)) \%>\%
|
||||
|
|
|
|||
Loading…
Reference in New Issue