diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml index a8f9ad1c..fe8ea837 100644 --- a/.github/workflows/check.yaml +++ b/.github/workflows/check.yaml @@ -66,8 +66,8 @@ jobs: - {os: ubuntu-20.04, r: '3.5', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} - {os: ubuntu-20.04, r: '3.4', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} - {os: ubuntu-20.04, r: '3.3', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} - # - {os: ubuntu-20.04, r: '3.2', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} - # - {os: ubuntu-20.04, r: '3.1', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} + - {os: ubuntu-20.04, r: '3.2', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} + - {os: ubuntu-20.04, r: '3.1', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} - {os: ubuntu-20.04, r: '3.0', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} - {os: ubuntu-16.04, r: 'devel', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} @@ -78,8 +78,8 @@ jobs: - {os: ubuntu-16.04, r: '3.5', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} - {os: ubuntu-16.04, r: '3.4', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} - {os: ubuntu-16.04, r: '3.3', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} - # - {os: ubuntu-16.04, r: '3.2', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} - # - {os: ubuntu-16.04, r: '3.1', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} + - {os: ubuntu-16.04, r: '3.2', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} + - {os: ubuntu-16.04, r: '3.1', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} - {os: ubuntu-16.04, r: '3.0', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} env: @@ -162,7 +162,8 @@ jobs: _R_CHECK_LENGTH_1_CONDITION_: verbose _R_CHECK_LENGTH_1_LOGIC2_: verbose run: | - R CMD check data-raw/AMR_latest.tar.gz --no-manual --no-build-vignettes + tar -xvf data-raw/AMR_latest.tar.gz + R CMD check AMR --no-manual --no-build-vignettes - name: Show testthat output if: always() diff --git a/DESCRIPTION b/DESCRIPTION index b70d1ffd..65782e16 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 1.6.0 -Date: 2021-03-14 +Version: 1.6.0.9000 +Date: 2021-04-07 Title: Antimicrobial Resistance Data Analysis Authors@R: c( person(role = c("aut", "cre"), @@ -35,11 +35,10 @@ Authors@R: c( family = "Souverein", given = "Dennis", email = "d.souvereing@streeklabhaarlem.nl"), person(role = "ctb", family = "Underwood", given = "Anthony", email = "au3@sanger.ac.uk")) -Description: Functions to simplify the analysis and prediction of Antimicrobial - Resistance (AMR) and to work with microbial and antimicrobial properties by - using evidence-based methods, like those defined by Leclercq et al. (2013) - and containing reference data such as - LPSN . +Description: Functions to simplify and standardise antimicrobial resistance (AMR) + data analysis and to work with microbial and antimicrobial properties by + using evidence-based methods and reliable reference data such as LPSN + . Depends: R (>= 3.0.0) Suggests: diff --git a/NAMESPACE b/NAMESPACE index 4cdb85b0..18ad201d 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -43,6 +43,8 @@ S3method(as.data.frame,ab) S3method(as.data.frame,mo) S3method(as.double,mic) S3method(as.integer,mic) +S3method(as.list,custom_eucast_rules) +S3method(as.list,custom_mdro_guideline) S3method(as.matrix,mic) S3method(as.numeric,mic) S3method(as.rsi,data.frame) @@ -57,6 +59,8 @@ S3method(barplot,disk) S3method(barplot,mic) S3method(barplot,rsi) S3method(c,ab) +S3method(c,custom_eucast_rules) +S3method(c,custom_mdro_guideline) S3method(c,disk) S3method(c,mic) S3method(c,mo) @@ -97,6 +101,7 @@ S3method(plot,rsi) S3method(print,ab) S3method(print,bug_drug_combinations) S3method(print,catalogue_of_life_version) +S3method(print,custom_eucast_rules) S3method(print,custom_mdro_guideline) S3method(print,disk) S3method(print,mic) @@ -184,6 +189,7 @@ export(count_all) export(count_df) export(count_resistant) export(count_susceptible) +export(custom_eucast_rules) export(custom_mdro_guideline) export(eucast_dosage) export(eucast_exceptional_phenotypes) diff --git a/NEWS.md b/NEWS.md index b1a879fe..399f4e49 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,19 @@ -# AMR 1.6.0 +# AMR 1.6.0.9000 +## Last updated: 7 April 2021 +### New +* Function `custom_eucast_rules()` that brings support for custom AMR rules in `eucast_rules()` + +# Changed +* Custom MDRO guidelines (`mdro()`, `custom_mdro_guideline()`): + * Custom MDRO guidelines can now be combined with other custom MDRO guidelines using `c()` + * Fix for applying the rules; in previous versions, rows were interpreted according to the last matched rule. Now, rows are interpreted according to the first matched rule +* Fix for `age_groups()` for persons aged zero +* The `example_isolates` data set now contains some (fictitious) zero-year old patients +* Fix for minor translation errors +* Printing of microbial codes in a `data.frame` or `tibble` now gives a warning if the data contains old microbial codes (from a previous AMR package version) + +# AMR 1.6.0 ### New * Support for EUCAST Clinical Breakpoints v11.0 (2021), effective in the `eucast_rules()` function and in `as.rsi()` to interpret MIC and disk diffusion values. This is now the default guideline in this package. @@ -59,7 +73,7 @@ ``` ### Changed -* Updated the bacterial taxonomy to 3 March 2021 (using [LSPN](https://lpsn.dsmz.de)) +* Updated the bacterial taxonomy to 3 March 2021 (using [LPSN](https://lpsn.dsmz.de)) * Added 3,372 new species and 1,523 existing species became synomyms * The URL of a bacterial species (`mo_url()`) will now lead to https://lpsn.dsmz.de * Big update for plotting classes `rsi`, ``, and ``: diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index 6907a185..5d100bf3 100755 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -504,8 +504,8 @@ format_class <- function(class, plural) { if ("matrix" %in% class) { class <- "a matrix" } - if ("isolate_identifier" %in% class) { - class <- "created with isolate_identifier()" + if ("custom_eucast_rules" %in% class) { + class <- "input created with `custom_eucast_rules()`" } if (any(c("mo", "ab", "rsi") %in% class)) { class <- paste0("of class <", class[1L], ">") @@ -522,6 +522,7 @@ meet_criteria <- function(object, looks_like = NULL, is_in = NULL, is_positive = NULL, + is_positive_or_zero = NULL, is_finite = NULL, contains_column_class = NULL, allow_NULL = FALSE, @@ -594,9 +595,16 @@ meet_criteria <- function(object, stop_if(is.numeric(object) && !all(object > 0, na.rm = TRUE), "argument `", obj_name, "` must ", ifelse(!is.null(has_length) && length(has_length) == 1 && has_length == 1, - "be a positive number", - "all be positive numbers"), - " (higher than zero)", + "be a number higher than zero", + "all be numbers higher than zero"), + call = call_depth) + } + if (!is.null(is_positive_or_zero)) { + stop_if(is.numeric(object) && !all(object >= 0, na.rm = TRUE), "argument `", obj_name, + "` must ", + ifelse(!is.null(has_length) && length(has_length) == 1 && has_length == 1, + "be zero or a positive number", + "all be zero or numbers higher than zero"), call = call_depth) } if (!is.null(is_finite)) { diff --git a/R/age.R b/R/age.R index 415b4067..c405e985 100755 --- a/R/age.R +++ b/R/age.R @@ -149,8 +149,8 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) { #' } #' } age_groups <- function(x, split_at = c(12, 25, 55, 75), na.rm = FALSE) { - meet_criteria(x, allow_class = c("numeric", "integer"), is_positive = TRUE, is_finite = TRUE) - meet_criteria(split_at, allow_class = c("numeric", "integer", "character"), is_positive = TRUE, is_finite = TRUE) + meet_criteria(x, allow_class = c("numeric", "integer"), is_positive_or_zero = TRUE, is_finite = TRUE) + meet_criteria(split_at, allow_class = c("numeric", "integer", "character"), is_positive_or_zero = TRUE, is_finite = TRUE) meet_criteria(na.rm, allow_class = "logical", has_length = 1) if (any(x < 0, na.rm = TRUE)) { diff --git a/R/custom_eucast_rules.R b/R/custom_eucast_rules.R new file mode 100644 index 00000000..486103a8 --- /dev/null +++ b/R/custom_eucast_rules.R @@ -0,0 +1,247 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# 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/ # +# ==================================================================== # + +#' Create Custom EUCAST Rules +#' +#' @inheritSection lifecycle Experimental Lifecycle +#' @param ... rules in formula notation, see *Examples* +#' @details +#' This documentation page will be updated shortly. **This function is experimental.** +#' +#' @section How it works: +#' .. +#' +#' It is also possible to define antibiotic groups instead of single antibiotics. The following groups are allowed (case-insensitive): `r vector_and(tolower(DEFINED_AB_GROUPS), quote = "``")`. +#' @export +#' @examples +#' x <- custom_eucast_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R", +#' AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I") +#' eucast_rules(example_isolates, +#' rules = "custom", +#' custom_rules = x, +#' info = FALSE) +#' +#' # combine rule sets +#' x2 <- c(x, +#' custom_eucast_rules(TZP == "R" ~ carbapenems == "R")) +#' x2 +custom_eucast_rules <- function(...) { + + dots <- tryCatch(list(...), + error = function(e) "error") + stop_if(identical(dots, "error"), + "rules must be a valid formula inputs (e.g., using '~'), see `?custom_eucast_rules`") + n_dots <- length(dots) + stop_if(n_dots == 0, "no custom rules were set. Please read the documentation using `?custom_eucast_rules`.") + out <- vector("list", n_dots) + for (i in seq_len(n_dots)) { + stop_ifnot(inherits(dots[[i]], "formula"), + "rule ", i, " must be a valid formula input (e.g., using '~'), see `?custom_eucast_rules`") + + # Query + qry <- dots[[i]][[2]] + if (inherits(qry, "call")) { + qry <- as.expression(qry) + } + qry <- as.character(qry) + # these will prevent vectorisation, so replace them: + qry <- gsub("&&", "&", qry, fixed = TRUE) + qry <- gsub("||", "|", qry, fixed = TRUE) + # format nicely, setting spaces around operators + qry <- gsub(" *([&|+-/*^><==]+) *", " \\1 ", qry) + qry <- gsub(" ?, ?", ", ", qry) + qry <- gsub("'", "\"", qry, fixed = TRUE) + out[[i]]$query <- as.expression(qry) + + # Resulting rule + result <- dots[[i]][[3]] + stop_ifnot(deparse(result) %like% "==", + "the result of rule ", i, " (the part after the `~`) must contain `==`, such as in `... ~ ampicillin == \"R\"`, see `?custom_eucast_rules`") + result_group <- as.character(result)[[2]] + if (paste0(toupper(result_group), "S") %in% DEFINED_AB_GROUPS) { + # support for e.g. 'aminopenicillin' if user meant 'aminopenicillins' + result_group <- paste0(result_group, "s") + } + if (toupper(result_group) %in% DEFINED_AB_GROUPS) { + result_group <- eval(parse(text = toupper(result_group)), envir = asNamespace("AMR")) + } else { + result_group <- tryCatch( + suppressWarnings(as.ab(result_group, + fast_mode = TRUE, + info = FALSE, + flag_multiple_results = FALSE)), + error = function(e) NA_character_) + } + + stop_if(any(is.na(result_group)), + "this result of rule ", i, " could not be translated to a single antimicrobial agent/group: \"", + as.character(result)[[2]], "\".\n\nThe input can be a name or code of an antimicrobial agent, or be one of: ", + vector_or(tolower(DEFINED_AB_GROUPS), quotes = FALSE), ".") + result_value <- as.character(result)[[3]] + result_value[result_value == "NA"] <- NA + stop_ifnot(result_value %in% c("R", "S", "I", NA), + "the resulting value of rule ", i, " must be either \"R\", \"S\", \"I\" or NA") + result_value <- as.rsi(result_value) + + out[[i]]$result_group <- result_group + out[[i]]$result_value <- result_value + } + + names(out) <- paste0("rule", seq_len(n_dots)) + set_clean_class(out, new_class = c("custom_eucast_rules", "list")) +} + +#' @method c custom_eucast_rules +#' @noRd +#' @export +c.custom_eucast_rules <- function(x, ...) { + if (length(list(...)) == 0) { + return(x) + } + out <- unclass(x) + for (e in list(...)) { + out <- c(out, unclass(e)) + } + names(out) <- paste0("rule", seq_len(length(out))) + set_clean_class(out, new_class = c("custom_eucast_rules", "list")) +} + +#' @method as.list custom_eucast_rules +#' @noRd +#' @export +as.list.custom_eucast_rules <- function(x, ...) { + c(x, ...) +} + +#' @method print custom_eucast_rules +#' @export +#' @noRd +print.custom_eucast_rules <- function(x, ...) { + cat("A set of custom EUCAST rules:\n") + for (i in seq_len(length(x))) { + rule <- x[[i]] + rule$query <- format_custom_query_rule(rule$query) + if (rule$result_value == "R") { + val <- font_rsi_R_bg(font_black(" R ")) + } else if (rule$result_value == "S") { + val <- font_rsi_S_bg(font_black(" S ")) + } else { + val <- font_rsi_I_bg(font_black(" I ")) + } + agents <- paste0(font_blue(ab_name(rule$result_group, language = NULL, tolower = TRUE), + collapse = NULL), + " (", rule$result_group, ")") + agents <- sort(agents) + rule_if <- word_wrap(paste0(i, ". ", font_bold("If "), font_blue(rule$query), font_bold(" then "), + "set to {result}:"), + extra_indent = 5) + rule_if <- gsub("{result}", val, rule_if, fixed = TRUE) + rule_then <- paste0(" ", word_wrap(paste0(agents, collapse = ", "), extra_indent = 5)) + cat("\n ", rule_if, "\n", rule_then, "\n", sep = "") + } +} + +run_custom_eucast_rules <- function(df, rule, info) { + n_dots <- length(rule) + stop_if(n_dots == 0, "no custom rules set", call = -2) + out <- character(length = NROW(df)) + reasons <- character(length = NROW(df)) + for (i in seq_len(n_dots)) { + qry <- tryCatch(eval(parse(text = rule[[i]]$query), envir = df, enclos = parent.frame()), + error = function(e) { + pkg_env$err_msg <- e$message + return("error") + }) + if (identical(qry, "error")) { + warning_("in custom_eucast_rules(): rule ", i, + " (`", as.character(rule[[i]]$query), "`) was ignored because of this error message: ", + pkg_env$err_msg, + call = FALSE, + add_fn = font_red) + next + } + stop_ifnot(is.logical(qry), "in custom_eucast_rules(): rule ", i, " (`", rule[[i]]$query, + "`) must return `TRUE` or `FALSE`, not ", + format_class(class(qry), plural = FALSE), call = FALSE) + + new_eucasts <- which(qry == TRUE & out == "") + + if (info == TRUE) { + cat(word_wrap("- Custom EUCAST rule ", i, ": `", as.character(rule[[i]]$query), + "` (", length(new_eucasts), " rows matched)"), "\n", sep = "") + } + val <- rule[[i]]$value + out[new_eucasts] <- val + reasons[new_eucasts] <- paste0("matched rule ", gsub("rule", "", names(rule)[i]), ": ", as.character(rule[[i]]$query)) + } + out[out == ""] <- "Negative" + reasons[out == "Negative"] <- "no rules matched" + + if (isTRUE(attributes(rule)$as_factor)) { + out <- factor(out, levels = attributes(rule)$values, ordered = TRUE) + } + + columns_nonsusceptible <- as.data.frame(t(df[, is.rsi(df)] == "R")) + columns_nonsusceptible <- vapply(FUN.VALUE = character(1), + columns_nonsusceptible, + function(x) paste0(rownames(columns_nonsusceptible)[which(x)], collapse = " ")) + columns_nonsusceptible[is.na(out)] <- NA_character_ + + data.frame(row_number = seq_len(NROW(df)), + EUCAST = out, + reason = reasons, + columns_nonsusceptible = columns_nonsusceptible, + stringsAsFactors = FALSE) +} + +format_custom_query_rule <- function(query, colours = has_colour()) { + query <- gsub(" & ", font_black(font_bold(" and ")), query, fixed = TRUE) + query <- gsub(" | ", font_black(" or "), query, fixed = TRUE) + query <- gsub(" + ", font_black(" plus "), query, fixed = TRUE) + query <- gsub(" - ", font_black(" minus "), query, fixed = TRUE) + query <- gsub(" / ", font_black(" divided by "), query, fixed = TRUE) + query <- gsub(" * ", font_black(" times "), query, fixed = TRUE) + query <- gsub(" == ", font_black(" is "), query, fixed = TRUE) + query <- gsub(" > ", font_black(" is higher than "), query, fixed = TRUE) + query <- gsub(" < ", font_black(" is lower than "), query, fixed = TRUE) + query <- gsub(" >= ", font_black(" is higher than or equal to "), query, fixed = TRUE) + query <- gsub(" <= ", font_black(" is lower than or equal to "), query, fixed = TRUE) + query <- gsub(" ^ ", font_black(" to the power of "), query, fixed = TRUE) + query <- gsub(" %in% ", font_black(" is one of "), query, fixed = TRUE) + query <- gsub(" %like% ", font_black(" resembles "), query, fixed = TRUE) + if (colours == TRUE) { + query <- gsub('"R"', font_rsi_R_bg(font_black(" R ")), query, fixed = TRUE) + query <- gsub('"S"', font_rsi_S_bg(font_black(" S ")), query, fixed = TRUE) + query <- gsub('"I"', font_rsi_I_bg(font_black(" I ")), query, fixed = TRUE) + } + # replace the black colour 'stops' with blue colour 'starts' + query <- gsub("\033[39m", "\033[34m", as.character(query), fixed = TRUE) + # start with blue + query <- paste0("\033[34m", query) + if (colours == FALSE) { + query <- font_stripstyle(query) + } + query +} diff --git a/R/eucast_rules.R b/R/eucast_rules.R index 23ade455..2df9c917 100755 --- a/R/eucast_rules.R +++ b/R/eucast_rules.R @@ -51,7 +51,7 @@ format_eucast_version_nr <- function(version, markdown = TRUE) { #' @inheritSection lifecycle Stable Lifecycle #' @param x data with antibiotic columns, such as `amox`, `AMX` and `AMC` #' @param info a logical to indicate whether progress should be printed to the console, defaults to only print while in interactive sessions -#' @param rules a character vector that specifies which rules should be applied. Must be one or more of `"breakpoints"`, `"expert"`, `"other"`, `"all"`, and defaults to `c("breakpoints", "expert")`. The default value can be set to another value, e.g. using `options(AMR_eucastrules = "all")`. +#' @param rules a character vector that specifies which rules should be applied. Must be one or more of `"breakpoints"`, `"expert"`, `"other"`, `"custom"`, `"all"`, and defaults to `c("breakpoints", "expert")`. The default value can be set to another value, e.g. using `options(AMR_eucastrules = "all")`. If using `"custom"`, be sure to fill in argument `custom_rules` too. Custom rules can be created with [custom_eucast_rules()]. #' @param verbose a [logical] to turn Verbose mode on and off (default is off). In Verbose mode, the function does not apply rules to the data, but instead returns a data set in logbook form with extensive info about which rows and columns would be effected and in which way. Using Verbose mode takes a lot more time. #' @param version_breakpoints the version number to use for the EUCAST Clinical Breakpoints guideline. Can be either `r vector_or(names(EUCAST_VERSION_BREAKPOINTS), reverse = TRUE)`. #' @param version_expertrules the version number to use for the EUCAST Expert Rules and Intrinsic Resistance guideline. Can be either `r vector_or(names(EUCAST_VERSION_EXPERT_RULES), reverse = TRUE)`. @@ -60,6 +60,7 @@ format_eucast_version_nr <- function(version, markdown = TRUE) { #' @param ab any (vector of) text that can be coerced to a valid antibiotic code with [as.ab()] #' @param administration route of administration, either `r vector_or(dosage$administration)` #' @param only_rsi_columns a logical to indicate whether only antibiotic columns must be detected that were transformed to class `` (see [as.rsi()]) on beforehand (defaults to `FALSE`) +#' @param custom_rules custom rules to apply, created with [custom_eucast_rules()] #' @inheritParams first_isolate #' @details #' **Note:** This function does not translate MIC values to RSI values. Use [as.rsi()] for that. \cr @@ -67,6 +68,18 @@ format_eucast_version_nr <- function(version, markdown = TRUE) { #' #' The file containing all EUCAST rules is located here: . #' +#' ## Custom Rules +#' +#' Custom rules can be created using [custom_eucast_rules()], e.g.: +#' +#' ``` +#' x <- custom_eucast_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R", +#' AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I") +#' +#' eucast_rules(example_isolates, rules = "custom", custom_rules = x) +#' ``` +#' +#' #' ## 'Other' Rules #' #' Before further processing, two non-EUCAST rules about drug combinations can be applied to improve the efficacy of the EUCAST rules, and the reliability of your data (analysis). These rules are: @@ -149,16 +162,31 @@ eucast_rules <- function(x, version_expertrules = 3.2, ampc_cephalosporin_resistance = NA, only_rsi_columns = FALSE, + custom_rules = NULL, ...) { meet_criteria(x, allow_class = "data.frame") meet_criteria(col_mo, allow_class = "character", has_length = 1, is_in = colnames(x), allow_NULL = TRUE) meet_criteria(info, allow_class = "logical", has_length = 1) - meet_criteria(rules, allow_class = "character", has_length = c(1, 2, 3, 4), is_in = c("breakpoints", "expert", "other", "all")) + meet_criteria(rules, allow_class = "character", has_length = c(1, 2, 3, 4, 5), is_in = c("breakpoints", "expert", "other", "all", "custom")) meet_criteria(verbose, allow_class = "logical", has_length = 1) meet_criteria(version_breakpoints, allow_class = c("numeric", "integer"), has_length = 1, is_in = as.double(names(EUCAST_VERSION_BREAKPOINTS))) meet_criteria(version_expertrules, allow_class = c("numeric", "integer"), has_length = 1, is_in = as.double(names(EUCAST_VERSION_EXPERT_RULES))) meet_criteria(ampc_cephalosporin_resistance, allow_class = c("logical", "character", "rsi"), has_length = 1, allow_NA = TRUE, allow_NULL = TRUE) meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1) + meet_criteria(custom_rules, allow_class = "custom_eucast_rules", allow_NULL = TRUE) + + if ("custom" %in% rules & is.null(custom_rules)) { + warning_("No custom rules were set with the `custom_rules` argument", + call = FALSE, + immediate = TRUE) + rules <- rules[rules != "custom"] + if (length(rules) == 0) { + if (info == TRUE) { + message_("No other rules were set, returning original data", add_fn = font_red, as_note = FALSE) + } + return(x) + } + } x_deparsed <- deparse(substitute(x)) if (length(x_deparsed) > 1 || !all(x_deparsed %like% "[a-z]+")) { @@ -263,238 +291,13 @@ eucast_rules <- function(x, info = info, only_rsi_columns = only_rsi_columns, ...) - - AMC <- cols_ab["AMC"] - AMK <- cols_ab["AMK"] - AMP <- cols_ab["AMP"] - AMX <- cols_ab["AMX"] - APL <- cols_ab["APL"] - APX <- cols_ab["APX"] - ATM <- cols_ab["ATM"] - AVB <- cols_ab["AVB"] - AVO <- cols_ab["AVO"] - AZD <- cols_ab["AZD"] - AZL <- cols_ab["AZL"] - AZM <- cols_ab["AZM"] - BAM <- cols_ab["BAM"] - BPR <- cols_ab["BPR"] - CAC <- cols_ab["CAC"] - CAT <- cols_ab["CAT"] - CAZ <- cols_ab["CAZ"] - CCP <- cols_ab["CCP"] - CCV <- cols_ab["CCV"] - CCX <- cols_ab["CCX"] - CDC <- cols_ab["CDC"] - CDR <- cols_ab["CDR"] - CDZ <- cols_ab["CDZ"] - CEC <- cols_ab["CEC"] - CED <- cols_ab["CED"] - CEI <- cols_ab["CEI"] - CEM <- cols_ab["CEM"] - CEP <- cols_ab["CEP"] - CFM <- cols_ab["CFM"] - CFM1 <- cols_ab["CFM1"] - CFP <- cols_ab["CFP"] - CFR <- cols_ab["CFR"] - CFS <- cols_ab["CFS"] - CFZ <- cols_ab["CFZ"] - CHE <- cols_ab["CHE"] - CHL <- cols_ab["CHL"] - CIC <- cols_ab["CIC"] - CID <- cols_ab["CID"] - CIP <- cols_ab["CIP"] - CLI <- cols_ab["CLI"] - CLM <- cols_ab["CLM"] - CLO <- cols_ab["CLO"] - CLR <- cols_ab["CLR"] - CMX <- cols_ab["CMX"] - CMZ <- cols_ab["CMZ"] - CND <- cols_ab["CND"] - COL <- cols_ab["COL"] - CPD <- cols_ab["CPD"] - CPI <- cols_ab["CPI"] - CPL <- cols_ab["CPL"] - CPM <- cols_ab["CPM"] - CPO <- cols_ab["CPO"] - CPR <- cols_ab["CPR"] - CPT <- cols_ab["CPT"] - CPX <- cols_ab["CPX"] - CRB <- cols_ab["CRB"] - CRD <- cols_ab["CRD"] - CRN <- cols_ab["CRN"] - CRO <- cols_ab["CRO"] - CSL <- cols_ab["CSL"] - CTB <- cols_ab["CTB"] - CTC <- cols_ab["CTC"] - CTF <- cols_ab["CTF"] - CTL <- cols_ab["CTL"] - CTS <- cols_ab["CTS"] - CTT <- cols_ab["CTT"] - CTX <- cols_ab["CTX"] - CTZ <- cols_ab["CTZ"] - CXM <- cols_ab["CXM"] - CYC <- cols_ab["CYC"] - CZA <- cols_ab["CZA"] - CZD <- cols_ab["CZD"] - CZO <- cols_ab["CZO"] - CZP <- cols_ab["CZP"] - CZX <- cols_ab["CZX"] - DAL <- cols_ab["DAL"] - DAP <- cols_ab["DAP"] - DIC <- cols_ab["DIC"] - DIR <- cols_ab["DIR"] - DIT <- cols_ab["DIT"] - DIX <- cols_ab["DIX"] - DIZ <- cols_ab["DIZ"] - DKB <- cols_ab["DKB"] - DOR <- cols_ab["DOR"] - DOX <- cols_ab["DOX"] - ENX <- cols_ab["ENX"] - EPC <- cols_ab["EPC"] - ERY <- cols_ab["ERY"] - ETP <- cols_ab["ETP"] - FEP <- cols_ab["FEP"] - FLC <- cols_ab["FLC"] - FLE <- cols_ab["FLE"] - FLR1 <- cols_ab["FLR1"] - FOS <- cols_ab["FOS"] - FOV <- cols_ab["FOV"] - FOX <- cols_ab["FOX"] - FOX1 <- cols_ab["FOX1"] - FUS <- cols_ab["FUS"] - GAT <- cols_ab["GAT"] - GEM <- cols_ab["GEM"] - GEN <- cols_ab["GEN"] - GRX <- cols_ab["GRX"] - HAP <- cols_ab["HAP"] - HET <- cols_ab["HET"] - IPM <- cols_ab["IPM"] - ISE <- cols_ab["ISE"] - JOS <- cols_ab["JOS"] - KAN <- cols_ab["KAN"] - LEN <- cols_ab["LEN"] - LEX <- cols_ab["LEX"] - LIN <- cols_ab["LIN"] - LNZ <- cols_ab["LNZ"] - LOM <- cols_ab["LOM"] - LOR <- cols_ab["LOR"] - LTM <- cols_ab["LTM"] - LVX <- cols_ab["LVX"] - MAN <- cols_ab["MAN"] - MCM <- cols_ab["MCM"] - MEC <- cols_ab["MEC"] - MEM <- cols_ab["MEM"] - MET <- cols_ab["MET"] - MEV <- cols_ab["MEV"] - MEZ <- cols_ab["MEZ"] - MFX <- cols_ab["MFX"] - MID <- cols_ab["MID"] - MNO <- cols_ab["MNO"] - MTM <- cols_ab["MTM"] - NAC <- cols_ab["NAC"] - NAF <- cols_ab["NAF"] - NAL <- cols_ab["NAL"] - NEO <- cols_ab["NEO"] - NET <- cols_ab["NET"] - NIT <- cols_ab["NIT"] - NOR <- cols_ab["NOR"] - NOV <- cols_ab["NOV"] - NVA <- cols_ab["NVA"] - OFX <- cols_ab["OFX"] - OLE <- cols_ab["OLE"] - ORI <- cols_ab["ORI"] - OXA <- cols_ab["OXA"] - PAZ <- cols_ab["PAZ"] - PEF <- cols_ab["PEF"] - PEN <- cols_ab["PEN"] - PHE <- cols_ab["PHE"] - PHN <- cols_ab["PHN"] - PIP <- cols_ab["PIP"] - PLB <- cols_ab["PLB"] - PME <- cols_ab["PME"] - PNM <- cols_ab["PNM"] - PRC <- cols_ab["PRC"] - PRI <- cols_ab["PRI"] - PRL <- cols_ab["PRL"] - PRP <- cols_ab["PRP"] - PRU <- cols_ab["PRU"] - PVM <- cols_ab["PVM"] - QDA <- cols_ab["QDA"] - RAM <- cols_ab["RAM"] - RFL <- cols_ab["RFL"] - RID <- cols_ab["RID"] - RIF <- cols_ab["RIF"] - ROK <- cols_ab["ROK"] - RST <- cols_ab["RST"] - RXT <- cols_ab["RXT"] - SAM <- cols_ab["SAM"] - SBC <- cols_ab["SBC"] - SDI <- cols_ab["SDI"] - SDM <- cols_ab["SDM"] - SIS <- cols_ab["SIS"] - SLF <- cols_ab["SLF"] - SLF1 <- cols_ab["SLF1"] - SLF10 <- cols_ab["SLF10"] - SLF11 <- cols_ab["SLF11"] - SLF12 <- cols_ab["SLF12"] - SLF13 <- cols_ab["SLF13"] - SLF2 <- cols_ab["SLF2"] - SLF3 <- cols_ab["SLF3"] - SLF4 <- cols_ab["SLF4"] - SLF5 <- cols_ab["SLF5"] - SLF6 <- cols_ab["SLF6"] - SLF7 <- cols_ab["SLF7"] - SLF8 <- cols_ab["SLF8"] - SLF9 <- cols_ab["SLF9"] - SLT1 <- cols_ab["SLT1"] - SLT2 <- cols_ab["SLT2"] - SLT3 <- cols_ab["SLT3"] - SLT4 <- cols_ab["SLT4"] - SLT5 <- cols_ab["SLT5"] - SLT6 <- cols_ab["SLT6"] - SMX <- cols_ab["SMX"] - SPI <- cols_ab["SPI"] - SPX <- cols_ab["SPX"] - SRX <- cols_ab["SRX"] - STR <- cols_ab["STR"] - STR1 <- cols_ab["STR1"] - SUD <- cols_ab["SUD"] - SUL <- cols_ab["SUL"] - SUT <- cols_ab["SUT"] - SXT <- cols_ab["SXT"] - SZO <- cols_ab["SZO"] - TAL <- cols_ab["TAL"] - TAZ <- cols_ab["TAZ"] - TCC <- cols_ab["TCC"] - TCM <- cols_ab["TCM"] - TCY <- cols_ab["TCY"] - TEC <- cols_ab["TEC"] - TEM <- cols_ab["TEM"] - TGC <- cols_ab["TGC"] - THA <- cols_ab["THA"] - TIC <- cols_ab["TIC"] - TIO <- cols_ab["TIO"] - TLT <- cols_ab["TLT"] - TLV <- cols_ab["TLV"] - TMP <- cols_ab["TMP"] - TMX <- cols_ab["TMX"] - TOB <- cols_ab["TOB"] - TRL <- cols_ab["TRL"] - TVA <- cols_ab["TVA"] - TZD <- cols_ab["TZD"] - TZP <- cols_ab["TZP"] - VAN <- cols_ab["VAN"] - ab_missing <- function(ab) { - all(ab %in% c(NULL, NA)) - } - - if (ab_missing(AMP) & !ab_missing(AMX)) { + if (!"AMP" %in% names(cols_ab) & "AMX" %in% names(cols_ab)) { # ampicillin column is missing, but amoxicillin is available if (info == TRUE) { - message_("Using column '", font_bold(AMX), "' as input for ampicillin since many EUCAST rules depend on it.") + message_("Using column '", cols_ab[names(cols_ab) == "AMX"], "' as input for ampicillin since many EUCAST rules depend on it.") } - AMP <- AMX + cols_ab <- c(cols_ab, c(AMP = unname(cols_ab[names(cols_ab) == "AMX"]))) } # data preparation ---- @@ -502,40 +305,23 @@ eucast_rules <- function(x, message_("Preparing data...", appendLF = FALSE, as_note = FALSE) } - # nolint start - # antibiotic classes ---- - aminoglycosides <- c(AMK, DKB, GEN, ISE, KAN, NEO, NET, RST, SIS, STR, STR1, TOB) - aminopenicillins <- c(AMP, AMX) - carbapenems <- c(DOR, ETP, IPM, MEM, MEV) - cephalosporins <- c(CDZ, CCP, CAC, CEC, CFR, RID, MAN, CTZ, CZD, CZO, CDR, DIT, FEP, CAT, CFM, CMX, CMZ, DIZ, CID, CFP, CSL, CND, CTX, CTT, CTF, FOX, CPM, CPO, CPD, CPR, CRD, CFS, CPT, CAZ, CCV, CTL, CTB, CZX, BPR, CFM1, CEI, CRO, CXM, LEX, CEP, HAP, CED, LTM, LOR) - cephalosporins_1st <- c(CAC, CFR, RID, CTZ, CZD, CZO, CRD, CTL, LEX, CEP, HAP, CED) - cephalosporins_2nd <- c(CEC, MAN, CMZ, CID, CND, CTT, CTF, FOX, CPR, CXM, LOR) - cephalosporins_3rd <- c(CDZ, CCP, CCX, CDR, DIT, DIX, CAT, CPI, CFM, CMX, DIZ, CFP, CSL, CTX, CTC, CTS, CHE, FOV, CFZ, CPM, CPD, CPX, CDC, CFS, CAZ, CZA, CCV, CEM, CPL, CTB, TIO, CZX, CZP, CRO, LTM) - cephalosporins_except_CAZ <- cephalosporins[cephalosporins != ifelse(is.null(CAZ), "", CAZ)] - fluoroquinolones <- c(CIP, ENX, FLE, GAT, GEM, GRX, LVX, LOM, MFX, NOR, OFX, PAZ, PEF, PRU, RFL, SPX, TMX, TVA) - glycopeptides <- c(AVO, NVA, RAM, TEC, TCM, VAN) # dalba/orita/tela are in lipoglycopeptides - lincosamides <- c(CLI, LIN, PRL) - lipoglycopeptides <- c(DAL, ORI, TLV) - macrolides <- c(AZM, CLR, DIR, ERY, FLR1, JOS, MID, MCM, OLE, ROK, RXT, SPI, TLT, TRL) - oxazolidinones <- c(CYC, LNZ, THA, TZD) - polymyxins <- c(PLB, COL) - streptogramins <- c(QDA, PRI) - tetracyclines <- c(DOX, MNO, TCY) # since EUCAST v3.1 tigecycline (TGC) is set apart - ureidopenicillins <- c(PIP, TZP, AZL, MEZ) - all_betalactams <- c(aminopenicillins, cephalosporins, carbapenems, ureidopenicillins, AMC, OXA, FLC, PEN) - # nolint end - # Some helper functions --------------------------------------------------- - get_antibiotic_columns <- function(x, df) { - x <- trimws(unlist(strsplit(x, ",", fixed = TRUE))) - y <- character(0) - for (i in seq_len(length(x))) { - if (is.function(get(x[i]))) { - stop("Column ", x[i], " is also a function. Please create an issue on github.com/msberends/AMR/issues.") + get_antibiotic_columns <- function(x, cols_ab) { + x <- strsplit(x, ", *")[[1]] + x_new <- character() + for (val in x) { + if (toupper(val) %in% ls(envir = asNamespace("AMR"))) { + # antibiotic group names, as defined in data-raw/_internals.R, such as `CARBAPENEMS` + val <- eval(parse(text = toupper(val)), envir = asNamespace("AMR")) + } else if (toupper(val) %in% AB_lookup$ab) { + # separate drugs, such as `AMX` + val <- as.ab(val) + } else { + stop_("antimicrobial agent (group) not found in EUCAST rules file: ", val, call = FALSE) } - y <- c(y, tryCatch(get(x[i]), error = function(e) "")) + x_new <- c(x_new, val) } - y[y != "" & y %in% colnames(df)] + cols_ab[match(x_new, names(cols_ab))] } markup_italics_where_needed <- function(x) { # returns names found in family, genus or species as italics @@ -688,7 +474,8 @@ eucast_rules <- function(x, last_verbose_info = verbose_info, original_data = x.bak, warned = warned, - info = info) + info = info, + verbose = verbose) n_added <- n_added + run_changes$added n_changed <- n_changed + run_changes$changed verbose_info <- run_changes$verbose_info @@ -720,7 +507,8 @@ eucast_rules <- function(x, last_verbose_info = verbose_info, original_data = x.bak, warned = warned, - info = info) + info = info, + verbose = verbose) n_added <- n_added + run_changes$added n_changed <- n_changed + run_changes$changed verbose_info <- run_changes$verbose_info @@ -740,10 +528,17 @@ eucast_rules <- function(x, } else { if (info == TRUE) { cat("\n") - message_("Skipping inheritance rules defined by this package, such as setting trimethoprim (TMP) = R where trimethoprim/sulfamethoxazole (SXT) = R. Use `eucast_rules(..., rules = \"all\")` to also apply those rules.") + message_("Skipping inheritance rules defined by this AMR package, such as setting trimethoprim (TMP) = R where trimethoprim/sulfamethoxazole (SXT) = R. Add \"other\" or \"all\" to the `rules` argument to apply those rules.") } } + if (!any(c("all", "custom") %in% rules) & !is.null(custom_rules)) { + if (info == TRUE) { + message_("Skipping custom EUCAST rules, since the `rules` argument does not contain \"custom\".") + } + custom_rules <- NULL + } + # Official EUCAST rules --------------------------------------------------- eucast_notification_shown <- FALSE if (!is.null(list(...)$eucast_rules_df)) { @@ -777,6 +572,7 @@ eucast_rules <- function(x, eucast_rules_df[which(eucast_rules_df$reference.rule %like% "ampc"), "to_value"] <- as.character(ampc_cephalosporin_resistance) } + # Go over all rules and apply them ---- for (i in seq_len(nrow(eucast_rules_df))) { rule_previous <- eucast_rules_df[max(1, i - 1), "reference.rule", drop = TRUE] @@ -899,26 +695,26 @@ eucast_rules <- function(x, source_value <- trimws(unlist(strsplit(eucast_rules_df[i, "have_these_values", drop = TRUE], ",", fixed = TRUE))) target_antibiotics <- eucast_rules_df[i, "then_change_these_antibiotics", drop = TRUE] target_value <- eucast_rules_df[i, "to_value", drop = TRUE] - + if (is.na(source_antibiotics)) { rows <- tryCatch(which(x[, if_mo_property, drop = TRUE] %like% mo_value), error = function(e) integer(0)) } else { - source_antibiotics <- get_antibiotic_columns(source_antibiotics, x) + source_antibiotics <- get_antibiotic_columns(source_antibiotics, cols_ab) if (length(source_value) == 1 & length(source_antibiotics) > 1) { source_value <- rep(source_value, length(source_antibiotics)) } if (length(source_antibiotics) == 0) { rows <- integer(0) } else if (length(source_antibiotics) == 1) { - rows <- tryCatch(which(x[, if_mo_property, drop = TRUE] %like% mo_value - & as.rsi_no_warning(x[, source_antibiotics[1L]]) == source_value[1L]), - error = function(e) integer(0)) + rows <- tryCatch(which(x[, if_mo_property, drop = TRUE] %like% mo_value + & as.rsi_no_warning(x[, source_antibiotics[1L]]) == source_value[1L]), + error = function(e) integer(0)) } else if (length(source_antibiotics) == 2) { - rows <- tryCatch(which(x[, if_mo_property, drop = TRUE] %like% mo_value - & as.rsi_no_warning(x[, source_antibiotics[1L]]) == source_value[1L] - & as.rsi_no_warning(x[, source_antibiotics[2L]]) == source_value[2L]), - error = function(e) integer(0)) + rows <- tryCatch(which(x[, if_mo_property, drop = TRUE] %like% mo_value + & as.rsi_no_warning(x[, source_antibiotics[1L]]) == source_value[1L] + & as.rsi_no_warning(x[, source_antibiotics[2L]]) == source_value[2L]), + error = function(e) integer(0)) # nolint start # } else if (length(source_antibiotics) == 3) { # rows <- tryCatch(which(x[, if_mo_property, drop = TRUE] %like% mo_value @@ -932,7 +728,7 @@ eucast_rules <- function(x, } } - cols <- get_antibiotic_columns(target_antibiotics, x) + cols <- get_antibiotic_columns(target_antibiotics, cols_ab) # Apply rule on data ------------------------------------------------------ # this will return the unique number of changes @@ -948,7 +744,8 @@ eucast_rules <- function(x, last_verbose_info = verbose_info, original_data = x.bak, warned = warned, - info = info) + info = info, + verbose = verbose) n_added <- n_added + run_changes$added n_changed <- n_changed + run_changes$changed verbose_info <- run_changes$verbose_info @@ -962,6 +759,61 @@ eucast_rules <- function(x, n_added <- 0 n_changed <- 0 } + } # end of going over all rules + + # Apply custom rules ---- + if (!is.null(custom_rules)) { + if (info == TRUE) { + cat("\n") + cat(font_bold("Custom EUCAST rules, set by user"), "\n") + } + for (i in seq_len(length(custom_rules))) { + rule <- custom_rules[[i]] + rows <- which(eval(parse(text = rule$query), envir = x)) + cols <- as.character(rule$result_group) + cols <- c(cols[cols %in% colnames(x)], # direct column names + unname(cols_ab[names(cols_ab) %in% cols])) # based on previous cols_ab finding + cols <- unique(cols) + target_value <- as.character(rule$result_value) + rule_text <- paste0("report as '", target_value, "' when ", + format_custom_query_rule(rule$query, colours = FALSE), ": ", + get_antibiotic_names(cols)) + if (info == TRUE) { + # print rule + cat(markup_italics_where_needed(word_wrap(format_custom_query_rule(rule$query, colours = FALSE), + width = getOption("width") - 30, + extra_indent = 6))) + warned <- FALSE + } + run_changes <- edit_rsi(x = x, + col_mo = col_mo, + to = target_value, + rule = c(rule_text, + "Custom EUCAST rules", + paste0("Custom EUCAST rule ", i), + paste0("Object '", deparse(substitute(custom_rules)), + "' consisting of ", length(custom_rules), " custom rules")), + rows = rows, + cols = cols, + last_verbose_info = verbose_info, + original_data = x.bak, + warned = warned, + info = info, + verbose = verbose) + n_added <- n_added + run_changes$added + n_changed <- n_changed + run_changes$changed + verbose_info <- run_changes$verbose_info + x <- run_changes$output + warn_lacking_rsi_class <- c(warn_lacking_rsi_class, run_changes$rsi_warn) + # Print number of new changes --------------------------------------------- + if (info == TRUE & rule_next != rule_current) { + # print only on last one of rules in this group + txt_ok(n_added = n_added, n_changed = n_changed, warned = warned) + # and reset counters + n_added <- 0 + n_changed <- 0 + } + } } # Print overview ---------------------------------------------------------- @@ -1089,7 +941,8 @@ edit_rsi <- function(x, last_verbose_info, original_data, warned, - info) { + info, + verbose) { cols <- unique(cols[!is.na(cols) & !is.null(cols)]) # for Verbose Mode, keep track of all changes and return them @@ -1146,7 +999,7 @@ edit_rsi <- function(x, ) track_changes$output <- new_edits - if (isTRUE(info) && !isTRUE(all.equal(x, track_changes$output))) { + if ((info == TRUE | verbose == TRUE) && !isTRUE(all.equal(x, track_changes$output))) { get_original_rows <- function(rowids) { as.integer(rownames(original_data[which(original_data$.rowid %in% rowids), , drop = FALSE])) } diff --git a/R/like.R b/R/like.R index b3673db9..8e82984e 100755 --- a/R/like.R +++ b/R/like.R @@ -23,14 +23,14 @@ # how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # ==================================================================== # -#' Pattern Matching with Keyboard Shortcut +#' Vectorised Pattern Matching with Keyboard Shortcut #' #' Convenient wrapper around [grepl()] to match a pattern: `x %like% pattern`. It always returns a [`logical`] vector and is always case-insensitive (use `x %like_case% pattern` for case-sensitive matching). Also, `pattern` can be as long as `x` to compare items of each index in both vectors, or they both can have the same length to iterate over all cases. #' @inheritSection lifecycle Stable Lifecycle #' @param x a character vector where matches are sought, or an object which can be coerced by [as.character()] to a character vector. #' @param pattern a character string containing a regular expression (or [character] string for `fixed = TRUE`) to be matched in the given character vector. Coerced by [as.character()] to a character string if possible. If a [character] vector of length 2 or more is supplied, the first element is used with a warning. #' @param ignore.case if `FALSE`, the pattern matching is *case sensitive* and if `TRUE`, case is ignored during matching. -#' @return A [`logical`] vector +#' @return A [logical] vector #' @name like #' @rdname like #' @export @@ -39,10 +39,10 @@ #' * Is case-insensitive (use `%like_case%` for case-sensitive matching) #' * Supports multiple patterns #' * Checks if `pattern` is a regular expression and sets `fixed = TRUE` if not, to greatly improve speed -#' * Always uses compatibility with Perl +#' * Always uses compatibility with Perl unless `fixed = TRUE`, to greatly improve speed #' #' Using RStudio? The text `%like%` can also be directly inserted in your code from the Addins menu and can have its own Keyboard Shortcut like `Ctrl+Shift+L` or `Cmd+Shift+L` (see `Tools` > `Modify Keyboard Shortcuts...`). -#' @source Idea from the [`like` function from the `data.table` package](https://github.com/Rdatatable/data.table/blob/master/R/like.R) +#' @source Idea from the [`like` function from the `data.table` package](https://github.com/Rdatatable/data.table/blob/ec1259af1bf13fc0c96a1d3f9e84d55d8106a9a4/R/like.R) #' @seealso [grepl()] #' @inheritSection AMR Read more on Our Website! #' @examples @@ -68,7 +68,7 @@ #' \donttest{ #' if (require("dplyr")) { #' example_isolates %>% -#' filter(mo_name(mo) %like% "^ent") +#' filter(mo_name() %like% "^ent") #' } #' } like <- function(x, pattern, ignore.case = TRUE) { @@ -98,14 +98,17 @@ like <- function(x, pattern, ignore.case = TRUE) { if (length(x) == 1) { x <- rep(x, length(pattern)) } else if (length(pattern) != length(x)) { - stop_("arguments `x` and `pattern` must be of same length, or either one must be 1") + stop_("arguments `x` and `pattern` must be of same length, or either one must be 1 ", + "(`x` has length ", length(x), " and `pattern` has length ", length(pattern), ")") } unlist( - Map(f = grepl, - pattern, - x, - MoreArgs = list(ignore.case = FALSE, fixed = fixed, perl = !fixed)), - use.names = FALSE) + mapply(FUN = grepl, + x = x, + pattern = pattern, + MoreArgs = list(ignore.case = FALSE, fixed = fixed, perl = !fixed), + SIMPLIFY = FALSE, + USE.NAMES = FALSE) + ) } } diff --git a/R/mdro.R b/R/mdro.R index d2fa22f9..d5d128ff 100755 --- a/R/mdro.R +++ b/R/mdro.R @@ -102,10 +102,22 @@ #' The outcome of the function can be used for the `guideline` argument in the [mdro()] function: #' #' ``` -#' x <- mdro(example_isolates, guideline = custom) +#' x <- mdro(example_isolates, +#' guideline = custom) #' table(x) -#' #> Elderly Type A Elderly Type B Negative -#' #> 43 891 1066 +#' #> Negative Elderly Type A Elderly Type B +#' #> 1070 198 732 +#' ``` +#' +#' Rules can also be combined with other custom rules by using [c()]: +#' +#' ``` +#' x <- mdro(example_isolates, +#' guideline = c(custom, +#' custom_mdro_guideline(ERY == "R" & age > 50 ~ "Elderly Type C"))) +#' table(x) +#' #> Negative Elderly Type A Elderly Type B Elderly Type C +#' #> 961 198 732 109 #' ``` #' #' The rules set (the `custom` object in this case) could be exported to a shared file location using [saveRDS()] if you collaborate with multiple users. The custom rules set could then be imported using [readRDS()]. @@ -246,7 +258,7 @@ mdro <- function(x = NULL, txt <- word_wrap(txt) cat(txt, "\n", sep = "") } - x <- run_custom_mdro_guideline(x, guideline) + x <- run_custom_mdro_guideline(df = x, guideline = guideline, info = info) if (info.bak == TRUE) { cat(group_msg) if (sum(!is.na(x$MDRO)) == 0) { @@ -1434,6 +1446,8 @@ mdro <- function(x = NULL, #' @rdname mdro #' @export custom_mdro_guideline <- function(..., as_factor = TRUE) { + meet_criteria(as_factor, allow_class = "logical", has_length = 1) + dots <- tryCatch(list(...), error = function(e) "error") stop_if(identical(dots, "error"), @@ -1470,11 +1484,49 @@ custom_mdro_guideline <- function(..., as_factor = TRUE) { names(out) <- paste0("rule", seq_len(n_dots)) out <- set_clean_class(out, new_class = c("custom_mdro_guideline", "list")) - attr(out, "values") <- c("Negative", vapply(FUN.VALUE = character(1), out, function(x) x$value)) + attr(out, "values") <- unname(c("Negative", vapply(FUN.VALUE = character(1), unclass(out), function(x) x$value))) attr(out, "as_factor") <- as_factor out } +#' @method c custom_mdro_guideline +#' @noRd +#' @export +c.custom_mdro_guideline <- function(x, ..., as_factor = NULL) { + if (length(list(...)) == 0) { + return(x) + } + if (!is.null(as_factor)) { + meet_criteria(as_factor, allow_class = "logical", has_length = 1) + } else { + as_factor <- attributes(x)$as_factor + } + for (g in list(...)) { + stop_ifnot(inherits(g, "custom_mdro_guideline"), + "for combining custom MDRO guidelines, all rules must be created with `custom_mdro_guideline()`", + call = FALSE) + vals <- attributes(x)$values + if (!all(attributes(g)$values %in% vals)) { + vals <- unname(unique(c(vals, attributes(g)$values))) + } + attributes(g) <- NULL + x <- c(unclass(x), unclass(g)) + attr(x, "values") <- vals + } + names(x) <- paste0("rule", seq_len(length(x))) + x <- set_clean_class(x, new_class = c("custom_mdro_guideline", "list")) + attr(x, "values") <- vals + attr(x, "as_factor") <- as_factor + x +} + +#' @method as.list custom_mdro_guideline +#' @noRd +#' @export +as.list.custom_mdro_guideline <- function(x, ...) { + c(x, ...) +} + #' @method print custom_mdro_guideline #' @export #' @noRd @@ -1482,23 +1534,10 @@ print.custom_mdro_guideline <- function(x, ...) { cat("A set of custom MDRO rules:\n") for (i in seq_len(length(x))) { rule <- x[[i]] - rule$query <- gsub(" & ", font_black(font_italic(" and ")), rule$query, fixed = TRUE) - rule$query <- gsub(" | ", font_black(" or "), rule$query, fixed = TRUE) - rule$query <- gsub(" + ", font_black(" plus "), rule$query, fixed = TRUE) - rule$query <- gsub(" - ", font_black(" minus "), rule$query, fixed = TRUE) - rule$query <- gsub(" / ", font_black(" divided by "), rule$query, fixed = TRUE) - rule$query <- gsub(" * ", font_black(" times "), rule$query, fixed = TRUE) - rule$query <- gsub(" == ", font_black(" is "), rule$query, fixed = TRUE) - rule$query <- gsub(" > ", font_black(" is higher than "), rule$query, fixed = TRUE) - rule$query <- gsub(" < ", font_black(" is lower than "), rule$query, fixed = TRUE) - rule$query <- gsub(" >= ", font_black(" is higher than or equal to "), rule$query, fixed = TRUE) - rule$query <- gsub(" <= ", font_black(" is lower than or equal to "), rule$query, fixed = TRUE) - rule$query <- gsub(" ^ ", font_black(" to the power of "), rule$query, fixed = TRUE) - # replace the black colour 'stops' with blue colour 'starts' - rule$query <- gsub("\033[39m", "\033[34m", as.character(rule$query), fixed = TRUE) - cat(" ", i, ". ", font_blue(rule$query), font_bold(" -> "), font_red(rule$value), "\n", sep = "") + rule$query <- format_custom_query_rule(rule$query) + cat(" ", i, ". ", font_bold("If "), font_blue(rule$query), font_bold(" then: "), font_red(rule$value), "\n", sep = "") } - cat(" ", i + 1, ". Otherwise", font_bold(" -> "), font_red(paste0("Negative")), "\n", sep = "") + cat(" ", i + 1, ". ", font_bold("Otherwise: "), font_red(paste0("Negative")), "\n", sep = "") cat("\nUnmatched rows will return ", font_red("NA"), ".\n", sep = "") if (isTRUE(attributes(x)$as_factor)) { cat("Results will be of class , with ordered levels: ", paste0(attributes(x)$values, collapse = " < "), "\n", sep = "") @@ -1507,7 +1546,7 @@ print.custom_mdro_guideline <- function(x, ...) { } } -run_custom_mdro_guideline <- function(df, guideline) { +run_custom_mdro_guideline <- function(df, guideline, info) { n_dots <- length(guideline) stop_if(n_dots == 0, "no custom guidelines set", call = -2) out <- character(length = NROW(df)) @@ -1520,7 +1559,7 @@ run_custom_mdro_guideline <- function(df, guideline) { }) if (identical(qry, "error")) { warning_("in custom_mdro_guideline(): rule ", i, - " (`", guideline[[i]]$query, "`) was ignored because of this error message: ", + " (`", as.character(guideline[[i]]$query), "`) was ignored because of this error message: ", pkg_env$err_msg, call = FALSE, add_fn = font_red) @@ -1529,9 +1568,16 @@ run_custom_mdro_guideline <- function(df, guideline) { stop_ifnot(is.logical(qry), "in custom_mdro_guideline(): rule ", i, " (`", guideline[[i]]$query, "`) must return `TRUE` or `FALSE`, not ", format_class(class(qry), plural = FALSE), call = FALSE) + + new_mdros <- which(qry == TRUE & out == "") + + if (info == TRUE) { + cat(word_wrap("- Custom MDRO rule ", i, ": `", as.character(guideline[[i]]$query), + "` (", length(new_mdros), " rows matched)"), "\n", sep = "") + } val <- guideline[[i]]$value - out[which(qry)] <- val - reasons[which(qry)] <- paste0("matched rule ", gsub("rule", "", names(guideline)[i]), ": ", as.character(guideline[[i]]$query)) + out[new_mdros] <- val + reasons[new_mdros] <- paste0("matched rule ", gsub("rule", "", names(guideline)[i]), ": ", as.character(guideline[[i]]$query)) } out[out == ""] <- "Negative" reasons[out == "Negative"] <- "no rules matched" @@ -1540,8 +1586,7 @@ run_custom_mdro_guideline <- function(df, guideline) { out <- factor(out, levels = attributes(guideline)$values, ordered = TRUE) } - rsi_cols <- vapply(FUN.VALUE = logical(1), df, function(x) is.rsi(x)) - columns_nonsusceptible <- as.data.frame(t(df[, rsi_cols] == "R")) + columns_nonsusceptible <- as.data.frame(t(df[, is.rsi(df)] == "R")) columns_nonsusceptible <- vapply(FUN.VALUE = character(1), columns_nonsusceptible, function(x) paste0(rownames(columns_nonsusceptible)[which(x)], collapse = " ")) diff --git a/R/mo.R b/R/mo.R index 68988ea7..c7f949fa 100755 --- a/R/mo.R +++ b/R/mo.R @@ -1654,10 +1654,28 @@ pillar_shaft.mo <- function(x, ...) { out[!is.na(x)] <- gsub("^([A-Z]+_)(.*)", paste0(font_subtle("\\1"), "\\2"), out[!is.na(x)], perl = TRUE) # and grey out every _ out[!is.na(x)] <- gsub("_", font_subtle("_"), out[!is.na(x)]) - + # markup NA and UNKNOWN out[is.na(x)] <- font_na(" NA") out[x == "UNKNOWN"] <- font_na(" UNKNOWN") + + if (!all(x[!is.na(x)] %in% MO_lookup$mo)) { + # markup old mo codes + out[!x %in% MO_lookup$mo] <- font_italic(font_na(x[!x %in% MO_lookup$mo], + collapse = NULL), + collapse = NULL) + # throw a warning with the affected column name + mo <- tryCatch(search_type_in_df(get_current_data(arg_name = "x", call = 0), type = "mo", info = FALSE), + error = function(e) NULL) + if (!is.null(mo)) { + col <- paste0("Column '", mo, "'") + } else { + col <- "The data" + } + warning_(col, " contains old microbial codes (from a previous AMR package version). ", + "Please update your MO codes with `as.mo()`.", + call = FALSE) + } # make it always fit exactly max_char <- max(nchar(x)) @@ -1753,11 +1771,16 @@ summary.mo <- function(object, ...) { #' @export #' @noRd as.data.frame.mo <- function(x, ...) { + if (!all(x[!is.na(x)] %in% MO_lookup$mo)) { + warning_("The data contains old microbial codes (from a previous AMR package version). ", + "Please update your MO codes with `as.mo()`.", + call = FALSE) + } nm <- deparse1(substitute(x)) if (!"nm" %in% names(list(...))) { - as.data.frame.vector(as.mo(x), ..., nm = nm) + as.data.frame.vector(x, ..., nm = nm) } else { - as.data.frame.vector(as.mo(x), ...) + as.data.frame.vector(x, ...) } } @@ -1875,6 +1898,7 @@ print.mo_uncertainties <- function(x, ...) { collapse = "") # after strwrap, make taxonomic names italic candidates <- gsub("([A-Za-z]+)", font_italic("\\1"), candidates, perl = TRUE) + candidates <- gsub(font_italic("and"), "and", candidates, fixed = TRUE) candidates <- gsub(paste(font_italic(c("Also", "matched"), collapse = NULL), collapse = " "), "Also matched", candidates, fixed = TRUE) @@ -2028,13 +2052,15 @@ replace_old_mo_codes <- function(x, property) { x[which(!is.na(matched))] <- mo_new[which(!is.na(matched))] n_matched <- length(matched[!is.na(matched)]) if (property != "mo") { - message_(font_blue("The input contained old microbial codes (from previous package versions). Please update your MO codes with `as.mo()`.")) + message_(font_blue(paste0("The input contained ", n_matched, + " old microbial code", ifelse(n_matched == 1, "", "s"), + " (from a previous AMR package version). Please update your MO codes with `as.mo()`."))) } else { - if (n_matched == 1) { - message_(font_blue("1 old microbial code (from previous package versions) was updated to a current used MO code.")) - } else { - message_(font_blue(n_matched, "old microbial codes (from previous package versions) were updated to current used MO codes.")) - } + message_(font_blue(paste0(n_matched, " old microbial code", ifelse(n_matched == 1, "", "s"), + " (from a previous AMR package version) ", + ifelse(n_matched == 1, "was", "were"), + " updated to ", ifelse(n_matched == 1, "a ", ""), + "currently used MO code", ifelse(n_matched == 1, "", "s"), "."))) } } x diff --git a/R/mo_property.R b/R/mo_property.R index e169202b..79279751 100755 --- a/R/mo_property.R +++ b/R/mo_property.R @@ -723,20 +723,13 @@ mo_validate <- function(x, property, language, ...) { # special case for mo_* functions where class is already return(MO_lookup[match(x, MO_lookup$mo), property, drop = TRUE]) } - + # try to catch an error when inputting an invalid argument # so the 'call.' can be set to FALSE tryCatch(x[1L] %in% MO_lookup[1, property, drop = TRUE], error = function(e) stop(e$message, call. = FALSE)) - - if (is.mo(x) - & !Becker %in% c(TRUE, "all") - & !Lancefield %in% c(TRUE, "all")) { - # this will not reset mo_uncertainties and mo_failures - # because it's already a valid MO - x <- exec_as.mo(x, property = property, initial_search = FALSE, language = language, ...) - } else if (!all(x %in% MO_lookup[, property, drop = TRUE]) - | has_Becker_or_Lancefield) { + + if (!all(x[!is.na(x)] %in% MO_lookup[, property, drop = TRUE]) | has_Becker_or_Lancefield) { x <- exec_as.mo(x, property = property, language = language, ...) } diff --git a/R/plot.R b/R/plot.R index eac2912e..43533edd 100644 --- a/R/plot.R +++ b/R/plot.R @@ -93,6 +93,14 @@ plot.mic <- function(x, meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) meet_criteria(expand, allow_class = "logical", has_length = 1) + # translate if not specifically set + if (missing(ylab)) { + ylab <- translate_AMR(ylab, language = language) + } + if (missing(xlab)) { + xlab <- translate_AMR(xlab, language = language) + } + if (length(colours_RSI) == 1) { colours_RSI <- rep(colours_RSI, 3) } @@ -135,13 +143,14 @@ plot.mic <- function(x, legend_txt <- c(legend_txt, "Resistant") legend_col <- c(legend_col, colours_RSI[1]) } - legend("top", + legend("top", x.intersp = 0.5, legend = translate_AMR(legend_txt, language = language), fill = legend_col, horiz = TRUE, - cex = 0.75, - box.lwd = 0, + cex = 0.75, + box.lwd = 0, + box.col = "#FFFFFF55", bg = "#FFFFFF55") } } @@ -170,6 +179,14 @@ barplot.mic <- function(height, meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) meet_criteria(expand, allow_class = "logical", has_length = 1) + # translate if not specifically set + if (missing(ylab)) { + ylab <- translate_AMR(ylab, language = language) + } + if (missing(xlab)) { + xlab <- translate_AMR(xlab, language = language) + } + main <- gsub(" +", " ", paste0(main, collapse = " ")) plot(x = height, @@ -209,6 +226,14 @@ ggplot.mic <- function(data, meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) meet_criteria(expand, allow_class = "logical", has_length = 1) + # translate if not specifically set + if (missing(ylab)) { + ylab <- translate_AMR(ylab, language = language) + } + if (missing(xlab)) { + xlab <- translate_AMR(xlab, language = language) + } + if ("main" %in% names(list(...))) { title <- list(...)$main } @@ -285,6 +310,14 @@ plot.disk <- function(x, meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) meet_criteria(expand, allow_class = "logical", has_length = 1) + # translate if not specifically set + if (missing(ylab)) { + ylab <- translate_AMR(ylab, language = language) + } + if (missing(xlab)) { + xlab <- translate_AMR(xlab, language = language) + } + if (length(colours_RSI) == 1) { colours_RSI <- rep(colours_RSI, 3) } @@ -333,8 +366,9 @@ plot.disk <- function(x, legend = translate_AMR(legend_txt, language = language), fill = legend_col, horiz = TRUE, - cex = 0.75, - box.lwd = 0, + cex = 0.75, + box.lwd = 0, + box.col = "#FFFFFF55", bg = "#FFFFFF55") } } @@ -363,6 +397,14 @@ barplot.disk <- function(height, meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) meet_criteria(expand, allow_class = "logical", has_length = 1) + # translate if not specifically set + if (missing(ylab)) { + ylab <- translate_AMR(ylab, language = language) + } + if (missing(xlab)) { + xlab <- translate_AMR(xlab, language = language) + } + main <- gsub(" +", " ", paste0(main, collapse = " ")) plot(x = height, @@ -402,6 +444,14 @@ ggplot.disk <- function(data, meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) meet_criteria(expand, allow_class = "logical", has_length = 1) + # translate if not specifically set + if (missing(ylab)) { + ylab <- translate_AMR(ylab, language = language) + } + if (missing(xlab)) { + xlab <- translate_AMR(xlab, language = language) + } + if ("main" %in% names(list(...))) { title <- list(...)$main } @@ -454,79 +504,6 @@ ggplot.disk <- function(data, ggplot2::labs(title = title, x = xlab, y = ylab, subtitle = cols_sub$sub) } -plot_prepare_table <- function(x, expand) { - if (is.mic(x)) { - if (expand == TRUE) { - # expand range for MIC by adding factors of 2 from lowest to highest so all MICs in between also print - extra_range <- max(x) / 2 - while (min(extra_range) / 2 > min(x)) { - extra_range <- c(min(extra_range) / 2, extra_range) - } - nms <- extra_range - extra_range <- rep(0, length(extra_range)) - names(extra_range) <- nms - x <- table(droplevels(x, as.mic = FALSE)) - extra_range <- extra_range[!names(extra_range) %in% names(x)] - x <- as.table(c(x, extra_range)) - } else { - x <- table(droplevels(x, as.mic = FALSE)) - } - x <- x[order(as.double(as.mic(names(x))))] - } else if (is.disk(x)) { - if (expand == TRUE) { - # expand range for disks from lowest to highest so all mm's in between also print - extra_range <- rep(0, max(x) - min(x) - 1) - names(extra_range) <- seq(min(x) + 1, max(x) - 1) - x <- table(x) - extra_range <- extra_range[!names(extra_range) %in% names(x)] - x <- as.table(c(x, extra_range)) - } else { - x <- table(x) - } - x <- x[order(as.double(names(x)))] - } - as.table(x) -} - -plot_name_of_I <- function(guideline) { - if (!guideline %like% "CLSI" && as.double(gsub("[^0-9]+", "", guideline)) >= 2019) { - # interpretation since 2019 - "Incr. exposure" - } else { - # interpretation until 2019 - "Intermediate" - } -} - -plot_colours_subtitle_guideline <- function(x, mo, ab, guideline, colours_RSI, fn, language, ...) { - guideline <- get_guideline(guideline, AMR::rsi_translation) - if (!is.null(mo) && !is.null(ab)) { - # interpret and give colour based on MIC values - mo <- as.mo(mo) - ab <- as.ab(ab) - rsi <- suppressWarnings(suppressMessages(as.rsi(fn(names(x)), mo = mo, ab = ab, guideline = guideline, ...))) - cols <- character(length = length(rsi)) - cols[is.na(rsi)] <- "#BEBEBE" - cols[rsi == "R"] <- colours_RSI[1] - cols[rsi == "S"] <- colours_RSI[2] - cols[rsi == "I"] <- colours_RSI[3] - moname <- mo_name(mo, language = language) - abname <- ab_name(ab, language = language) - if (all(cols == "#BEBEBE")) { - message_("No ", guideline, " interpretations found for ", - ab_name(ab, language = NULL, tolower = TRUE), " in ", moname) - guideline_txt <- "" - } else { - guideline_txt <- paste0("(", guideline, ")") - } - sub <- bquote(.(abname)~"in"~italic(.(moname))~.(guideline_txt)) - } else { - cols <- "#BEBEBE" - sub <- NULL - } - list(cols = cols, count = as.double(x), sub = sub, guideline = guideline) -} - #' @method plot rsi #' @export #' @importFrom graphics plot text axis @@ -599,6 +576,14 @@ barplot.rsi <- function(height, meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) meet_criteria(expand, allow_class = "logical", has_length = 1) + # translate if not specifically set + if (missing(ylab)) { + ylab <- translate_AMR(ylab, language = language) + } + if (missing(xlab)) { + xlab <- translate_AMR(xlab, language = language) + } + if (length(colours_RSI) == 1) { colours_RSI <- rep(colours_RSI, 3) } @@ -624,6 +609,7 @@ ggplot.rsi <- function(data, xlab = "Antimicrobial Interpretation", ylab = "Frequency", colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"), + language = get_locale(), ...) { stop_ifnot_installed("ggplot2") meet_criteria(title, allow_class = "character", allow_NULL = TRUE) @@ -631,6 +617,14 @@ ggplot.rsi <- function(data, meet_criteria(xlab, allow_class = "character", has_length = 1) meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3)) + # translate if not specifically set + if (missing(ylab)) { + ylab <- translate_AMR(ylab, language = language) + } + if (missing(xlab)) { + xlab <- translate_AMR(xlab, language = language) + } + if ("main" %in% names(list(...))) { title <- list(...)$main } @@ -658,3 +652,76 @@ ggplot.rsi <- function(data, ggplot2::labs(title = title, x = xlab, y = ylab) + ggplot2::theme(legend.position = "none") } + +plot_prepare_table <- function(x, expand) { + if (is.mic(x)) { + if (expand == TRUE) { + # expand range for MIC by adding factors of 2 from lowest to highest so all MICs in between also print + extra_range <- max(x) / 2 + while (min(extra_range) / 2 > min(x)) { + extra_range <- c(min(extra_range) / 2, extra_range) + } + nms <- extra_range + extra_range <- rep(0, length(extra_range)) + names(extra_range) <- nms + x <- table(droplevels(x, as.mic = FALSE)) + extra_range <- extra_range[!names(extra_range) %in% names(x)] + x <- as.table(c(x, extra_range)) + } else { + x <- table(droplevels(x, as.mic = FALSE)) + } + x <- x[order(as.double(as.mic(names(x))))] + } else if (is.disk(x)) { + if (expand == TRUE) { + # expand range for disks from lowest to highest so all mm's in between also print + extra_range <- rep(0, max(x) - min(x) - 1) + names(extra_range) <- seq(min(x) + 1, max(x) - 1) + x <- table(x) + extra_range <- extra_range[!names(extra_range) %in% names(x)] + x <- as.table(c(x, extra_range)) + } else { + x <- table(x) + } + x <- x[order(as.double(names(x)))] + } + as.table(x) +} + +plot_name_of_I <- function(guideline) { + if (!guideline %like% "CLSI" && as.double(gsub("[^0-9]+", "", guideline)) >= 2019) { + # interpretation since 2019 + "Incr. exposure" + } else { + # interpretation until 2019 + "Intermediate" + } +} + +plot_colours_subtitle_guideline <- function(x, mo, ab, guideline, colours_RSI, fn, language, ...) { + guideline <- get_guideline(guideline, AMR::rsi_translation) + if (!is.null(mo) && !is.null(ab)) { + # interpret and give colour based on MIC values + mo <- as.mo(mo) + ab <- as.ab(ab) + rsi <- suppressWarnings(suppressMessages(as.rsi(fn(names(x)), mo = mo, ab = ab, guideline = guideline, ...))) + cols <- character(length = length(rsi)) + cols[is.na(rsi)] <- "#BEBEBE" + cols[rsi == "R"] <- colours_RSI[1] + cols[rsi == "S"] <- colours_RSI[2] + cols[rsi == "I"] <- colours_RSI[3] + moname <- mo_name(mo, language = language) + abname <- ab_name(ab, language = language) + if (all(cols == "#BEBEBE")) { + message_("No ", guideline, " interpretations found for ", + ab_name(ab, language = NULL, tolower = TRUE), " in ", moname) + guideline_txt <- "" + } else { + guideline_txt <- paste0("(", guideline, ")") + } + sub <- bquote(.(abname)~"-"~italic(.(moname))~.(guideline_txt)) + } else { + cols <- "#BEBEBE" + sub <- NULL + } + list(cols = cols, count = as.double(x), sub = sub, guideline = guideline) +} diff --git a/R/sysdata.rda b/R/sysdata.rda index 55d1a17f..7a9cd5ec 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/R/translate.R b/R/translate.R index 05b60f2d..b6591866 100755 --- a/R/translate.R +++ b/R/translate.R @@ -157,11 +157,13 @@ translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE, a df_trans$regular_expr[is.na(df_trans$regular_expr)] <- FALSE # check if text to look for is in one of the patterns - any_form_in_patterns <- tryCatch(any(from_unique %like% paste0("(", paste(df_trans$pattern, collapse = "|"), ")")), - error = function(e) { - warning_("Translation not possible. Please open an issue on GitHub (https://github.com/msberends/AMR/issues).", call = FALSE) - return(FALSE) - }) + any_form_in_patterns <- tryCatch( + any(from_unique %like% paste0("(", paste(gsub(" +\\(.*", "", df_trans$pattern), collapse = "|"), ")")), + error = function(e) { + warning_("Translation not possible. Please open an issue on GitHub (https://github.com/msberends/AMR/issues).", call = FALSE) + return(FALSE) + }) + if (NROW(df_trans) == 0 | !any_form_in_patterns) { return(from) } @@ -170,7 +172,7 @@ translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE, a function(i) from_unique_translated <<- gsub(pattern = df_trans$pattern[i], replacement = df_trans[i, language, drop = TRUE], x = from_unique_translated, - ignore.case = !df_trans$case_sensitive[i], + ignore.case = !df_trans$case_sensitive[i] & df_trans$regular_expr[i], fixed = !df_trans$regular_expr[i], perl = df_trans$regular_expr[i])) diff --git a/_pkgdown.yml b/_pkgdown.yml index 463c130a..c6b55461 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -143,6 +143,7 @@ reference: - "`as.mic`" - "`as.disk`" - "`eucast_rules`" + - "`custom_eucast_rules`" - title: "Analysing data: antimicrobial resistance" desc: > diff --git a/data-raw/AMR_latest.tar.gz b/data-raw/AMR_latest.tar.gz index b1e77944..8a1018bd 100644 Binary files a/data-raw/AMR_latest.tar.gz and b/data-raw/AMR_latest.tar.gz differ diff --git a/data-raw/_internals.R b/data-raw/_internals.R index 34f63cf3..4aff8f05 100644 --- a/data-raw/_internals.R +++ b/data-raw/_internals.R @@ -134,7 +134,7 @@ create_intr_resistance <- function() { -# Save internal data sets to R/sysdata.rda -------------------------------- +# Save internal data to R/sysdata.rda ------------------------------------- # See 'data-raw/eucast_rules.tsv' for the EUCAST reference file eucast_rules_file <- utils::read.delim(file = "data-raw/eucast_rules.tsv", @@ -188,6 +188,35 @@ AB_lookup <- create_AB_lookup() MO_lookup <- create_MO_lookup() MO.old_lookup <- create_MO.old_lookup() +# antibiotic groups +# (these will also be used for eucast_rules() and understanding data-raw/eucast_rules.tsv) +globalenv_before_ab <- c(ls(envir = globalenv()), "globalenv_before_ab") +AMINOGLYCOSIDES <- antibiotics %>% filter(group %like% "aminoglycoside") %>% pull(ab) +AMINOPENICILLINS <- as.ab(c("AMP", "AMX")) +CARBAPENEMS <- antibiotics %>% filter(group %like% "carbapenem") %>% pull(ab) +CEPHALOSPORINS <- antibiotics %>% filter(group %like% "cephalosporin") %>% pull(ab) +CEPHALOSPORINS_1ST <- antibiotics %>% filter(group %like% "cephalosporin.*1") %>% pull(ab) +CEPHALOSPORINS_2ND <- antibiotics %>% filter(group %like% "cephalosporin.*2") %>% pull(ab) +CEPHALOSPORINS_3RD <- antibiotics %>% filter(group %like% "cephalosporin.*3") %>% pull(ab) +CEPHALOSPORINS_EXCEPT_CAZ <- CEPHALOSPORINS[CEPHALOSPORINS != "CAZ"] +FLUOROQUINOLONES <- antibiotics %>% filter(atc_group2 %like% "fluoroquinolone") %>% pull(ab) +LIPOGLYCOPEPTIDES <- as.ab(c("DAL", "ORI", "TLV")) # dalba/orita/tela +GLYCOPEPTIDES <- antibiotics %>% filter(group %like% "glycopeptide") %>% pull(ab) +GLYCOPEPTIDES_EXCEPT_LIPO <- GLYCOPEPTIDES[!GLYCOPEPTIDES %in% LIPOGLYCOPEPTIDES] +LINCOSAMIDES <- antibiotics %>% filter(atc_group2 %like% "lincosamide") %>% pull(ab) %>% c("PRL") +MACROLIDES <- antibiotics %>% filter(atc_group2 %like% "macrolide") %>% pull(ab) +OXAZOLIDINONES <- antibiotics %>% filter(group %like% "oxazolidinone") %>% pull(ab) +PENICILLINS <- antibiotics %>% filter(group %like% "penicillin") %>% pull(ab) +POLYMYXINS <- antibiotics %>% filter(group %like% "polymyxin") %>% pull(ab) +STREPTOGRAMINS <- antibiotics %>% filter(atc_group2 %like% "streptogramin") %>% pull(ab) +TETRACYCLINES <- antibiotics %>% filter(atc_group2 %like% "tetracycline") %>% pull(ab) +TETRACYCLINES_EXCEPT_TGC <- TETRACYCLINES[TETRACYCLINES != "TGC"] +UREIDOPENICILLINS <- as.ab(c("PIP", "TZP", "AZL", "MEZ")) +BETALACTAMS <- c(PENICILLINS, CEPHALOSPORINS, CARBAPENEMS) + +DEFINED_AB_GROUPS <- ls(envir = globalenv()) +DEFINED_AB_GROUPS <- DEFINED_AB_GROUPS[!DEFINED_AB_GROUPS %in% globalenv_before_ab] + # Export to package as internal data ---- usethis::use_data(eucast_rules_file, translations_file, @@ -199,6 +228,29 @@ usethis::use_data(eucast_rules_file, AB_lookup, MO_lookup, MO.old_lookup, + AMINOGLYCOSIDES, + AMINOPENICILLINS, + CARBAPENEMS, + CEPHALOSPORINS, + CEPHALOSPORINS_1ST, + CEPHALOSPORINS_2ND, + CEPHALOSPORINS_3RD, + CEPHALOSPORINS_EXCEPT_CAZ, + FLUOROQUINOLONES, + LIPOGLYCOPEPTIDES, + GLYCOPEPTIDES, + GLYCOPEPTIDES_EXCEPT_LIPO, + LINCOSAMIDES, + MACROLIDES, + OXAZOLIDINONES, + PENICILLINS, + POLYMYXINS, + STREPTOGRAMINS, + TETRACYCLINES, + TETRACYCLINES_EXCEPT_TGC, + UREIDOPENICILLINS, + BETALACTAMS, + DEFINED_AB_GROUPS, internal = TRUE, overwrite = TRUE, version = 2, diff --git a/data-raw/eucast_rules.tsv b/data-raw/eucast_rules.tsv index b2706643..bc351394 100644 --- a/data-raw/eucast_rules.tsv +++ b/data-raw/eucast_rules.tsv @@ -1,7 +1,7 @@ # ------------------------------------------------------------------------------------------------------------------------------- # For editing this EUCAST reference file, these values can all be used for targeting antibiotics: -# 'all_betalactams', 'aminoglycosides', 'aminopenicillins', 'carbapenems', 'cephalosporins', 'cephalosporins_1st', 'cephalosporins_2nd', 'cephalosporins_3rd', 'cephalosporins_except_CAZ', -# 'fluoroquinolones', 'glycopeptides', 'lincosamides', 'lipoglycopeptides', 'macrolides', 'oxazolidinones', 'polymyxins', 'streptogramins', 'tetracyclines', 'ureidopenicillins', +# 'betalactams', 'aminoglycosides', 'aminopenicillins', 'carbapenems', 'cephalosporins', 'cephalosporins_1st', 'cephalosporins_2nd', 'cephalosporins_3rd', 'cephalosporins_except_CAZ', +# 'fluoroquinolones', 'glycopeptides', 'glycopeptides_except_lipo', 'lincosamides', 'lipoglycopeptides', 'macrolides', 'oxazolidinones', 'polymyxins', 'streptogramins', 'tetracyclines', 'tetracyclines_except_TGC', 'ureidopenicillins', # and all separate EARS-Net letter codes like 'AMC'. They can be separated by comma: 'AMC, fluoroquinolones'. # The 'if_mo_property' column can be any column name from the AMR::microorganisms data set, or "genus_species" or "gramstain". # The like.is.one_of column must be 'like' or 'is' or 'one_of' ('like' will read the 'this_value' column as regular expression) @@ -14,7 +14,7 @@ order is Enterobacterales AMP I AMX I Enterobacterales (Order) Breakpoints 10 order is Enterobacterales AMP R AMX R Enterobacterales (Order) Breakpoints 10 genus is Staphylococcus PEN, FOX S AMP, AMX, PIP, TIC S Staphylococcus Breakpoints 10 genus is Staphylococcus PEN, FOX R, S OXA, FLC S Staphylococcus Breakpoints 10 -genus is Staphylococcus FOX R all_betalactams R Staphylococcus Breakpoints 10 +genus is Staphylococcus FOX R betalactams R Staphylococcus Breakpoints 10 genus_species is Staphylococcus saprophyticus AMP S AMX, AMC, PIP, TZP S Staphylococcus Breakpoints 10 genus is Staphylococcus FOX S carbapenems, cephalosporins_except_CAZ S Staphylococcus Breakpoints 10 genus is Staphylococcus FOX I carbapenems, cephalosporins_except_CAZ I Staphylococcus Breakpoints 10 @@ -120,7 +120,7 @@ order is Enterobacterales AMP I AMX I Enterobacterales (Order) Breakpoints 11 order is Enterobacterales AMP R AMX R Enterobacterales (Order) Breakpoints 11 genus is Staphylococcus PEN, FOX S AMP, AMX, PIP, TIC S Staphylococcus Breakpoints 11 genus is Staphylococcus PEN, FOX R, S OXA, FLC S Staphylococcus Breakpoints 11 -genus is Staphylococcus FOX R all_betalactams R Staphylococcus Breakpoints 11 +genus is Staphylococcus FOX R betalactams R Staphylococcus Breakpoints 11 genus_species is Staphylococcus saprophyticus AMP S AMX, AMC, PIP, TZP S Staphylococcus Breakpoints 11 genus is Staphylococcus FOX S carbapenems, cephalosporins_except_CAZ S Staphylococcus Breakpoints 11 genus is Staphylococcus FOX I carbapenems, cephalosporins_except_CAZ I Staphylococcus Breakpoints 11 @@ -224,7 +224,7 @@ genus_species is Burkholderia pseudomallei TCY R DOX R Burkholderia pseudomallei genus is Bacillus NOR S fluoroquinolones S Bacillus Breakpoints 11 added in 11 genus is Bacillus NOR I fluoroquinolones I Bacillus Breakpoints 11 added in 11 genus is Bacillus NOR R fluoroquinolones R Bacillus Breakpoints 11 added in 11 -order is Enterobacterales PEN, glycopeptides, FUS, macrolides, LIN, streptogramins, RIF, DAP, LNZ R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 +order is Enterobacterales PEN, glycopeptides_except_lipo, FUS, macrolides, LIN, streptogramins, RIF, DAP, LNZ R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 fullname like ^Citrobacter (koseri|amalonaticus|sedlakii|farmeri|rodentium) aminopenicillins, TIC R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 fullname like ^Citrobacter (freundii|braakii|murliniae|werkmanii|youngae) aminopenicillins, AMC, CZO, FOX R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 genus_species is Enterobacter cloacae aminopenicillins, AMC, CZO, FOX R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 @@ -232,17 +232,17 @@ genus_species is Klebsiella aerogenes aminopenicillins, AMC, CZO, FOX R Table genus_species is Escherichia hermannii aminopenicillins, TIC R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 genus_species is Hafnia alvei aminopenicillins, AMC, CZO, FOX R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 genus is Klebsiella aminopenicillins, TIC R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 -genus_species is Morganella morganii aminopenicillins, AMC, CZO, tetracyclines, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 -genus_species is Proteus mirabilis tetracyclines, TGC, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 -genus_species is Proteus penneri aminopenicillins, CZO, CXM, tetracyclines, TGC, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 -genus_species is Proteus vulgaris aminopenicillins, CZO, CXM, tetracyclines, TGC, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 -genus_species is Providencia rettgeri aminopenicillins, AMC, CZO, CXM, tetracyclines, TGC, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 -genus_species is Providencia stuartii aminopenicillins, AMC, CZO, CXM, tetracyclines, TGC, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 +genus_species is Morganella morganii aminopenicillins, AMC, CZO, DOX, MNO, TCY, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 +genus_species is Proteus mirabilis DOX, MNO, TCY, TGC, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 +genus_species is Proteus penneri aminopenicillins, CZO, CXM, DOX, MNO, TCY, TGC, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 +genus_species is Proteus vulgaris aminopenicillins, CZO, CXM, DOX, MNO, TCY, TGC, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 +genus_species is Providencia rettgeri aminopenicillins, AMC, CZO, CXM, DOX, MNO, TCY, TGC, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 +genus_species is Providencia stuartii aminopenicillins, AMC, CZO, CXM, DOX, MNO, TCY, TGC, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 genus is Raoultella aminopenicillins, TIC R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 genus_species is Serratia marcescens aminopenicillins, AMC, CZO, FOX, CXM, DOX, TCY, polymyxins, NIT R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 genus_species is Yersinia enterocolitica aminopenicillins, AMC, TIC, CZO, FOX R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 genus_species is Yersinia pseudotuberculosis PLB, COL R Table 01: Intrinsic resistance in Enterobacterales (at the time: Enterobacteriaceae) Expert Rules 3.1 -genus one_of Achromobacter, Acinetobacter, Alcaligenes, Bordetella, Burkholderia, Elizabethkingia, Flavobacterium, Ochrobactrum, Pseudomonas, Stenotrophomonas PEN, FOX, CXM, glycopeptides, FUS, macrolides, LIN, streptogramins, RIF, DAP, LNZ R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1 +genus one_of Achromobacter, Acinetobacter, Alcaligenes, Bordetella, Burkholderia, Elizabethkingia, Flavobacterium, Ochrobactrum, Pseudomonas, Stenotrophomonas PEN, FOX, CXM, glycopeptides_except_lipo, FUS, macrolides, LIN, streptogramins, RIF, DAP, LNZ R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1 genus_species is Acinetobacter baumannii aminopenicillins, AMC, CZO, CTX, CRO, ATM, ETP, TMP, FOS, DOX, TCY R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1 genus_species is Acinetobacter pittii aminopenicillins, AMC, CZO, CTX, CRO, ATM, ETP, TMP, FOS, DOX, TCY R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1 genus_species is Acinetobacter nosocomialis aminopenicillins, AMC, CZO, CTX, CRO, ATM, ETP, TMP, FOS, DOX, TCY R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1 @@ -251,9 +251,9 @@ genus_species is Achromobacter xylosoxidans aminopenicillins, CZO, CTX, CRO, E fullname like ^Burkholderia (ambifaria|anthina|arboris|cepacia|cenocepacia|contaminans|diffusa|dolosa|lata|latens|metallica|multivorans|paludis|pseudomultivorans|pyrrocinia|pseudomultivorans|seminalis|stabilis|stagnalis|territorii|ubonensis|vietnamiensis) aminopenicillins, AMC, TIC, PIP, TZP, CZO, CTX, CRO, ATM, ETP, CIP, CHL, aminoglycosides, TMP, FOS, polymyxins R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1 genus_species is Elizabethkingia meningoseptica aminopenicillins, AMC, TIC, CZO, CTX, CRO, CAZ, FEP, ATM, ETP, IPM, MEM, polymyxins R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1 genus_species is Ochrobactrum anthropi aminopenicillins, AMC, TIC, PIP, TZP, CZO, CTX, CRO, CAZ, FEP, ATM, ETP R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1 -genus_species is Pseudomonas aeruginosa aminopenicillins, AMC, CZO, CTX, CRO, ETP, CHL, KAN, NEO, TMP, SXT, tetracyclines, TGC R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1 +genus_species is Pseudomonas aeruginosa aminopenicillins, AMC, CZO, CTX, CRO, ETP, CHL, KAN, NEO, TMP, SXT, DOX, MNO, TCY, TGC R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1 genus_species is Stenotrophomonas maltophilia aminopenicillins, AMC, TIC, PIP, TZP, CZO, CTX, CRO, ATM, ETP, IPM, MEM, aminoglycosides, TMP, FOS, TCY R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules 3.1 -genus one_of Haemophilus, Moraxella, Neisseria, Campylobacter glycopeptides, LIN, DAP, LNZ R Table 03: Intrinsic resistance in other Gram-negative bacteria Expert Rules 3.1 +genus one_of Haemophilus, Moraxella, Neisseria, Campylobacter glycopeptides_except_lipo, LIN, DAP, LNZ R Table 03: Intrinsic resistance in other Gram-negative bacteria Expert Rules 3.1 genus_species is Haemophilus influenzae FUS, streptogramins R Table 03: Intrinsic resistance in other Gram-negative bacteria Expert Rules 3.1 genus_species is Moraxella catarrhalis TMP R Table 03: Intrinsic resistance in other Gram-negative bacteria Expert Rules 3.1 genus is Neisseria TMP R Table 03: Intrinsic resistance in other Gram-negative bacteria Expert Rules 3.1 @@ -279,8 +279,8 @@ genus_species is Enterococcus casseliflavus FUS, CAZ, cephalosporins_except_CA genus_species is Enterococcus faecium FUS, CAZ, cephalosporins_except_CAZ, aminoglycosides, macrolides, TMP, SXT R Table 04: Intrinsic resistance in Gram-positive bacteria Expert Rules 3.1 genus is Corynebacterium FOS R Table 04: Intrinsic resistance in Gram-positive bacteria Expert Rules 3.1 genus_species is Listeria monocytogenes cephalosporins R Table 04: Intrinsic resistance in Gram-positive bacteria Expert Rules 3.1 -genus one_of Leuconostoc, Pediococcus glycopeptides R Table 04: Intrinsic resistance in Gram-positive bacteria Expert Rules 3.1 -genus is Lactobacillus glycopeptides R Table 04: Intrinsic resistance in Gram-positive bacteria Expert Rules 3.1 +genus one_of Leuconostoc, Pediococcus glycopeptides_except_lipo R Table 04: Intrinsic resistance in Gram-positive bacteria Expert Rules 3.1 +genus is Lactobacillus glycopeptides_except_lipo R Table 04: Intrinsic resistance in Gram-positive bacteria Expert Rules 3.1 genus_species is Clostridium ramosum VAN R Table 04: Intrinsic resistance in Gram-positive bacteria Expert Rules 3.1 genus_species is Clostridium innocuum VAN R Table 04: Intrinsic resistance in Gram-positive bacteria Expert Rules 3.1 genus_species one_of Streptococcus group A, Streptococcus group B, Streptococcus group C, Streptococcus group G PEN S aminopenicillins, cephalosporins_except_CAZ, carbapenems S Table 08: Interpretive rules for B-lactam agents and Gram-positive cocci Expert Rules 3.1 @@ -298,7 +298,7 @@ genus is Staphylococcus MFX R fluoroquinolones R Table 13: Interpretive rules fo genus_species is Streptococcus pneumoniae MFX R fluoroquinolones R Table 13: Interpretive rules for quinolones Expert Rules 3.1 order is Enterobacterales CIP R fluoroquinolones R Table 13: Interpretive rules for quinolones Expert Rules 3.1 genus_species is Neisseria gonorrhoeae CIP R fluoroquinolones R Table 13: Interpretive rules for quinolones Expert Rules 3.1 -order is Enterobacterales PEN, glycopeptides, lipoglycopeptides, FUS, macrolides, lincosamides, streptogramins, RIF, oxazolidinones R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 +order is Enterobacterales PEN, glycopeptides_except_lipo, lipoglycopeptides, FUS, macrolides, lincosamides, streptogramins, RIF, oxazolidinones R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 fullname like ^Citrobacter (koseri|amalonaticus|sedlakii|farmeri|rodentium) aminopenicillins, TIC R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 fullname like ^Citrobacter (freundii|braakii|murliniae|werkmanii|youngae) aminopenicillins, AMC, SAM, CZO, CEP, LEX, CFR, FOX R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 genus_species is Enterobacter cloacae aminopenicillins, AMC, SAM, CZO, CEP, LEX, CFR, FOX R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 @@ -308,13 +308,13 @@ genus_species is Klebsiella aerogenes aminopenicillins, AMC, SAM, CZO, CEP, LE genus_species is Klebsiella oxytoca aminopenicillins, TIC R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 fullname like ^Klebsiella( pneumoniae| quasipneumoniae| variicola)? aminopenicillins, TIC R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 genus_species is Leclercia adecarboxylata FOS R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 -genus_species is Morganella morganii aminopenicillins, AMC, SAM, CZO, CEP, LEX, CFR, tetracyclines, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 +genus_species is Morganella morganii aminopenicillins, AMC, SAM, CZO, CEP, LEX, CFR, DOX, MNO, TCY, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 genus_species is Plesiomonas shigelloides aminopenicillins, AMC, SAM R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 -genus_species is Proteus mirabilis tetracyclines, TGC, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 -genus_species is Proteus penneri aminopenicillins, CZO, CEP, LEX, CFR, CXM, tetracyclines, TGC, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 -genus_species is Proteus vulgaris aminopenicillins, CZO, CEP, LEX, CFR, CXM, tetracyclines, TGC, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 -genus_species is Providencia rettgeri aminopenicillins, AMC, SAM, CZO, CEP, LEX, CFR, tetracyclines, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 -genus_species is Providencia stuartii aminopenicillins, AMC, SAM, CZO, CEP, LEX, CFR, tetracyclines, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 +genus_species is Proteus mirabilis DOX, MNO, TCY, TGC, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 +genus_species is Proteus penneri aminopenicillins, CZO, CEP, LEX, CFR, CXM, DOX, MNO, TCY, TGC, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 +genus_species is Proteus vulgaris aminopenicillins, CZO, CEP, LEX, CFR, CXM, DOX, MNO, TCY, TGC, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 +genus_species is Providencia rettgeri aminopenicillins, AMC, SAM, CZO, CEP, LEX, CFR, DOX, MNO, TCY, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 +genus_species is Providencia stuartii aminopenicillins, AMC, SAM, CZO, CEP, LEX, CFR, DOX, MNO, TCY, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 genus is Raoultella aminopenicillins, TIC R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 genus_species is Serratia marcescens aminopenicillins, AMC, SAM, CZO, CEP, LEX, CFR, FOX, CXM, DOX, TCY, polymyxins, NIT R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 genus_species is Yersinia enterocolitica aminopenicillins, AMC, SAM, TIC, CZO, CEP, LEX, CFR, FOX R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 @@ -324,20 +324,20 @@ genus_species is Aeromonas veronii aminopenicillins, AMC, SAM, FOX R Table 1: genus_species is Aeromonas dhakensis aminopenicillins, AMC, SAM, FOX R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 genus_species is Aeromonas caviae aminopenicillins, AMC, SAM, FOX R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 genus_species is Aeromonas jandaei aminopenicillins, AMC, SAM, TIC, CZO, CEP, LEX, CFR, FOX R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 -genus one_of Achromobacter, Acinetobacter, Alcaligenes, Bordetella, Burkholderia, Elizabethkingia, Flavobacterium, Ochrobactrum, Pseudomonas, Stenotrophomonas PEN, cephalosporins_1st, cephalosporins_2nd, glycopeptides, lipoglycopeptides, FUS, macrolides, lincosamides, streptogramins, RIF, oxazolidinones R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 +genus one_of Achromobacter, Acinetobacter, Alcaligenes, Bordetella, Burkholderia, Elizabethkingia, Flavobacterium, Ochrobactrum, Pseudomonas, Stenotrophomonas PEN, cephalosporins_1st, cephalosporins_2nd, glycopeptides_except_lipo, lipoglycopeptides, FUS, macrolides, lincosamides, streptogramins, RIF, oxazolidinones R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 fullname like ^Acinetobacter (baumannii|pittii|nosocomialis) aminopenicillins, AMC, CRO, CTX, ATM, ETP, TMP, FOS, DOX, TCY R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…) genus is Acinetobacter DOX, TCY R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…) genus_species is Achromobacter xylosoxidans aminopenicillins, CRO, CTX, ETP R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…) fullname like ^Burkholderia (ambifaria|anthina|arboris|cepacia|cenocepacia|contaminans|diffusa|dolosa|lata|latens|metallica|multivorans|paludis|pseudomultivorans|pyrrocinia|pseudomultivorans|seminalis|stabilis|stagnalis|territorii|ubonensis|vietnamiensis) aminopenicillins, AMC, SAM, TIC, TCC, PIP, TZP, CRO, CTX, ATM, ETP, CIP, CHL, aminoglycosides, TMP, FOS, polymyxins R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…) genus_species is Elizabethkingia meningoseptica aminopenicillins, AMC, SAM, TIC, TCC, PIP, CZO, CTX, CRO, CAZ, FEP, ATM, ETP, IPM, MEM, polymyxins R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…) genus_species is Ochrobactrum anthropi aminopenicillins, AMC, SAM, TIC, TCC, PIP, TZP, CZO, CTX, CRO, CAZ, FEP, ATM, ETP R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…) -genus_species is Pseudomonas aeruginosa aminopenicillins, AMC, SAM, CTX, CRO, ETP, CHL, KAN, NEO, TMP, tetracyclines, TGC R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…) +genus_species is Pseudomonas aeruginosa aminopenicillins, AMC, SAM, CTX, CRO, ETP, CHL, KAN, NEO, TMP, DOX, MNO, TCY, TGC R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…) genus_species is Stenotrophomonas maltophilia aminopenicillins, AMC, SAM, TIC, PIP, TZP, CRO, CTX, ATM, ETP, IPM, MEM, aminoglycosides, TMP, FOS, TCY R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…) -genus_species is Haemophilus influenzae FUS, streptogramins, glycopeptides, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2 -genus_species is Moraxella catarrhalis TMP, glycopeptides, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2 -genus is Neisseria TMP, glycopeptides, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2 -genus_species is Campylobacter fetus FUS, streptogramins, TMP, NAL, glycopeptides, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2 -fullname like ^Campylobacter (jejuni|coli) FUS, streptogramins, TMP, glycopeptides, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2 +genus_species is Haemophilus influenzae FUS, streptogramins, glycopeptides_except_lipo, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2 +genus_species is Moraxella catarrhalis TMP, glycopeptides_except_lipo, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2 +genus is Neisseria TMP, glycopeptides_except_lipo, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2 +genus_species is Campylobacter fetus FUS, streptogramins, TMP, NAL, glycopeptides_except_lipo, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2 +fullname like ^Campylobacter (jejuni|coli) FUS, streptogramins, TMP, glycopeptides_except_lipo, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2 gramstain is Gram-positive ATM, TEM, polymyxins, NAL R Table 4: Intrinsic resistance in gram-positive bacteria Expert Rules 3.2 genus_species is Staphylococcus saprophyticus FUS, CAZ, FOS, NOV R Table 4: Intrinsic resistance in gram-positive bacteria Expert Rules 3.2 genus_species is Staphylococcus cohnii CAZ, NOV R Table 4: Intrinsic resistance in gram-positive bacteria Expert Rules 3.2 @@ -372,8 +372,8 @@ fullname like ^(Serratia|Providencia|Morganella morganii) TGC R Expert Rules o genus is Salmonella cephalosporins_2nd R Expert Rules on Salmonella Expert Rules 3.2 genus is Salmonella aminoglycosides R Expert Rules on Salmonella Expert Rules 3.2 genus is Salmonella PEF R CIP R Expert Rules on Salmonella Expert Rules 3.2 -genus_species is Staphylococcus aureus FOX1 R all_betalactams R Expert Rules on Staphylococcus Expert Rules 3.2 -genus_species is Staphylococcus aureus FOX1 S all_betalactams S Expert Rules on Staphylococcus Expert Rules 3.2 +genus_species is Staphylococcus aureus FOX1 R betalactams R Expert Rules on Staphylococcus Expert Rules 3.2 +genus_species is Staphylococcus aureus FOX1 S betalactams S Expert Rules on Staphylococcus Expert Rules 3.2 genus_species one_of Staphylococcus aureus, Staphylococcus lugdunensis PEN R AMP, AMX, AZL, BAM, CRB, CRN, EPC, HET, MEC, MEZ, MTM, PIP, PME, PVM, SBC, TAL, TEM, TIC R Expert Rules on Staphylococcus Expert Rules 3.2 all penicillins without beta-lactamse inhibitor genus is Staphylococcus ERY, CLI S macrolides, lincosamides S Expert Rules on Staphylococcus Expert Rules 3.2 genus is Staphylococcus NOR S CIP, LVX, MFX, OFX S Expert Rules on Staphylococcus Expert Rules 3.2 @@ -400,7 +400,7 @@ genus_species is Streptococcus pneumoniae TCY S DOX, MNO S Expert Rules on Strep genus_species is Streptococcus pneumoniae TCY R DOX, MNO R Expert Rules on Streptococcus pneumoniae Expert Rules 3.2 genus_species is Streptococcus pneumoniae VAN S lipoglycopeptides S Expert Rules on Streptococcus pneumoniae Expert Rules 3.2 fullname like ^Streptococcus (anginosus|australis|bovis|constellatus|cristatus|equinus|gallolyticus|gordonii|infantarius|infantis|intermedius|mitis|mutans|oligofermentans|oralis|parasanguinis|peroris|pseudopneumoniae|salivarius|sanguinis|sinensis|sobrinus|thermophilus|vestibularis|viridans)$ PEN S aminopenicillins, CTX, CRO S Expert Rules on Viridans Group Streptococci Expert Rules 3.2 -genus_species is Haemophilus influenzae PEN S all_betalactams S Expert Rules on Haemophilus influenzae Expert Rules 3.2 +genus_species is Haemophilus influenzae PEN S betalactams S Expert Rules on Haemophilus influenzae Expert Rules 3.2 genus_species is Haemophilus influenzae NAL S fluoroquinolones S Expert Rules on Haemophilus influenzae Expert Rules 3.2 genus_species is Haemophilus influenzae NAL R CIP, LVX, MFX R Expert Rules on Haemophilus influenzae Expert Rules 3.2 genus_species is Haemophilus influenzae TCY S DOX, MNO S Expert Rules on Haemophilus influenzae Expert Rules 3.2 diff --git a/data-raw/reproduction_of_microorganisms_update.R b/data-raw/reproduction_of_microorganisms_update.R index 768ff903..b4dcfb2e 100644 --- a/data-raw/reproduction_of_microorganisms_update.R +++ b/data-raw/reproduction_of_microorganisms_update.R @@ -160,7 +160,7 @@ updated_microorganisms <- taxonomy %>% TRUE ~ "subsp."), ref = get_author_year(authors), species_id = as.character(record_no), - source = "LSPN", + source = "LPSN", prevalence = 0, snomed = NA) diff --git a/data-raw/translations.tsv b/data-raw/translations.tsv index 5867097b..2d296a64 100644 --- a/data-raw/translations.tsv +++ b/data-raw/translations.tsv @@ -39,6 +39,10 @@ antibiotic TRUE TRUE FALSE Antibiotikum antibioticum antibiótico Antibiotic TRUE TRUE FALSE Antibiotikum Antibioticum Antibiótico Drug TRUE TRUE FALSE Medikament Middel Fármaco drug TRUE TRUE FALSE Medikament middel fármaco +Frequency FALSE TRUE FALSE Zahl Aantal +Minimum Inhibitory Concentration (mg/L) FALSE FALSE FALSE Minimale Hemm-Konzentration (mg/L) Minimale inhiberende concentratie (mg/L) +Disk diffusion diameter (mm) FALSE FALSE FALSE Durchmesser der Scheibenzone (mm) Diameter diskzone (mm) +Antimicrobial Interpretation FALSE FALSE FALSE Antimikrobielle Auswertung Antimicrobiële interpretatie 4-aminosalicylic acid FALSE TRUE FALSE 4-Aminosalicylsäure 4-aminosalicylzuur Ácido 4-aminosalicílico Adefovir dipivoxil FALSE TRUE FALSE Adefovir Dipivoxil Adefovir Adefovir dipivoxil Aldesulfone sodium FALSE TRUE FALSE Aldesulfon-Natrium Aldesulfon Aldesulfona sódica diff --git a/data/example_isolates.rda b/data/example_isolates.rda index 34b9357c..fa7d8b3d 100644 Binary files a/data/example_isolates.rda and b/data/example_isolates.rda differ diff --git a/docs/404.html b/docs/404.html index 4cec1e55..64395d00 100644 --- a/docs/404.html +++ b/docs/404.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0 + 1.6.0.9000 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 9a11931d..3f822da2 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0 + 1.6.0.9000 diff --git a/docs/articles/index.html b/docs/articles/index.html index f3c90025..81e867e3 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0 + 1.6.0.9000 diff --git a/docs/authors.html b/docs/authors.html index 210a41ed..7c17f4e3 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0 + 1.6.0.9000 diff --git a/docs/index.html b/docs/index.html index a340937a..3a38112f 100644 --- a/docs/index.html +++ b/docs/index.html @@ -19,11 +19,10 @@ - + + + + + + + + +Create Custom EUCAST Rules — custom_eucast_rules • AMR (for R) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+
+ + + + +
+ +
+
+
+

