(v2.1.1.9050) vctrs fix for `sir`, small documentation fixes

This commit is contained in:
dr. M.S. (Matthijs) Berends 2024-06-15 15:33:49 +02:00
parent 9bf7584d58
commit bdbf5198a2
15 changed files with 248 additions and 165 deletions

View File

@ -1,6 +1,6 @@
Package: AMR Package: AMR
Version: 2.1.1.9049 Version: 2.1.1.9050
Date: 2024-06-14 Date: 2024-06-15
Title: Antimicrobial Resistance Data Analysis Title: Antimicrobial Resistance Data Analysis
Description: Functions to simplify and standardise antimicrobial resistance (AMR) Description: Functions to simplify and standardise antimicrobial resistance (AMR)
data analysis and to work with microbial and antimicrobial properties by data analysis and to work with microbial and antimicrobial properties by

View File

@ -84,6 +84,7 @@ S3method(plot,mic)
S3method(plot,resistance_predict) S3method(plot,resistance_predict)
S3method(plot,sir) S3method(plot,sir)
S3method(print,ab) S3method(print,ab)
S3method(print,ab_selector)
S3method(print,av) S3method(print,av)
S3method(print,bug_drug_combinations) S3method(print,bug_drug_combinations)
S3method(print,custom_eucast_rules) S3method(print,custom_eucast_rules)

View File

@ -1,4 +1,4 @@
# AMR 2.1.1.9049 # AMR 2.1.1.9050
*(this beta version will eventually become v3.0. We're happy to reach a new major milestone soon, which will be all about the new One Health support!)* *(this beta version will eventually become v3.0. We're happy to reach a new major milestone soon, which will be all about the new One Health support!)*

View File

@ -524,6 +524,9 @@ word_wrap <- function(...,
# otherwise, give a 'click to run' popup # otherwise, give a 'click to run' popup
parts[cmds & parts %unlike% "[.]"] <- font_url(url = paste0("ide:run:AMR::", parts[cmds & parts %unlike% "[.]"]), parts[cmds & parts %unlike% "[.]"] <- font_url(url = paste0("ide:run:AMR::", parts[cmds & parts %unlike% "[.]"]),
txt = parts[cmds & parts %unlike% "[.]"]) txt = parts[cmds & parts %unlike% "[.]"])
# text starting with `?` must also lead to the help page
parts[parts %like% "^[?]"] <- font_url(url = paste0("ide:help:AMR::", gsub("()", "", gsub("^[?]", "", parts[parts %like% "^[?]"]), fixed = TRUE)),
txt = parts[parts %like% "^[?]"])
msg <- paste0(parts, collapse = "`") msg <- paste0(parts, collapse = "`")
} }
msg <- gsub("`(.+?)`", font_grey_bg("\\1"), msg) msg <- gsub("`(.+?)`", font_grey_bg("\\1"), msg)

View File

