diff --git a/DESCRIPTION b/DESCRIPTION index b2b74f41..e5921f77 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 1.7.1.9001 -Date: 2021-06-05 +Version: 1.7.1.9002 +Date: 2021-06-14 Title: Antimicrobial Resistance Data Analysis Authors@R: c( person(role = c("aut", "cre"), @@ -59,7 +59,7 @@ Suggests: tinytest, xml2 VignetteBuilder: knitr,rmarkdown -URL: https://msberends.github.io/AMR/, https://github.com/msberends/AMR +URL: https://github.com/msberends/AMR, https://msberends.github.io/AMR BugReports: https://github.com/msberends/AMR/issues License: GPL-2 | file LICENSE Encoding: UTF-8 diff --git a/NEWS.md b/NEWS.md index 3196c43e..ae25ba85 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,12 @@ -# `AMR` 1.7.1.9001 -## Last updated: 5 June 2021 +# `AMR` 1.7.1.9002 +## Last updated: 14 June 2021 ### Changed -* Added more antibiotic class selectors, such as `lincosamides()` and `lipoglycopeptides()` +* Added more antibiotic class selectors: `aminopenicillins()`, `lincosamides()`, `lipoglycopeptides()`, `polymyxins()`, `quinolones()`, `streptogramins()` and `ureidopenicillins()` +* Added `ggplot2::autoplot()` generic for classes ``, ``, `` and `` +* Fix to prevent introducing `NA`s for old MO codes when running `as.mo()` on them +* Added more informative error messages when any of the `proportion_*()` and `count_*()` functions fail +* Fix for using antibiotic selectors multiple times in one call (e.g., using in `dplyr::filter()` and immediately after in `dplyr::select()`) # `AMR` 1.7.1 diff --git a/R/ab_class_selectors.R b/R/ab_class_selectors.R index 4d912f3e..18fa70bf 100644 --- a/R/ab_class_selectors.R +++ b/R/ab_class_selectors.R @@ -278,7 +278,7 @@ ab_selector <- function(function_name, } # get_current_data() has to run each time, for cases where e.g., filter() and select() are used in same call - vars_df <- get_current_data(arg_name = NA, call = -3, reuse_equal_call = FALSE) + vars_df <- get_current_data(arg_name = NA, call = -3, reuse_from_1st_call = FALSE) # to improve speed, get_column_abx() will only run once when e.g. in a select or group call ab_in_data <- get_column_abx(vars_df, info = FALSE, only_rsi_columns = only_rsi_columns, sort = FALSE) diff --git a/R/count.R b/R/count.R index 45fb5622..83ede9ba 100755 --- a/R/count.R +++ b/R/count.R @@ -82,6 +82,12 @@ #' n1 = count_all(CIP), # the actual total; sum of all three #' n2 = n_rsi(CIP), # same - analogous to n_distinct #' total = n()) # NOT the number of tested isolates! +#' +#' # Number of available isolates for a whole antibiotic class +#' # (i.e., in this data set columns GEN, TOB, AMK, KAN) +#' example_isolates %>% +#' group_by(hospital_id) %>% +#' summarise(across(aminoglycosides(), n_rsi)) #' #' # Count co-resistance between amoxicillin/clav acid and gentamicin, #' # so we can see that combination therapy does a lot more than mono therapy. @@ -108,81 +114,97 @@ #' } #' } count_resistant <- function(..., only_all_tested = FALSE) { - rsi_calc(..., - ab_result = "R", - only_all_tested = only_all_tested, - only_count = TRUE) + tryCatch( + rsi_calc(..., + ab_result = "R", + only_all_tested = only_all_tested, + only_count = TRUE), + error = function(e) stop_(e$message, call = -5)) } #' @rdname count #' @export count_susceptible <- function(..., only_all_tested = FALSE) { - rsi_calc(..., - ab_result = c("S", "I"), - only_all_tested = only_all_tested, - only_count = TRUE) + tryCatch( + rsi_calc(..., + ab_result = c("S", "I"), + only_all_tested = only_all_tested, + only_count = TRUE), + error = function(e) stop_(e$message, call = -5)) } #' @rdname count #' @export count_R <- function(..., only_all_tested = FALSE) { - rsi_calc(..., - ab_result = "R", - only_all_tested = only_all_tested, - only_count = TRUE) + tryCatch( + rsi_calc(..., + ab_result = "R", + only_all_tested = only_all_tested, + only_count = TRUE), + error = function(e) stop_(e$message, call = -5)) } #' @rdname count #' @export count_IR <- function(..., only_all_tested = FALSE) { - if (message_not_thrown_before("count_IR")) { - warning_("Using count_IR() is discouraged; use count_resistant() instead to not consider \"I\" being resistant.", call = FALSE) + if (message_not_thrown_before("count_IR", entire_session = TRUE)) { + message_("Using `count_IR()` is discouraged; use `count_resistant()` instead to not consider \"I\" being resistant. This note will be shown once for this session.", as_note = FALSE) remember_thrown_message("count_IR") } - rsi_calc(..., - ab_result = c("I", "R"), - only_all_tested = only_all_tested, - only_count = TRUE) + tryCatch( + rsi_calc(..., + ab_result = c("I", "R"), + only_all_tested = only_all_tested, + only_count = TRUE), + error = function(e) stop_(e$message, call = -5)) } #' @rdname count #' @export count_I <- function(..., only_all_tested = FALSE) { - rsi_calc(..., - ab_result = "I", - only_all_tested = only_all_tested, - only_count = TRUE) + tryCatch( + rsi_calc(..., + ab_result = "I", + only_all_tested = only_all_tested, + only_count = TRUE), + error = function(e) stop_(e$message, call = -5)) } #' @rdname count #' @export count_SI <- function(..., only_all_tested = FALSE) { - rsi_calc(..., - ab_result = c("S", "I"), - only_all_tested = only_all_tested, - only_count = TRUE) + tryCatch( + rsi_calc(..., + ab_result = c("S", "I"), + only_all_tested = only_all_tested, + only_count = TRUE), + error = function(e) stop_(e$message, call = -5)) } #' @rdname count #' @export count_S <- function(..., only_all_tested = FALSE) { - if (message_not_thrown_before("count_S")) { - warning_("Using count_S() is discouraged; use count_susceptible() instead to also consider \"I\" being susceptible.", call = FALSE) + if (message_not_thrown_before("count_S", entire_session = TRUE)) { + message_("Using `count_S()` is discouraged; use `count_susceptible()` instead to also consider \"I\" being susceptible. This note will be shown once for this session.", as_note = FALSE) remember_thrown_message("count_S") } - rsi_calc(..., - ab_result = "S", - only_all_tested = only_all_tested, - only_count = TRUE) + tryCatch( + rsi_calc(..., + ab_result = "S", + only_all_tested = only_all_tested, + only_count = TRUE), + error = function(e) stop_(e$message, call = -5)) } #' @rdname count #' @export count_all <- function(..., only_all_tested = FALSE) { - rsi_calc(..., - ab_result = c("S", "I", "R"), - only_all_tested = only_all_tested, - only_count = TRUE) + tryCatch( + rsi_calc(..., + ab_result = c("S", "I", "R"), + only_all_tested = only_all_tested, + only_count = TRUE), + error = function(e) stop_(e$message, call = -5)) } #' @rdname count @@ -196,11 +218,13 @@ count_df <- function(data, language = get_locale(), combine_SI = TRUE, combine_IR = FALSE) { - rsi_calc_df(type = "count", - data = data, - translate_ab = translate_ab, - language = language, - combine_SI = combine_SI, - combine_IR = combine_IR, - combine_SI_missing = missing(combine_SI)) + tryCatch( + rsi_calc_df(type = "count", + data = data, + translate_ab = translate_ab, + language = language, + combine_SI = combine_SI, + combine_IR = combine_IR, + combine_SI_missing = missing(combine_SI)), + error = function(e) stop_(e$message, call = -5)) } diff --git a/R/deprecated.R b/R/deprecated.R index 210f8bf3..561644ac 100755 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -62,7 +62,7 @@ filter_first_weighted_isolate <- function(x = NULL, 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 <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x) + x <- tryCatch(get_current_data(arg_name = "x", call = -2, reuse_from_1st_call = FALSE), error = function(e) x) } meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0 meet_criteria(col_date, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) @@ -104,7 +104,7 @@ key_antibiotics <- function(x = NULL, 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 <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x) + x <- tryCatch(get_current_data(arg_name = "x", call = -2, reuse_from_1st_call = FALSE), error = function(e) x) } key_antimicrobials(x = x, @@ -170,7 +170,7 @@ filter_ab_class <- function(x, if (missing(x) || 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 - .call_depth) + x <- get_current_data(arg_name = "x", call = -2 - .call_depth, reuse_from_1st_call = FALSE) .x_name <- "your_data" } meet_criteria(x, allow_class = "data.frame", .call_depth = .call_depth) diff --git a/R/first_isolate.R b/R/first_isolate.R index 39668209..892bc74a 100755 --- a/R/first_isolate.R +++ b/R/first_isolate.R @@ -207,7 +207,7 @@ first_isolate <- function(x = NULL, 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 <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x) + x <- tryCatch(get_current_data(arg_name = "x", call = -2, reuse_from_1st_call = FALSE), error = function(e) x) } meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0 meet_criteria(col_date, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) @@ -618,7 +618,7 @@ filter_first_isolate <- function(x = NULL, 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 <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x) + x <- tryCatch(get_current_data(arg_name = "x", call = -2, reuse_from_1st_call = FALSE), error = function(e) x) } meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0 meet_criteria(col_date, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) diff --git a/R/key_antimicrobials.R b/R/key_antimicrobials.R index c1c2b1d2..7e35c68a 100755 --- a/R/key_antimicrobials.R +++ b/R/key_antimicrobials.R @@ -130,7 +130,7 @@ key_antimicrobials <- function(x = NULL, 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 <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x) + x <- tryCatch(get_current_data(arg_name = "x", call = -2, reuse_from_1st_call = FALSE), error = function(e) x) } meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0 meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE, is_in = colnames(x)) @@ -232,7 +232,7 @@ all_antimicrobials <- function(x = NULL, 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 <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x) + x <- tryCatch(get_current_data(arg_name = "x", call = -2, reuse_from_1st_call = FALSE), error = function(e) x) } meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0 meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1) diff --git a/R/mdro.R b/R/mdro.R index fb3d0a37..edf4010e 100755 --- a/R/mdro.R +++ b/R/mdro.R @@ -170,7 +170,7 @@ mdro <- function(x = NULL, 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 <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x) + x <- tryCatch(get_current_data(arg_name = "x", call = -2, reuse_from_1st_call = FALSE), error = function(e) x) } meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0 meet_criteria(guideline, allow_class = c("list", "character"), allow_NULL = TRUE) diff --git a/R/mo.R b/R/mo.R index 0a870533..804263dc 100755 --- a/R/mo.R +++ b/R/mo.R @@ -1664,16 +1664,25 @@ pillar_shaft.mo <- function(x, ...) { out[is.na(x)] <- font_na(" NA") out[x == "UNKNOWN"] <- font_na(" UNKNOWN") - if (!all(x[!is.na(x)] %in% MO_lookup$mo)) { + df <- tryCatch(get_current_data(arg_name = "x", + call = 0, + reuse_from_1st_call = FALSE), + error = function(e) NULL) + if (!is.null(df)) { + mo_cols <- vapply(FUN.VALUE = logical(1), df, is.mo) + } else { + mo_cols <- NULL + } + + if (!all(x[!is.na(x)] %in% MO_lookup$mo) | + (!is.null(df) && !all(unlist(df[, which(mo_cols), drop = FALSE]) %in% MO_lookup$mo))) { # markup old mo codes out[!x %in% MO_lookup$mo] <- font_italic(font_na(x[!x %in% MO_lookup$mo], collapse = NULL), collapse = NULL) - # throw a warning with the affected column name - mo <- tryCatch(search_type_in_df(get_current_data(arg_name = "x", call = 0), type = "mo", info = FALSE), - error = function(e) NULL) - if (!is.null(mo)) { - col <- paste0("Column '", mo, "'") + # throw a warning with the affected column name(s) + if (!is.null(mo_cols)) { + col <- paste0("Column ", vector_or(colnames(df)[mo_cols], quotes = TRUE, sort = FALSE)) } else { col <- "The data" } @@ -1681,7 +1690,7 @@ pillar_shaft.mo <- function(x, ...) { "Please update your MO codes with `as.mo()`.", call = FALSE) } - + # make it always fit exactly max_char <- max(nchar(x)) if (is.na(max_char)) { @@ -2039,12 +2048,16 @@ parse_and_convert <- function(x) { x <- as.data.frame(x, stringsAsFactors = FALSE)[[1]] } } + x_class <- class(x) + x <- as.character(x) x[is.null(x)] <- NA parsed <- iconv(x, to = "UTF-8") parsed[is.na(parsed) & !is.na(x)] <- iconv(x[is.na(parsed) & !is.na(x)], from = "Latin1", to = "ASCII//TRANSLIT") parsed <- gsub('"', "", parsed, fixed = TRUE) parsed <- gsub(" +", " ", parsed, perl = TRUE) parsed <- trimws(parsed) + class(parsed) <- x_class + parsed }, error = function(e) stop(e$message, call. = FALSE)) # this will also be thrown when running `as.mo(no_existing_object)` parsed } diff --git a/R/mo_property.R b/R/mo_property.R index 6fb01a41..419dc0f9 100755 --- a/R/mo_property.R +++ b/R/mo_property.R @@ -747,7 +747,9 @@ mo_validate <- function(x, property, language, ...) { find_mo_col <- function(fn) { # this function tries to find an mo column in the data the function was called in, # which is useful when functions are used within dplyr verbs - df <- get_current_data(arg_name = "x", call = -3) # will return an error if not found + df <- get_current_data(arg_name = "x", + call = -3, + reuse_from_1st_call = FALSE) # will return an error if not found mo <- NULL try({ mo <- suppressMessages(search_type_in_df(df, "mo")) diff --git a/R/plot.R b/R/plot.R index 0dbc4de5..22892b98 100644 --- a/R/plot.R +++ b/R/plot.R @@ -287,6 +287,11 @@ ggplot.mic <- function(data, ggplot2::labs(title = title, x = xlab, y = ylab, subtitle = cols_sub$sub) } +#' @method autoplot mic +#' @rdname plot +# will be exported using s3_register() in R/zzz.R +autoplot.mic <- ggplot.mic + #' @method plot disk #' @export #' @importFrom graphics barplot axis mtext legend @@ -506,6 +511,11 @@ ggplot.disk <- function(data, ggplot2::labs(title = title, x = xlab, y = ylab, subtitle = cols_sub$sub) } +#' @method autoplot disk +#' @rdname plot +# will be exported using s3_register() in R/zzz.R +autoplot.disk <- ggplot.disk + #' @method plot rsi #' @export #' @importFrom graphics plot text axis @@ -657,6 +667,11 @@ ggplot.rsi <- function(data, ggplot2::theme(legend.position = "none") } +#' @method autoplot rsi +#' @rdname plot +# will be exported using s3_register() in R/zzz.R +autoplot.rsi <- ggplot.rsi + plot_prepare_table <- function(x, expand) { x <- x[!is.na(x)] stop_if(length(x) == 0, "no observations to plot", call = FALSE) diff --git a/R/proportion.R b/R/proportion.R index 99991bbf..6e632aa8 100755 --- a/R/proportion.R +++ b/R/proportion.R @@ -167,12 +167,14 @@ resistance <- function(..., minimum = 30, as_percent = FALSE, only_all_tested = FALSE) { - rsi_calc(..., - ab_result = "R", - minimum = minimum, - as_percent = as_percent, - only_all_tested = only_all_tested, - only_count = FALSE) + tryCatch( + rsi_calc(..., + ab_result = "R", + minimum = minimum, + as_percent = as_percent, + only_all_tested = only_all_tested, + only_count = FALSE), + error = function(e) stop_(e$message, call = -5)) } #' @rdname proportion @@ -181,12 +183,14 @@ susceptibility <- function(..., minimum = 30, as_percent = FALSE, only_all_tested = FALSE) { - rsi_calc(..., - ab_result = c("S", "I"), - minimum = minimum, - as_percent = as_percent, - only_all_tested = only_all_tested, - only_count = FALSE) + tryCatch( + rsi_calc(..., + ab_result = c("S", "I"), + minimum = minimum, + as_percent = as_percent, + only_all_tested = only_all_tested, + only_count = FALSE), + error = function(e) stop_(e$message, call = -5)) } #' @rdname proportion @@ -195,12 +199,14 @@ proportion_R <- function(..., minimum = 30, as_percent = FALSE, only_all_tested = FALSE) { - rsi_calc(..., - ab_result = "R", - minimum = minimum, - as_percent = as_percent, - only_all_tested = only_all_tested, - only_count = FALSE) + tryCatch( + rsi_calc(..., + ab_result = "R", + minimum = minimum, + as_percent = as_percent, + only_all_tested = only_all_tested, + only_count = FALSE), + error = function(e) stop_(e$message, call = -5)) } #' @rdname proportion @@ -209,12 +215,14 @@ proportion_IR <- function(..., minimum = 30, as_percent = FALSE, only_all_tested = FALSE) { - rsi_calc(..., - ab_result = c("I", "R"), - minimum = minimum, - as_percent = as_percent, - only_all_tested = only_all_tested, - only_count = FALSE) + tryCatch( + rsi_calc(..., + ab_result = c("I", "R"), + minimum = minimum, + as_percent = as_percent, + only_all_tested = only_all_tested, + only_count = FALSE), + error = function(e) stop_(e$message, call = -5)) } #' @rdname proportion @@ -223,12 +231,14 @@ proportion_I <- function(..., minimum = 30, as_percent = FALSE, only_all_tested = FALSE) { - rsi_calc(..., - ab_result = "I", - minimum = minimum, - as_percent = as_percent, - only_all_tested = only_all_tested, - only_count = FALSE) + tryCatch( + rsi_calc(..., + ab_result = "I", + minimum = minimum, + as_percent = as_percent, + only_all_tested = only_all_tested, + only_count = FALSE), + error = function(e) stop_(e$message, call = -5)) } #' @rdname proportion @@ -237,12 +247,14 @@ proportion_SI <- function(..., minimum = 30, as_percent = FALSE, only_all_tested = FALSE) { - rsi_calc(..., - ab_result = c("S", "I"), - minimum = minimum, - as_percent = as_percent, - only_all_tested = only_all_tested, - only_count = FALSE) + tryCatch( + rsi_calc(..., + ab_result = c("S", "I"), + minimum = minimum, + as_percent = as_percent, + only_all_tested = only_all_tested, + only_count = FALSE), + error = function(e) stop_(e$message, call = -5)) } #' @rdname proportion @@ -251,12 +263,14 @@ proportion_S <- function(..., minimum = 30, as_percent = FALSE, only_all_tested = FALSE) { - rsi_calc(..., - ab_result = "S", - minimum = minimum, - as_percent = as_percent, - only_all_tested = only_all_tested, - only_count = FALSE) + tryCatch( + rsi_calc(..., + ab_result = "S", + minimum = minimum, + as_percent = as_percent, + only_all_tested = only_all_tested, + only_count = FALSE), + error = function(e) stop_(e$message, call = -5)) } #' @rdname proportion @@ -268,13 +282,15 @@ proportion_df <- function(data, as_percent = FALSE, combine_SI = TRUE, combine_IR = FALSE) { - rsi_calc_df(type = "proportion", - data = data, - translate_ab = translate_ab, - language = language, - minimum = minimum, - as_percent = as_percent, - combine_SI = combine_SI, - combine_IR = combine_IR, - combine_SI_missing = missing(combine_SI)) + tryCatch( + rsi_calc_df(type = "proportion", + data = data, + translate_ab = translate_ab, + language = language, + minimum = minimum, + as_percent = as_percent, + combine_SI = combine_SI, + combine_IR = combine_IR, + combine_SI_missing = missing(combine_SI)), + error = function(e) stop_(e$message, call = -5)) } diff --git a/R/resistance_predict.R b/R/resistance_predict.R index e9293035..41295c37 100755 --- a/R/resistance_predict.R +++ b/R/resistance_predict.R @@ -143,7 +143,7 @@ resistance_predict <- function(x, meet_criteria(info, allow_class = "logical", has_length = 1) stop_if(is.null(model), 'choose a regression model with the `model` argument, e.g. resistance_predict(..., model = "binomial")') - + dots <- unlist(list(...)) if (length(dots) != 0) { # backwards compatibility with old arguments @@ -321,7 +321,7 @@ plot.resistance_predict <- function(x, main = paste("Resistance Prediction of", } else { ylab <- "%IR" } - + plot(x = x$year, y = x$value, ylim = c(0, 1), @@ -351,20 +351,6 @@ plot.resistance_predict <- function(x, main = paste("Resistance Prediction of", col = "grey40") } - -#' @method ggplot resistance_predict -#' @rdname resistance_predict -# will be exported using s3_register() in R/zzz.R -ggplot.resistance_predict <- function(x, - main = paste("Resistance Prediction of", x_name), - ribbon = TRUE, - ...) { - x_name <- paste0(ab_name(attributes(x)$ab), " (", attributes(x)$ab, ")") - meet_criteria(main, allow_class = "character", has_length = 1) - meet_criteria(ribbon, allow_class = "logical", has_length = 1) - ggplot_rsi_predict(x = x, main = main, ribbon = ribbon, ...) -} - #' @rdname resistance_predict #' @export ggplot_rsi_predict <- function(x, @@ -407,3 +393,21 @@ ggplot_rsi_predict <- function(x, colour = "grey40") p } + +#' @method ggplot resistance_predict +#' @rdname resistance_predict +# will be exported using s3_register() in R/zzz.R +ggplot.resistance_predict <- function(x, + main = paste("Resistance Prediction of", x_name), + ribbon = TRUE, + ...) { + x_name <- paste0(ab_name(attributes(x)$ab), " (", attributes(x)$ab, ")") + meet_criteria(main, allow_class = "character", has_length = 1) + meet_criteria(ribbon, allow_class = "logical", has_length = 1) + ggplot_rsi_predict(x = x, main = main, ribbon = ribbon, ...) +} + +#' @method autoplot resistance_predict +#' @rdname resistance_predict +# will be exported using s3_register() in R/zzz.R +autoplot.resistance_predict <- ggplot.resistance_predict diff --git a/R/rsi.R b/R/rsi.R index d58c1c68..cc5fa42c 100755 --- a/R/rsi.R +++ b/R/rsi.R @@ -349,7 +349,7 @@ as.rsi.mic <- function(x, # for dplyr's across() cur_column_dplyr <- import_fn("cur_column", "dplyr", error_on_fail = FALSE) - if (!is.null(cur_column_dplyr) && tryCatch(is.data.frame(get_current_data("ab", 0)), error = function(e) FALSE)) { + if (!is.null(cur_column_dplyr) && tryCatch(is.data.frame(get_current_data("ab", call = 0, reuse_from_1st_call = FALSE)), error = function(e) FALSE)) { # try to get current column, which will only be available when in across() ab <- tryCatch(cur_column_dplyr(), error = function(e) ab) @@ -438,7 +438,7 @@ as.rsi.disk <- function(x, # for dplyr's across() cur_column_dplyr <- import_fn("cur_column", "dplyr", error_on_fail = FALSE) - if (!is.null(cur_column_dplyr) && tryCatch(is.data.frame(get_current_data("ab", 0)), error = function(e) FALSE)) { + if (!is.null(cur_column_dplyr) && tryCatch(is.data.frame(get_current_data("ab", call = 0, reuse_from_1st_call = FALSE)), error = function(e) FALSE)) { # try to get current column, which will only be available when in across() ab <- tryCatch(cur_column_dplyr(), error = function(e) ab) @@ -448,7 +448,7 @@ as.rsi.disk <- function(x, mo_var_found <- "" if (is.null(mo)) { tryCatch({ - df <- get_current_data(arg_name = "mo", call = -3) # will return an error if not found + df <- get_current_data(arg_name = "mo", call = -3, reuse_from_1st_call = FALSE) # will return an error if not found mo <- NULL try({ mo <- suppressMessages(search_type_in_df(df, "mo")) diff --git a/R/sysdata.rda b/R/sysdata.rda index 71dacfce..aa044514 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/R/zzz.R b/R/zzz.R index bcb2d57d..da6e8ce0 100755 --- a/R/zzz.R +++ b/R/zzz.R @@ -65,6 +65,10 @@ if (utf8_supported && !is_latex) { s3_register("ggplot2::ggplot", "mic") s3_register("ggplot2::ggplot", "disk") s3_register("ggplot2::ggplot", "resistance_predict") + s3_register("ggplot2::autoplot", "rsi") + s3_register("ggplot2::autoplot", "mic") + s3_register("ggplot2::autoplot", "disk") + s3_register("ggplot2::autoplot", "resistance_predict") # if mo source exists, fire it up (see mo_source()) try({ diff --git a/data-raw/AMR_latest.tar.gz b/data-raw/AMR_latest.tar.gz index b9c5b823..d9586309 100644 Binary files a/data-raw/AMR_latest.tar.gz and b/data-raw/AMR_latest.tar.gz differ diff --git a/data-raw/exploratory_data_analysis_test.R b/data-raw/exploratory_data_analysis_test.R new file mode 100644 index 00000000..f833fc67 --- /dev/null +++ b/data-raw/exploratory_data_analysis_test.R @@ -0,0 +1,28 @@ +library(dplyr) +example_isolates %>% + select(mo, where(is.rsi)) %>% + tidyr::pivot_longer(cols = where(is.rsi)) %>% + # remove intrisic R + filter(!paste(mo, name) %in% AMR:::INTRINSIC_R) %>% + mutate(name = as.ab(name), + value = ifelse(value == "R", 1, 0), + class = ab_group(name)) %>% + group_by(mo, class) %>% + summarise(n = n(), + res = mean(value, na.rm = TRUE)) %>% + filter(n > 30, !is.na(res)) + + + +df <- example_isolates +search_mo <- "B_ESCHR_COLI" +intrinsic_res <- INTRINSIC_R[INTRINSIC_R %like% search_mo] +intrinsic_res <- gsub(".* (.*)", "\\1", intrinsic_res) + +x <- df %>% + select(mo, where(is.rsi)) %>% + filter(mo == search_mo) %>% + # at least 30 results available + select(function(x) sum(!is.na(x)) >= 30) %>% + # remove intrisic R + select(!matches(paste(intrinsic_res, collapse = "|"))) diff --git a/docs/404.html b/docs/404.html index b1ca057c..b7b9f89e 100644 --- a/docs/404.html +++ b/docs/404.html @@ -81,7 +81,7 @@ AMR (for R) - 1.7.1.9001 + 1.7.1.9002 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 73d7ad02..6bfda843 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -81,7 +81,7 @@ AMR (for R) - 1.7.1.9001 + 1.7.1.9002 diff --git a/docs/articles/datasets.html b/docs/articles/datasets.html index 61c3b6a9..62ef922e 100644 --- a/docs/articles/datasets.html +++ b/docs/articles/datasets.html @@ -39,7 +39,7 @@ AMR (for R) - 1.7.1.9001 + 1.7.1.9002 @@ -187,12 +187,12 @@ -
+

Data sets for download / own use

-

05 June 2021

+

14 June 2021

Source: vignettes/datasets.Rmd diff --git a/docs/articles/index.html b/docs/articles/index.html index bfe5c0c4..076b7206 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.7.1.9001 + 1.7.1.9002
diff --git a/docs/authors.html b/docs/authors.html index 32037449..de4a968c 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -81,7 +81,7 @@ AMR (for R) - 1.7.1.9001 + 1.7.1.9002
diff --git a/docs/index.html b/docs/index.html index 9df87552..cd303566 100644 --- a/docs/index.html +++ b/docs/index.html @@ -42,7 +42,7 @@ AMR (for R) - 1.7.1.9001 + 1.7.1.9002
@@ -213,7 +213,7 @@ With AMR (for R), there’s always a knowledgeable microbiologist by your side! 
 # AMR works great with dplyr, but it's not required or neccesary
-library(AMR)
+library(AMR)
 library(dplyr)
 
 example_isolates %>%
diff --git a/docs/news/index.html b/docs/news/index.html
index 379fdd32..794a5a4a 100644
--- a/docs/news/index.html
+++ b/docs/news/index.html
@@ -81,7 +81,7 @@
       
       
         AMR (for R)
-        1.7.1.9001
+        1.7.1.9002
@@ -236,19 +236,24 @@ Source: NEWS.md
-
-

- Unreleased AMR 1.7.1.9001

-
+
+

+ Unreleased AMR 1.7.1.9002

+

-Last updated: 5 June 2021 +Last updated: 14 June 2021

Changed

@@ -302,7 +307,7 @@
  • Function betalactams() as additional antbiotic column selector and function filter_betalactams() as additional antbiotic column filter. The group of betalactams consists of all carbapenems, cephalosporins and penicillins.
    • -
  • A ggplot() method for resistance_predict() +
  • A ggplot() method for resistance_predict()
    • @@ -403,7 +408,7 @@ #> 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

    • -

  • ggplot() generics for classes <mic> and <disk>

    • +

  • ggplot() generics for classes <mic> and <disk>

  • Function mo_is_yeast(), which determines whether a microorganism is a member of the taxonomic class Saccharomycetes or the taxonomic order Saccharomycetales:

    @@ -460,7 +465,7 @@
 
  • Plotting of MIC and disk diffusion values now support interpretation colouring if you supply the microorganism and antimicrobial agent
    • 
 
  • All colours were updated to colour-blind friendly versions for values R, S and I for all plot methods (also applies to tibble printing)
    • 
 
  • Interpretation of MIC and disk diffusion values to R/SI will now be translated if the system language is German, Dutch or Spanish (see translate)
    • 
-
  • Plotting is now possible with base R using plot() and with ggplot2 using ggplot() on any vector of MIC and disk diffusion values
    • 
+
  • Plotting is now possible with base R using plot() and with ggplot2 using ggplot() on any vector of MIC and disk diffusion values
    •
  • Updated SNOMED codes to US Edition of SNOMED CT from 1 September 2020 and added the source to the help page of the microorganisms data set
    • @@ -498,7 +503,7 @@ Other
    • Big documentation updates
      • -
    • Loading the package (i.e., library(AMR)) now is ~50 times faster than before, in costs of package size (which increased by ~3 MB)
      • +
    • Loading the package (i.e., library(AMR)) now is ~50 times faster than before, in costs of package size (which increased by ~3 MB)
    @@ -629,7 +634,7 @@

    Curious about which enterococci are actually intrinsic resistant to vancomycin?

     
-library(AMR)
+library(AMR)
 library(dplyr)
 intrinsic_resistant %>%
   filter(antibiotic == "Vancomycin", microorganism %like% "Enterococcus") %>% 
diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml
index 4fc4fc0d..18f2ebe2 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-06-05T13:10Z
+last_built: 2021-06-14T20:03Z
 urls:
   reference: https://msberends.github.io/AMR//reference
   article: https://msberends.github.io/AMR//articles
diff --git a/docs/reference/AMR.html b/docs/reference/AMR.html
index 1734524e..b7fbfb3c 100644
--- a/docs/reference/AMR.html
+++ b/docs/reference/AMR.html
@@ -82,7 +82,7 @@
       
       
         AMR (for R)
-        1.7.1.9001
+        1.7.1.9002
    diff --git a/docs/reference/count.html b/docs/reference/count.html index a73e3a60..13e9e41a 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.7.1 + 1.7.1.9002 @@ -409,6 +409,12 @@ A microorganism is categorised as Susceptible, Increased exposure when n1 = count_all(CIP), # the actual total; sum of all three n2 = n_rsi(CIP), # same - analogous to n_distinct total = n()) # NOT the number of tested isolates! + + # Number of available isolates for a whole antibiotic class + # (i.e., in this data set columns GEN, TOB, AMK, KAN) + example_isolates %>% + group_by(hospital_id) %>% + summarise(across(aminoglycosides(), n_rsi)) # Count co-resistance between amoxicillin/clav acid and gentamicin, # so we can see that combination therapy does a lot more than mono therapy. diff --git a/docs/reference/index.html b/docs/reference/index.html index 9de75c81..39309e8a 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.7.1.9001 + 1.7.1.9002 @@ -508,7 +508,7 @@ -

    plot(<mic>) ggplot(<mic>) plot(<disk>) ggplot(<disk>) plot(<rsi>) ggplot(<rsi>)

    +

    plot(<mic>) ggplot(<mic>) autoplot(<mic>) plot(<disk>) ggplot(<disk>) autoplot(<disk>) plot(<rsi>) ggplot(<rsi>) autoplot(<rsi>)

    Plotting for Classes rsi, mic and disk

    @@ -532,7 +532,7 @@ -

    resistance_predict() rsi_predict() plot(<resistance_predict>) ggplot(<resistance_predict>) ggplot_rsi_predict()

    +

    resistance_predict() rsi_predict() plot(<resistance_predict>) ggplot_rsi_predict() ggplot(<resistance_predict>) autoplot(<resistance_predict>)

    Predict antimicrobial resistance

    diff --git a/docs/reference/plot.html b/docs/reference/plot.html index 92aa2f84..9455c025 100644 --- a/docs/reference/plot.html +++ b/docs/reference/plot.html @@ -82,7 +82,7 @@ AMR (for R) - 1.7.1 + 1.7.1.9002 @@ -258,7 +258,23 @@ ) # S3 method for mic -ggplot( +ggplot( + data, + mapping = NULL, + title = paste("MIC values of", deparse(substitute(data))), + ylab = "Frequency", + xlab = "Minimum Inhibitory Concentration (mg/L)", + mo = NULL, + ab = NULL, + guideline = "EUCAST", + colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"), + language = get_locale(), + expand = TRUE, + ... +) + +# S3 method for mic +autoplot( data, mapping = NULL, title = paste("MIC values of", deparse(substitute(data))), @@ -289,7 +305,23 @@ ) # S3 method for disk -ggplot( +ggplot( + data, + mapping = NULL, + title = paste("Disk zones of", deparse(substitute(data))), + ylab = "Frequency", + xlab = "Disk diffusion diameter (mm)", + mo = NULL, + ab = NULL, + guideline = "EUCAST", + colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"), + language = get_locale(), + expand = TRUE, + ... +) + +# S3 method for disk +autoplot( data, mapping = NULL, title = paste("Disk zones of", deparse(substitute(data))), @@ -314,7 +346,19 @@ ) # S3 method for rsi -ggplot( +ggplot( + data, + mapping = NULL, + title = paste("Resistance Overview of", deparse(substitute(data))), + xlab = "Antimicrobial Interpretation", + ylab = "Frequency", + colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"), + language = get_locale(), + ... +) + +# S3 method for rsi +autoplot( data, mapping = NULL, title = paste("Resistance Overview of", deparse(substitute(data))), diff --git a/docs/reference/resistance_predict.html b/docs/reference/resistance_predict.html index 7de9618c..b27144fc 100644 --- a/docs/reference/resistance_predict.html +++ b/docs/reference/resistance_predict.html @@ -82,7 +82,7 @@ AMR (for R) - 1.7.1 + 1.7.1.9002 @@ -275,10 +275,18 @@ # S3 method for resistance_predict plot(x, main = paste("Resistance Prediction of", x_name), ...) +ggplot_rsi_predict( + x, + main = paste("Resistance Prediction of", x_name), + ribbon = TRUE, + ... +) + # S3 method for resistance_predict ggplot(x, main = paste("Resistance Prediction of", x_name), ribbon = TRUE, ...) -ggplot_rsi_predict( +# S3 method for resistance_predict +autoplot( x, main = paste("Resistance Prediction of", x_name), ribbon = TRUE, diff --git a/docs/survey.html b/docs/survey.html index 645ca556..a4b75df7 100644 --- a/docs/survey.html +++ b/docs/survey.html @@ -81,7 +81,7 @@ AMR (for R) - 1.7.1.9001 + 1.7.1.9002 diff --git a/inst/tinytest/test-zzz.R b/inst/tinytest/test-zzz.R index 2ecb7720..6cf3ca86 100644 --- a/inst/tinytest/test-zzz.R +++ b/inst/tinytest/test-zzz.R @@ -24,7 +24,7 @@ # ==================================================================== # # Check if these function still exist in the package (all are in Suggests field) -# Since GitHub Action runs every night, we will get emailed when a dependency fails based on this unit test +# Since GitHub Actions runs every night, we will get emailed when a dependency fails based on this unit test # functions used by import_fn() import_functions <- c( "anti_join" = "dplyr", @@ -53,14 +53,23 @@ call_functions <- c( # skimr "inline_hist" = "skimr", "sfl" = "skimr", - # set_mo_source + # readxl "read_excel" = "readxl", - # ggplot_rsi + # ggplot2 + "aes" = "ggplot2", "aes_string" = "ggplot2", + "arrow" = "ggplot2", + "autoplot" = "ggplot2", "element_blank" = "ggplot2", "element_line" = "ggplot2", "element_text" = "ggplot2", + "expand_limits" = "ggplot2", "facet_wrap" = "ggplot2", + "geom_errorbar" = "ggplot2", + "geom_path" = "ggplot2", + "geom_point" = "ggplot2", + "geom_ribbon" = "ggplot2", + "geom_segment" = "ggplot2", "geom_text" = "ggplot2", "ggplot" = "ggplot2", "labs" = "ggplot2", @@ -70,31 +79,9 @@ call_functions <- c( "scale_y_continuous" = "ggplot2", "theme" = "ggplot2", "theme_minimal" = "ggplot2", - # ggplot_pca - "aes" = "ggplot2", - "arrow" = "ggplot2", - "element_blank" = "ggplot2", - "element_line" = "ggplot2", - "element_text" = "ggplot2", - "expand_limits" = "ggplot2", - "geom_path" = "ggplot2", - "geom_point" = "ggplot2", - "geom_segment" = "ggplot2", - "geom_text" = "ggplot2", - "ggplot" = "ggplot2", - "labs" = "ggplot2", - "theme" = "ggplot2", - "theme_minimal" = "ggplot2", "unit" = "ggplot2", "xlab" = "ggplot2", - "ylab" = "ggplot2", - # resistance_predict - "aes" = "ggplot2", - "geom_errorbar" = "ggplot2", - "geom_point" = "ggplot2", - "geom_ribbon" = "ggplot2", - "ggplot" = "ggplot2", - "labs" = "ggplot2" + "ylab" = "ggplot2" ) import_functions <- c(import_functions, call_functions) diff --git a/man/count.Rd b/man/count.Rd index 1a273144..c8c92eae 100644 --- a/man/count.Rd +++ b/man/count.Rd @@ -167,6 +167,12 @@ if (require("dplyr")) { n1 = count_all(CIP), # the actual total; sum of all three n2 = n_rsi(CIP), # same - analogous to n_distinct total = n()) # NOT the number of tested isolates! + + # Number of available isolates for a whole antibiotic class + # (i.e., in this data set columns GEN, TOB, AMK, KAN) + example_isolates \%>\% + group_by(hospital_id) \%>\% + summarise(across(aminoglycosides(), n_rsi)) # Count co-resistance between amoxicillin/clav acid and gentamicin, # so we can see that combination therapy does a lot more than mono therapy. diff --git a/man/plot.Rd b/man/plot.Rd index 67e10f88..ed164a78 100644 --- a/man/plot.Rd +++ b/man/plot.Rd @@ -4,10 +4,13 @@ \alias{plot} \alias{plot.mic} \alias{ggplot.mic} +\alias{autoplot.mic} \alias{plot.disk} \alias{ggplot.disk} +\alias{autoplot.disk} \alias{plot.rsi} \alias{ggplot.rsi} +\alias{autoplot.rsi} \title{Plotting for Classes \code{rsi}, \code{mic} and \code{disk}} \usage{ \method{plot}{mic}( @@ -39,6 +42,21 @@ ... ) +\method{autoplot}{mic}( + data, + mapping = NULL, + title = paste("MIC values of", deparse(substitute(data))), + ylab = "Frequency", + xlab = "Minimum Inhibitory Concentration (mg/L)", + mo = NULL, + ab = NULL, + guideline = "EUCAST", + colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"), + language = get_locale(), + expand = TRUE, + ... +) + \method{plot}{disk}( x, main = paste("Disk zones of", deparse(substitute(x))), @@ -68,6 +86,21 @@ ... ) +\method{autoplot}{disk}( + data, + mapping = NULL, + title = paste("Disk zones of", deparse(substitute(data))), + ylab = "Frequency", + xlab = "Disk diffusion diameter (mm)", + mo = NULL, + ab = NULL, + guideline = "EUCAST", + colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"), + language = get_locale(), + expand = TRUE, + ... +) + \method{plot}{rsi}( x, ylab = "Percentage", @@ -86,6 +119,17 @@ language = get_locale(), ... ) + +\method{autoplot}{rsi}( + data, + mapping = NULL, + title = paste("Resistance Overview of", deparse(substitute(data))), + xlab = "Antimicrobial Interpretation", + ylab = "Frequency", + colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"), + language = get_locale(), + ... +) } \arguments{ \item{x, data}{MIC values created with \code{\link[=as.mic]{as.mic()}} or disk diffusion values created with \code{\link[=as.disk]{as.disk()}}} diff --git a/man/resistance_predict.Rd b/man/resistance_predict.Rd index fbb97bce..1a251c82 100644 --- a/man/resistance_predict.Rd +++ b/man/resistance_predict.Rd @@ -4,8 +4,9 @@ \alias{resistance_predict} \alias{rsi_predict} \alias{plot.resistance_predict} -\alias{ggplot.resistance_predict} \alias{ggplot_rsi_predict} +\alias{ggplot.resistance_predict} +\alias{autoplot.resistance_predict} \title{Predict antimicrobial resistance} \usage{ resistance_predict( @@ -40,9 +41,16 @@ rsi_predict( \method{plot}{resistance_predict}(x, main = paste("Resistance Prediction of", x_name), ...) +ggplot_rsi_predict( + x, + main = paste("Resistance Prediction of", x_name), + ribbon = TRUE, + ... +) + \method{ggplot}{resistance_predict}(x, main = paste("Resistance Prediction of", x_name), ribbon = TRUE, ...) -ggplot_rsi_predict( +\method{autoplot}{resistance_predict}( x, main = paste("Resistance Prediction of", x_name), ribbon = TRUE,