diff --git a/DESCRIPTION b/DESCRIPTION index b64e4717..4eb24628 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 1.7.1.9052 -Date: 2021-10-06 +Version: 1.7.1.9053 +Date: 2021-11-01 Title: Antimicrobial Resistance Data Analysis Description: Functions to simplify and standardise antimicrobial resistance (AMR) data analysis and to work with microbial and antimicrobial properties by @@ -12,32 +12,32 @@ Authors@R: c( email = "m.s.berends@umcg.nl", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-7620-1800")), + person(given = "Dennis", + family = "Souverein", + role = c("aut", "ctb"), + comment = c(ORCID = "0000-0003-0455-0336")), + person(given = c("Erwin", "E.", "A."), + family = "Hassing", + role = c("aut", "ctb")), person(given = c("Christian", "F."), family = "Luz", role = c("aut", "ctb"), comment = c(ORCID = "0000-0001-5809-5995")), - person(given = c("Alexander", "W."), - family = "Friedrich", - role = "ths", - comment = c(ORCID = "0000-0003-4881-038X")), - person(given = c("Bhanu", "N.", "M."), - family = "Sinha", - role = "ths", - comment = c(ORCID = "0000-0003-1634-0010")), person(given = c("Casper", "J."), family = "Albers", role = "ths", comment = c(ORCID = "0000-0002-9213-6743")), + person(given = c("Judith", "M."), + family = "Fonville", + role = "ctb"), + person(given = c("Alexander", "W."), + family = "Friedrich", + role = "ths", + comment = c(ORCID = "0000-0003-4881-038X")), person(given = "Corinna", family = "Glasner", role = "ths", comment = c(ORCID = "0000-0003-1241-1328")), - person(given = c("Judith", "M."), - family = "Fonville", - role = "ctb"), - person(given = c("Erwin", "E.", "A."), - family = "Hassing", - role = "ctb"), person(given = c("Eric", "H.", "L.", "C.", "M."), family = "Hazenberg", role = "ctb"), @@ -59,10 +59,10 @@ Authors@R: c( person(given = c("Rogier", "P."), family = "Schade", role = "ctb"), - person(given = "Dennis", - family = "Souverein", - role = "ctb", - comment = c(ORCID = "0000-0003-0455-0336")), + person(given = c("Bhanu", "N.", "M."), + family = "Sinha", + role = "ths", + comment = c(ORCID = "0000-0003-1634-0010")), person(given = "Anthony", family = "Underwood", role = "ctb", @@ -83,7 +83,7 @@ Suggests: tinytest, xml2 VignetteBuilder: knitr,rmarkdown -URL: https://github.com/msberends/AMR, https://msberends.github.io/AMR +URL: https://msberends.github.io/AMR, https://github.com/msberends/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 6e69ca19..88c8b7dd 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,5 @@ -# `AMR` 1.7.1.9052 -## Last updated: 6 October 2021 +# `AMR` 1.7.1.9053 +## Last updated: 1 November 2021 ### Breaking changes * Removed `p_symbol()` and all `filter_*()` functions (except for `filter_first_isolate()`), which were all deprecated in a previous package version @@ -39,7 +39,7 @@ * When printing a tibble with any old MO code, a warning will be thrown that old codes should be updated using `as.mo()` * Improved automatic column selector when `col_*` arguments are left blank, e.g. in `first_isolate()` * The right input types for `random_mic()`, `random_disk()` and `random_rsi()` are now enforced -* `as.rsi()` can now correct for textual input (such as "Susceptible", "Resistant") in Dutch, English, French, German, Italian, Portuguese and Spanish +* `as.rsi()` can now correct for textual input (such as "Susceptible", "Resistant") in Danish, Dutch, English, French, German, Italian, Portuguese and Spanish * When warnings are thrown because of too few isolates in any `count_*()`, `proportion_*()` function (or `resistant()` or `susceptible()`), the `dplyr` group will be shown, if available * Fix for legends created with `scale_rsi_colours()` when using `ggplot2` v3.3.4 or higher (this is ggplot2 bug 4511, soon to be fixed) * Fix for minor translation errors @@ -47,6 +47,10 @@ * Improved algorithm for generating random MICs with `random_mic()` * Improved plot legends for MICs and disk diffusion values * Improved speed of `as.ab()` and all `ab_*()` functions +* Added `fortify()` extensions for plotting methods + +### Other +* This package is now being maintained by two epidemiologists and a data scientist from two different non-profit healthcare organisations. All functions in this package are now all considered to be stable. Updates to the AMR interpretation rules (such as by EUCAST and CLSI), the microbial taxonomy, and the antibiotic dosages will all be updated yearly from now on. # AMR 1.7.1 diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index 2964515d..9e9077f7 100755 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -53,15 +53,68 @@ pm_left_join <- function(x, y, by = NULL, suffix = c(".x", ".y")) { merged } -quick_case_when <- function(...) { - vectors <- list(...) - split <- lapply(vectors, function(x) unlist(strsplit(paste(deparse(x), collapse = ""), "~", fixed = TRUE))) - for (i in seq_len(length(vectors))) { - if (eval(parse(text = split[[i]][1]), envir = parent.frame())) { - return(eval(parse(text = split[[i]][2]), envir = parent.frame())) +# copied and slightly rewritten from poorman under same license (2021-10-15) +quick_case_when <- function (...) { + fs <- list(...) + lapply(fs, function(x) if (class(x) != "formula") + stop("`case_when()` requires formula inputs.")) + n <- length(fs) + if (n == 0L) + stop("No cases provided.") + + validate_case_when_length <- function (query, value, fs) { + lhs_lengths <- lengths(query) + rhs_lengths <- lengths(value) + all_lengths <- unique(c(lhs_lengths, rhs_lengths)) + if (length(all_lengths) <= 1L) + return(all_lengths[[1L]]) + non_atomic_lengths <- all_lengths[all_lengths != 1L] + len <- non_atomic_lengths[[1L]] + if (length(non_atomic_lengths) == 1L) + return(len) + inconsistent_lengths <- non_atomic_lengths[-1L] + lhs_problems <- lhs_lengths %in% inconsistent_lengths + rhs_problems <- rhs_lengths %in% inconsistent_lengths + problems <- lhs_problems | rhs_problems + if (any(problems)) { + stop("The following formulas must be length ", len, " or 1, not ", + paste(inconsistent_lengths, collapse = ", "), ".\n ", + paste(fs[problems], collapse = "\n "), + call. = FALSE) } } - return(NA) + + replace_with <- function (x, i, val, arg_name) { + if (is.null(val)) + return(x) + i[is.na(i)] <- FALSE + if (length(val) == 1L) { + x[i] <- val + } + else { + x[i] <- val[i] + } + x + } + + query <- vector("list", n) + value <- vector("list", n) + default_env <- parent.frame() + for (i in seq_len(n)) { + query[[i]] <- eval(fs[[i]][[2]], envir = default_env) + value[[i]] <- eval(fs[[i]][[3]], envir = default_env) + if (!is.logical(query[[i]])) + stop(fs[[i]][[2]], " does not return a `logical` vector.") + } + m <- validate_case_when_length(query, value, fs) + out <- value[[1]][rep(NA_integer_, m)] + replaced <- rep(FALSE, m) + for (i in seq_len(n)) { + out <- replace_with(out, query[[i]] & !replaced, value[[i]], + NULL) + replaced <- replaced | (query[[i]] & !is.na(query[[i]])) + } + out } # No export, no Rd diff --git a/R/plot.R b/R/plot.R index 6a9d6751..a8c3c296 100644 --- a/R/plot.R +++ b/R/plot.R @@ -28,7 +28,7 @@ #' Functions to plot classes `rsi`, `mic` and `disk`, with support for base \R and `ggplot2`. #' @inheritSection lifecycle Maturing Lifecycle #' @inheritSection AMR Read more on Our Website! -#' @param x,object values created with [as.mic()], [as.disk()] or [as.rsi()] +#' @param x,object values created with [as.mic()], [as.disk()] or [as.rsi()] (or their `random_*` variants, such as [random_mic()]) #' @param mo any (vector of) text that can be coerced to a valid microorganism code with [as.mo()] #' @param ab any (vector of) text that can be coerced to a valid antimicrobial code with [as.ab()] #' @param guideline interpretation guideline to use, defaults to the latest included EUCAST guideline, see *Details* @@ -46,7 +46,9 @@ #' @name plot #' @rdname plot #' @return The `autoplot()` functions return a [`ggplot`][ggplot2::ggplot()] model that is extendible with any `ggplot2` function. -#' @param ... arguments passed on to [as.rsi()] +#' +#' The `fortify()` functions return a [data.frame] as an extension for usage in the [ggplot2::ggplot()] function. +#' @param ... arguments passed on to methods #' @examples #' some_mic_values <- random_mic(size = 100) #' some_disk_values <- random_disk(size = 100, mo = "Escherichia coli", ab = "cipro") @@ -283,6 +285,13 @@ autoplot.mic <- function(object, ggplot2::labs(title = title, x = xlab, y = ylab, subtitle = cols_sub$sub) } +#' @method fortify mic +#' @rdname plot +# will be exported using s3_register() in R/zzz.R +fortify.mic <- function(object, ...) { + stats::setNames(as.data.frame(plot_prepare_table(object, expand = FALSE)), + c("x", "y")) +} #' @method plot disk #' @export @@ -500,6 +509,14 @@ autoplot.disk <- function(object, ggplot2::labs(title = title, x = xlab, y = ylab, subtitle = cols_sub$sub) } +#' @method fortify disk +#' @rdname plot +# will be exported using s3_register() in R/zzz.R +fortify.disk <- function(object, ...) { + stats::setNames(as.data.frame(plot_prepare_table(object, expand = FALSE)), + c("x", "y")) +} + #' @method plot rsi #' @export #' @importFrom graphics plot text axis @@ -646,6 +663,14 @@ autoplot.rsi <- function(object, ggplot2::theme(legend.position = "none") } +#' @method fortify rsi +#' @rdname plot +# will be exported using s3_register() in R/zzz.R +fortify.rsi <- function(object, ...) { + stats::setNames(as.data.frame(table(object)), + c("x", "y")) +} + 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/zzz.R b/R/zzz.R index 9e1e1dbb..635dba00 100755 --- a/R/zzz.R +++ b/R/zzz.R @@ -66,6 +66,10 @@ if (utf8_supported && !is_latex) { s3_register("ggplot2::autoplot", "mic") s3_register("ggplot2::autoplot", "disk") s3_register("ggplot2::autoplot", "resistance_predict") + # Support for fortify from the ggplot2 package + s3_register("ggplot2::fortify", "rsi") + s3_register("ggplot2::fortify", "mic") + s3_register("ggplot2::fortify", "disk") # Support vctrs package for use in e.g. dplyr verbs s3_register("vctrs::vec_ptype2", "ab.character") s3_register("vctrs::vec_ptype2", "character.ab") diff --git a/data-raw/AMR_latest.tar.gz b/data-raw/AMR_latest.tar.gz index 69e4101d..53db11ff 100644 Binary files a/data-raw/AMR_latest.tar.gz and b/data-raw/AMR_latest.tar.gz differ diff --git a/docs/articles/datasets.html b/docs/articles/datasets.html index d1926e32..18d20f54 100644 --- a/docs/articles/datasets.html +++ b/docs/articles/datasets.html @@ -30,8 +30,6 @@ - -