@ -57,59 +57,31 @@
#' example_isolates #' example_isolates
#' #'
#' #'
#' # Examples sections below are split into 'base R', 'dplyr', and 'data.table': #' # Examples sections below are split into 'dplyr', 'base R', and 'data.table':
#'
#'
#' # base R ------------------------------------------------------------------
#'
#' # select columns 'IPM' (imipenem) and 'MEM' (meropenem)
#' example_isolates[, carbapenems()]
#'
#' # select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB'
#' example_isolates[, c("mo", aminoglycosides())]
#'
#' # select only antibiotic columns with DDDs for oral treatment
#' example_isolates[, administrable_per_os()]
#'
#' # filter using any() or all()
#' example_isolates[any(carbapenems() == "R"), ]
#' subset(example_isolates, any(carbapenems() == "R"))
#'
#' # filter on any or all results in the carbapenem columns (i.e., IPM, MEM):
#' example_isolates[any(carbapenems()), ]
#' example_isolates[all(carbapenems()), ]
#'
#' # filter with multiple antibiotic selectors using c()
#' example_isolates[all(c(carbapenems(), aminoglycosides()) == "R"), ]
#'
#' # filter + select in one go: get penicillins in carbapenem-resistant strains
#' example_isolates[any(carbapenems() == "R"), penicillins()]
#'
#' # You can combine selectors with '&' to be more specific. For example,
#' # penicillins() would select benzylpenicillin ('peni G') and
#' # administrable_per_os() would select erythromycin. Yet, when combined these
#' # drugs are both omitted since benzylpenicillin is not administrable per os
#' # and erythromycin is not a penicillin:
#' example_isolates[, penicillins() & administrable_per_os()]
#'
#' # ab_selector() applies a filter in the `antibiotics` data set and is thus
#' # very flexible. For instance, to select antibiotic columns with an oral DDD
#' # of at least 1 gram:
#' example_isolates[, ab_selector(oral_ddd > 1 & oral_units == "g")]
#' #'
#' \donttest{ #' \donttest{
#' # dplyr ------------------------------------------------------------------- #' # dplyr -------------------------------------------------------------------
#' #'
#' if (require("dplyr")) { #' if (require("dplyr")) {
#' tibble(kefzol = random_sir(5)) %>% #'. example_isolates %>% select(carbapenems())
#' select(cephalosporins()) #' }
#'
#' if (require("dplyr")) {
#' # select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB'
#' example_isolates %>% select(mo, aminoglycosides())
#' }
#'
#' if (require("dplyr")) {
#' # select only antibiotic columns with DDDs for oral treatment
#'. example_isolates %>% select(administrable_per_os())
#' } #' }
#' #'
#' if (require("dplyr")) { #' if (require("dplyr")) {
#' # get AMR for all aminoglycosides e.g., per ward: #' # get AMR for all aminoglycosides e.g., per ward:
#' example_isolates %>% #' example_isolates %>%
#' group_by(ward) %>% #' group_by(ward) %>%
#' summarise(across(aminoglycosides(), resistance)) #' summarise(across(aminoglycosides(),
#' resistance))
#' } #' }
#' if (require("dplyr")) { #' if (require("dplyr")) {
#' # You can combine selectors with '&' to be more specific: #' # You can combine selectors with '&' to be more specific:
@ -121,7 +93,8 @@
#' example_isolates %>% #' example_isolates %>%
#' filter(mo_genus() %in% c("Escherichia", "Klebsiella")) %>% #' filter(mo_genus() %in% c("Escherichia", "Klebsiella")) %>%
#' group_by(ward) %>% #' group_by(ward) %>%
#' summarise(across(not_intrinsic_resistant(), resistance)) #' summarise_at(not_intrinsic_resistant(),
#' resistance)
#' } #' }
#' if (require("dplyr")) { #' if (require("dplyr")) {
#' # get susceptibility for antibiotics whose name contains "trim": #' # get susceptibility for antibiotics whose name contains "trim":
@ -187,6 +160,44 @@
#' } #' }
#' #'
#' #'
#' # base R ------------------------------------------------------------------
#'
#' # select columns 'IPM' (imipenem) and 'MEM' (meropenem)
#' example_isolates[, carbapenems()]
#'
#' # select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB'
#' example_isolates[, c("mo", aminoglycosides())]
#'
#' # select only antibiotic columns with DDDs for oral treatment
#' example_isolates[, administrable_per_os()]
#'
#' # filter using any() or all()
#' example_isolates[any(carbapenems() == "R"), ]
#' subset(example_isolates, any(carbapenems() == "R"))
#'
#' # filter on any or all results in the carbapenem columns (i.e., IPM, MEM):
#' example_isolates[any(carbapenems()), ]
#' example_isolates[all(carbapenems()), ]
#'
#' # filter with multiple antibiotic selectors using c()
#' example_isolates[all(c(carbapenems(), aminoglycosides()) == "R"), ]
#'
#' # filter + select in one go: get penicillins in carbapenem-resistant strains
#' example_isolates[any(carbapenems() == "R"), penicillins()]
#'
#' # You can combine selectors with '&' to be more specific. For example,
#' # penicillins() would select benzylpenicillin ('peni G') and
#' # administrable_per_os() would select erythromycin. Yet, when combined these
#' # drugs are both omitted since benzylpenicillin is not administrable per os
#' # and erythromycin is not a penicillin:
#' example_isolates[, penicillins() & administrable_per_os()]
#'
#' # ab_selector() applies a filter in the `antibiotics` data set and is thus
#' # very flexible. For instance, to select antibiotic columns with an oral DDD
#' # of at least 1 gram:
#' example_isolates[, ab_selector(oral_ddd > 1 & oral_units == "g")]
#'
#'
#' # data.table -------------------------------------------------------------- #' # data.table --------------------------------------------------------------
#' #'
#' # data.table is supported as well, just use it in the same way as with #' # data.table is supported as well, just use it in the same way as with
@ -679,6 +690,16 @@ ab_select_exec <- function(function_name,
) )
} }
#' @method print ab_selector
#' @export
#' @noRd
print.ab_selector <- function(x, ...) {
warning_("It should never be needed to print an antibiotic selector class. Are you using data.table? Then add the argument `with = FALSE`, see our examples at `?ab_selector`.",
immediate = TRUE)
cat("Class 'ab_selector'\n")
print(as.character(x), quote = FALSE)
}
#' @method c ab_selector #' @method c ab_selector
#' @export #' @export
#' @noRd #' @noRd