Create Custom EUCAST Rules

+ Source: R/custom_eucast_rules.R + +
+ +
+

Create Custom EUCAST Rules

+
+ + 
custom_eucast_rules(...)
+ +

Arguments

+ + + + + + +
...

rules in formula notation, see Examples

+ +

Details

+ +

This documentation page will be updated shortly. This function is experimental.

+

How it works

+ + + +

..

+

It is also possible to define antibiotic groups instead of single antibiotics. The following groups are allowed (case-insensitive): aminoglycosides, aminopenicillins, betalactams, carbapenems, cephalosporins, cephalosporins_1st, cephalosporins_2nd, cephalosporins_3rd, cephalosporins_except_caz, fluoroquinolones, glycopeptides, glycopeptides_except_lipo, lincosamides, lipoglycopeptides, macrolides, oxazolidinones, penicillins, polymyxins, streptogramins, tetracyclines, tetracyclines_except_tgc and ureidopenicillins.

+

Experimental Lifecycle

+ + + +


+The lifecycle of this function is experimental. An experimental function is in early stages of development. The unlying code might be changing frequently. Experimental functions might be removed without deprecation, so you are generally best off waiting until a function is more mature before you use it in production code. Experimental functions are only available in development versions of this AMR package and will thus not be included in releases that are submitted to CRAN, since such functions have not yet matured enough.

