diff --git a/DESCRIPTION b/DESCRIPTION index 01431cae2..cc9fc7618 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 1.5.0.9015 -Date: 2021-02-04 +Version: 1.5.0.9016 +Date: 2021-02-08 Title: Antimicrobial Resistance Data Analysis Authors@R: c( person(role = c("aut", "cre"), diff --git a/NAMESPACE b/NAMESPACE index aab403a56..504c8510c 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -143,6 +143,7 @@ export(filter_first_weighted_isolate) export(filter_fluoroquinolones) export(filter_glycopeptides) export(filter_macrolides) +export(filter_oxazolidinones) export(filter_penicillins) export(filter_tetracyclines) export(first_isolate) @@ -211,6 +212,7 @@ export(mo_url) export(mo_year) export(mrgn) export(n_rsi) +export(oxazolidinones) export(p_symbol) export(pca) export(penicillins) diff --git a/NEWS.md b/NEWS.md index a66aa7ee9..f78a10280 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,30 +1,26 @@ -# AMR 1.5.0.9015 -## Last updated: 4 February 2021 +# AMR 1.5.0.9016 +## Last updated: 8 February 2021 -### Breaking -* Functions that are applied to a data set containing antibiotic columns gained the argument `only_rsi_columns`, which defaults to `TRUE` if any of the columns are of class `` (i.e., transformed with `as.rsi()`). This increases reliability of automatic determination of antibiotic columns (so only columns that are defined to be `` will be affected). - - This change might invalidate existing code. But since the new argument always returns `FALSE` when no `` column can be found in the data, this chance is low. - - Affected functions are: +### 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. + * Added function `eucast_dosage()` to get a `data.frame` with advised dosages of a certain bug-drug combination, which is based on the new `dosage` data set + * Added data set `dosage` to fuel the new `eucast_dosage()` function and to make this data available in a structured way + * Existing data set `example_isolates` now reflects the latest EUCAST rules +* Added argument `only_rsi_columns` for some functions, which defaults to `FALSE`, to indicate if the functions must only be applied to columns that are of class `` (i.e., transformed with `as.rsi()`). This increases speed since automatic determination of antibiotic columns is not needed anymore. Affected functions are: * All antibiotic selector functions (`ab_class()` and its wrappers, such as `aminoglocysides()`, `carbapenems()`, `penicillins()`) * All antibiotic filter functions (`filter_ab_class()` and its wrappers, such as `filter_aminoglocysides()`, `filter_carbapenems()`, `filter_penicillins()`) * `eucast_rules()` * `mdro()` (including wrappers such as `brmo()`, `mrgn` and `eucast_exceptional_phenotypes()`) * `guess_ab_col()` - - You can quickly transform all your eligible columns using either: - +* Functions `oxazolidinones()` (an antibiotic selector function) and `filter_oxazolidinones()` (an antibiotic filter function) to select/filter on e.g. linezolid and tedizolid ```r library(dplyr) - your_date %>% mutate_if(is.rsi.eligible, as.rsi) # old dplyr - your_date %>% mutate(across((is.rsi.eligible), as.rsi)) # new dplyr - ``` - -### 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. -* Data set `dosage` to fuel the new `eucast_dosage()` function and to make this data available in a structured way -* Function `eucast_dosage()` to get a `data.frame` with advised dosages of a certain bug-drug combination, which is based on the new `dosage` data set + x <- example_isolates %>% select(date, hospital_id, oxazolidinones()) + #> Selecting oxazolidinones: column 'LNZ' (linezolid) + + x <- example_isolates %>% filter_oxazolidinones() + #> Filtering on oxazolidinones: value in column `LNZ` (linezolid) is either "R", "S" or "I" + ``` * Support for custom MDRO guidelines, using the new `custom_mdro_guideline()` function, please see `mdro()` for additional info * Function `isolate_identifier()`, which will paste a microorganism code with all antimicrobial results of a data set into one string for each row. This is useful to compare isolates, e.g. between institutions or regions, when there is no genotyping available. * Function `mo_is_yeast()`, which determines whether a microorganism is a member of the taxonomic class Saccharomycetes or the taxonomic order Saccharomycetales: diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index 9ad53dcd4..336c48727 100755 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -675,7 +675,18 @@ get_current_data <- function(arg_name, call) { # nothing worked, so: if (is.na(arg_name)) { - stop_("this function must be used inside valid dplyr selection verbs or inside a data.frame call", + if (isTRUE(is.numeric(call))) { + fn <- as.character(sys.call(call + 1)[1]) + examples <- paste0(", e.g.:\n", + " your_data %>% select(", fn, "())\n", + " your_data %>% select(column_a, column_b, ", fn, "())\n", + " your_data[, ", fn, "()]\n", + ' your_data[, c("column_a", "column_b", ', fn, "())]") + } else { + examples <- "" + } + stop_("this function must be used inside valid dplyr selection verbs or inside a data.frame call", + examples, call = call) } else { stop_("argument `", arg_name, "` is missing with no default", call = call) @@ -721,6 +732,11 @@ get_current_column <- function() { } } +is_null_or_grouped_tbl <- function(x) { + # attribute "grouped_df" might change at one point, so only set in one place; here. + is.null(x) || inherits(x, "grouped_tbl") +} + unique_call_id <- function(entire_session = FALSE) { if (entire_session == TRUE) { c(envir = "session", diff --git a/R/ab_class_selectors.R b/R/ab_class_selectors.R index e82343dc9..53b1fe6bd 100644 --- a/R/ab_class_selectors.R +++ b/R/ab_class_selectors.R @@ -27,7 +27,7 @@ #' #' These functions help to select the columns of antibiotics that are of a specific antibiotic class, without the need to define the columns or antibiotic abbreviations. \strong{\Sexpr{ifelse(as.double(R.Version()$major) + (as.double(R.Version()$minor) / 10) < 3.2, paste0("NOTE: THESE FUNCTIONS DO NOT WORK ON YOUR CURRENT R VERSION. These functions require R version 3.2 or later - you have ", R.version.string, "."), "")}} #' @inheritSection lifecycle Stable Lifecycle -#' @param only_rsi_columns a logical to indicate whether only columns of class [``]([rsi]) must be selected. If set to `NULL` (default), it will be `TRUE` if any column of the data was [transformed to class ``]([rsi]) on beforehand, and `FALSE` otherwise. +#' @param only_rsi_columns a logical to indicate whether only columns of class [``]([rsi]) must be selected (defaults to `FALSE`) #' @inheritParams filter_ab_class #' @details \strong{\Sexpr{ifelse(as.double(R.Version()$major) + (as.double(R.Version()$minor) / 10) < 3.2, paste0("NOTE: THESE FUNCTIONS DO NOT WORK ON YOUR CURRENT R VERSION. These functions require R version 3.2 or later - you have ", R.version.string, "."), "")}} #' @@ -81,85 +81,91 @@ #' example_isolates %>% filter(across(carbapenems(), ~. == "R")) #' } ab_class <- function(ab_class, - only_rsi_columns = NULL) { + only_rsi_columns = FALSE) { ab_selector(ab_class, function_name = "ab_class", only_rsi_columns = only_rsi_columns) } #' @rdname antibiotic_class_selectors #' @export -aminoglycosides <- function(only_rsi_columns = NULL) { +aminoglycosides <- function(only_rsi_columns = FALSE) { ab_selector("aminoglycoside", function_name = "aminoglycosides", only_rsi_columns = only_rsi_columns) } #' @rdname antibiotic_class_selectors #' @export -carbapenems <- function(only_rsi_columns = NULL) { +carbapenems <- function(only_rsi_columns = FALSE) { ab_selector("carbapenem", function_name = "carbapenems", only_rsi_columns = only_rsi_columns) } #' @rdname antibiotic_class_selectors #' @export -cephalosporins <- function(only_rsi_columns = NULL) { +cephalosporins <- function(only_rsi_columns = FALSE) { ab_selector("cephalosporin", function_name = "cephalosporins", only_rsi_columns = only_rsi_columns) } #' @rdname antibiotic_class_selectors #' @export -cephalosporins_1st <- function(only_rsi_columns = NULL) { +cephalosporins_1st <- function(only_rsi_columns = FALSE) { ab_selector("cephalosporins.*1", function_name = "cephalosporins_1st", only_rsi_columns = only_rsi_columns) } #' @rdname antibiotic_class_selectors #' @export -cephalosporins_2nd <- function(only_rsi_columns = NULL) { +cephalosporins_2nd <- function(only_rsi_columns = FALSE) { ab_selector("cephalosporins.*2", function_name = "cephalosporins_2nd", only_rsi_columns = only_rsi_columns) } #' @rdname antibiotic_class_selectors #' @export -cephalosporins_3rd <- function(only_rsi_columns = NULL) { +cephalosporins_3rd <- function(only_rsi_columns = FALSE) { ab_selector("cephalosporins.*3", function_name = "cephalosporins_3rd", only_rsi_columns = only_rsi_columns) } #' @rdname antibiotic_class_selectors #' @export -cephalosporins_4th <- function(only_rsi_columns = NULL) { +cephalosporins_4th <- function(only_rsi_columns = FALSE) { ab_selector("cephalosporins.*4", function_name = "cephalosporins_4th", only_rsi_columns = only_rsi_columns) } #' @rdname antibiotic_class_selectors #' @export -cephalosporins_5th <- function(only_rsi_columns = NULL) { +cephalosporins_5th <- function(only_rsi_columns = FALSE) { ab_selector("cephalosporins.*5", function_name = "cephalosporins_5th", only_rsi_columns = only_rsi_columns) } #' @rdname antibiotic_class_selectors #' @export -fluoroquinolones <- function(only_rsi_columns = NULL) { +fluoroquinolones <- function(only_rsi_columns = FALSE) { ab_selector("fluoroquinolone", function_name = "fluoroquinolones", only_rsi_columns = only_rsi_columns) } #' @rdname antibiotic_class_selectors #' @export -glycopeptides <- function(only_rsi_columns = NULL) { +glycopeptides <- function(only_rsi_columns = FALSE) { ab_selector("glycopeptide", function_name = "glycopeptides", only_rsi_columns = only_rsi_columns) } #' @rdname antibiotic_class_selectors #' @export -macrolides <- function(only_rsi_columns = NULL) { +macrolides <- function(only_rsi_columns = FALSE) { ab_selector("macrolide", function_name = "macrolides", only_rsi_columns = only_rsi_columns) } #' @rdname antibiotic_class_selectors #' @export -penicillins <- function(only_rsi_columns = NULL) { +oxazolidinones <- function(only_rsi_columns = FALSE) { + ab_selector("oxazolidinone", function_name = "oxazolidinones", only_rsi_columns = only_rsi_columns) +} + +#' @rdname antibiotic_class_selectors +#' @export +penicillins <- function(only_rsi_columns = FALSE) { ab_selector("penicillin", function_name = "penicillins", only_rsi_columns = only_rsi_columns) } #' @rdname antibiotic_class_selectors #' @export -tetracyclines <- function(only_rsi_columns = NULL) { +tetracyclines <- function(only_rsi_columns = FALSE) { ab_selector("tetracycline", function_name = "tetracyclines", only_rsi_columns = only_rsi_columns) } @@ -168,7 +174,7 @@ ab_selector <- function(ab_class, only_rsi_columns) { meet_criteria(ab_class, allow_class = "character", has_length = 1, .call_depth = 1) meet_criteria(function_name, allow_class = "character", has_length = 1, .call_depth = 1) - meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1, allow_NULL = TRUE, .call_depth = 1) + meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1, .call_depth = 1) if (as.double(R.Version()$major) + (as.double(R.Version()$minor) / 10) < 3.2) { warning_("antibiotic class selectors such as ", function_name, @@ -178,9 +184,7 @@ ab_selector <- function(ab_class, } vars_df <- get_current_data(arg_name = NA, call = -3) - if (is.null(only_rsi_columns)) { - only_rsi_columns <- any(is.rsi(vars_df)) - } + # improve speed here so it will only run once when e.g. in one select call if (!identical(pkg_env$ab_selector, unique_call_id())) { ab_in_data <- get_column_abx(vars_df, info = FALSE, only_rsi_columns = only_rsi_columns) @@ -212,14 +216,16 @@ ab_selector <- function(ab_class, if (length(agents) == 0) { message_("No antimicrobial agents of class ", ab_group, " found", examples, ".") } else { - agents_formatted <- paste0("column '", font_bold(agents, collapse = NULL), "'") + agents_formatted <- paste0("'", font_bold(agents, collapse = NULL), "'") agents_names <- ab_name(names(agents), tolower = TRUE, language = NULL) need_name <- tolower(gsub("[^a-zA-Z]", "", agents)) != tolower(gsub("[^a-zA-Z]", "", agents_names)) agents_formatted[need_name] <- paste0(agents_formatted[need_name], " (", agents_names[need_name], ")") - message_("Selecting ", ab_group, ": ", vector_and(agents_formatted, quotes = FALSE), + message_("Selecting ", ab_group, ": ", + ifelse(length(agents) == 1, "column ", "columns "), + vector_and(agents_formatted, quotes = FALSE), as_note = FALSE, - extra_indent = 4) + extra_indent = 6) } remember_thrown_message(function_name) } diff --git a/R/ab_property.R b/R/ab_property.R index 5c201adf7..5fce38605 100644 --- a/R/ab_property.R +++ b/R/ab_property.R @@ -35,7 +35,7 @@ #' @param units a logical to indicate whether the units instead of the DDDs itself must be returned, see *Examples* #' @param open browse the URL using [utils::browseURL()] #' @param ... other arguments passed on to [as.ab()] -#' @details All output will be [translate]d where possible. +#' @details All output [will be translated][translate] where possible. #' #' The function [ab_url()] will return the direct URL to the official WHO website. A warning will be returned if the required ATC code is not available. #' @inheritSection as.ab Source diff --git a/R/eucast_rules.R b/R/eucast_rules.R index 3660d3c35..89f38ba5d 100755 --- a/R/eucast_rules.R +++ b/R/eucast_rules.R @@ -78,7 +78,7 @@ format_eucast_version_nr <- function(version, markdown = TRUE) { #' @param ... column name of an antibiotic, see section *Antibiotics* below #' @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 ``]([rsi]) on beforehand. Defaults to `TRUE` if any column of `x` is of class ``. +#' @param only_rsi_columns a logical to indicate whether only antibiotic columns must be detected that were [transformed to class ``]([rsi]) on beforehand (defaults to `FALSE`) #' @inheritParams first_isolate #' @details #' **Note:** This function does not translate MIC values to RSI values. Use [as.rsi()] for that. \cr @@ -167,7 +167,7 @@ eucast_rules <- function(x, version_breakpoints = 11.0, version_expertrules = 3.2, ampc_cephalosporin_resistance = NA, - only_rsi_columns = any(is.rsi(x)), + only_rsi_columns = FALSE, ...) { meet_criteria(x, allow_class = "data.frame") meet_criteria(col_mo, allow_class = "character", has_length = 1, is_in = colnames(x), allow_NULL = TRUE) @@ -282,17 +282,7 @@ eucast_rules <- function(x, info = info, only_rsi_columns = only_rsi_columns, ...) - - - if (only_rsi_columns == TRUE && !paste0(sys.calls()[1], collapse = "") %like% "only_rsi_columns") { - cols_rsi_eligible <- colnames(x[, is.rsi.eligible(x), drop = FALSE]) - if (length(cols_rsi_eligible) > 0) { - message_("These columns might be eligible for EUCAST rules, but are ignored since `only_rsi_columns` is `TRUE`: ", - vector_and(cols_rsi_eligible, quotes = TRUE, sort = FALSE), - as_note = TRUE, add_fn = font_red) - } - } - + AMC <- cols_ab["AMC"] AMK <- cols_ab["AMK"] AMP <- cols_ab["AMP"] @@ -850,7 +840,7 @@ eucast_rules <- function(x, # is new rule within group, print its name cat(markup_italics_where_needed(word_wrap(rule_current, width = getOption("width") - 30, - extra_indent = 4))) + extra_indent = 6))) warned <- FALSE } } diff --git a/R/filter_ab_class.R b/R/filter_ab_class.R index c9fb2db46..e716bf2ff 100644 --- a/R/filter_ab_class.R +++ b/R/filter_ab_class.R @@ -31,7 +31,7 @@ #' @param ab_class an antimicrobial class, like `"carbapenems"`. The columns `group`, `atc_group1` and `atc_group2` of the [antibiotics] data set will be searched (case-insensitive) for this value. #' @param result an antibiotic result: S, I or R (or a combination of more of them) #' @param scope the scope to check which variables to check, can be `"any"` (default) or `"all"` -#' @param only_rsi_columns a logical to indicate whether only columns must be included that were [transformed to class ``]([rsi]) on beforehand. Defaults to `TRUE` if any column of `x` is of class ``. +#' @param only_rsi_columns a logical to indicate whether only columns must be included that were [transformed to class ``]([rsi]) on beforehand (defaults to `FALSE`) #' @param ... arguments passed on to [filter_ab_class()] #' @details All columns of `x` will be searched for known antibiotic names, abbreviations, brand names and codes (ATC, EARS-Net, WHO, etc.). This means that a filter function like e.g. [filter_aminoglycosides()] will include column names like 'gen', 'genta', 'J01GB03', 'tobra', 'Tobracin', etc. #' @rdname filter_ab_class @@ -82,7 +82,7 @@ filter_ab_class <- function(x, ab_class, result = NULL, scope = "any", - only_rsi_columns = any(is.rsi(x)), + only_rsi_columns = FALSE, ...) { .call_depth <- list(...)$`.call_depth` if (is.null(.call_depth)) { @@ -92,6 +92,7 @@ filter_ab_class <- function(x, meet_criteria(ab_class, allow_class = "character", has_length = 1, .call_depth = .call_depth) meet_criteria(result, allow_class = "character", has_length = c(1, 2, 3), allow_NULL = TRUE, .call_depth = .call_depth) meet_criteria(scope, allow_class = "character", has_length = 1, is_in = c("all", "any"), .call_depth = .call_depth) + meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1, .call_depth = .call_depth) check_dataset_integrity() @@ -110,7 +111,7 @@ filter_ab_class <- function(x, stop_ifnot(all(scope %in% c("any", "all")), "`scope` must be one of: 'any', 'all'") # get all columns in data with names that resemble antibiotics - ab_in_data <- get_column_abx(x, info = FALSE) + ab_in_data <- get_column_abx(x, info = FALSE, only_rsi_columns = only_rsi_columns) if (length(ab_in_data) == 0) { message_("No columns with class found (see ?as.rsi), data left unchanged.") return(x.bak) @@ -132,17 +133,14 @@ filter_ab_class <- function(x, # get the columns with a group names in the chosen ab class agents <- ab_in_data[names(ab_in_data) %in% ab_reference$ab] if (length(agents) == 0) { - message_("no antimicrobial agents of class ", ab_group, + message_("No antimicrobial agents of class ", ab_group, " found (such as ", find_ab_names(ab_class, 2), - "), data left unchanged.") + ")", + ifelse(only_rsi_columns == TRUE, " with class ,", ","), + " data left unchanged.") return(x.bak) } - if (length(result) == 1) { - operator <- " is " - } else { - operator <- " is one of " - } if (scope == "any") { scope_txt <- " or " scope_fn <- any @@ -154,9 +152,14 @@ filter_ab_class <- function(x, } } if (length(agents) > 1) { - scope <- paste(scope, "of columns ") + operator <- " are" + scope <- paste("values in", scope, "of columns ") } else { - scope <- "column " + operator <- " is" + scope <- "value in column " + } + if (length(result) > 1) { + operator <- paste(operator, "either") } # sort columns on official name @@ -166,7 +169,9 @@ filter_ab_class <- function(x, paste(paste0("`", font_bold(agents, collapse = NULL), "` (", ab_name(names(agents), tolower = TRUE, language = NULL), ")"), collapse = scope_txt), - operator, toString(result), as_note = FALSE) + operator, " ", vector_or(result, quotes = TRUE), + as_note = FALSE, + extra_indent = 6) x_transposed <- as.list(as.data.frame(t(x[, agents, drop = FALSE]), stringsAsFactors = FALSE)) filtered <- vapply(FUN.VALUE = logical(1), x_transposed, function(y) scope_fn(y %in% result, na.rm = TRUE)) x <- x[which(filtered), , drop = FALSE] @@ -179,11 +184,13 @@ filter_ab_class <- function(x, filter_aminoglycosides <- function(x, result = NULL, scope = "any", + only_rsi_columns = FALSE, ...) { filter_ab_class(x = x, ab_class = "aminoglycoside", result = result, scope = scope, + only_rsi_columns = only_rsi_columns, .call_depth = 1, ...) } @@ -193,11 +200,13 @@ filter_aminoglycosides <- function(x, filter_carbapenems <- function(x, result = NULL, scope = "any", + only_rsi_columns = FALSE, ...) { filter_ab_class(x = x, ab_class = "carbapenem", result = result, scope = scope, + only_rsi_columns = only_rsi_columns, .call_depth = 1, ...) } @@ -207,11 +216,13 @@ filter_carbapenems <- function(x, filter_cephalosporins <- function(x, result = NULL, scope = "any", + only_rsi_columns = FALSE, ...) { filter_ab_class(x = x, ab_class = "cephalosporin", result = result, scope = scope, + only_rsi_columns = only_rsi_columns, .call_depth = 1, ...) } @@ -221,11 +232,13 @@ filter_cephalosporins <- function(x, filter_1st_cephalosporins <- function(x, result = NULL, scope = "any", + only_rsi_columns = FALSE, ...) { filter_ab_class(x = x, ab_class = "cephalosporins (1st gen.)", result = result, scope = scope, + only_rsi_columns = only_rsi_columns, .call_depth = 1, ...) } @@ -235,11 +248,13 @@ filter_1st_cephalosporins <- function(x, filter_2nd_cephalosporins <- function(x, result = NULL, scope = "any", + only_rsi_columns = FALSE, ...) { filter_ab_class(x = x, ab_class = "cephalosporins (2nd gen.)", result = result, scope = scope, + only_rsi_columns = only_rsi_columns, .call_depth = 1, ...) } @@ -249,11 +264,13 @@ filter_2nd_cephalosporins <- function(x, filter_3rd_cephalosporins <- function(x, result = NULL, scope = "any", + only_rsi_columns = FALSE, ...) { filter_ab_class(x = x, ab_class = "cephalosporins (3rd gen.)", result = result, scope = scope, + only_rsi_columns = only_rsi_columns, .call_depth = 1, ...) } @@ -263,11 +280,13 @@ filter_3rd_cephalosporins <- function(x, filter_4th_cephalosporins <- function(x, result = NULL, scope = "any", + only_rsi_columns = FALSE, ...) { filter_ab_class(x = x, ab_class = "cephalosporins (4th gen.)", result = result, scope = scope, + only_rsi_columns = only_rsi_columns, .call_depth = 1, ...) } @@ -277,11 +296,13 @@ filter_4th_cephalosporins <- function(x, filter_5th_cephalosporins <- function(x, result = NULL, scope = "any", + only_rsi_columns = FALSE, ...) { filter_ab_class(x = x, ab_class = "cephalosporins (5th gen.)", result = result, scope = scope, + only_rsi_columns = only_rsi_columns, .call_depth = 1, ...) } @@ -291,11 +312,13 @@ filter_5th_cephalosporins <- function(x, filter_fluoroquinolones <- function(x, result = NULL, scope = "any", + only_rsi_columns = FALSE, ...) { filter_ab_class(x = x, ab_class = "fluoroquinolone", result = result, scope = scope, + only_rsi_columns = only_rsi_columns, .call_depth = 1, ...) } @@ -305,11 +328,13 @@ filter_fluoroquinolones <- function(x, filter_glycopeptides <- function(x, result = NULL, scope = "any", + only_rsi_columns = FALSE, ...) { filter_ab_class(x = x, ab_class = "glycopeptide", result = result, scope = scope, + only_rsi_columns = only_rsi_columns, .call_depth = 1, ...) } @@ -319,11 +344,29 @@ filter_glycopeptides <- function(x, filter_macrolides <- function(x, result = NULL, scope = "any", + only_rsi_columns = FALSE, ...) { filter_ab_class(x = x, ab_class = "macrolide", result = result, scope = scope, + only_rsi_columns = only_rsi_columns, + .call_depth = 1, + ...) +} + +#' @rdname filter_ab_class +#' @export +filter_oxazolidinones <- function(x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ...) { + filter_ab_class(x = x, + ab_class = "oxazolidinone", + result = result, + scope = scope, + only_rsi_columns = only_rsi_columns, .call_depth = 1, ...) } @@ -333,11 +376,13 @@ filter_macrolides <- function(x, filter_penicillins <- function(x, result = NULL, scope = "any", + only_rsi_columns = FALSE, ...) { filter_ab_class(x = x, ab_class = "penicillin", result = result, scope = scope, + only_rsi_columns = only_rsi_columns, .call_depth = 1, ...) } @@ -347,11 +392,13 @@ filter_penicillins <- function(x, filter_tetracyclines <- function(x, result = NULL, scope = "any", + only_rsi_columns = FALSE, ...) { filter_ab_class(x = x, ab_class = "tetracycline", result = result, scope = scope, + only_rsi_columns = only_rsi_columns, .call_depth = 1, ...) } @@ -364,6 +411,7 @@ find_ab_group <- function(ab_class) { "fluoroquinolone", "glycopeptide", "macrolide", + "oxazolidinone", "tetracycline"), paste0(ab_class, "s"), antibiotics %pm>% diff --git a/R/first_isolate.R b/R/first_isolate.R index d266e623d..995e9c173 100755 --- a/R/first_isolate.R +++ b/R/first_isolate.R @@ -27,7 +27,7 @@ #' #' Determine first (weighted) isolates of all microorganisms of every patient per episode and (if needed) per specimen type. To determine patient episodes not necessarily based on microorganisms, use [is_new_episode()] that also supports grouping with the `dplyr` package. #' @inheritSection lifecycle Stable Lifecycle -#' @param x a [data.frame] containing isolates. Can be left blank for automatic determination. +#' @param x a [data.frame] containing isolates. Can be left blank for automatic determination, see *Examples*. #' @param col_date column name of the result date (or date that is was received on the lab), defaults to the first column with a date class #' @param col_patient_id column name of the unique IDs of the patients, defaults to the first column that starts with 'patient' or 'patid' (case insensitive) #' @param col_mo column name of the IDs of the microorganisms (see [as.mo()]), defaults to the first column of class [`mo`]. Values will be coerced using [as.mo()]. @@ -86,7 +86,7 @@ #' #' 2. Using `type = "points"` and argument `points_threshold` #' -#' A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds `points_threshold`, which default to `2`, an isolate will be (re)selected as a first weighted isolate. +#' A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds `points_threshold`, which defaults to `2`, an isolate will be (re)selected as a first weighted isolate. #' @rdname first_isolate #' @seealso [key_antibiotics()] #' @export @@ -99,10 +99,12 @@ #' # `example_isolates` is a data set available in the AMR package. #' # See ?example_isolates. #' -#' # basic filtering on first isolates -#' example_isolates[first_isolate(), ] +#' example_isolates[first_isolate(example_isolates), ] #' #' \donttest{ +#' # faster way, only works in R 3.2 and later: +#' example_isolates[first_isolate(), ] +#' #' # get all first Gram-negatives #' example_isolates[which(first_isolate() & mo_is_gram_negative()), ] #' @@ -140,7 +142,7 @@ #' # when you (erroneously) would have used all isolates for analysis. #' } #' } -first_isolate <- function(x, +first_isolate <- function(x = NULL, col_date = NULL, col_patient_id = NULL, col_mo = NULL, @@ -158,10 +160,7 @@ first_isolate <- function(x, info = interactive(), include_unknown = FALSE, ...) { - if (missing(x)) { - x <- get_current_data(arg_name = "x", call = -2) - } - meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0 + meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE) # also checks dimensions to be >0 meet_criteria(col_date, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) meet_criteria(col_patient_id, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) @@ -185,6 +184,14 @@ first_isolate <- function(x, meet_criteria(info, allow_class = "logical", has_length = 1) meet_criteria(include_unknown, allow_class = "logical", has_length = 1) + if (is_null_or_grouped_tbl(x)) { + # when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all()) + # is also fix for using a grouped df as input (a dot as first argument) + x <- get_current_data(arg_name = "x", call = -2) + } + # remove data.table, grouping from tibbles, etc. + x <- as.data.frame(x, stringsAsFactors = FALSE) + dots <- unlist(list(...)) if (length(dots) != 0) { # backwards compatibility with old arguments @@ -197,18 +204,7 @@ first_isolate <- function(x, } } - # fix for using a grouped df as input (a dot as first argument) - # such as example_isolates %>% group_by(hospital_id) %>% mutate(first_isolate = first_isolate(.)) - if (inherits(x, "grouped_df")) { - # get_current_data() contains dplyr::cur_data_all() - x <- tryCatch(get_current_data(arg_name = "x", 0), - error = function(e) x) - } - - # remove data.table, grouping from tibbles, etc. - x <- as.data.frame(x, stringsAsFactors = FALSE) - - # try to find columns based on type + # try to find columns based on type # -- mo if (is.null(col_mo)) { col_mo <- search_type_in_df(x = x, type = "mo") @@ -510,15 +506,20 @@ first_isolate <- function(x, #' @rdname first_isolate #' @export -filter_first_isolate <- function(x, +filter_first_isolate <- function(x = NULL, col_date = NULL, col_patient_id = NULL, col_mo = NULL, ...) { - meet_criteria(x, allow_class = "data.frame") + meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE) meet_criteria(col_date, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) meet_criteria(col_patient_id, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) + if (is_null_or_grouped_tbl(x)) { + # when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all()) + # is also fix for using a grouped df as input (a dot as first argument) + x <- get_current_data(arg_name = "x", call = -2) + } subset(x, first_isolate(x = x, col_date = col_date, col_patient_id = col_patient_id, @@ -528,17 +529,22 @@ filter_first_isolate <- function(x, #' @rdname first_isolate #' @export -filter_first_weighted_isolate <- function(x, +filter_first_weighted_isolate <- function(x = NULL, col_date = NULL, col_patient_id = NULL, col_mo = NULL, col_keyantibiotics = NULL, ...) { - meet_criteria(x, allow_class = "data.frame") + meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE) meet_criteria(col_date, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) meet_criteria(col_patient_id, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) meet_criteria(col_keyantibiotics, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) + if (is_null_or_grouped_tbl(x)) { + # when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all()) + # is also fix for using a grouped df as input (a dot as first argument) + x <- get_current_data(arg_name = "x", call = -2) + } y <- x if (is.null(col_keyantibiotics)) { # first try to look for it diff --git a/R/guess_ab_col.R b/R/guess_ab_col.R index d995706b6..6d8fe47d1 100755 --- a/R/guess_ab_col.R +++ b/R/guess_ab_col.R @@ -30,7 +30,7 @@ #' @param x a [data.frame] #' @param search_string a text to search `x` for, will be checked with [as.ab()] if this value is not a column in `x` #' @param verbose a logical to indicate whether additional info should be printed -#' @param only_rsi_columns a logical to indicate whether only antibiotic columns must be detected that were [transformed to class ``]([rsi]) on beforehand. Defaults to `TRUE` if any column of `x` is of class ``. +#' @param only_rsi_columns a logical to indicate whether only antibiotic columns must be detected that were [transformed to class ``]([rsi]) on beforehand (defaults to `FALSE`) #' @details You can look for an antibiotic (trade) name or abbreviation and it will search `x` and the [antibiotics] data set for any column containing a name or code of that antibiotic. **Longer columns names take precedence over shorter column names.** #' @return A column name of `x`, or `NULL` when no result is found. #' @export @@ -63,7 +63,7 @@ #' AMP_ED20 = "S") #' guess_ab_col(df, "ampicillin") #' # [1] "AMP_ED20" -guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE, only_rsi_columns = any(is.rsi(x))) { +guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE, only_rsi_columns = FALSE) { meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE) meet_criteria(search_string, allow_class = "character", has_length = 1, allow_NULL = TRUE) meet_criteria(verbose, allow_class = "logical", has_length = 1) diff --git a/R/key_antibiotics.R b/R/key_antibiotics.R index ad8304d7c..686d59f35 100755 --- a/R/key_antibiotics.R +++ b/R/key_antibiotics.R @@ -108,7 +108,7 @@ #' sum(my_patients$first_weighted, na.rm = TRUE) #' } #' } -key_antibiotics <- function(x, +key_antibiotics <- function(x = NULL, col_mo = NULL, universal_1 = guess_ab_col(x, "amoxicillin"), universal_2 = guess_ab_col(x, "amoxicillin/clavulanic acid"), @@ -130,10 +130,7 @@ key_antibiotics <- function(x, GramNeg_6 = guess_ab_col(x, "meropenem"), warnings = TRUE, ...) { - if (missing(x)) { - x <- get_current_data(arg_name = "x", call = -2) - } - meet_criteria(x, allow_class = "data.frame") + meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE) meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) meet_criteria(universal_1, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) meet_criteria(universal_2, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) @@ -155,6 +152,14 @@ key_antibiotics <- function(x, meet_criteria(GramNeg_6, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) meet_criteria(warnings, allow_class = "logical", has_length = 1) + if (is_null_or_grouped_tbl(x)) { + # when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all()) + # is also fix for using a grouped df as input (a dot as first argument) + x <- get_current_data(arg_name = "x", call = -2) + } + # force regular data.frame, not a tibble or data.table + x <- as.data.frame(x, stringsAsFactors = FALSE) + dots <- unlist(list(...)) if (length(dots) != 0) { # backwards compatibility with old arguments @@ -249,7 +254,6 @@ key_antibiotics <- function(x, remember_thrown_message("key_antibiotics.gramneg") } - x <- as.data.frame(x, stringsAsFactors = FALSE) x[, col_mo] <- as.mo(x[, col_mo, drop = TRUE]) x$gramstain <- mo_gramstain(x[, col_mo, drop = TRUE], language = NULL) x$key_ab <- NA_character_ diff --git a/R/mdro.R b/R/mdro.R index 600e1411c..a5a9b3e55 100755 --- a/R/mdro.R +++ b/R/mdro.R @@ -146,19 +146,16 @@ #' MRGN = mrgn()) #' } #' } -mdro <- function(x, +mdro <- function(x = NULL, guideline = "CMI2012", col_mo = NULL, info = interactive(), pct_required_classes = 0.5, combine_SI = TRUE, verbose = FALSE, - only_rsi_columns = any(is.rsi(x)), + only_rsi_columns = FALSE, ...) { - if (missing(x)) { - x <- get_current_data(arg_name = "x", call = -2) - } - meet_criteria(x, allow_class = "data.frame") + meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE) meet_criteria(guideline, allow_class = c("list", "character"), allow_NULL = TRUE) if (!is.list(guideline)) { meet_criteria(guideline, allow_class = "character", has_length = 1, allow_NULL = TRUE) @@ -168,9 +165,18 @@ mdro <- function(x, meet_criteria(pct_required_classes, allow_class = "numeric", has_length = 1) meet_criteria(combine_SI, allow_class = "logical", has_length = 1) meet_criteria(verbose, allow_class = "logical", has_length = 1) + meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1) check_dataset_integrity() + info.bak <- info + if (message_not_thrown_before("mdro")) { + remember_thrown_message("mdro") + } else { + # don't thrown info's more than once per call + info <- FALSE + } + if (interactive() & verbose == TRUE & info == TRUE) { txt <- paste0("WARNING: In Verbose mode, the mdro() function does not return the MDRO results, but instead returns a data set in logbook form with extensive info about which isolates would be MDRO-positive, or why they are not.", "\n\nThis may overwrite your existing data if you use e.g.:", @@ -187,10 +193,37 @@ mdro <- function(x, } } + group_msg <- "" + if (info.bak == TRUE) { + # print group name if used in dplyr::group_by() + cur_group <- import_fn("cur_group", "dplyr", error_on_fail = FALSE) + if (!is.null(cur_group)) { + group_df <- tryCatch(cur_group(), error = function(e) data.frame()) + if (NCOL(group_df) > 0) { + # transform factors to characters + group <- vapply(FUN.VALUE = character(1), group_df, function(x) { + if (is.numeric(x)) { + format(x) + } else if (is.logical(x)) { + as.character(x) + } else { + paste0('"', x, '"') + } + }) + group_msg <- paste0("\nGroup: ", paste0(names(group), " = ", group, collapse = ", "), "\n") + } + } + } + + if (is_null_or_grouped_tbl(x)) { + # when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all()) + # is also fix for using a grouped df as input (a dot as first argument) + x <- get_current_data(arg_name = "x", call = -2) + } + # force regular data.frame, not a tibble or data.table x <- as.data.frame(x, stringsAsFactors = FALSE) - stop_ifnot(is.numeric(pct_required_classes), "`pct_required_classes` must be numeric") if (pct_required_classes > 1) { # allow pct_required_classes = 75 -> pct_required_classes = 0.75 pct_required_classes <- pct_required_classes / 100 @@ -215,7 +248,8 @@ mdro <- function(x, cat(txt, "\n", sep = "") } x <- run_custom_mdro_guideline(x, guideline) - if (info == TRUE) { + if (info.bak == TRUE) { + cat(group_msg) if (sum(!is.na(x$MDRO)) == 0) { cat(word_wrap(font_bold(paste0("=> Found 0 MDROs since no isolates are covered by the custom guideline")))) } else { @@ -496,16 +530,7 @@ mdro <- function(x, only_rsi_columns = only_rsi_columns, ...) } - - if (only_rsi_columns == TRUE) { - cols_rsi_eligible <- colnames(x[, is.rsi.eligible(x), drop = FALSE]) - if (length(cols_rsi_eligible) > 0) { - message_("These columns might be eligible for determining ", guideline$type, ", but are ignored since `only_rsi_columns` is `TRUE`: ", - vector_and(cols_rsi_eligible, quotes = TRUE, sort = FALSE), - as_note = TRUE, add_fn = font_red) - } - } - + # nolint start AMC <- cols_ab["AMC"] AMK <- cols_ab["AMK"] @@ -1341,7 +1366,8 @@ mdro <- function(x, x$reason <- "PDR/MDR/XDR criteria were met" } - if (info == TRUE) { + if (info.bak == TRUE) { + cat(group_msg) if (sum(!is.na(x$MDRO)) == 0) { cat(font_bold(paste0("=> Found 0 MDROs since no isolates are covered by the guideline"))) } else { @@ -1362,8 +1388,11 @@ mdro <- function(x, # Results ---- if (guideline$code == "cmi2012") { if (any(x$MDRO == -1, na.rm = TRUE)) { - warning_("NA introduced for isolates where the available percentage of antimicrobial classes was below ", - percentage(pct_required_classes), " (set with `pct_required_classes`)", call = FALSE) + if (message_not_thrown_before("mdro.availability")) { + warning_("NA introduced for isolates where the available percentage of antimicrobial classes was below ", + percentage(pct_required_classes), " (set with `pct_required_classes`)", call = FALSE) + remember_thrown_message("mdro.availability") + } # set these -1s to NA x[which(x$MDRO == -1), "MDRO"] <- NA_integer_ } @@ -1423,12 +1452,12 @@ custom_mdro_guideline <- function(..., as_factor = TRUE) { qry <- as.expression(qry) } qry <- as.character(qry) - # these will prevent vectorisaton, so replace them: + # these will prevent vectorisation, so replace them: qry <- gsub("&&", "&", qry, fixed = TRUE) qry <- gsub("||", "|", qry, fixed = TRUE) # support filter()-like writing: custom_mdro_guideline('CIP == "R", AMX == "S"' ~ "result 1") qry <- gsub(" *, *", " & ", qry) - # format nicely + # format nicely, setting spaces around operators qry <- gsub(" *([&|+-/*^><==]+) *", " \\1 ", qry) qry <- gsub("'", "\"", qry, fixed = TRUE) out[[i]]$query <- as.expression(qry) @@ -1454,21 +1483,23 @@ 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(" & ", " and ", rule$query, fixed = TRUE) - rule$query <- gsub(" | ", " or ", rule$query, fixed = TRUE) - rule$query <- gsub(" + ", " plus ", rule$query, fixed = TRUE) - rule$query <- gsub(" - ", " minus ", rule$query, fixed = TRUE) - rule$query <- gsub(" / ", " divided by ", rule$query, fixed = TRUE) - rule$query <- gsub(" * ", " times ", rule$query, fixed = TRUE) - rule$query <- gsub(" == ", " is ", rule$query, fixed = TRUE) - rule$query <- gsub(" > ", " is higher than ", rule$query, fixed = TRUE) - rule$query <- gsub(" < ", " is lower than ", rule$query, fixed = TRUE) - rule$query <- gsub(" >= ", " is higher than or equal to ", rule$query, fixed = TRUE) - rule$query <- gsub(" <= ", " is lower than or equal to ", rule$query, fixed = TRUE) - rule$query <- gsub(" ^ ", " to the power of ", rule$query, fixed = TRUE) - cat(" ", i, ". ", font_blue(as.character(rule$query)), " -> ", font_red(rule$value), "\n", sep = "") + 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 = "") } - cat(" ", i + 1, ". Otherwise -> ", font_red(paste0("Negative")), "\n", sep = "") + cat(" ", i + 1, ". Otherwise", font_bold(" -> "), 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 = "") @@ -1489,7 +1520,9 @@ run_custom_mdro_guideline <- function(df, guideline) { return("error") }) if (identical(qry, "error")) { - warning_("in custom_mdro_guideline(): rule ", i, " (`", guideline[[i]]$query, "`) was ignored because of this error message: ", pkg_env$err_msg, + warning_("in custom_mdro_guideline(): rule ", i, + " (`", guideline[[i]]$query, "`) was ignored because of this error message: ", + pkg_env$err_msg, call = FALSE, add_fn = font_red) next @@ -1524,55 +1557,50 @@ run_custom_mdro_guideline <- function(df, guideline) { #' @rdname mdro #' @export -brmo <- function(x, guideline = "BRMO", only_rsi_columns = any(is.rsi(x)), ...) { - if (missing(x)) { - x <- get_current_data(arg_name = "x", call = -2) - } - meet_criteria(x, allow_class = "data.frame") - meet_criteria(guideline, allow_class = "character", has_length = 1) - mdro(x, guideline = "BRMO", only_rsi_columns = only_rsi_columns, ...) +brmo <- function(x = NULL, only_rsi_columns = FALSE, ...) { + meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE) + meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1) + stop_if("guideline" %in% names(list(...)), + "argument `guideline` must not be set since this is a guideline-specific function") + mdro(x = x, only_rsi_columns = only_rsi_columns, guideline = "BRMO", ...) } #' @rdname mdro #' @export -mrgn <- function(x, guideline = "MRGN", only_rsi_columns = any(is.rsi(x)), ...) { - if (missing(x)) { - x <- get_current_data(arg_name = "x", call = -2) - } - meet_criteria(x, allow_class = "data.frame") - meet_criteria(guideline, allow_class = "character", has_length = 1) - mdro(x = x, guideline = "MRGN", only_rsi_columns = only_rsi_columns, ...) +mrgn <- function(x = NULL, only_rsi_columns = FALSE, ...) { + meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE) + meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1) + stop_if("guideline" %in% names(list(...)), + "argument `guideline` must not be set since this is a guideline-specific function") + mdro(x = x, only_rsi_columns = only_rsi_columns, guideline = "MRGN", ...) } #' @rdname mdro #' @export -mdr_tb <- function(x, guideline = "TB", only_rsi_columns = any(is.rsi(x)), ...) { - if (missing(x)) { - x <- get_current_data(arg_name = "x", call = -2) - } - meet_criteria(x, allow_class = "data.frame") - meet_criteria(guideline, allow_class = "character", has_length = 1) - mdro(x = x, guideline = "TB", only_rsi_columns = only_rsi_columns, ...) +mdr_tb <- function(x = NULL, only_rsi_columns = FALSE, ...) { + meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE) + meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1) + stop_if("guideline" %in% names(list(...)), + "argument `guideline` must not be set since this is a guideline-specific function") + mdro(x = x, only_rsi_columns = only_rsi_columns, guideline = "TB", ...) } #' @rdname mdro #' @export -mdr_cmi2012 <- function(x, guideline = "CMI2012", only_rsi_columns = any(is.rsi(x)), ...) { - if (missing(x)) { - x <- get_current_data(arg_name = "x", call = -2) - } - meet_criteria(x, allow_class = "data.frame") - meet_criteria(guideline, allow_class = "character", has_length = 1) - mdro(x = x, guideline = "CMI2012", only_rsi_columns = only_rsi_columns, ...) +mdr_cmi2012 <- function(x = NULL, only_rsi_columns = FALSE, ...) { + meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE) + meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1) + stop_if("guideline" %in% names(list(...)), + "argument `guideline` must not be set since this is a guideline-specific function") + mdro(x = x, only_rsi_columns = only_rsi_columns, guideline = "CMI2012", ...) } #' @rdname mdro #' @export -eucast_exceptional_phenotypes <- function(x, guideline = "EUCAST", only_rsi_columns = any(is.rsi(x)), ...) { - if (missing(x)) { - x <- get_current_data(arg_name = "x", call = -2) - } - meet_criteria(x, allow_class = "data.frame") - meet_criteria(guideline, allow_class = "character", has_length = 1) - mdro(x = x, guideline = "EUCAST", only_rsi_columns = only_rsi_columns, ...) +eucast_exceptional_phenotypes <- function(x = NULL, only_rsi_columns = FALSE, ...) { + meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE) + meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1) + stop_if("guideline" %in% names(list(...)), + "argument `guideline` must not be set since this is a guideline-specific function") + mdro(x = x, only_rsi_columns = only_rsi_columns, guideline = "EUCAST", ...) } diff --git a/R/mo_property.R b/R/mo_property.R index 1a08e56d1..12758d5ae 100755 --- a/R/mo_property.R +++ b/R/mo_property.R @@ -44,11 +44,11 @@ #' #' The Gram stain - [mo_gramstain()] - will be determined based on the taxonomic kingdom and phylum. According to Cavalier-Smith (2002, [PMID 11837318](https://pubmed.ncbi.nlm.nih.gov/11837318)), who defined subkingdoms Negibacteria and Posibacteria, only these phyla are Posibacteria: Actinobacteria, Chloroflexi, Firmicutes and Tenericutes. These bacteria are considered Gram-positive - all other bacteria are considered Gram-negative. Species outside the kingdom of Bacteria will return a value `NA`. Functions [mo_is_gram_negative()] and [mo_is_gram_positive()] always return `TRUE` or `FALSE` (except when the input is `NA` or the MO code is `UNKNOWN`), thus always return `FALSE` for species outside the taxonomic kingdom of Bacteria. #' -#' Determination of yeasts - [mo_is_yeast()] - will be based on the taxonomic phylum, class and order. Budding yeasts are true fungi of the phylum Ascomycetes, class Saccharomycetes (also called Hemiascomycetes). The true yeasts are separated into one main order Saccharomycetales. For all microorganisms that are in one of those two groups, the function will return `TRUE`. It returns `FALSE` for all other taxonomic entries. +#' Determination of yeasts - [mo_is_yeast()] - will be based on the taxonomic kingdom and class. *Budding yeasts* are fungi of the phylum Ascomycetes, class Saccharomycetes (also called Hemiascomycetes). *True yeasts* are aggregated into the underlying order Saccharomycetales. Thus, for all microorganisms that are fungi and member of the taxonomic class Saccharomycetes, the function will return `TRUE`. It returns `FALSE` otherwise (except when the input is `NA` or the MO code is `UNKNOWN`). #' -#' Intrinsic resistance - [mo_is_intrinsic_resistant()] - will be determined based on the [intrinsic_resistant] data set, which is based on `r format_eucast_version_nr(3.2)`. The [mo_is_intrinsic_resistant()] can be vectorised over arguments `x` (input for microorganisms) and over `ab` (input for antibiotics). +#' Intrinsic resistance - [mo_is_intrinsic_resistant()] - will be determined based on the [intrinsic_resistant] data set, which is based on `r format_eucast_version_nr(3.2)`. The [mo_is_intrinsic_resistant()] functions can be vectorised over arguments `x` (input for microorganisms) and over `ab` (input for antibiotics). #' -#' All output will be [translate]d where possible. +#' All output [will be translated][translate] where possible. #' #' The function [mo_url()] will return the direct URL to the online database entry, which also shows the scientific reference of the concerned species. #' @inheritSection mo_matching_score Matching Score for Microorganisms @@ -438,8 +438,7 @@ mo_is_yeast <- function(x, language = get_locale(), ...) { load_mo_failures_uncertainties_renamed(metadata) out <- rep(FALSE, length(x)) - out[x.kingdom == "Fungi" & - ((x.phylum == "Ascomycetes" & x.class == "Saccharomycetes") | x.order == "Saccharomycetales")] <- TRUE + out[x.kingdom == "Fungi" & x.class == "Saccharomycetes"] <- TRUE out[x.mo %in% c(NA_character_, "UNKNOWN")] <- NA out } diff --git a/R/rsi.R b/R/rsi.R index 4922301f7..df5422b9f 100755 --- a/R/rsi.R +++ b/R/rsi.R @@ -204,6 +204,7 @@ is.rsi.eligible <- function(x, threshold = 0.05) { meet_criteria(threshold, allow_class = "numeric", has_length = 1) if (inherits(x, "data.frame")) { + # iterate this function over all columns return(unname(vapply(FUN.VALUE = logical(1), x, is.rsi.eligible))) } @@ -235,6 +236,8 @@ is.rsi.eligible <- function(x, threshold = 0.05) { ab <- suppressWarnings(as.ab(cur_col, fast_mode = TRUE, info = FALSE)) if (!is.na(ab)) { # this is a valid antibiotic code + message_("Column '", font_bold(cur_col), "' is as.rsi()-eligible (despite only having empty values), since it seems to be ", + ab_name(ab, language = NULL, tolower = TRUE), " (", ab, ")") return(TRUE) } } diff --git a/data-raw/AMR_1.5.0.9015.tar.gz b/data-raw/AMR_1.5.0.9016.tar.gz similarity index 86% rename from data-raw/AMR_1.5.0.9015.tar.gz rename to data-raw/AMR_1.5.0.9016.tar.gz index 0ee172a0a..ad1a01932 100644 Binary files a/data-raw/AMR_1.5.0.9015.tar.gz and b/data-raw/AMR_1.5.0.9016.tar.gz differ diff --git a/data/example_isolates.rda b/data/example_isolates.rda index 8490f6d4d..34b9357cc 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 47317f000..9f8b1cf31 100644 --- a/docs/404.html +++ b/docs/404.html @@ -81,7 +81,7 @@ AMR (for R) - 1.5.0.9015 + 1.5.0.9016 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 45c14a427..a9c2bca36 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -81,7 +81,7 @@ AMR (for R) - 1.5.0.9015 + 1.5.0.9016 diff --git a/docs/articles/index.html b/docs/articles/index.html index 72636d25d..d6f73389b 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.5.0.9015 + 1.5.0.9016 diff --git a/docs/authors.html b/docs/authors.html index 9dd8acb98..bd5df5f68 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -81,7 +81,7 @@ AMR (for R) - 1.5.0.9015 + 1.5.0.9016 diff --git a/docs/index.html b/docs/index.html index b2d3b2e14..24e23c9cd 100644 --- a/docs/index.html +++ b/docs/index.html @@ -43,7 +43,7 @@ AMR (for R) - 1.5.0.9015 + 1.5.0.9016 @@ -197,7 +197,7 @@ -

Note: the rules of ‘EUCAST Clinical Breakpoints v11.0 (2021)’ will be added in the next release, to be expected in February/March 2021.

+

Note: the rules of ‘EUCAST Clinical Breakpoints v11.0 (2021)’ are implemented in the latest beta version, awaiting the next stable release (expected end of February)

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. 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!
Take me to the 5-min survey!

@@ -230,9 +230,9 @@ Since you are one of our users, we would like to know how you use the package an #> NOTE: Using column 'mo' as input for mo_is_intrinsic_resistant() #> NOTE: Determining intrinsic resistance based on 'EUCAST Expert Rules' and #> 'EUCAST Intrinsic Resistance and Unusual Phenotypes' v3.2 (2020). -#> Selecting aminoglycosides: 'AMK' (amikacin), 'GEN' (gentamicin), -#> 'KAN' (kanamycin), 'TOB' (tobramycin) -#> Selecting carbapenems: 'IPM' (imipenem), 'MEM' (meropenem) +#> Selecting aminoglycosides: columns 'AMK' (amikacin), 'GEN' (gentamicin), +#> 'KAN' (kanamycin) and 'TOB' (tobramycin) +#> Selecting carbapenems: columns 'IPM' (imipenem) and 'MEM' (meropenem)

With only having defined a row filter on Gram-negative bacteria with intrinsic resistance to cefotaxime (mo_is_gram_negative() and mo_is_intrinsic_resistant()) and a column selection on two antibiotic groups (aminoglycosides() and carbapenems()), the reference data about all microorganisms and all antibiotics in the AMR package make sure you get what you meant:

diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index 50d65fa82..4dd7b6e4a 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -12,7 +12,7 @@ articles: datasets: datasets.html resistance_predict: resistance_predict.html welcome_to_AMR: welcome_to_AMR.html -last_built: 2021-02-04T15:47Z +last_built: 2021-02-08T12:50Z urls: reference: https://msberends.github.io/AMR//reference article: https://msberends.github.io/AMR//articles diff --git a/docs/reference/AMR-deprecated.html b/docs/reference/AMR-deprecated.html index 380ea177b..374f569e2 100644 --- a/docs/reference/AMR-deprecated.html +++ b/docs/reference/AMR-deprecated.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/AMR.html b/docs/reference/AMR.html index fefb20ccf..ecc5ff9a9 100644 --- a/docs/reference/AMR.html +++ b/docs/reference/AMR.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/WHOCC.html b/docs/reference/WHOCC.html index a9fd67971..4720c3773 100644 --- a/docs/reference/WHOCC.html +++ b/docs/reference/WHOCC.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/WHONET.html b/docs/reference/WHONET.html index 3c1f6f7ec..308eb038f 100644 --- a/docs/reference/WHONET.html +++ b/docs/reference/WHONET.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/ab_from_text.html b/docs/reference/ab_from_text.html index 17066236e..ec9af198b 100644 --- a/docs/reference/ab_from_text.html +++ b/docs/reference/ab_from_text.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9015 + 1.5.0.9016 diff --git a/docs/reference/ab_property.html b/docs/reference/ab_property.html index 8acbae63e..1aafb7886 100644 --- a/docs/reference/ab_property.html +++ b/docs/reference/ab_property.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 @@ -317,7 +317,7 @@

Details

-

All output will be translated where possible.

+

All output will be translated where possible.

The function ab_url() will return the direct URL to the official WHO website. A warning will be returned if the required ATC code is not available.

Stable Lifecycle

diff --git a/docs/reference/age.html b/docs/reference/age.html index a0fab4fc3..78601d417 100644 --- a/docs/reference/age.html +++ b/docs/reference/age.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/age_groups.html b/docs/reference/age_groups.html index 2735e357f..63b2104ba 100644 --- a/docs/reference/age_groups.html +++ b/docs/reference/age_groups.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/antibiotic_class_selectors.html b/docs/reference/antibiotic_class_selectors.html index c63ae60e2..187ba8de7 100644 --- a/docs/reference/antibiotic_class_selectors.html +++ b/docs/reference/antibiotic_class_selectors.html @@ -83,7 +83,7 @@ AMR (for R) - 1.5.0.9013 + 1.5.0.9016 @@ -244,33 +244,35 @@

-
ab_class(ab_class, only_rsi_columns = NULL)
+    
ab_class(ab_class, only_rsi_columns = FALSE)
 
-aminoglycosides(only_rsi_columns = NULL)
+aminoglycosides(only_rsi_columns = FALSE)
 
-carbapenems(only_rsi_columns = NULL)
+carbapenems(only_rsi_columns = FALSE)
 
-cephalosporins(only_rsi_columns = NULL)
+cephalosporins(only_rsi_columns = FALSE)
 
-cephalosporins_1st(only_rsi_columns = NULL)
+cephalosporins_1st(only_rsi_columns = FALSE)
 
-cephalosporins_2nd(only_rsi_columns = NULL)
+cephalosporins_2nd(only_rsi_columns = FALSE)
 
-cephalosporins_3rd(only_rsi_columns = NULL)
+cephalosporins_3rd(only_rsi_columns = FALSE)
 
-cephalosporins_4th(only_rsi_columns = NULL)
+cephalosporins_4th(only_rsi_columns = FALSE)
 
-cephalosporins_5th(only_rsi_columns = NULL)
+cephalosporins_5th(only_rsi_columns = FALSE)
 
-fluoroquinolones(only_rsi_columns = NULL)
+fluoroquinolones(only_rsi_columns = FALSE)
 
-glycopeptides(only_rsi_columns = NULL)
+glycopeptides(only_rsi_columns = FALSE)
 
-macrolides(only_rsi_columns = NULL)
+macrolides(only_rsi_columns = FALSE)
 
-penicillins(only_rsi_columns = NULL)
+oxazolidinones(only_rsi_columns = FALSE)
 
-tetracyclines(only_rsi_columns = NULL)
+penicillins(only_rsi_columns = FALSE) + +tetracyclines(only_rsi_columns = FALSE)

Arguments

@@ -281,7 +283,7 @@ - +
only_rsi_columns

a logical to indicate whether only columns of class <rsi> must be selected. If set to NULL (default), it will be TRUE if any column of the data was transformed to class <rsi> on beforehand, and FALSE otherwise.

a logical to indicate whether only columns of class <rsi> must be selected (defaults to FALSE)

diff --git a/docs/reference/antibiotics.html b/docs/reference/antibiotics.html index 65c4d12ec..0e97a4ee4 100644 --- a/docs/reference/antibiotics.html +++ b/docs/reference/antibiotics.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/as.ab.html b/docs/reference/as.ab.html index 09f5fd459..ecd7947a9 100644 --- a/docs/reference/as.ab.html +++ b/docs/reference/as.ab.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/as.disk.html b/docs/reference/as.disk.html index 2db882761..14d40449f 100644 --- a/docs/reference/as.disk.html +++ b/docs/reference/as.disk.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/as.mic.html b/docs/reference/as.mic.html index b76622bed..3fd49dd12 100644 --- a/docs/reference/as.mic.html +++ b/docs/reference/as.mic.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/as.mo.html b/docs/reference/as.mo.html index 5d0e34b84..01cb0fedb 100644 --- a/docs/reference/as.mo.html +++ b/docs/reference/as.mo.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/as.rsi.html b/docs/reference/as.rsi.html index 15b8497da..11a37fa6e 100644 --- a/docs/reference/as.rsi.html +++ b/docs/reference/as.rsi.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9015 + 1.5.0.9016 diff --git a/docs/reference/atc_online.html b/docs/reference/atc_online.html index fd999c68d..7c4b9bab3 100644 --- a/docs/reference/atc_online.html +++ b/docs/reference/atc_online.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/availability.html b/docs/reference/availability.html index 10d5be471..e05e8c7f4 100644 --- a/docs/reference/availability.html +++ b/docs/reference/availability.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/bug_drug_combinations.html b/docs/reference/bug_drug_combinations.html index 65c3ba202..b62ad5569 100644 --- a/docs/reference/bug_drug_combinations.html +++ b/docs/reference/bug_drug_combinations.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/catalogue_of_life.html b/docs/reference/catalogue_of_life.html index 2faa0041d..878469511 100644 --- a/docs/reference/catalogue_of_life.html +++ b/docs/reference/catalogue_of_life.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/catalogue_of_life_version.html b/docs/reference/catalogue_of_life_version.html index d7391b4e5..a1477fbdc 100644 --- a/docs/reference/catalogue_of_life_version.html +++ b/docs/reference/catalogue_of_life_version.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/count.html b/docs/reference/count.html index 38b20baa3..519aea1a2 100644 --- a/docs/reference/count.html +++ b/docs/reference/count.html @@ -83,7 +83,7 @@ count_resistant() should be used to count resistant isolates, count_susceptible( AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/dosage.html b/docs/reference/dosage.html index c4d9dd1b9..73559e2f2 100644 --- a/docs/reference/dosage.html +++ b/docs/reference/dosage.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/eucast_rules.html b/docs/reference/eucast_rules.html index 0a252aa06..042193fca 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.5.0.9014 + 1.5.0.9016 @@ -253,7 +253,7 @@ To improve the interpretation of the antibiogram before EUCAST rules are applied version_breakpoints = 11, version_expertrules = 3.2, ampc_cephalosporin_resistance = NA, - only_rsi_columns = any(is.rsi(x)), + only_rsi_columns = FALSE, ... ) @@ -296,7 +296,7 @@ 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> on beforehand. Defaults to TRUE if any column of x is of class <rsi>.

+

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

... diff --git a/docs/reference/example_isolates.html b/docs/reference/example_isolates.html index af3c64dc7..3f28e7450 100644 --- a/docs/reference/example_isolates.html +++ b/docs/reference/example_isolates.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/example_isolates_unclean.html b/docs/reference/example_isolates_unclean.html index 8a73aeae7..312e4e9d2 100644 --- a/docs/reference/example_isolates_unclean.html +++ b/docs/reference/example_isolates_unclean.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/filter_ab_class.html b/docs/reference/filter_ab_class.html index 2095cb914..b113c9b1b 100644 --- a/docs/reference/filter_ab_class.html +++ b/docs/reference/filter_ab_class.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9013 + 1.5.0.9016 @@ -247,35 +247,121 @@ ab_class, result = NULL, scope = "any", - only_rsi_columns = any(is.rsi(x)), + only_rsi_columns = FALSE, ... ) -filter_aminoglycosides(x, result = NULL, scope = "any", ...) +filter_aminoglycosides( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_carbapenems(x, result = NULL, scope = "any", ...) +filter_carbapenems( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_cephalosporins(x, result = NULL, scope = "any", ...) +filter_cephalosporins( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_1st_cephalosporins(x, result = NULL, scope = "any", ...) +filter_1st_cephalosporins( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_2nd_cephalosporins(x, result = NULL, scope = "any", ...) +filter_2nd_cephalosporins( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_3rd_cephalosporins(x, result = NULL, scope = "any", ...) +filter_3rd_cephalosporins( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_4th_cephalosporins(x, result = NULL, scope = "any", ...) +filter_4th_cephalosporins( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_5th_cephalosporins(x, result = NULL, scope = "any", ...) +filter_5th_cephalosporins( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_fluoroquinolones(x, result = NULL, scope = "any", ...) +filter_fluoroquinolones( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_glycopeptides(x, result = NULL, scope = "any", ...) +filter_glycopeptides( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_macrolides(x, result = NULL, scope = "any", ...) +filter_macrolides( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_penicillins(x, result = NULL, scope = "any", ...) +filter_oxazolidinones( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_tetracyclines(x, result = NULL, scope = "any", ...) +filter_penicillins( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) + +filter_tetracyclines( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +)

Arguments

@@ -298,7 +384,7 @@ - + diff --git a/docs/reference/first_isolate.html b/docs/reference/first_isolate.html index 813aaab05..b1bc7ee95 100644 --- a/docs/reference/first_isolate.html +++ b/docs/reference/first_isolate.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9015 + 1.5.0.9016 @@ -243,7 +243,7 @@
first_isolate(
-  x,
+  x = NULL,
   col_date = NULL,
   col_patient_id = NULL,
   col_mo = NULL,
@@ -264,7 +264,7 @@
 )
 
 filter_first_isolate(
-  x,
+  x = NULL,
   col_date = NULL,
   col_patient_id = NULL,
   col_mo = NULL,
@@ -272,7 +272,7 @@
 )
 
 filter_first_weighted_isolate(
-  x,
+  x = NULL,
   col_date = NULL,
   col_patient_id = NULL,
   col_mo = NULL,
@@ -285,7 +285,7 @@
     
- + @@ -399,7 +399,7 @@
  • Using type = "keyantibiotics" and argument ignore_I

    Any difference from S to R (or vice versa) will (re)select an isolate as a first weighted isolate. With ignore_I = FALSE, also differences from I to S|R (or vice versa) will lead to this. This is a reliable method and 30-35 times faster than method 2. Read more about this in the key_antibiotics() function.

  • Using type = "points" and argument points_threshold

    -

    A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds points_threshold, which default to 2, an isolate will be (re)selected as a first weighted isolate.

  • +

    A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds points_threshold, which defaults to 2, an isolate will be (re)selected as a first weighted isolate.

    Stable Lifecycle

    @@ -422,10 +422,12 @@ The lifecycle of this function is stable# `example_isolates` is a data set available in the AMR package. # See ?example_isolates. -# basic filtering on first isolates -example_isolates[first_isolate(), ] +example_isolates[first_isolate(example_isolates), ] # \donttest{ +# faster way, only works in R 3.2 and later: +example_isolates[first_isolate(), ] + # get all first Gram-negatives example_isolates[which(first_isolate() & mo_is_gram_negative()), ] diff --git a/docs/reference/g.test.html b/docs/reference/g.test.html index aac8fd026..a4345ea9d 100644 --- a/docs/reference/g.test.html +++ b/docs/reference/g.test.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/get_episode.html b/docs/reference/get_episode.html index 35e72b5a9..15ccb3430 100644 --- a/docs/reference/get_episode.html +++ b/docs/reference/get_episode.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/ggplot_rsi.html b/docs/reference/ggplot_rsi.html index 709ececb1..c5319d89f 100644 --- a/docs/reference/ggplot_rsi.html +++ b/docs/reference/ggplot_rsi.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/guess_ab_col.html b/docs/reference/guess_ab_col.html index 8bac09011..97b2edce0 100644 --- a/docs/reference/guess_ab_col.html +++ b/docs/reference/guess_ab_col.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 @@ -246,7 +246,7 @@ x = NULL, search_string = NULL, verbose = FALSE, - only_rsi_columns = any(is.rsi(x)) + only_rsi_columns = FALSE )

    Arguments

    @@ -266,7 +266,7 @@
    - +
    only_rsi_columns

    a logical to indicate whether only columns must be included that were transformed to class <rsi> on beforehand. Defaults to TRUE if any column of x is of class <rsi>.

    a logical to indicate whether only columns must be included that were transformed to class <rsi> on beforehand (defaults to FALSE)

    ...
    x

    a data.frame containing isolates. Can be left blank for automatic determination.

    a data.frame containing isolates. Can be left blank for automatic determination, see Examples.

    col_date
    only_rsi_columns

    a logical to indicate whether only antibiotic columns must be detected that were transformed to class <rsi> on beforehand. Defaults to TRUE if any column of x is of class <rsi>.

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

    diff --git a/docs/reference/index.html b/docs/reference/index.html index 59740f863..c08f18296 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.5.0.9015 + 1.5.0.9016 @@ -526,13 +526,13 @@ -

    ab_class() aminoglycosides() carbapenems() cephalosporins() cephalosporins_1st() cephalosporins_2nd() cephalosporins_3rd() cephalosporins_4th() cephalosporins_5th() fluoroquinolones() glycopeptides() macrolides() penicillins() tetracyclines()

    +

    ab_class() aminoglycosides() carbapenems() cephalosporins() cephalosporins_1st() cephalosporins_2nd() cephalosporins_3rd() cephalosporins_4th() cephalosporins_5th() fluoroquinolones() glycopeptides() macrolides() oxazolidinones() penicillins() tetracyclines()

    Antibiotic Class Selectors

    -

    filter_ab_class() filter_aminoglycosides() filter_carbapenems() filter_cephalosporins() filter_1st_cephalosporins() filter_2nd_cephalosporins() filter_3rd_cephalosporins() filter_4th_cephalosporins() filter_5th_cephalosporins() filter_fluoroquinolones() filter_glycopeptides() filter_macrolides() filter_penicillins() filter_tetracyclines()

    +

    filter_ab_class() filter_aminoglycosides() filter_carbapenems() filter_cephalosporins() filter_1st_cephalosporins() filter_2nd_cephalosporins() filter_3rd_cephalosporins() filter_4th_cephalosporins() filter_5th_cephalosporins() filter_fluoroquinolones() filter_glycopeptides() filter_macrolides() filter_oxazolidinones() filter_penicillins() filter_tetracyclines()

    Filter Isolates on Result in Antimicrobial Class

    diff --git a/docs/reference/intrinsic_resistant.html b/docs/reference/intrinsic_resistant.html index e1b79c5ba..c60cdb351 100644 --- a/docs/reference/intrinsic_resistant.html +++ b/docs/reference/intrinsic_resistant.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/isolate_identifier.html b/docs/reference/isolate_identifier.html index 0b0a9ff29..602a3dc59 100644 --- a/docs/reference/isolate_identifier.html +++ b/docs/reference/isolate_identifier.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/join.html b/docs/reference/join.html index c7fb67cce..9ff06ea1d 100644 --- a/docs/reference/join.html +++ b/docs/reference/join.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/key_antibiotics.html b/docs/reference/key_antibiotics.html index a2e97fc09..d43042cc4 100644 --- a/docs/reference/key_antibiotics.html +++ b/docs/reference/key_antibiotics.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 @@ -243,7 +243,7 @@
    key_antibiotics(
    -  x,
    +  x = NULL,
       col_mo = NULL,
       universal_1 = guess_ab_col(x, "amoxicillin"),
       universal_2 = guess_ab_col(x, "amoxicillin/clavulanic acid"),
    @@ -380,7 +380,7 @@ The lifecycle of this function is stable

    Using type = "keyantibiotics" and argument ignore_I

    Any difference from S to R (or vice versa) will (re)select an isolate as a first weighted isolate. With ignore_I = FALSE, also differences from I to S|R (or vice versa) will lead to this. This is a reliable method and 30-35 times faster than method 2. Read more about this in the key_antibiotics() function.

  • Using type = "points" and argument points_threshold

    -

    A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds points_threshold, which default to 2, an isolate will be (re)selected as a first weighted isolate.

  • +

    A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds points_threshold, which defaults to 2, an isolate will be (re)selected as a first weighted isolate.

    Read more on Our Website!

    diff --git a/docs/reference/kurtosis.html b/docs/reference/kurtosis.html index d74ca3c1c..1d2e6c7ac 100644 --- a/docs/reference/kurtosis.html +++ b/docs/reference/kurtosis.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/like.html b/docs/reference/like.html index 17097aeca..66999fd54 100644 --- a/docs/reference/like.html +++ b/docs/reference/like.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/mdro.html b/docs/reference/mdro.html index c838960e7..c5e2c9b2c 100644 --- a/docs/reference/mdro.html +++ b/docs/reference/mdro.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 @@ -243,33 +243,28 @@
    mdro(
    -  x,
    +  x = NULL,
       guideline = "CMI2012",
       col_mo = NULL,
       info = interactive(),
       pct_required_classes = 0.5,
       combine_SI = TRUE,
       verbose = FALSE,
    -  only_rsi_columns = any(is.rsi(x)),
    +  only_rsi_columns = FALSE,
       ...
     )
     
     custom_mdro_guideline(..., as_factor = TRUE)
     
    -brmo(x, guideline = "BRMO", only_rsi_columns = any(is.rsi(x)), ...)
    +brmo(x = NULL, only_rsi_columns = FALSE, ...)
     
    -mrgn(x, guideline = "MRGN", only_rsi_columns = any(is.rsi(x)), ...)
    +mrgn(x = NULL, only_rsi_columns = FALSE, ...)
     
    -mdr_tb(x, guideline = "TB", only_rsi_columns = any(is.rsi(x)), ...)
    +mdr_tb(x = NULL, only_rsi_columns = FALSE, ...)
     
    -mdr_cmi2012(x, guideline = "CMI2012", only_rsi_columns = any(is.rsi(x)), ...)
    +mdr_cmi2012(x = NULL, only_rsi_columns = FALSE, ...)
     
    -eucast_exceptional_phenotypes(
    -  x,
    -  guideline = "EUCAST",
    -  only_rsi_columns = any(is.rsi(x)),
    -  ...
    -)
    +eucast_exceptional_phenotypes(x = NULL, only_rsi_columns = FALSE, ...)

    Arguments

    @@ -304,7 +299,7 @@ - + diff --git a/docs/reference/microorganisms.codes.html b/docs/reference/microorganisms.codes.html index 5407ecad9..7287e7d5d 100644 --- a/docs/reference/microorganisms.codes.html +++ b/docs/reference/microorganisms.codes.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/microorganisms.html b/docs/reference/microorganisms.html index 8b5ac3fcf..dae989b19 100644 --- a/docs/reference/microorganisms.html +++ b/docs/reference/microorganisms.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/microorganisms.old.html b/docs/reference/microorganisms.old.html index 00c102186..53fed7f3a 100644 --- a/docs/reference/microorganisms.old.html +++ b/docs/reference/microorganisms.old.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/mo_matching_score.html b/docs/reference/mo_matching_score.html index 329388e4f..c49afc362 100644 --- a/docs/reference/mo_matching_score.html +++ b/docs/reference/mo_matching_score.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/mo_property.html b/docs/reference/mo_property.html index 46c08ec6f..42278533b 100644 --- a/docs/reference/mo_property.html +++ b/docs/reference/mo_property.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9015 + 1.5.0.9016 @@ -349,9 +349,9 @@

    The short name - mo_shortname() - almost always returns the first character of the genus and the full species, like "E. coli". Exceptions are abbreviations of staphylococci (such as "CoNS", Coagulase-Negative Staphylococci) and beta-haemolytic streptococci (such as "GBS", Group B Streptococci). Please bear in mind that e.g. E. coli could mean Escherichia coli (kingdom of Bacteria) as well as Entamoeba coli (kingdom of Protozoa). Returning to the full name will be done using as.mo() internally, giving priority to bacteria and human pathogens, i.e. "E. coli" will be considered Escherichia coli. In other words, mo_fullname(mo_shortname("Entamoeba coli")) returns "Escherichia coli".

    Since the top-level of the taxonomy is sometimes referred to as 'kingdom' and sometimes as 'domain', the functions mo_kingdom() and mo_domain() return the exact same results.

    The Gram stain - mo_gramstain() - will be determined based on the taxonomic kingdom and phylum. According to Cavalier-Smith (2002, PMID 11837318), who defined subkingdoms Negibacteria and Posibacteria, only these phyla are Posibacteria: Actinobacteria, Chloroflexi, Firmicutes and Tenericutes. These bacteria are considered Gram-positive - all other bacteria are considered Gram-negative. Species outside the kingdom of Bacteria will return a value NA. Functions mo_is_gram_negative() and mo_is_gram_positive() always return TRUE or FALSE (except when the input is NA or the MO code is UNKNOWN), thus always return FALSE for species outside the taxonomic kingdom of Bacteria.

    -

    Determination of yeasts - mo_is_yeast() - will be based on the taxonomic phylum, class and order. Budding yeasts are true fungi of the phylum Ascomycetes, class Saccharomycetes (also called Hemiascomycetes). The true yeasts are separated into one main order Saccharomycetales. For all microorganisms that are in one of those two groups, the function will return TRUE. It returns FALSE for all other taxonomic entries.

    -

    Intrinsic resistance - mo_is_intrinsic_resistant() - will be determined based on the intrinsic_resistant data set, which is based on 'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes' v3.2 (2020). The mo_is_intrinsic_resistant() can be vectorised over arguments x (input for microorganisms) and over ab (input for antibiotics).

    -

    All output will be translated where possible.

    +

    Determination of yeasts - mo_is_yeast() - will be based on the taxonomic kingdom and class. Budding yeasts are fungi of the phylum Ascomycetes, class Saccharomycetes (also called Hemiascomycetes). True yeasts are aggregated into the underlying order Saccharomycetales. Thus, for all microorganisms that are fungi and member of the taxonomic class Saccharomycetes, the function will return TRUE. It returns FALSE otherwise (except when the input is NA or the MO code is UNKNOWN).

    +

    Intrinsic resistance - mo_is_intrinsic_resistant() - will be determined based on the intrinsic_resistant data set, which is based on 'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes' v3.2 (2020). The mo_is_intrinsic_resistant() functions can be vectorised over arguments x (input for microorganisms) and over ab (input for antibiotics).

    +

    All output will be translated where possible.

    The function mo_url() will return the direct URL to the online database entry, which also shows the scientific reference of the concerned species.

    Stable Lifecycle

    diff --git a/docs/reference/mo_source.html b/docs/reference/mo_source.html index 90eaae799..2030f5132 100644 --- a/docs/reference/mo_source.html +++ b/docs/reference/mo_source.html @@ -83,7 +83,7 @@ This is the fastest way to have your organisation (or analysis) specific codes p AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/pca.html b/docs/reference/pca.html index 1b5fced12..06ac67fcc 100644 --- a/docs/reference/pca.html +++ b/docs/reference/pca.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/plot.html b/docs/reference/plot.html index 1857ffd6e..b71efe64e 100644 --- a/docs/reference/plot.html +++ b/docs/reference/plot.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/proportion.html b/docs/reference/proportion.html index 62590c087..3424c0dd2 100644 --- a/docs/reference/proportion.html +++ b/docs/reference/proportion.html @@ -83,7 +83,7 @@ resistance() should be used to calculate resistance, susceptibility() should be AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/random.html b/docs/reference/random.html index 6bfa9f6df..f9c48cdd1 100644 --- a/docs/reference/random.html +++ b/docs/reference/random.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/resistance_predict.html b/docs/reference/resistance_predict.html index 3f1e5b431..9728ccb0c 100644 --- a/docs/reference/resistance_predict.html +++ b/docs/reference/resistance_predict.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 @@ -287,7 +287,7 @@ - + diff --git a/docs/reference/rsi_translation.html b/docs/reference/rsi_translation.html index a37725c44..713dcef45 100644 --- a/docs/reference/rsi_translation.html +++ b/docs/reference/rsi_translation.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/skewness.html b/docs/reference/skewness.html index d84086dd5..65d21c0d6 100644 --- a/docs/reference/skewness.html +++ b/docs/reference/skewness.html @@ -83,7 +83,7 @@ When negative ('left-skewed'): the left tail is longer; the mass of the distribu AMR (for R) - 1.5.0.9014 + 1.5.0.9016 diff --git a/docs/reference/translate.html b/docs/reference/translate.html index 16209a9bb..372f3cc4f 100644 --- a/docs/reference/translate.html +++ b/docs/reference/translate.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9015 + 1.5.0.9016 diff --git a/docs/survey.html b/docs/survey.html index 0ba3b1165..903490319 100644 --- a/docs/survey.html +++ b/docs/survey.html @@ -81,7 +81,7 @@ AMR (for R) - 1.5.0.9015 + 1.5.0.9016 diff --git a/index.md b/index.md index 852bfefee..52e24b552 100644 --- a/index.md +++ b/index.md @@ -1,6 +1,6 @@ # `AMR` (for R) -*Note: the rules of 'EUCAST Clinical Breakpoints v11.0 (2021)' will be added in the next release, to be expected in February/March 2021.* +*Note: the rules of 'EUCAST Clinical Breakpoints v11.0 (2021)' are implemented in [the latest beta version](./#latest-development-version), awaiting the next stable release (expected end of February)* > **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! @@ -39,9 +39,9 @@ example_isolates %>% #> NOTE: Using column 'mo' as input for mo_is_intrinsic_resistant() #> NOTE: Determining intrinsic resistance based on 'EUCAST Expert Rules' and #> 'EUCAST Intrinsic Resistance and Unusual Phenotypes' v3.2 (2020). -#> Selecting aminoglycosides: 'AMK' (amikacin), 'GEN' (gentamicin), -#> 'KAN' (kanamycin), 'TOB' (tobramycin) -#> Selecting carbapenems: 'IPM' (imipenem), 'MEM' (meropenem) +#> Selecting aminoglycosides: columns 'AMK' (amikacin), 'GEN' (gentamicin), +#> 'KAN' (kanamycin) and 'TOB' (tobramycin) +#> Selecting carbapenems: columns 'IPM' (imipenem) and 'MEM' (meropenem) ``` With only having defined a row filter on Gram-negative bacteria with intrinsic resistance to cefotaxime (`mo_is_gram_negative()` and `mo_is_intrinsic_resistant()`) and a column selection on two antibiotic groups (`aminoglycosides()` and `carbapenems()`), the reference data about [all microorganisms](./reference/microorganisms.html) and [all antibiotics](./reference/antibiotics.html) in the `AMR` package make sure you get what you meant: diff --git a/man/ab_property.Rd b/man/ab_property.Rd index fa3a98552..23c68f3b4 100644 --- a/man/ab_property.Rd +++ b/man/ab_property.Rd @@ -72,7 +72,7 @@ ab_property(x, property = "name", language = get_locale(), ...) Use these functions to return a specific property of an antibiotic from the \link{antibiotics} data set. All input values will be evaluated internally with \code{\link[=as.ab]{as.ab()}}. } \details{ -All output will be \link{translate}d where possible. +All output \link[=translate]{will be translated} where possible. The function \code{\link[=ab_url]{ab_url()}} will return the direct URL to the official WHO website. A warning will be returned if the required ATC code is not available. } diff --git a/man/antibiotic_class_selectors.Rd b/man/antibiotic_class_selectors.Rd index f220e5fbf..8c3097eb3 100644 --- a/man/antibiotic_class_selectors.Rd +++ b/man/antibiotic_class_selectors.Rd @@ -14,42 +14,45 @@ \alias{fluoroquinolones} \alias{glycopeptides} \alias{macrolides} +\alias{oxazolidinones} \alias{penicillins} \alias{tetracyclines} \title{Antibiotic Class Selectors} \usage{ -ab_class(ab_class, only_rsi_columns = NULL) +ab_class(ab_class, only_rsi_columns = FALSE) -aminoglycosides(only_rsi_columns = NULL) +aminoglycosides(only_rsi_columns = FALSE) -carbapenems(only_rsi_columns = NULL) +carbapenems(only_rsi_columns = FALSE) -cephalosporins(only_rsi_columns = NULL) +cephalosporins(only_rsi_columns = FALSE) -cephalosporins_1st(only_rsi_columns = NULL) +cephalosporins_1st(only_rsi_columns = FALSE) -cephalosporins_2nd(only_rsi_columns = NULL) +cephalosporins_2nd(only_rsi_columns = FALSE) -cephalosporins_3rd(only_rsi_columns = NULL) +cephalosporins_3rd(only_rsi_columns = FALSE) -cephalosporins_4th(only_rsi_columns = NULL) +cephalosporins_4th(only_rsi_columns = FALSE) -cephalosporins_5th(only_rsi_columns = NULL) +cephalosporins_5th(only_rsi_columns = FALSE) -fluoroquinolones(only_rsi_columns = NULL) +fluoroquinolones(only_rsi_columns = FALSE) -glycopeptides(only_rsi_columns = NULL) +glycopeptides(only_rsi_columns = FALSE) -macrolides(only_rsi_columns = NULL) +macrolides(only_rsi_columns = FALSE) -penicillins(only_rsi_columns = NULL) +oxazolidinones(only_rsi_columns = FALSE) -tetracyclines(only_rsi_columns = NULL) +penicillins(only_rsi_columns = FALSE) + +tetracyclines(only_rsi_columns = FALSE) } \arguments{ \item{ab_class}{an antimicrobial class, like \code{"carbapenems"}. The columns \code{group}, \code{atc_group1} and \code{atc_group2} of the \link{antibiotics} data set will be searched (case-insensitive) for this value.} -\item{only_rsi_columns}{a logical to indicate whether only columns of class \href{[rsi]}{\verb{}} must be selected. If set to \code{NULL} (default), it will be \code{TRUE} if any column of the data was \href{[rsi]}{transformed to class \verb{}} on beforehand, and \code{FALSE} otherwise.} +\item{only_rsi_columns}{a logical to indicate whether only columns of class \href{[rsi]}{\verb{}} must be selected (defaults to \code{FALSE})} } \description{ These functions help to select the columns of antibiotics that are of a specific antibiotic class, without the need to define the columns or antibiotic abbreviations. \strong{\Sexpr{ifelse(as.double(R.Version()$major) + (as.double(R.Version()$minor) / 10) < 3.2, paste0("NOTE: THESE FUNCTIONS DO NOT WORK ON YOUR CURRENT R VERSION. These functions require R version 3.2 or later - you have ", R.version.string, "."), "")}} diff --git a/man/eucast_rules.Rd b/man/eucast_rules.Rd index 138d43452..a0dc008f3 100644 --- a/man/eucast_rules.Rd +++ b/man/eucast_rules.Rd @@ -26,7 +26,7 @@ eucast_rules( version_breakpoints = 11, version_expertrules = 3.2, ampc_cephalosporin_resistance = NA, - only_rsi_columns = any(is.rsi(x)), + only_rsi_columns = FALSE, ... ) @@ -49,7 +49,7 @@ eucast_dosage(ab, administration = "iv", version_breakpoints = 11) \item{ampc_cephalosporin_resistance}{a character value that should be applied for AmpC de-repressed cephalosporin-resistant mutants, defaults to \code{NA}. Currently only works when \code{version_expertrules} is \code{3.2}; '\emph{EUCAST Expert Rules v3.2 on Enterobacterales}' states that results of cefotaxime, ceftriaxone and ceftazidime should be reported with a note, or results should be suppressed (emptied) for these agents. A value of \code{NA} for this argument will remove results for these agents, while e.g. a value of \code{"R"} will make the results for these agents resistant. Use \code{NULL} to not alter the results for AmpC de-repressed cephalosporin-resistant mutants. \cr For \emph{EUCAST Expert Rules} v3.2, this rule applies to: \emph{Citrobacter braakii}, \emph{Citrobacter freundii}, \emph{Citrobacter gillenii}, \emph{Citrobacter murliniae}, \emph{Citrobacter rodenticum}, \emph{Citrobacter sedlakii}, \emph{Citrobacter werkmanii}, \emph{Citrobacter youngae}, \emph{Enterobacter}, \emph{Hafnia alvei}, \emph{Klebsiella aerogenes}, \emph{Morganella morganii}, \emph{Providencia} and \emph{Serratia}.} -\item{only_rsi_columns}{a logical to indicate whether only antibiotic columns must be detected that were \href{[rsi]}{transformed to class \verb{}} on beforehand. Defaults to \code{TRUE} if any column of \code{x} is of class \verb{}.} +\item{only_rsi_columns}{a logical to indicate whether only antibiotic columns must be detected that were \href{[rsi]}{transformed to class \verb{}} on beforehand (defaults to \code{FALSE})} \item{...}{column name of an antibiotic, see section \emph{Antibiotics} below} diff --git a/man/filter_ab_class.Rd b/man/filter_ab_class.Rd index 80d2a381c..2d5240df6 100644 --- a/man/filter_ab_class.Rd +++ b/man/filter_ab_class.Rd @@ -13,6 +13,7 @@ \alias{filter_fluoroquinolones} \alias{filter_glycopeptides} \alias{filter_macrolides} +\alias{filter_oxazolidinones} \alias{filter_penicillins} \alias{filter_tetracyclines} \title{Filter Isolates on Result in Antimicrobial Class} @@ -22,35 +23,121 @@ filter_ab_class( ab_class, result = NULL, scope = "any", - only_rsi_columns = any(is.rsi(x)), + only_rsi_columns = FALSE, ... ) -filter_aminoglycosides(x, result = NULL, scope = "any", ...) +filter_aminoglycosides( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_carbapenems(x, result = NULL, scope = "any", ...) +filter_carbapenems( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_cephalosporins(x, result = NULL, scope = "any", ...) +filter_cephalosporins( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_1st_cephalosporins(x, result = NULL, scope = "any", ...) +filter_1st_cephalosporins( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_2nd_cephalosporins(x, result = NULL, scope = "any", ...) +filter_2nd_cephalosporins( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_3rd_cephalosporins(x, result = NULL, scope = "any", ...) +filter_3rd_cephalosporins( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_4th_cephalosporins(x, result = NULL, scope = "any", ...) +filter_4th_cephalosporins( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_5th_cephalosporins(x, result = NULL, scope = "any", ...) +filter_5th_cephalosporins( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_fluoroquinolones(x, result = NULL, scope = "any", ...) +filter_fluoroquinolones( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_glycopeptides(x, result = NULL, scope = "any", ...) +filter_glycopeptides( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_macrolides(x, result = NULL, scope = "any", ...) +filter_macrolides( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_penicillins(x, result = NULL, scope = "any", ...) +filter_oxazolidinones( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) -filter_tetracyclines(x, result = NULL, scope = "any", ...) +filter_penicillins( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) + +filter_tetracyclines( + x, + result = NULL, + scope = "any", + only_rsi_columns = FALSE, + ... +) } \arguments{ \item{x}{a data set} @@ -61,7 +148,7 @@ filter_tetracyclines(x, result = NULL, scope = "any", ...) \item{scope}{the scope to check which variables to check, can be \code{"any"} (default) or \code{"all"}} -\item{only_rsi_columns}{a logical to indicate whether only columns must be included that were \href{[rsi]}{transformed to class \verb{}} on beforehand. Defaults to \code{TRUE} if any column of \code{x} is of class \verb{}.} +\item{only_rsi_columns}{a logical to indicate whether only columns must be included that were \href{[rsi]}{transformed to class \verb{}} on beforehand (defaults to \code{FALSE})} \item{...}{arguments passed on to \code{\link[=filter_ab_class]{filter_ab_class()}}} } diff --git a/man/first_isolate.Rd b/man/first_isolate.Rd index 5fb0a3095..53c572cb0 100755 --- a/man/first_isolate.Rd +++ b/man/first_isolate.Rd @@ -12,7 +12,7 @@ Methodology of this function is strictly based on: } \usage{ first_isolate( - x, + x = NULL, col_date = NULL, col_patient_id = NULL, col_mo = NULL, @@ -33,7 +33,7 @@ first_isolate( ) filter_first_isolate( - x, + x = NULL, col_date = NULL, col_patient_id = NULL, col_mo = NULL, @@ -41,7 +41,7 @@ filter_first_isolate( ) filter_first_weighted_isolate( - x, + x = NULL, col_date = NULL, col_patient_id = NULL, col_mo = NULL, @@ -50,7 +50,7 @@ filter_first_weighted_isolate( ) } \arguments{ -\item{x}{a \link{data.frame} containing isolates. Can be left blank for automatic determination.} +\item{x}{a \link{data.frame} containing isolates. Can be left blank for automatic determination, see \emph{Examples}.} \item{col_date}{column name of the result date (or date that is was received on the lab), defaults to the first column with a date class} @@ -130,7 +130,7 @@ There are two ways to determine whether isolates can be included as first weight Any difference from S to R (or vice versa) will (re)select an isolate as a first weighted isolate. With \code{ignore_I = FALSE}, also differences from I to S|R (or vice versa) will lead to this. This is a reliable method and 30-35 times faster than method 2. Read more about this in the \code{\link[=key_antibiotics]{key_antibiotics()}} function. \item Using \code{type = "points"} and argument \code{points_threshold} -A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds \code{points_threshold}, which default to \code{2}, an isolate will be (re)selected as a first weighted isolate. +A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds \code{points_threshold}, which defaults to \code{2}, an isolate will be (re)selected as a first weighted isolate. } } @@ -151,10 +151,12 @@ On our website \url{https://msberends.github.io/AMR/} you can find \href{https:/ # `example_isolates` is a data set available in the AMR package. # See ?example_isolates. -# basic filtering on first isolates -example_isolates[first_isolate(), ] +example_isolates[first_isolate(example_isolates), ] \donttest{ +# faster way, only works in R 3.2 and later: +example_isolates[first_isolate(), ] + # get all first Gram-negatives example_isolates[which(first_isolate() & mo_is_gram_negative()), ] diff --git a/man/guess_ab_col.Rd b/man/guess_ab_col.Rd index ef2a14aba..a566673e6 100644 --- a/man/guess_ab_col.Rd +++ b/man/guess_ab_col.Rd @@ -8,7 +8,7 @@ guess_ab_col( x = NULL, search_string = NULL, verbose = FALSE, - only_rsi_columns = any(is.rsi(x)) + only_rsi_columns = FALSE ) } \arguments{ @@ -18,7 +18,7 @@ guess_ab_col( \item{verbose}{a logical to indicate whether additional info should be printed} -\item{only_rsi_columns}{a logical to indicate whether only antibiotic columns must be detected that were \href{[rsi]}{transformed to class \verb{}} on beforehand. Defaults to \code{TRUE} if any column of \code{x} is of class \verb{}.} +\item{only_rsi_columns}{a logical to indicate whether only antibiotic columns must be detected that were \href{[rsi]}{transformed to class \verb{}} on beforehand (defaults to \code{FALSE})} } \value{ A column name of \code{x}, or \code{NULL} when no result is found. diff --git a/man/key_antibiotics.Rd b/man/key_antibiotics.Rd index 79bac695a..c48da92bb 100755 --- a/man/key_antibiotics.Rd +++ b/man/key_antibiotics.Rd @@ -6,7 +6,7 @@ \title{Key Antibiotics for First (Weighted) Isolates} \usage{ key_antibiotics( - x, + x = NULL, col_mo = NULL, universal_1 = guess_ab_col(x, "amoxicillin"), universal_2 = guess_ab_col(x, "amoxicillin/clavulanic acid"), @@ -125,7 +125,7 @@ There are two ways to determine whether isolates can be included as first weight Any difference from S to R (or vice versa) will (re)select an isolate as a first weighted isolate. With \code{ignore_I = FALSE}, also differences from I to S|R (or vice versa) will lead to this. This is a reliable method and 30-35 times faster than method 2. Read more about this in the \code{\link[=key_antibiotics]{key_antibiotics()}} function. \item Using \code{type = "points"} and argument \code{points_threshold} -A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds \code{points_threshold}, which default to \code{2}, an isolate will be (re)selected as a first weighted isolate. +A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds \code{points_threshold}, which defaults to \code{2}, an isolate will be (re)selected as a first weighted isolate. } } diff --git a/man/mdro.Rd b/man/mdro.Rd index d846ff567..3cb9c2584 100644 --- a/man/mdro.Rd +++ b/man/mdro.Rd @@ -20,33 +20,28 @@ See the supported guidelines above for the list of publications used for this fu } \usage{ mdro( - x, + x = NULL, guideline = "CMI2012", col_mo = NULL, info = interactive(), pct_required_classes = 0.5, combine_SI = TRUE, verbose = FALSE, - only_rsi_columns = any(is.rsi(x)), + only_rsi_columns = FALSE, ... ) custom_mdro_guideline(..., as_factor = TRUE) -brmo(x, guideline = "BRMO", only_rsi_columns = any(is.rsi(x)), ...) +brmo(x = NULL, only_rsi_columns = FALSE, ...) -mrgn(x, guideline = "MRGN", only_rsi_columns = any(is.rsi(x)), ...) +mrgn(x = NULL, only_rsi_columns = FALSE, ...) -mdr_tb(x, guideline = "TB", only_rsi_columns = any(is.rsi(x)), ...) +mdr_tb(x = NULL, only_rsi_columns = FALSE, ...) -mdr_cmi2012(x, guideline = "CMI2012", only_rsi_columns = any(is.rsi(x)), ...) +mdr_cmi2012(x = NULL, only_rsi_columns = FALSE, ...) -eucast_exceptional_phenotypes( - x, - guideline = "EUCAST", - only_rsi_columns = any(is.rsi(x)), - ... -) +eucast_exceptional_phenotypes(x = NULL, only_rsi_columns = FALSE, ...) } \arguments{ \item{x}{a \link{data.frame} with antibiotics columns, like \code{AMX} or \code{amox}. Can be left blank for automatic determination.} @@ -63,7 +58,7 @@ eucast_exceptional_phenotypes( \item{verbose}{a logical to turn Verbose mode on and off (default is off). In Verbose mode, the function does not return the MDRO results, but instead returns a data set in logbook form with extensive info about which isolates would be MDRO-positive, or why they are not.} -\item{only_rsi_columns}{a logical to indicate whether only antibiotic columns must be detected that were \href{[rsi]}{transformed to class \verb{}} on beforehand. Defaults to \code{TRUE} if any column of \code{x} is of class \verb{}.} +\item{only_rsi_columns}{a logical to indicate whether only antibiotic columns must be detected that were \href{[rsi]}{transformed to class \verb{}} on beforehand (defaults to \code{FALSE})} \item{...}{in case of \code{\link[=custom_mdro_guideline]{custom_mdro_guideline()}}: a set of rules, see section \emph{Using Custom Guidelines} below. Otherwise: column name of an antibiotic, see section \emph{Antibiotics} below.} diff --git a/man/mo_property.Rd b/man/mo_property.Rd index c683ad8f0..7f90e6564 100644 --- a/man/mo_property.Rd +++ b/man/mo_property.Rd @@ -126,11 +126,11 @@ Since the top-level of the taxonomy is sometimes referred to as 'kingdom' and so The Gram stain - \code{\link[=mo_gramstain]{mo_gramstain()}} - will be determined based on the taxonomic kingdom and phylum. According to Cavalier-Smith (2002, \href{https://pubmed.ncbi.nlm.nih.gov/11837318}{PMID 11837318}), who defined subkingdoms Negibacteria and Posibacteria, only these phyla are Posibacteria: Actinobacteria, Chloroflexi, Firmicutes and Tenericutes. These bacteria are considered Gram-positive - all other bacteria are considered Gram-negative. Species outside the kingdom of Bacteria will return a value \code{NA}. Functions \code{\link[=mo_is_gram_negative]{mo_is_gram_negative()}} and \code{\link[=mo_is_gram_positive]{mo_is_gram_positive()}} always return \code{TRUE} or \code{FALSE} (except when the input is \code{NA} or the MO code is \code{UNKNOWN}), thus always return \code{FALSE} for species outside the taxonomic kingdom of Bacteria. -Determination of yeasts - \code{\link[=mo_is_yeast]{mo_is_yeast()}} - will be based on the taxonomic phylum, class and order. Budding yeasts are true fungi of the phylum Ascomycetes, class Saccharomycetes (also called Hemiascomycetes). The true yeasts are separated into one main order Saccharomycetales. For all microorganisms that are in one of those two groups, the function will return \code{TRUE}. It returns \code{FALSE} for all other taxonomic entries. +Determination of yeasts - \code{\link[=mo_is_yeast]{mo_is_yeast()}} - will be based on the taxonomic kingdom and class. \emph{Budding yeasts} are fungi of the phylum Ascomycetes, class Saccharomycetes (also called Hemiascomycetes). \emph{True yeasts} are aggregated into the underlying order Saccharomycetales. Thus, for all microorganisms that are fungi and member of the taxonomic class Saccharomycetes, the function will return \code{TRUE}. It returns \code{FALSE} otherwise (except when the input is \code{NA} or the MO code is \code{UNKNOWN}). -Intrinsic resistance - \code{\link[=mo_is_intrinsic_resistant]{mo_is_intrinsic_resistant()}} - will be determined based on the \link{intrinsic_resistant} data set, which is based on \href{https://www.eucast.org/expert_rules_and_intrinsic_resistance/}{'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes' v3.2} (2020). The \code{\link[=mo_is_intrinsic_resistant]{mo_is_intrinsic_resistant()}} can be vectorised over arguments \code{x} (input for microorganisms) and over \code{ab} (input for antibiotics). +Intrinsic resistance - \code{\link[=mo_is_intrinsic_resistant]{mo_is_intrinsic_resistant()}} - will be determined based on the \link{intrinsic_resistant} data set, which is based on \href{https://www.eucast.org/expert_rules_and_intrinsic_resistance/}{'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes' v3.2} (2020). The \code{\link[=mo_is_intrinsic_resistant]{mo_is_intrinsic_resistant()}} functions can be vectorised over arguments \code{x} (input for microorganisms) and over \code{ab} (input for antibiotics). -All output will be \link{translate}d where possible. +All output \link[=translate]{will be translated} where possible. The function \code{\link[=mo_url]{mo_url()}} will return the direct URL to the online database entry, which also shows the scientific reference of the concerned species. } diff --git a/man/resistance_predict.Rd b/man/resistance_predict.Rd index 36ee1dcb5..d90029a64 100644 --- a/man/resistance_predict.Rd +++ b/man/resistance_predict.Rd @@ -47,7 +47,7 @@ ggplot_rsi_predict( ) } \arguments{ -\item{x}{a \link{data.frame} containing isolates. Can be left blank for automatic determination.} +\item{x}{a \link{data.frame} containing isolates. Can be left blank for automatic determination, see \emph{Examples}.} \item{col_ab}{column name of \code{x} containing antimicrobial interpretations (\code{"R"}, \code{"I"} and \code{"S"})} diff --git a/tests/testthat/test-_misc.R b/tests/testthat/test-_misc.R index 3a89e5f9f..8827ece3a 100755 --- a/tests/testthat/test-_misc.R +++ b/tests/testthat/test-_misc.R @@ -54,3 +54,12 @@ test_that("looking up ab columns works", { expect_warning(get_column_abx(dplyr::rename(example_isolates, thisone = AMX), amox = "thisone", tmp = "thisone", verbose = TRUE)) expect_warning(get_column_abx(dplyr::rename(example_isolates, thisone = AMX), amox = "thisone", tmp = "thisone", verbose = FALSE)) }) + +test_that("looking up ab columns works", { + skip_on_cran() + library(dplyr) + + # we rely on "grouped_tbl" being a class of grouped tibbles, so: + expect_true(is_null_or_grouped_tbl(example_isolates %>% group_by(hospital_id))) + +})
    only_rsi_columns

    a logical to indicate whether only antibiotic columns must be detected that were transformed to class <rsi> on beforehand. Defaults to TRUE if any column of x is of class <rsi>.

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

    ...
    x

    a data.frame containing isolates. Can be left blank for automatic determination.

    a data.frame containing isolates. Can be left blank for automatic determination, see Examples.

    col_ab