diff --git a/DESCRIPTION b/DESCRIPTION index 65dca906..8fa764c7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 2.1.1.9049 -Date: 2024-06-14 +Version: 2.1.1.9050 +Date: 2024-06-15 Title: Antimicrobial Resistance Data Analysis Description: Functions to simplify and standardise antimicrobial resistance (AMR) data analysis and to work with microbial and antimicrobial properties by diff --git a/NAMESPACE b/NAMESPACE index b168cc8e..e81a07bd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -84,6 +84,7 @@ S3method(plot,mic) S3method(plot,resistance_predict) S3method(plot,sir) S3method(print,ab) +S3method(print,ab_selector) S3method(print,av) S3method(print,bug_drug_combinations) S3method(print,custom_eucast_rules) diff --git a/NEWS.md b/NEWS.md index aaab189e..d8d8df8e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -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!)* diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index 91c5f59c..25938aa1 100644 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -524,6 +524,9 @@ word_wrap <- function(..., # otherwise, give a 'click to run' popup parts[cmds & parts %unlike% "[.]"] <- font_url(url = paste0("ide:run:AMR::", 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 <- gsub("`(.+?)`", font_grey_bg("\\1"), msg) diff --git a/R/ab_selectors.R b/R/ab_selectors.R index 4a20fee6..56c6a7f8 100755 --- a/R/ab_selectors.R +++ b/R/ab_selectors.R @@ -57,59 +57,31 @@ #' example_isolates #' #' -#' # Examples sections below are split into 'base R', 'dplyr', 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")] -#' +#' # Examples sections below are split into 'dplyr', 'base R', and 'data.table': +#' #' \donttest{ #' # dplyr ------------------------------------------------------------------- +#' +#' if (require("dplyr")) { +#'. example_isolates %>% select(carbapenems()) +#' } #' #' if (require("dplyr")) { -#' tibble(kefzol = random_sir(5)) %>% -#' select(cephalosporins()) +#' # 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")) { #' # get AMR for all aminoglycosides e.g., per ward: #' example_isolates %>% #' group_by(ward) %>% -#' summarise(across(aminoglycosides(), resistance)) +#' summarise(across(aminoglycosides(), +#' resistance)) #' } #' if (require("dplyr")) { #' # You can combine selectors with '&' to be more specific: @@ -121,7 +93,8 @@ #' example_isolates %>% #' filter(mo_genus() %in% c("Escherichia", "Klebsiella")) %>% #' group_by(ward) %>% -#' summarise(across(not_intrinsic_resistant(), resistance)) +#' summarise_at(not_intrinsic_resistant(), +#' resistance) #' } #' if (require("dplyr")) { #' # 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 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 #' @export #' @noRd diff --git a/R/eucast_rules.R b/R/eucast_rules.R index c74c05d8..ce330387 100755 --- a/R/eucast_rules.R +++ b/R/eucast_rules.R @@ -462,7 +462,7 @@ eucast_rules <- function(x, font_red(paste0( "v", utils::packageDescription("AMR")$Version, ", ", format(as.Date(utils::packageDescription("AMR")$Date), format = "%Y") - )), "), see ?eucast_rules\n" + )), "), see `?eucast_rules`\n" )) )) } diff --git a/R/key_antimicrobials.R b/R/key_antimicrobials.R index fbae1a3f..2916c13c 100755 --- a/R/key_antimicrobials.R +++ b/R/key_antimicrobials.R @@ -188,7 +188,7 @@ key_antimicrobials <- function(x = NULL, "No columns available ", 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`." ) } diff --git a/R/pca.R b/R/pca.R index 7c13a348..802a058c 100755 --- a/R/pca.R +++ b/R/pca.R @@ -113,7 +113,7 @@ pca <- function(x, x <- as.data.frame(new_list, stringsAsFactors = FALSE) 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 diff --git a/R/resistance_predict.R b/R/resistance_predict.R index 2c50a36c..c4221e68 100755 --- a/R/resistance_predict.R +++ b/R/resistance_predict.R @@ -231,7 +231,7 @@ resistance_predict <- function(x, prediction <- predictmodel$fit se <- predictmodel$se.fit } else { - stop("no valid model selected. See ?resistance_predict.") + stop("no valid model selected. See `?resistance_predict`.") } # prepare the output dataframe diff --git a/R/sir.R b/R/sir.R index c797635e..affb5ce0 100755 --- a/R/sir.R +++ b/R/sir.R @@ -158,6 +158,51 @@ #' #' # 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 #' df <- data.frame( #' microorganism = "Escherichia coli", @@ -187,36 +232,6 @@ #' 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 ------------------------------------ #' @@ -1121,6 +1136,7 @@ as_sir_method <- function(method_short, suppressMessages(suppressWarnings(ab_name(ab_current, language = NULL, tolower = TRUE))), " (", ab_current, ")" ) + notes <- character(0) # gather all available breakpoints for current MO breakpoints_current <- breakpoints %pm>% @@ -1165,7 +1181,8 @@ as_sir_method <- function(method_short, subset(host_match == TRUE) } else { # 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)), ab = rep(ab_current, length(rows)), mo = rep(breakpoints_current[, "mo", drop = TRUE], length(rows)), + method = rep(method_coerced, length(rows)), input = as.double(values), 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)), + notes = rep(paste0(notes, collapse = " "), length(rows)), + guideline = rep(guideline_coerced, length(rows)), ref_table = rep(breakpoints_current[, "ref_tbl", 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 ) ) @@ -1268,6 +1286,8 @@ as_sir_method <- function(method_short, } if (isTRUE(rise_warning)) { message(font_rose_bg(" WARNING ")) + } else if (length(notes) > 0) { + message(font_yellow_bg(" NOTES ")) } else if (length(msgs) == 0) { message(font_green_bg(" OK ")) } else { diff --git a/R/vctrs.R b/R/vctrs.R index db8855cd..36483276 100755 --- a/R/vctrs.R +++ b/R/vctrs.R @@ -109,10 +109,13 @@ vec_ptype_abbr.disk <- function(x, ...) { "dsk" } vec_ptype2.disk.default <- function (x, y, ..., x_arg = "", y_arg = "") { - x + NA_disk_[0] } 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, ...) { unclass(x) @@ -136,11 +139,11 @@ vec_cast.disk.character <- function(x, to, ...) { # S3: mic ---- vec_ptype2.mic.default <- function (x, y, ..., x_arg = "", y_arg = "") { # this will make sure that currently implemented MIC levels are returned - as.mic(x) + NA_mic_[0] } vec_ptype2.mic.mic <- function(x, y, ...) { # this will make sure that currently implemented MIC levels are returned - as.mic(x) + NA_mic_[0] } vec_cast.mic.mic <- function(x, to, ...) { # 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, ...) { 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, ...) { as.character(x) } diff --git a/R/zzz.R b/R/zzz.R index 8af3068b..39cfcf78 100755 --- a/R/zzz.R +++ b/R/zzz.R @@ -62,13 +62,15 @@ AMR_env$sir_interpretation_history <- data.frame( mo_user = character(0), ab = set_clean_class(character(0), c("ab", "character")), mo = set_clean_class(character(0), c("mo", "character")), + method = character(0), input = double(0), outcome = NA_sir_[0], - method = character(0), - breakpoint_S_R = character(0), - guideline = character(0), host = character(0), + notes = character(0), + guideline = character(0), ref_table = character(0), + uti = logical(0), + breakpoint_S_R = character(0), 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", "mic") 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", "av") 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_ptype2", "disk.default") 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", "disk.integer") 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_cast", "character.sir") 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 (tryCatch(file.exists(getOption("AMR_mo_source", "~/mo_source.rds")), error = function(e) FALSE)) { diff --git a/data/example_isolates.rda b/data/example_isolates.rda index 3a5d7af1..bb130884 100644 Binary files a/data/example_isolates.rda and b/data/example_isolates.rda differ diff --git a/man/antibiotic_class_selectors.Rd b/man/antibiotic_class_selectors.Rd index cb69f8b5..93ba5fa3 100644 --- a/man/antibiotic_class_selectors.Rd +++ b/man/antibiotic_class_selectors.Rd @@ -185,59 +185,31 @@ All data sets in this \code{AMR} package (about microorganisms, antibiotics, SIR example_isolates -# Examples sections below are split into 'base R', 'dplyr', 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")] +# Examples sections below are split into 'dplyr', 'base R', and 'data.table': \donttest{ # dplyr ------------------------------------------------------------------- if (require("dplyr")) { - tibble(kefzol = random_sir(5)) \%>\% - select(cephalosporins()) +. example_isolates \%>\% select(carbapenems()) +} + +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")) { # get AMR for all aminoglycosides e.g., per ward: example_isolates \%>\% group_by(ward) \%>\% - summarise(across(aminoglycosides(), resistance)) + summarise(across(aminoglycosides(), + resistance)) } if (require("dplyr")) { # You can combine selectors with '&' to be more specific: @@ -249,7 +221,8 @@ if (require("dplyr")) { example_isolates \%>\% filter(mo_genus() \%in\% c("Escherichia", "Klebsiella")) \%>\% group_by(ward) \%>\% - summarise(across(not_intrinsic_resistant(), resistance)) + summarise_at(not_intrinsic_resistant(), + resistance) } if (require("dplyr")) { # 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 is supported as well, just use it in the same way as with diff --git a/man/as.sir.Rd b/man/as.sir.Rd index 6384a13a..2ea89c64 100644 --- a/man/as.sir.Rd +++ b/man/as.sir.Rd @@ -251,6 +251,51 @@ summary(example_isolates) # see all SIR results at a glance # 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 df <- data.frame( microorganism = "Escherichia coli", @@ -280,36 +325,6 @@ as.sir( 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 ------------------------------------