+ +

Examples

+ 
x <- custom_eucast_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
+                         AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I")
+eucast_rules(example_isolates,
+             rules = "custom",
+             custom_rules = x,
+             info = FALSE)
+             
+# combine rule sets
+x2 <- c(x,
+        custom_eucast_rules(TZP == "R" ~ carbapenems == "R"))
+x2
+
+
+ +
+ + + +
+ + + + + + + + diff --git a/docs/reference/eucast_rules.html b/docs/reference/eucast_rules.html index a14a50f7..81533b2a 100644 --- a/docs/reference/eucast_rules.html +++ b/docs/reference/eucast_rules.html @@ -83,7 +83,7 @@ To improve the interpretation of the antibiogram before EUCAST rules are applied AMR (for R) - 1.6.0 + 1.6.0.9000 @@ -254,6 +254,7 @@ To improve the interpretation of the antibiogram before EUCAST rules are applied version_expertrules = 3.2, ampc_cephalosporin_resistance = NA, only_rsi_columns = FALSE, + custom_rules = NULL, ... ) @@ -276,7 +277,7 @@ To improve the interpretation of the antibiogram before EUCAST rules are applied rules -

a character vector that specifies which rules should be applied. Must be one or more of "breakpoints", "expert", "other", "all", and defaults to c("breakpoints", "expert"). The default value can be set to another value, e.g. using options(AMR_eucastrules = "all").

