mirror of
https://github.com/msberends/AMR.git
synced 2024-12-25 06:46:11 +01:00
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(...)
|
||||
|
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
|
||||
|
@ -363,7 +363,8 @@ set_ab_names <- function(data, ..., property = "name", language = get_AMR_locale
|
||||
df <- tryCatch(suppressWarnings(pm_select(data, ...)),
|
||||
error = function(e) {
|
||||
data[, c(...), drop = FALSE]
|
||||
})
|
||||
}
|
||||
)
|
||||
} else if (tryCatch(is.character(c(...)), error = function(e) FALSE)) {
|
||||
df <- data[, c(...), drop = FALSE]
|
||||
} else {
|
||||
|
@ -136,17 +136,20 @@
|
||||
#' # Traditional antibiogram ----------------------------------------------
|
||||
#'
|
||||
#' antibiogram(example_isolates,
|
||||
#' antibiotics = c(aminoglycosides(), carbapenems()))
|
||||
#' antibiotics = c(aminoglycosides(), carbapenems())
|
||||
#' )
|
||||
#'
|
||||
#' antibiogram(example_isolates,
|
||||
#' antibiotics = aminoglycosides(),
|
||||
#' ab_transform = "atc",
|
||||
#' mo_transform = "gramstain")
|
||||
#' mo_transform = "gramstain"
|
||||
#' )
|
||||
#'
|
||||
#' antibiogram(example_isolates,
|
||||
#' antibiotics = carbapenems(),
|
||||
#' ab_transform = "name",
|
||||
#' mo_transform = "name")
|
||||
#' mo_transform = "name"
|
||||
#' )
|
||||
#'
|
||||
#'
|
||||
#' # Combined antibiogram -------------------------------------------------
|
||||
@ -154,13 +157,15 @@
|
||||
#' # combined antibiotics yield higher empiric coverage
|
||||
#' antibiogram(example_isolates,
|
||||
#' antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
|
||||
#' mo_transform = "gramstain")
|
||||
#' mo_transform = "gramstain"
|
||||
#' )
|
||||
#'
|
||||
#' antibiogram(example_isolates,
|
||||
#' antibiotics = c("TZP", "TZP+TOB"),
|
||||
#' mo_transform = "gramstain",
|
||||
#' ab_transform = "name",
|
||||
#' sep = " & ")
|
||||
#' sep = " & "
|
||||
#' )
|
||||
#'
|
||||
#'
|
||||
#' # Syndromic antibiogram ------------------------------------------------
|
||||
@ -168,7 +173,8 @@
|
||||
#' # the data set could contain a filter for e.g. respiratory specimens
|
||||
#' antibiogram(example_isolates,
|
||||
#' antibiotics = c(aminoglycosides(), carbapenems()),
|
||||
#' syndromic_group = "ward")
|
||||
#' syndromic_group = "ward"
|
||||
#' )
|
||||
#'
|
||||
#' # now define a data set with only E. coli
|
||||
#' ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ]
|
||||
@ -179,8 +185,10 @@
|
||||
#' antibiotics = aminoglycosides(),
|
||||
#' ab_transform = "name",
|
||||
#' syndromic_group = ifelse(ex1$ward == "ICU",
|
||||
#' "UCI", "No UCI"),
|
||||
#' language = "es")
|
||||
#' "UCI", "No UCI"
|
||||
#' ),
|
||||
#' language = "es"
|
||||
#' )
|
||||
#'
|
||||
#'
|
||||
#' # Weighted-incidence syndromic combination antibiogram (WISCA) ---------
|
||||
@ -192,18 +200,22 @@
|
||||
#' 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"))
|
||||
#' "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")
|
||||
#' mo_transform = "gramstain"
|
||||
#' )
|
||||
#' ab2 <- antibiogram(example_isolates,
|
||||
#' antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
|
||||
#' mo_transform = "gramstain",
|
||||
#' syndromic_group = "ward")
|
||||
#' syndromic_group = "ward"
|
||||
#' )
|
||||
#'
|
||||
#' plot(ab1)
|
||||
#'
|
||||
@ -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
|
||||
@ -329,8 +343,10 @@ antibiogram <- function(x,
|
||||
|
||||
# get numbers of S, I, R (per group)
|
||||
out <- out %pm>%
|
||||
bug_drug_combinations(col_mo = ".mo",
|
||||
FUN = function(x) x)
|
||||
bug_drug_combinations(
|
||||
col_mo = ".mo",
|
||||
FUN = function(x) x
|
||||
)
|
||||
counts <- out
|
||||
|
||||
# regroup for summarising
|
||||
@ -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
|
||||
@ -445,7 +463,8 @@ antibiogram <- function(x,
|
||||
|
||||
structure(as_original_data_class(new_df, class(x), extra_class = "antibiogram"),
|
||||
long = long,
|
||||
combine_SI = combine_SI)
|
||||
combine_SI = combine_SI
|
||||
)
|
||||
}
|
||||
|
||||
#' @export
|
||||
@ -458,7 +477,7 @@ 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)))
|
||||
@ -466,14 +485,16 @@ plot.antibiogram <- function(x, ...) {
|
||||
mo <- mo_levels[i]
|
||||
df_sub <- df[df$mo == mo, , drop = FALSE]
|
||||
|
||||
barplot(height = df_sub$SI * 100,
|
||||
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)
|
||||
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,
|
||||
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")) +
|
||||
}
|
||||
),
|
||||
position = ggplot2::position_dodge2(preserve = "single")
|
||||
) +
|
||||
ggplot2::facet_wrap("mo") +
|
||||
ggplot2::labs(y = ifelse(isTRUE(attributes(object)$combine_SI), "%SI", "%S"),
|
||||
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
|
||||
|
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
|
||||
|
@ -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>%
|
||||
|
@ -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")) {
|
||||
@ -130,7 +134,6 @@
|
||||
#' # 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)) %>%
|
||||
|
12
R/mo.R
12
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)
|
||||
|
@ -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],
|
||||
|
@ -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,20 +1,24 @@
|
||||
|
||||
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"),
|
||||
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)
|
||||
snomed = snomed2
|
||||
)
|
||||
|
||||
new_groupa <- microorganisms %>%
|
||||
filter(mo == "B_SLMNL_GRPB") %>%
|
||||
mutate(mo = "B_SLMNL_GRPA",
|
||||
mutate(
|
||||
mo = "B_SLMNL_GRPA",
|
||||
fullname = gsub("roup B", "roup A", fullname),
|
||||
species = gsub("roup B", "roup A", species))
|
||||
species = gsub("roup B", "roup A", species)
|
||||
)
|
||||
|
||||
microorganisms$mo <- as.character(microorganisms$mo)
|
||||
|
||||
|
@ -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")
|
||||
)
|
||||
)
|
||||
# Traditional antibiogram ----------------------------------------------
|
||||
|
||||
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 ----------------------------------------------
|
||||
#
|
||||
# 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")
|
||||
# }
|
||||
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,17 +153,20 @@ 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")
|
||||
mo_transform = "gramstain"
|
||||
)
|
||||
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = carbapenems(),
|
||||
ab_transform = "name",
|
||||
mo_transform = "name")
|
||||
mo_transform = "name"
|
||||
)
|
||||
|
||||
|
||||
# Combined antibiogram -------------------------------------------------
|
||||
@ -171,13 +174,15 @@ antibiogram(example_isolates,
|
||||
# combined antibiotics yield higher empiric coverage
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
|
||||
mo_transform = "gramstain")
|
||||
mo_transform = "gramstain"
|
||||
)
|
||||
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c("TZP", "TZP+TOB"),
|
||||
mo_transform = "gramstain",
|
||||
ab_transform = "name",
|
||||
sep = " & ")
|
||||
sep = " & "
|
||||
)
|
||||
|
||||
|
||||
# Syndromic antibiogram ------------------------------------------------
|
||||
@ -185,7 +190,8 @@ antibiogram(example_isolates,
|
||||
# the data set could contain a filter for e.g. respiratory specimens
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c(aminoglycosides(), carbapenems()),
|
||||
syndromic_group = "ward")
|
||||
syndromic_group = "ward"
|
||||
)
|
||||
|
||||
# now define a data set with only E. coli
|
||||
ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ]
|
||||
@ -196,8 +202,10 @@ antibiogram(ex1,
|
||||
antibiotics = aminoglycosides(),
|
||||
ab_transform = "name",
|
||||
syndromic_group = ifelse(ex1$ward == "ICU",
|
||||
"UCI", "No UCI"),
|
||||
language = "es")
|
||||
"UCI", "No UCI"
|
||||
),
|
||||
language = "es"
|
||||
)
|
||||
|
||||
|
||||
# Weighted-incidence syndromic combination antibiogram (WISCA) ---------
|
||||
@ -209,18 +217,22 @@ antibiogram(example_isolates,
|
||||
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"))
|
||||
"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")
|
||||
mo_transform = "gramstain"
|
||||
)
|
||||
ab2 <- antibiogram(example_isolates,
|
||||
antibiotics = c("AMC", "CIP", "TZP", "TZP+TOB"),
|
||||
mo_transform = "gramstain",
|
||||
syndromic_group = "ward")
|
||||
syndromic_group = "ward"
|
||||
)
|
||||
|
||||
plot(ab1)
|
||||
|
||||
|
@ -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")) {
|
||||
@ -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
Block a user