View File

@ -462,7 +462,7 @@ eucast_rules <- function(x,
font_red(paste0( font_red(paste0(
"v", utils::packageDescription("AMR")$Version, ", ", "v", utils::packageDescription("AMR")$Version, ", ",
format(as.Date(utils::packageDescription("AMR")$Date), format = "%Y") format(as.Date(utils::packageDescription("AMR")$Date), format = "%Y")
)), "), see ?eucast_rules\n" )), "), see `?eucast_rules`\n"
)) ))
)) ))
} }

View File

@ -188,7 +188,7 @@ key_antimicrobials <- function(x = NULL,
"No columns available ", "No columns available ",
paste0("Only using ", values_new_length, " out of ", values_old_length, " defined columns ") paste0("Only using ", values_new_length, " out of ", values_old_length, " defined columns ")
), ),
"as key antimicrobials for ", name, "s. See ?key_antimicrobials." "as key antimicrobials for ", name, "s. See `?key_antimicrobials`."
) )
} }

View File

@ -113,7 +113,7 @@ pca <- function(x,
x <- as.data.frame(new_list, stringsAsFactors = FALSE) x <- as.data.frame(new_list, stringsAsFactors = FALSE)
if (any(vapply(FUN.VALUE = logical(1), x, function(y) !is.numeric(y)))) { if (any(vapply(FUN.VALUE = logical(1), x, function(y) !is.numeric(y)))) {
warning_("in `pca()`: be sure to first calculate the resistance (or susceptibility) of variables with antimicrobial test results, since PCA works with numeric variables only. See Examples in ?pca.", call = FALSE) warning_("in `pca()`: be sure to first calculate the resistance (or susceptibility) of variables with antimicrobial test results, since PCA works with numeric variables only. See Examples in `?pca`.", call = FALSE)
} }
# set column names # set column names

View File

@ -231,7 +231,7 @@ resistance_predict <- function(x,
prediction <- predictmodel$fit prediction <- predictmodel$fit
se <- predictmodel$se.fit se <- predictmodel$se.fit
} else { } else {
stop("no valid model selected. See ?resistance_predict.") stop("no valid model selected. See `?resistance_predict`.")
} }
# prepare the output dataframe # prepare the output dataframe

88
R/sir.R
View File