+

a character vector that specifies which rules should be applied. Must be one or more of "breakpoints", "expert", "other", "custom", "all", and defaults to c("breakpoints", "expert"). The default value can be set to another value, e.g. using options(AMR_eucastrules = "all"). If using "custom", be sure to fill in argument custom_rules too. Custom rules can be created with custom_eucast_rules().

verbose @@ -298,6 +299,10 @@ To improve the interpretation of the antibiogram before EUCAST rules are applied only_rsi_columns

a logical to indicate whether only antibiotic columns must be detected that were transformed to class <rsi> (see as.rsi()) on beforehand (defaults to FALSE)

+ + custom_rules +

custom rules to apply, created with custom_eucast_rules()

+ ...

column name of an antibiotic, see section Antibiotics below

@@ -332,7 +337,17 @@ Leclercq et al. EUCAST expert rules in antimicrobial susceptibility test

Note: This function does not translate MIC values to RSI values. Use as.rsi() for that.
Note: When ampicillin (AMP, J01CA01) is not available but amoxicillin (AMX, J01CA04) is, the latter will be used for all rules where there is a dependency on ampicillin. These drugs are interchangeable when it comes to expression of antimicrobial resistance.

-

The file containing all EUCAST rules is located here: https://github.com/msberends/AMR/blob/master/data-raw/eucast_rules.tsv.

'Other' Rules

+

The file containing all EUCAST rules is located here: https://github.com/msberends/AMR/blob/master/data-raw/eucast_rules.tsv.

Custom Rules

+ + +

Custom rules can be created using custom_eucast_rules(), e.g.:

x <- custom_eucast_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
+                         AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I")
+
+eucast_rules(example_isolates, rules = "custom", custom_rules = x)
+
+ + +

'Other' Rules

Before further processing, two non-EUCAST rules about drug combinations can be applied to improve the efficacy of the EUCAST rules, and the reliability of your data (analysis). These rules are:

    diff --git a/docs/reference/ggplot_pca.html b/docs/reference/ggplot_pca.html index bc333ca5..cc917ff0 100644 --- a/docs/reference/ggplot_pca.html +++ b/docs/reference/ggplot_pca.html @@ -82,7 +82,7 @@ AMR (for R) - 1.6.0 + 1.6.0.9000 diff --git a/docs/reference/index.html b/docs/reference/index.html index 35cdd7b0..139f65e3 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0 + 1.6.0.9000 @@ -450,6 +450,12 @@

    eucast_rules() eucast_dosage()

    Apply EUCAST Rules

    + + + +

    custom_eucast_rules()

    + +

    Create Custom EUCAST Rules

    @@ -595,7 +601,7 @@

    like() `%like%` `%like_case%`

    -

    Pattern Matching with Keyboard Shortcut

    +

    Vectorised Pattern Matching with Keyboard Shortcut

    diff --git a/docs/reference/like.html b/docs/reference/like.html index eabe55d5..38df8be5 100644 --- a/docs/reference/like.html +++ b/docs/reference/like.html @@ -6,7 +6,7 @@ -Pattern Matching with Keyboard Shortcut — like • AMR (for R) +Vectorised Pattern Matching with Keyboard Shortcut — like • AMR (for R) @@ -48,7 +48,7 @@ - + @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9027 + 1.6.0.9000 @@ -233,7 +233,7 @@
    -

    Pattern Matching with Keyboard Shortcut

    +

    Vectorised Pattern Matching with Keyboard Shortcut

    Source: R/like.R
    @@ -267,17 +267,17 @@

    Source

    -

    Idea from the like function from the data.table package

    +

    Idea from the like function from the data.table package

    Value

    -

    A logical vector

    +

    A logical vector

    Details

    The %like% function:

    • Is case-insensitive (use %like_case% for case-sensitive matching)

    • Supports multiple patterns

    • Checks if pattern is a regular expression and sets fixed = TRUE if not, to greatly improve speed

      • -

    • Always uses compatibility with Perl

      • +

    • Always uses compatibility with Perl unless fixed = TRUE, to greatly improve speed

    Using RStudio? The text %like% can also be directly inserted in your code from the Addins menu and can have its own Keyboard Shortcut like Ctrl+Shift+L or Cmd+Shift+L (see Tools > Modify Keyboard Shortcuts...).

    @@ -320,7 +320,7 @@ The lifecycle of this function is stable# \donttest{ if (require("dplyr")) { example_isolates %>% - filter(mo_name(mo) %like% "^ent") + filter(mo_name() %like% "^ent") } # } diff --git a/docs/reference/mdro.html b/docs/reference/mdro.html index b76eab58..5a2c60b9 100644 --- a/docs/reference/mdro.html +++ b/docs/reference/mdro.html @@ -82,7 +82,7 @@ AMR (for R) - 1.6.0 + 1.6.0.9000
    @@ -374,10 +374,19 @@ Ordered factor with levels #> Unmatched rows will return NA. -

    The outcome of the function can be used for the guideline argument in the mdro() function:

    x <- mdro(example_isolates, guideline = custom)