@ -158,6 +158,51 @@
#' #'
#' # For INTERPRETING disk diffusion and MIC values ----------------------- #' # For INTERPRETING disk diffusion and MIC values -----------------------
#' #'
#' \donttest{
#' ## Using dplyr -------------------------------------------------
#' if (require("dplyr")) {
#' # approaches that all work without additional arguments:
#' df %>% mutate_if(is.mic, as.sir)
#' df %>% mutate_if(function(x) is.mic(x) | is.disk(x), as.sir)
#' df %>% mutate(across(where(is.mic), as.sir))
#' df %>% mutate_at(vars(AMP:TOB), as.sir)
#' df %>% mutate(across(AMP:TOB, as.sir))
#'
#' # approaches that all work with additional arguments:
#' df %>% mutate_if(is.mic, as.sir, mo = "column1", guideline = "CLSI")
#' df %>% mutate(across(where(is.mic),
#' function(x) as.sir(x, mo = "column1", guideline = "CLSI")))
#' df %>% mutate_at(vars(AMP:TOB), as.sir, mo = "column1", guideline = "CLSI")
#' df %>% mutate(across(AMP:TOB,
#' function(x) as.sir(x, mo = "column1", guideline = "CLSI")))
#'
#' # for veterinary breakpoints, add 'host':
#' df %>% mutate_if(is.mic, as.sir, guideline = "CLSI", host = "species_column")
#' df %>% mutate_if(is.mic, as.sir, guideline = "CLSI", host = "horse")
#' df %>% mutate(across(where(is.mic),
#' function(x) as.sir(x, guideline = "CLSI", host = "species_column")))
#' df %>% mutate_at(vars(AMP:TOB), as.sir, guideline = "CLSI", host = "species_column")
#' df %>% mutate(across(AMP:TOB,
#' function(x) as.sir(x, mo = "column1", guideline = "CLSI")))
#'
#' # to include information about urinary tract infections (UTI)
#' data.frame(mo = "E. coli",
#' nitrofuratoin = c("<= 2", 32),
#' from_the_bladder = c(TRUE, FALSE)) %>%
#' as.sir(uti = "from_the_bladder")
#'
#' data.frame(mo = "E. coli",
#' nitrofuratoin = c("<= 2", 32),
#' specimen = c("urine", "blood")) %>%
#' as.sir() # automatically determines urine isolates
#'
#' df %>%
#' mutate_at(vars(AMP:TOB), as.sir, mo = "E. coli", uti = TRUE)
#' }
#'
#'
#' ## Using base R ------------------------------------------------
#'
#' # a whole data set, even with combined MIC values and disk zones #' # a whole data set, even with combined MIC values and disk zones
#' df <- data.frame( #' df <- data.frame(
#' microorganism = "Escherichia coli", #' microorganism = "Escherichia coli",
@ -187,36 +232,6 @@
#' guideline = "EUCAST" #' guideline = "EUCAST"
#' ) #' )
#' #'
#' \donttest{
#' # the dplyr way
#' if (require("dplyr")) {
#' df %>% mutate_if(is.mic, as.sir)
#' df %>% mutate_if(function(x) is.mic(x) | is.disk(x), as.sir)
#' df %>% mutate(across(where(is.mic), as.sir))
#' df %>% mutate_at(vars(AMP:TOB), as.sir)
#' df %>% mutate(across(AMP:TOB, as.sir))
#'
#' df %>%
#' mutate_at(vars(AMP:TOB), as.sir, mo = "microorganism")
#'
#' # to include information about urinary tract infections (UTI)
#' data.frame(
#' mo = "E. coli",
#' NIT = c("<= 2", 32),
#' from_the_bladder = c(TRUE, FALSE)
#' ) %>%
#' as.sir(uti = "from_the_bladder")
#'
#' data.frame(
#' mo = "E. coli",
#' NIT = c("<= 2", 32),
#' specimen = c("urine", "blood")
#' ) %>%
#' as.sir() # automatically determines urine isolates
#'
#' df %>%
#' mutate_at(vars(AMP:TOB), as.sir, mo = "E. coli", uti = TRUE)
#' }
#' #'
#' # For CLEANING existing SIR values ------------------------------------ #' # For CLEANING existing SIR values ------------------------------------
#' #'
@ -1121,6 +1136,7 @@ as_sir_method <- function(method_short,
suppressMessages(suppressWarnings(ab_name(ab_current, language = NULL, tolower = TRUE))), suppressMessages(suppressWarnings(ab_name(ab_current, language = NULL, tolower = TRUE))),
" (", ab_current, ")" " (", ab_current, ")"
) )
notes <- character(0)
# gather all available breakpoints for current MO # gather all available breakpoints for current MO
breakpoints_current <- breakpoints %pm>% breakpoints_current <- breakpoints %pm>%
@ -1165,7 +1181,8 @@ as_sir_method <- function(method_short,
subset(host_match == TRUE) subset(host_match == TRUE)
} else { } else {
# no breakpoint found for this host, so sort on mostly available guidelines # no breakpoint found for this host, so sort on mostly available guidelines
msgs <- c(msgs, paste0("No breakpoints available for ", font_bold(host_current), " for ", ab_formatted, " in ", mo_formatted, " - using ", font_bold(breakpoints_current$host[1]), " instead.")) notes <- c(notes, paste0("No breakpoints available for ", font_bold(host_current), " for ", ab_formatted, " in ", mo_formatted, " - using ", font_bold(breakpoints_current$host[1]), " instead."))
# msgs <- c(msgs, paste0("No breakpoints available for ", font_bold(host_current), " for ", ab_formatted, " in ", mo_formatted, " - using ", font_bold(breakpoints_current$host[1]), " instead."))
} }
} }
@ -1243,14 +1260,15 @@ as_sir_method <- function(method_short,
mo_user = rep(mo.bak[match(mo_current, df$mo)][1], length(rows)), mo_user = rep(mo.bak[match(mo_current, df$mo)][1], length(rows)),
ab = rep(ab_current, length(rows)), ab = rep(ab_current, length(rows)),
mo = rep(breakpoints_current[, "mo", drop = TRUE], length(rows)), mo = rep(breakpoints_current[, "mo", drop = TRUE], length(rows)),
method = rep(method_coerced, length(rows)),
input = as.double(values), input = as.double(values),
outcome = as.sir(new_sir), outcome = as.sir(new_sir),
method = rep(method_coerced, length(rows)),
breakpoint_S_R = rep(paste0(breakpoints_current[, "breakpoint_S", drop = TRUE], "-", breakpoints_current[, "breakpoint_R", drop = TRUE]), length(rows)),
guideline = rep(guideline_coerced, length(rows)),
host = rep(breakpoints_current[, "host", drop = TRUE], length(rows)), host = rep(breakpoints_current[, "host", drop = TRUE], length(rows)),
notes = rep(paste0(notes, collapse = " "), length(rows)),
guideline = rep(guideline_coerced, length(rows)),
ref_table = rep(breakpoints_current[, "ref_tbl", drop = TRUE], length(rows)), ref_table = rep(breakpoints_current[, "ref_tbl", drop = TRUE], length(rows)),
uti = rep(breakpoints_current[, "uti", drop = TRUE], length(rows)), uti = rep(breakpoints_current[, "uti", drop = TRUE], length(rows)),
breakpoint_S_R = rep(paste0(breakpoints_current[, "breakpoint_S", drop = TRUE], "-", breakpoints_current[, "breakpoint_R", drop = TRUE]), length(rows)),
stringsAsFactors = FALSE stringsAsFactors = FALSE
) )
) )
@ -1268,6 +1286,8 @@ as_sir_method <- function(method_short,
} }
if (isTRUE(rise_warning)) { if (isTRUE(rise_warning)) {
message(font_rose_bg(" WARNING ")) message(font_rose_bg(" WARNING "))
} else if (length(notes) > 0) {
message(font_yellow_bg(" NOTES "))
} else if (length(msgs) == 0) { } else if (length(msgs) == 0) {
message(font_green_bg(" OK ")) message(font_green_bg(" OK "))
} else { } else {

View File

@ -109,10 +109,13 @@ vec_ptype_abbr.disk <- function(x, ...) {
"dsk" "dsk"
} }
vec_ptype2.disk.default <- function (x, y, ..., x_arg = "", y_arg = "") { vec_ptype2.disk.default <- function (x, y, ..., x_arg = "", y_arg = "") {
x NA_disk_[0]
} }
vec_ptype2.disk.disk <- function(x, y, ...) { vec_ptype2.disk.disk <- function(x, y, ...) {
x NA_disk_[0]
}
vec_cast.disk.disk <- function(x, to, ...) {
as.disk(x)
} }
vec_cast.integer.disk <- function(x, to, ...) { vec_cast.integer.disk <- function(x, to, ...) {
unclass(x) unclass(x)
@ -136,11 +139,11 @@ vec_cast.disk.character <- function(x, to, ...) {
# S3: mic ---- # S3: mic ----
vec_ptype2.mic.default <- function (x, y, ..., x_arg = "", y_arg = "") { vec_ptype2.mic.default <- function (x, y, ..., x_arg = "", y_arg = "") {
# this will make sure that currently implemented MIC levels are returned # this will make sure that currently implemented MIC levels are returned
as.mic(x) NA_mic_[0]
} }
vec_ptype2.mic.mic <- function(x, y, ...) { vec_ptype2.mic.mic <- function(x, y, ...) {
# this will make sure that currently implemented MIC levels are returned # this will make sure that currently implemented MIC levels are returned
as.mic(x) NA_mic_[0]
} }
vec_cast.mic.mic <- function(x, to, ...) { vec_cast.mic.mic <- function(x, to, ...) {
# this will make sure that currently implemented MIC levels are returned # this will make sure that currently implemented MIC levels are returned
@ -187,6 +190,10 @@ vec_ptype2.sir.sir <- function(x, y, ...) {
vec_ptype2.character.sir <- function(x, y, ...) { vec_ptype2.character.sir <- function(x, y, ...) {
NA_sir_[0] NA_sir_[0]
} }
vec_cast.sir.sir <- function(x, to, ...) {
# this makes sure that old SIR objects (with S/I/R) are converted to the current structure (S/SDD/I/R/NI)
as.sir(x)
}
vec_cast.character.sir <- function(x, to, ...) { vec_cast.character.sir <- function(x, to, ...) {
as.character(x) as.character(x)
} }

11
R/zzz.R
View File

@ -62,13 +62,15 @@ AMR_env$sir_interpretation_history <- data.frame(
mo_user = character(0), mo_user = character(0),
ab = set_clean_class(character(0), c("ab", "character")), ab = set_clean_class(character(0), c("ab", "character")),
mo = set_clean_class(character(0), c("mo", "character")), mo = set_clean_class(character(0), c("mo", "character")),
method = character(0),
input = double(0), input = double(0),
outcome = NA_sir_[0], outcome = NA_sir_[0],
method = character(0),
breakpoint_S_R = character(0),
guideline = character(0),
host = character(0), host = character(0),
notes = character(0),
guideline = character(0),
ref_table = character(0), ref_table = character(0),
uti = logical(0),
breakpoint_S_R = character(0),
stringsAsFactors = FALSE stringsAsFactors = FALSE
) )
@ -95,6 +97,7 @@ AMR_env$sup_1_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$sup_1 %o
s3_register("pillar::pillar_shaft", "sir") s3_register("pillar::pillar_shaft", "sir")
s3_register("pillar::pillar_shaft", "mic") s3_register("pillar::pillar_shaft", "mic")
s3_register("pillar::pillar_shaft", "disk") s3_register("pillar::pillar_shaft", "disk")
# no type_sum of disk, that's now in vctrs::vec_ptype_full
s3_register("pillar::type_sum", "ab") s3_register("pillar::type_sum", "ab")
s3_register("pillar::type_sum", "av") s3_register("pillar::type_sum", "av")
s3_register("pillar::type_sum", "mo") s3_register("pillar::type_sum", "mo")
@ -153,6 +156,7 @@ AMR_env$sup_1_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$sup_1 %o
s3_register("vctrs::vec_ptype_abbr", "disk") s3_register("vctrs::vec_ptype_abbr", "disk")
s3_register("vctrs::vec_ptype2", "disk.default") s3_register("vctrs::vec_ptype2", "disk.default")
s3_register("vctrs::vec_ptype2", "disk.disk") s3_register("vctrs::vec_ptype2", "disk.disk")
s3_register("vctrs::vec_cast", "disk.disk")
s3_register("vctrs::vec_cast", "integer.disk") s3_register("vctrs::vec_cast", "integer.disk")
s3_register("vctrs::vec_cast", "disk.integer") s3_register("vctrs::vec_cast", "disk.integer")
s3_register("vctrs::vec_cast", "double.disk") s3_register("vctrs::vec_cast", "double.disk")
@ -179,6 +183,7 @@ AMR_env$sup_1_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$sup_1 %o
s3_register("vctrs::vec_ptype2", "character.sir") s3_register("vctrs::vec_ptype2", "character.sir")
s3_register("vctrs::vec_cast", "character.sir") s3_register("vctrs::vec_cast", "character.sir")
s3_register("vctrs::vec_cast", "sir.character") s3_register("vctrs::vec_cast", "sir.character")
s3_register("vctrs::vec_cast", "sir.sir")
# if mo source exists, fire it up (see mo_source()) # if mo source exists, fire it up (see mo_source())
if (tryCatch(file.exists(getOption("AMR_mo_source", "~/mo_source.rds")), error = function(e) FALSE)) { if (tryCatch(file.exists(getOption("AMR_mo_source", "~/mo_source.rds")), error = function(e) FALSE)) {

Binary file not shown.

View File

@ -185,59 +185,31 @@ All data sets in this \code{AMR} package (about microorganisms, antibiotics, SIR
example_isolates example_isolates
# Examples sections below are split into 'base R', 'dplyr', and 'data.table': # Examples sections below are split into 'dplyr', 'base R', and 'data.table':
# base R ------------------------------------------------------------------
# select columns 'IPM' (imipenem) and 'MEM' (meropenem)
example_isolates[, carbapenems()]
# select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB'
example_isolates[, c("mo", aminoglycosides())]
# select only antibiotic columns with DDDs for oral treatment
example_isolates[, administrable_per_os()]
# filter using any() or all()
example_isolates[any(carbapenems() == "R"), ]
subset(example_isolates, any(carbapenems() == "R"))
# filter on any or all results in the carbapenem columns (i.e., IPM, MEM):
example_isolates[any(carbapenems()), ]
example_isolates[all(carbapenems()), ]
# filter with multiple antibiotic selectors using c()
example_isolates[all(c(carbapenems(), aminoglycosides()) == "R"), ]
# filter + select in one go: get penicillins in carbapenem-resistant strains
example_isolates[any(carbapenems() == "R"), penicillins()]
# You can combine selectors with '&' to be more specific. For example,
# penicillins() would select benzylpenicillin ('peni G') and
# administrable_per_os() would select erythromycin. Yet, when combined these
# drugs are both omitted since benzylpenicillin is not administrable per os
# and erythromycin is not a penicillin:
example_isolates[, penicillins() & administrable_per_os()]
# ab_selector() applies a filter in the `antibiotics` data set and is thus
# very flexible. For instance, to select antibiotic columns with an oral DDD
# of at least 1 gram:
example_isolates[, ab_selector(oral_ddd > 1 & oral_units == "g")]
\donttest{ \donttest{
# dplyr ------------------------------------------------------------------- # dplyr -------------------------------------------------------------------
if (require("dplyr")) { if (require("dplyr")) {
tibble(kefzol = random_sir(5)) \%>\% . example_isolates \%>\% select(carbapenems())
select(cephalosporins()) }
if (require("dplyr")) {
# select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB'
example_isolates \%>\% select(mo, aminoglycosides())
}
if (require("dplyr")) {
# select only antibiotic columns with DDDs for oral treatment
. example_isolates \%>\% select(administrable_per_os())
} }
if (require("dplyr")) { if (require("dplyr")) {
# get AMR for all aminoglycosides e.g., per ward: # get AMR for all aminoglycosides e.g., per ward:
example_isolates \%>\% example_isolates \%>\%
group_by(ward) \%>\% group_by(ward) \%>\%
summarise(across(aminoglycosides(), resistance)) summarise(across(aminoglycosides(),
resistance))
} }
if (require("dplyr")) { if (require("dplyr")) {
# You can combine selectors with '&' to be more specific: # You can combine selectors with '&' to be more specific:
@ -249,7 +221,8 @@ if (require("dplyr")) {
example_isolates \%>\% example_isolates \%>\%
filter(mo_genus() \%in\% c("Escherichia", "Klebsiella")) \%>\% filter(mo_genus() \%in\% c("Escherichia", "Klebsiella")) \%>\%
group_by(ward) \%>\% group_by(ward) \%>\%
summarise(across(not_intrinsic_resistant(), resistance)) summarise_at(not_intrinsic_resistant(),
resistance)
} }
if (require("dplyr")) { if (require("dplyr")) {
# get susceptibility for antibiotics whose name contains "trim": # get susceptibility for antibiotics whose name contains "trim":
@ -315,6 +288,44 @@ if (require("dplyr")) {
} }
# base R ------------------------------------------------------------------
# select columns 'IPM' (imipenem) and 'MEM' (meropenem)
example_isolates[, carbapenems()]
# select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB'
example_isolates[, c("mo", aminoglycosides())]
# select only antibiotic columns with DDDs for oral treatment
example_isolates[, administrable_per_os()]
# filter using any() or all()
example_isolates[any(carbapenems() == "R"), ]
subset(example_isolates, any(carbapenems() == "R"))
# filter on any or all results in the carbapenem columns (i.e., IPM, MEM):
example_isolates[any(carbapenems()), ]
example_isolates[all(carbapenems()), ]
# filter with multiple antibiotic selectors using c()
example_isolates[all(c(carbapenems(), aminoglycosides()) == "R"), ]
# filter + select in one go: get penicillins in carbapenem-resistant strains
example_isolates[any(carbapenems() == "R"), penicillins()]
# You can combine selectors with '&' to be more specific. For example,
# penicillins() would select benzylpenicillin ('peni G') and
# administrable_per_os() would select erythromycin. Yet, when combined these
# drugs are both omitted since benzylpenicillin is not administrable per os
# and erythromycin is not a penicillin:
example_isolates[, penicillins() & administrable_per_os()]
# ab_selector() applies a filter in the `antibiotics` data set and is thus
# very flexible. For instance, to select antibiotic columns with an oral DDD
# of at least 1 gram:
example_isolates[, ab_selector(oral_ddd > 1 & oral_units == "g")]
# data.table -------------------------------------------------------------- # data.table --------------------------------------------------------------
# data.table is supported as well, just use it in the same way as with # data.table is supported as well, just use it in the same way as with

View File

@ -251,6 +251,51 @@ summary(example_isolates) # see all SIR results at a glance
# For INTERPRETING disk diffusion and MIC values ----------------------- # For INTERPRETING disk diffusion and MIC values -----------------------
\donttest{
## Using dplyr -------------------------------------------------
if (require("dplyr")) {
# approaches that all work without additional arguments:
df \%>\% mutate_if(is.mic, as.sir)
df \%>\% mutate_if(function(x) is.mic(x) | is.disk(x), as.sir)
df \%>\% mutate(across(where(is.mic), as.sir))
df \%>\% mutate_at(vars(AMP:TOB), as.sir)
df \%>\% mutate(across(AMP:TOB, as.sir))
# approaches that all work with additional arguments:
df \%>\% mutate_if(is.mic, as.sir, mo = "column1", guideline = "CLSI")
df \%>\% mutate(across(where(is.mic),
function(x) as.sir(x, mo = "column1", guideline = "CLSI")))
df \%>\% mutate_at(vars(AMP:TOB), as.sir, mo = "column1", guideline = "CLSI")
df \%>\% mutate(across(AMP:TOB,
function(x) as.sir(x, mo = "column1", guideline = "CLSI")))
# for veterinary breakpoints, add 'host':
df \%>\% mutate_if(is.mic, as.sir, guideline = "CLSI", host = "species_column")
df \%>\% mutate_if(is.mic, as.sir, guideline = "CLSI", host = "horse")
df \%>\% mutate(across(where(is.mic),
function(x) as.sir(x, guideline = "CLSI", host = "species_column")))
df \%>\% mutate_at(vars(AMP:TOB), as.sir, guideline = "CLSI", host = "species_column")
df \%>\% mutate(across(AMP:TOB,
function(x) as.sir(x, mo = "column1", guideline = "CLSI")))
# to include information about urinary tract infections (UTI)
data.frame(mo = "E. coli",
nitrofuratoin = c("<= 2", 32),
from_the_bladder = c(TRUE, FALSE)) \%>\%
as.sir(uti = "from_the_bladder")
data.frame(mo = "E. coli",
nitrofuratoin = c("<= 2", 32),
specimen = c("urine", "blood")) \%>\%
as.sir() # automatically determines urine isolates
df \%>\%
mutate_at(vars(AMP:TOB), as.sir, mo = "E. coli", uti = TRUE)
}
## Using base R ------------------------------------------------
# a whole data set, even with combined MIC values and disk zones # a whole data set, even with combined MIC values and disk zones
df <- data.frame( df <- data.frame(
microorganism = "Escherichia coli", microorganism = "Escherichia coli",
@ -280,36 +325,6 @@ as.sir(
guideline = "EUCAST" guideline = "EUCAST"
) )
\donttest{
# the dplyr way
if (require("dplyr")) {
df \%>\% mutate_if(is.mic, as.sir)
df \%>\% mutate_if(function(x) is.mic(x) | is.disk(x), as.sir)
df \%>\% mutate(across(where(is.mic), as.sir))
df \%>\% mutate_at(vars(AMP:TOB), as.sir)
df \%>\% mutate(across(AMP:TOB, as.sir))
df \%>\%
mutate_at(vars(AMP:TOB), as.sir, mo = "microorganism")
# to include information about urinary tract infections (UTI)
data.frame(
mo = "E. coli",
NIT = c("<= 2", 32),
from_the_bladder = c(TRUE, FALSE)
) \%>\%
as.sir(uti = "from_the_bladder")
data.frame(
mo = "E. coli",
NIT = c("<= 2", 32),
specimen = c("urine", "blood")
) \%>\%
as.sir() # automatically determines urine isolates
df \%>\%
mutate_at(vars(AMP:TOB), as.sir, mo = "E. coli", uti = TRUE)
}
# For CLEANING existing SIR values ------------------------------------ # For CLEANING existing SIR values ------------------------------------