+
    The outcome of the function can be used for the guideline argument in the mdro() function:
    x <- mdro(example_isolates,
+          guideline = custom)
 table(x)
-#> Elderly Type A Elderly Type B       Negative 
-#>             43            891           1066 
+#>       Negative Elderly Type A Elderly Type B
+#>           1070            198            732
+
    
+
+
    Rules can also be combined with other custom rules by using c():
    x <- mdro(example_isolates,
+          guideline = c(custom, 
+                        custom_mdro_guideline(ERY == "R" & age > 50 ~ "Elderly Type C")))
+table(x)
+#>       Negative Elderly Type A Elderly Type B Elderly Type C 
+#>            961            198            732            109
 
    
 
 
    The rules set (the custom object in this case) could be exported to a shared file location using saveRDS() if you collaborate with multiple users. The custom rules set could then be imported using readRDS().
    
diff --git a/docs/reference/plot.html b/docs/reference/plot.html
index b1060767..0985d8d3 100644
--- a/docs/reference/plot.html
+++ b/docs/reference/plot.html
@@ -82,7 +82,7 @@
       
       
         AMR (for R)
-        1.5.0.9031
+        1.6.0.9000
    @@ -321,6 +321,7 @@ xlab = "Antimicrobial Interpretation", ylab = "Frequency", colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"), + language = get_locale(), ... ) @@ -407,7 +408,7 @@ The lifecycle of this function is stableplot(some_mic_values, mo = "S. aureus", ab = "ampicillin") plot(some_disk_values, mo = "Escherichia coli", ab = "cipro") -if (require("ggplot2")) { +if (require("ggplot2")) { ggplot(some_mic_values) ggplot(some_disk_values, mo = "Escherichia coli", ab = "cipro") ggplot(some_rsi_values) diff --git a/docs/sitemap.xml b/docs/sitemap.xml index e2a0039f..f0c0e8de 100644 --- a/docs/sitemap.xml +++ b/docs/sitemap.xml @@ -66,6 +66,9 @@ https://msberends.github.io/AMR//reference/count.html + + https://msberends.github.io/AMR//reference/custom_eucast_rules.html + https://msberends.github.io/AMR//reference/dosage.html diff --git a/docs/survey.html b/docs/survey.html index 29b47f81..e83a7dcb 100644 --- a/docs/survey.html +++ b/docs/survey.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0 + 1.6.0.9000 diff --git a/index.md b/index.md index bc25b4b8..e783a4eb 100644 --- a/index.md +++ b/index.md @@ -1,6 +1,6 @@ # `AMR` (for R) -*Note: the rules of 'EUCAST Clinical Breakpoints v11.0 (2021)' are now implemented* +*Note: the rules of 'EUCAST Clinical Breakpoints v11.0 (2021)' are now implemented.* > **PLEASE TAKE PART IN OUR SURVEY!** > Since you are one of our users, we would like to know how you use the package and what it brought you or your organisation. **If you have a minute, please [anonymously fill in this short questionnaire](./survey.html)**. Your valuable input will help to improve the package and its functionalities. You can answer the open questions in either English, Spanish, French, Dutch, or German. Thank you very much in advance! diff --git a/man/custom_eucast_rules.Rd b/man/custom_eucast_rules.Rd new file mode 100644 index 00000000..9fed0904 --- /dev/null +++ b/man/custom_eucast_rules.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/custom_eucast_rules.R +\name{custom_eucast_rules} +\alias{custom_eucast_rules} +\title{Create Custom EUCAST Rules} +\usage{ +custom_eucast_rules(...) +} +\arguments{ +\item{...}{rules in formula notation, see \emph{Examples}} +} +\description{ +Create Custom EUCAST Rules +} +\details{ +This documentation page will be updated shortly. \strong{This function is experimental.} +} +\section{How it works}{ + +.. + +It is also possible to define antibiotic groups instead of single antibiotics. The following groups are allowed (case-insensitive): \code{aminoglycosides}, \code{aminopenicillins}, \code{betalactams}, \code{carbapenems}, \code{cephalosporins}, \code{cephalosporins_1st}, \code{cephalosporins_2nd}, \code{cephalosporins_3rd}, \code{cephalosporins_except_caz}, \code{fluoroquinolones}, \code{glycopeptides}, \code{glycopeptides_except_lipo}, \code{lincosamides}, \code{lipoglycopeptides}, \code{macrolides}, \code{oxazolidinones}, \code{penicillins}, \code{polymyxins}, \code{streptogramins}, \code{tetracyclines}, \code{tetracyclines_except_tgc} and \code{ureidopenicillins}. +} + +\section{Experimental Lifecycle}{ + +\if{html}{\figure{lifecycle_experimental.svg}{options: style=margin-bottom:5px} \cr} +The \link[=lifecycle]{lifecycle} of this function is \strong{experimental}. An experimental function is in early stages of development. The unlying code might be changing frequently. Experimental functions might be removed without deprecation, so you are generally best off waiting until a function is more mature before you use it in production code. Experimental functions are only available in development versions of this \code{AMR} package and will thus not be included in releases that are submitted to CRAN, since such functions have not yet matured enough. +} + +\examples{ +x <- custom_eucast_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R", + AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I") +eucast_rules(example_isolates, + rules = "custom", + custom_rules = x, + info = FALSE) + +# combine rule sets +x2 <- c(x, + custom_eucast_rules(TZP == "R" ~ carbapenems == "R")) +x2 +} diff --git a/man/eucast_rules.Rd b/man/eucast_rules.Rd index 29c6c743..412a9877 100644 --- a/man/eucast_rules.Rd +++ b/man/eucast_rules.Rd @@ -27,6 +27,7 @@ eucast_rules( version_expertrules = 3.2, ampc_cephalosporin_resistance = NA, only_rsi_columns = FALSE, + custom_rules = NULL, ... ) @@ -39,7 +40,7 @@ eucast_dosage(ab, administration = "iv", version_breakpoints = 11) \item{info}{a logical to indicate whether progress should be printed to the console, defaults to only print while in interactive sessions} -\item{rules}{a character vector that specifies which rules should be applied. Must be one or more of \code{"breakpoints"}, \code{"expert"}, \code{"other"}, \code{"all"}, and defaults to \code{c("breakpoints", "expert")}. The default value can be set to another value, e.g. using \code{options(AMR_eucastrules = "all")}.} +\item{rules}{a character vector that specifies which rules should be applied. Must be one or more of \code{"breakpoints"}, \code{"expert"}, \code{"other"}, \code{"custom"}, \code{"all"}, and defaults to \code{c("breakpoints", "expert")}. The default value can be set to another value, e.g. using \code{options(AMR_eucastrules = "all")}. If using \code{"custom"}, be sure to fill in argument \code{custom_rules} too. Custom rules can be created with \code{\link[=custom_eucast_rules]{custom_eucast_rules()}}.} \item{verbose}{a \link{logical} to turn Verbose mode on and off (default is off). In Verbose mode, the function does not apply rules to the data, but instead returns a data set in logbook form with extensive info about which rows and columns would be effected and in which way. Using Verbose mode takes a lot more time.} @@ -51,6 +52,8 @@ eucast_dosage(ab, administration = "iv", version_breakpoints = 11) \item{only_rsi_columns}{a logical to indicate whether only antibiotic columns must be detected that were transformed to class \verb{} (see \code{\link[=as.rsi]{as.rsi()}}) on beforehand (defaults to \code{FALSE})} +\item{custom_rules}{custom rules to apply, created with \code{\link[=custom_eucast_rules]{custom_eucast_rules()}}} + \item{...}{column name of an antibiotic, see section \emph{Antibiotics} below} \item{ab}{any (vector of) text that can be coerced to a valid antibiotic code with \code{\link[=as.ab]{as.ab()}}} @@ -70,6 +73,15 @@ To improve the interpretation of the antibiogram before EUCAST rules are applied \strong{Note:} When ampicillin (AMP, J01CA01) is not available but amoxicillin (AMX, J01CA04) is, the latter will be used for all rules where there is a dependency on ampicillin. These drugs are interchangeable when it comes to expression of antimicrobial resistance. The file containing all EUCAST rules is located here: \url{https://github.com/msberends/AMR/blob/master/data-raw/eucast_rules.tsv}. +\subsection{Custom Rules}{ + +Custom rules can be created using \code{\link[=custom_eucast_rules]{custom_eucast_rules()}}, e.g.:\preformatted{x <- custom_eucast_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R", + AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I") + +eucast_rules(example_isolates, rules = "custom", custom_rules = x) +} +} + \subsection{'Other' Rules}{ Before further processing, two non-EUCAST rules about drug combinations can be applied to improve the efficacy of the EUCAST rules, and the reliability of your data (analysis). These rules are: diff --git a/man/like.Rd b/man/like.Rd index e752f060..a07fa9cd 100755 --- a/man/like.Rd +++ b/man/like.Rd @@ -4,9 +4,9 @@ \alias{like} \alias{\%like\%} \alias{\%like_case\%} -\title{Pattern Matching with Keyboard Shortcut} +\title{Vectorised Pattern Matching with Keyboard Shortcut} \source{ -Idea from the \href{https://github.com/Rdatatable/data.table/blob/master/R/like.R}{\code{like} function from the \code{data.table} package} +Idea from the \href{https://github.com/Rdatatable/data.table/blob/ec1259af1bf13fc0c96a1d3f9e84d55d8106a9a4/R/like.R}{\code{like} function from the \code{data.table} package} } \usage{ like(x, pattern, ignore.case = TRUE) @@ -23,7 +23,7 @@ x \%like_case\% pattern \item{ignore.case}{if \code{FALSE}, the pattern matching is \emph{case sensitive} and if \code{TRUE}, case is ignored during matching.} } \value{ -A \code{\link{logical}} vector +A \link{logical} vector } \description{ Convenient wrapper around \code{\link[=grepl]{grepl()}} to match a pattern: \code{x \%like\% pattern}. It always returns a \code{\link{logical}} vector and is always case-insensitive (use \code{x \%like_case\% pattern} for case-sensitive matching). Also, \code{pattern} can be as long as \code{x} to compare items of each index in both vectors, or they both can have the same length to iterate over all cases. @@ -34,7 +34,7 @@ The \verb{\%like\%} function: \item Is case-insensitive (use \verb{\%like_case\%} for case-sensitive matching) \item Supports multiple patterns \item Checks if \code{pattern} is a regular expression and sets \code{fixed = TRUE} if not, to greatly improve speed -\item Always uses compatibility with Perl +\item Always uses compatibility with Perl unless \code{fixed = TRUE}, to greatly improve speed } Using RStudio? The text \verb{\%like\%} can also be directly inserted in your code from the Addins menu and can have its own Keyboard Shortcut like \code{Ctrl+Shift+L} or \code{Cmd+Shift+L} (see \code{Tools} > \verb{Modify Keyboard Shortcuts...}). @@ -75,7 +75,7 @@ a \%like\% b[1] \donttest{ if (require("dplyr")) { example_isolates \%>\% - filter(mo_name(mo) \%like\% "^ent") + filter(mo_name() \%like\% "^ent") } } } diff --git a/man/mdro.Rd b/man/mdro.Rd index 3139cca7..a2687610 100644 --- a/man/mdro.Rd +++ b/man/mdro.Rd @@ -134,10 +134,19 @@ You can print the rules set in the console for an overview. Colours will help re #> Unmatched rows will return NA. } -The outcome of the function can be used for the \code{guideline} argument in the \code{\link[=mdro]{mdro()}} function:\preformatted{x <- mdro(example_isolates, guideline = custom) +The outcome of the function can be used for the \code{guideline} argument in the \code{\link[=mdro]{mdro()}} function:\preformatted{x <- mdro(example_isolates, + guideline = custom) table(x) -#> Elderly Type A Elderly Type B Negative -#> 43 891 1066 +#> Negative Elderly Type A Elderly Type B +#> 1070 198 732 +} + +Rules can also be combined with other custom rules by using \code{\link[=c]{c()}}:\preformatted{x <- mdro(example_isolates, + guideline = c(custom, + custom_mdro_guideline(ERY == "R" & age > 50 ~ "Elderly Type C"))) +table(x) +#> Negative Elderly Type A Elderly Type B Elderly Type C +#> 961 198 732 109 } The rules set (the \code{custom} object in this case) could be exported to a shared file location using \code{\link[=saveRDS]{saveRDS()}} if you collaborate with multiple users. The custom rules set could then be imported using \code{\link[=readRDS]{readRDS()}}. diff --git a/man/plot.Rd b/man/plot.Rd index cb289011..2f6d608f 100644 --- a/man/plot.Rd +++ b/man/plot.Rd @@ -83,6 +83,7 @@ xlab = "Antimicrobial Interpretation", ylab = "Frequency", colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"), + language = get_locale(), ... ) } diff --git a/tests/testthat/test-eucast_rules.R b/tests/testthat/test-eucast_rules.R index 4c8a23d4..a3e54aa5 100755 --- a/tests/testthat/test-eucast_rules.R +++ b/tests/testthat/test-eucast_rules.R @@ -80,11 +80,10 @@ test_that("EUCAST rules work", { library(dplyr, warn.conflicts = FALSE) expect_equal(suppressWarnings( example_isolates %>% + filter(mo_family(mo) == "Enterobacteriaceae") %>% mutate(TIC = as.rsi("R"), PIP = as.rsi("S")) %>% eucast_rules(col_mo = "mo", version_expertrules = 3.1, info = FALSE) %>% - left_join_microorganisms(by = "mo") %>% - filter(family == "Enterobacteriaceae") %>% pull(PIP) %>% unique() %>% as.character()), @@ -145,3 +144,21 @@ test_that("EUCAST rules work", { expect_s3_class(eucast_dosage(c("tobra", "genta", "cipro")), "data.frame") }) + +test_that("Custom EUCAST rules work", { + + skip_on_cran() + x <- custom_eucast_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R", + AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I") + expect_output(print(x)) + expect_output(print(c(x, x))) + expect_output(print(as.list(x, x))) + + # this custom rules makes 8 changes + expect_equal(nrow(eucast_rules(example_isolates, + rules = "custom", + custom_rules = x, + info = FALSE, + verbose = TRUE)), + 8) +}) diff --git a/tests/testthat/test-kurtosis.R b/tests/testthat/test-kurtosis.R index 4d8e7654..e4f6848f 100644 --- a/tests/testthat/test-kurtosis.R +++ b/tests/testthat/test-kurtosis.R @@ -28,20 +28,20 @@ context("kurtosis.R") test_that("kurtosis works", { skip_on_cran() expect_equal(kurtosis(example_isolates$age), - 3.549319, + 5.227999, tolerance = 0.00001) expect_equal(unname(kurtosis(data.frame(example_isolates$age))), - 3.549319, + 5.227999, tolerance = 0.00001) expect_equal(unname(kurtosis(data.frame(example_isolates$age), excess = TRUE)), - 0.549319, + 2.227999, tolerance = 0.00001) expect_equal(kurtosis(matrix(example_isolates$age)), - 3.549319, + 5.227999, tolerance = 0.00001) expect_equal(kurtosis(matrix(example_isolates$age), excess = TRUE), - 0.549319, + 2.227999, tolerance = 0.00001) }) diff --git a/tests/testthat/test-mdro.R b/tests/testthat/test-mdro.R index 42bf6363..b5423e73 100755 --- a/tests/testthat/test-mdro.R +++ b/tests/testthat/test-mdro.R @@ -228,8 +228,11 @@ test_that("mdro works", { "ERY == 'R' & age > 60" ~ "Elderly Type B", as_factor = TRUE) expect_output(print(custom)) + expect_output(print(c(custom, custom))) + expect_output(print(as.list(custom, custom))) + expect_output(x <- mdro(example_isolates, guideline = custom, info = TRUE)) - expect_equal(as.double(table(x)), c(1066, 43, 891)) + expect_equal(as.double(table(x)), c(1070, 198, 732)) expect_output(print(custom_mdro_guideline(AMX == "R" ~ "test", as_factor = FALSE))) expect_error(custom_mdro_guideline()) diff --git a/tests/testthat/test-skewness.R b/tests/testthat/test-skewness.R index bbe7b47d..0de83335 100644 --- a/tests/testthat/test-skewness.R +++ b/tests/testthat/test-skewness.R @@ -28,12 +28,12 @@ context("skewness.R") test_that("skewness works", { skip_on_cran() expect_equal(skewness(example_isolates$age), - -0.8958019, + -1.212888, tolerance = 0.00001) expect_equal(unname(skewness(data.frame(example_isolates$age))), - -0.8958019, + -1.212888, tolerance = 0.00001) expect_equal(skewness(matrix(example_isolates$age)), - -0.8958019, + -1.212888, tolerance = 0.00001) })