diff --git a/DESCRIPTION b/DESCRIPTION index c63ac516..eb573d2a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 1.5.0.9024 -Date: 2021-02-22 +Version: 1.5.0.9025 +Date: 2021-02-25 Title: Antimicrobial Resistance Data Analysis Authors@R: c( person(role = c("aut", "cre"), diff --git a/NAMESPACE b/NAMESPACE index 0037a592..a120bd83 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -32,6 +32,7 @@ S3method(as.rsi,data.frame) S3method(as.rsi,default) S3method(as.rsi,disk) S3method(as.rsi,mic) +S3method(barplot,disk) S3method(barplot,mic) S3method(barplot,rsi) S3method(c,ab) @@ -242,7 +243,7 @@ export(theme_rsi) importFrom(graphics,arrows) importFrom(graphics,axis) importFrom(graphics,barplot) -importFrom(graphics,par) +importFrom(graphics,mtext) importFrom(graphics,plot) importFrom(graphics,points) importFrom(graphics,text) diff --git a/NEWS.md b/NEWS.md index 48fe00dd..4eb68a0e 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,5 @@ -# AMR 1.5.0.9024 -## Last updated: 22 February 2021 +# AMR 1.5.0.9025 +## Last updated: 25 February 2021 ### 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. @@ -23,6 +23,7 @@ ``` * 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. +* `ggplot()` generics for classes `` and `` * Function `mo_is_yeast()`, which determines whether a microorganism is a member of the taxonomic class Saccharomycetes or the taxonomic order Saccharomycetales: ```r mo_kingdom(c("Aspergillus", "Candida")) @@ -54,12 +55,14 @@ * `is.rsi.eligible()` now detects if the column name resembles an antibiotic name or code and now returns `TRUE` immediately if the input contains any of the values "R", "S" or "I". This drastically improves speed, also for a lot of other functions that rely on automatic determination of antibiotic columns. * Functions `get_episode()` and `is_new_episode()` now support less than a day as value for argument `episode_days` (e.g., to include one patient/test per hour) * Argument `ampc_cephalosporin_resistance` in `eucast_rules()` now also applies to value "I" (not only "S") -* Updated colours of values R, S and I in tibble printing +* Updated `plot()` functions for classes ``, `` and `` - the former two now support colouring if you supply the microorganism and antimicrobial agent +* Updated colours to colour-blind friendly version for values R, S and I in tibble printing and for all plot methods (`ggplot_rsi()` and using `plot()` on classes ``, `` and ``) * Functions `print()` and `summary()` on a Principal Components Analysis object (`pca()`) now print additional group info if the original data was grouped using `dplyr::group_by()` * Improved speed and reliability of `guess_ab_col()`. As this also internally improves the reliability of `first_isolate()` and `mdro()`, this might have a slight impact on the results of those functions. * Fix for `mo_name()` when used in other languages than English * The `like()` function (and its fast alias `%like%`) now always use Perl compatibility, improving speed for many functions in this package (e.g., `as.mo()` is now up to 4 times faster) * *Staphylococcus cornubiensis* is now correctly categorised as coagulase-positive +* `random_disk()` and `random_mic()` now have an expanded range in their randomisation ### Other * Big documentation updates diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index 264bf934..6e3a00e1 100755 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -879,13 +879,16 @@ font_green_bg <- function(..., collapse = " ") { try_colour(..., before = "\033[42m", after = "\033[49m", collapse = collapse) } font_rsi_R_bg <- function(..., collapse = " ") { - try_colour(..., before = "\033[48;5;210m", after = "\033[49m", collapse = collapse) + #ED553B + try_colour(..., before = "\033[48;5;203m", after = "\033[49m", collapse = collapse) } font_rsi_S_bg <- function(..., collapse = " ") { - try_colour(..., before = "\033[48;5;113m", after = "\033[49m", collapse = collapse) + #3CAEA3 + try_colour(..., before = "\033[48;5;79m", after = "\033[49m", collapse = collapse) } font_rsi_I_bg <- function(..., collapse = " ") { - try_colour(..., before = "\033[48;5;185m", after = "\033[49m", collapse = collapse) + #F6D55C + try_colour(..., before = "\033[48;5;222m", after = "\033[49m", collapse = collapse) } font_red_bg <- function(..., collapse = " ") { try_colour(..., before = "\033[41m", after = "\033[49m", collapse = collapse) diff --git a/R/amr.R b/R/amr.R index b1fc4382..20f6fa0e 100644 --- a/R/amr.R +++ b/R/amr.R @@ -73,16 +73,3 @@ #' @name AMR #' @rdname AMR NULL - -#' Plotting for Classes `rsi`, `mic` and `disk` -#' -#' Functions to print classes of the `AMR` package. -#' @inheritSection lifecycle Stable Lifecycle -#' @inheritSection AMR Read more on Our Website! -#' @param ... Arguments passed on to functions -#' @inheritParams base::plot -#' @inheritParams graphics::barplot -#' @name plot -#' @rdname plot -#' @keywords internal -NULL diff --git a/R/disk.R b/R/disk.R index 895912ff..5a9f188b 100644 --- a/R/disk.R +++ b/R/disk.R @@ -145,30 +145,6 @@ print.disk <- function(x, ...) { print(as.integer(x), quote = FALSE) } -#' @method plot disk -#' @export -#' @importFrom graphics barplot axis -#' @rdname plot -plot.disk <- function(x, - main = paste("Disk zones values of", deparse(substitute(x))), - ylab = "Frequency", - xlab = "Disk diffusion (mm)", - axes = FALSE, - ...) { - meet_criteria(main, allow_class = "character", has_length = 1) - meet_criteria(ylab, allow_class = "character", has_length = 1) - meet_criteria(xlab, allow_class = "character", has_length = 1) - meet_criteria(axes, allow_class = "logical", has_length = 1) - - barplot(table(x), - ylab = ylab, - xlab = xlab, - axes = axes, - main = main, - ...) - axis(2, seq(0, max(table(x)))) -} - #' @method [ disk #' @export #' @noRd diff --git a/R/ggplot_rsi.R b/R/ggplot_rsi.R index a53357fc..7206f3ea 100755 --- a/R/ggplot_rsi.R +++ b/R/ggplot_rsi.R @@ -36,7 +36,8 @@ #' @param facet variable to split plots by, either `"interpretation"` (default) or `"antibiotic"` or a grouping variable #' @inheritParams proportion #' @param nrow (when using `facet`) number of rows -#' @param colours a named vector with colours for the bars. The names must be one or more of: S, SI, I, IR, R or be `FALSE` to use default [ggplot2][ggplot2::ggplot()] colours. +#' @param colours a named vector with colours for the bars. The names must be one or more of: S, SI, I, IR, R or be `FALSE` for standard [ggplot2][ggplot2::ggplot()] colours. The default colours are colour-blind friendly. +#' @param aesthetics aesthetics to apply the colours to, defaults to "fill" but can also be "colour" or "both" #' @param datalabels show datalabels using [labels_rsi_count()] #' @param datalabels.size size of the datalabels #' @param datalabels.colour colour of the datalabels @@ -364,25 +365,27 @@ scale_y_percent <- function(breaks = seq(0, 1, 0.1), limits = NULL) { #' @rdname ggplot_rsi #' @export -scale_rsi_colours <- function(colours = c(S = "#61a8ff", - SI = "#61a8ff", - I = "#61f7ff", - IR = "#ff6961", - R = "#ff6961")) { +scale_rsi_colours <- function(colours = c(S = "#3CAEA3", + SI = "#3CAEA3", + I = "#F6D55C", + IR = "#ED553B", + R = "#ED553B"), + aesthetics = "fill") { stop_ifnot_installed("ggplot2") meet_criteria(colours, allow_class = c("character", "logical")) - - # previous colour: palette = "RdYlGn" - # previous colours: values = c("#b22222", "#ae9c20", "#7cfc00") + meet_criteria(aesthetics, allow_class = c("character"), has_length = c(1, 2), is_in = c("colour", "color", "fill", "both")) if (!identical(colours, FALSE)) { - original_cols <- c(S = "#61a8ff", - SI = "#61a8ff", - I = "#61f7ff", - IR = "#ff6961", - R = "#ff6961") + if ("both" %in% aesthetics) { + aesthetics <- c("colour", "fill") + } + original_cols <- c(S = "#3CAEA3", + SI = "#3CAEA3", + I = "#F6D55C", + IR = "#ED553B", + R = "#ED553B") colours <- replace(original_cols, names(colours), colours) - ggplot2::scale_fill_manual(values = colours) + ggplot2::scale_fill_manual(values = colours, aesthetics = aesthetics) } } diff --git a/R/like.R b/R/like.R index 7676af3c..8519fe16 100755 --- a/R/like.R +++ b/R/like.R @@ -25,7 +25,7 @@ #' Pattern Matching with Keyboard Shortcut #' -#' Convenient wrapper around [grep()] to match a pattern: `x %like% pattern`. It always returns a [`logical`] vector and is always case-insensitive (use `x %like_case% pattern` for case-sensitive matching). Also, `pattern` can be as long as `x` to compare items of each index in both vectors, or they both can have the same length to iterate over all cases. +#' Convenient wrapper around [grepl()] to match a pattern: `x %like% pattern`. It always returns a [`logical`] vector and is always case-insensitive (use `x %like_case% pattern` for case-sensitive matching). Also, `pattern` can be as long as `x` to compare items of each index in both vectors, or they both can have the same length to iterate over all cases. #' @inheritSection lifecycle Stable Lifecycle #' @param x a character vector where matches are sought, or an object which can be coerced by [as.character()] to a character vector. #' @param pattern a character string containing a regular expression (or [character] string for `fixed = TRUE`) to be matched in the given character vector. Coerced by [as.character()] to a character string if possible. If a [character] vector of length 2 or more is supplied, the first element is used with a warning. @@ -43,7 +43,7 @@ #' #' Using RStudio? The text `%like%` can also be directly inserted in your code from the Addins menu and can have its own Keyboard Shortcut like `Ctrl+Shift+L` or `Cmd+Shift+L` (see `Tools` > `Modify Keyboard Shortcuts...`). #' @source Idea from the [`like` function from the `data.table` package](https://github.com/Rdatatable/data.table/blob/master/R/like.R) -#' @seealso [grep()] +#' @seealso [grepl()] #' @inheritSection AMR Read more on Our Website! #' @examples #' # simple test @@ -53,13 +53,17 @@ #' #> TRUE #' b %like% a #' #> FALSE -#' -#' # also supports multiple patterns, length must be equal to x +#' +#' # also supports multiple patterns #' a <- c("Test case", "Something different", "Yet another thing") #' b <- c( "case", "diff", "yet") #' a %like% b #' #> TRUE TRUE TRUE -#' +#' a[1] %like% b +#' #> TRUE FALSE FALSE +#' a %like% b[1] +#' #> TRUE FALSE FALSE +#' #' # get isolates whose name start with 'Ent' or 'ent' #' \donttest{ #' if (require("dplyr")) { @@ -71,7 +75,11 @@ like <- function(x, pattern, ignore.case = TRUE) { meet_criteria(x, allow_NA = TRUE) meet_criteria(pattern, allow_NA = FALSE) meet_criteria(ignore.case, allow_class = "logical", has_length = 1) - + + if (all(is.na(x))) { + return(rep(FALSE, length(x))) + } + # set to fixed if no regex found fixed <- !any(is_possibly_regex(pattern)) if (ignore.case == TRUE) { @@ -79,53 +87,26 @@ like <- function(x, pattern, ignore.case = TRUE) { x <- tolower(x) pattern <- tolower(pattern) } - - if (length(pattern) > 1 & length(x) == 1) { - x <- rep(x, length(pattern)) - } - - if (all(is.na(x))) { - return(rep(FALSE, length(x))) - } - - if (length(pattern) > 1) { - res <- vector(length = length(pattern)) - if (length(x) != length(pattern)) { - if (length(x) == 1) { - x <- rep(x, length(pattern)) - } - # return TRUE for every 'x' that matches any 'pattern', FALSE otherwise - for (i in seq_len(length(res))) { - if (is.factor(x[i])) { - res[i] <- as.integer(x[i]) %in% grep(pattern[i], levels(x[i]), ignore.case = FALSE, fixed = fixed) - } else { - res[i] <- grepl(pattern[i], x[i], ignore.case = FALSE, fixed = fixed, perl = !fixed) - } - } - res <- vapply(FUN.VALUE = logical(1), pattern, function(pttrn) grepl(pttrn, x, ignore.case = FALSE, fixed = fixed)) - res2 <- as.logical(rowSums(res)) - # get only first item of every hit in pattern - res2[duplicated(res)] <- FALSE - res2[rowSums(res) == 0] <- NA - return(res2) - } else { - # x and pattern are of same length, so items with each other - for (i in seq_len(length(res))) { - if (is.factor(x[i])) { - res[i] <- as.integer(x[i]) %in% grep(pattern[i], levels(x[i]), ignore.case = FALSE, fixed = fixed, perl = !fixed) - } else { - res[i] <- grepl(pattern[i], x[i], ignore.case = FALSE, fixed = fixed, perl = !fixed) - } - } - return(res) - } - } - - # the regular way how grepl works; just one pattern against one or more x + if (is.factor(x)) { - as.integer(x) %in% grep(pattern, levels(x), ignore.case = FALSE, fixed = fixed, perl = !fixed) - } else { + x <- as.character(x) + } + + if (length(pattern) == 1) { grepl(pattern, x, ignore.case = FALSE, fixed = fixed, perl = !fixed) + } else { + if (length(x) == 1) { + x <- rep(x, length(pattern)) + } else if (length(pattern) != length(x)) { + stop_("arguments `x` and `pattern` must be of same length, or either one must be 1") + } + mapply(FUN = grepl, + pattern, + x, + MoreArgs = list(ignore.case = FALSE, fixed = fixed, perl = !fixed), + SIMPLIFY = TRUE, + USE.NAMES = FALSE) + } } diff --git a/R/mic.R b/R/mic.R index 318f5959..3bfe19d2 100755 --- a/R/mic.R +++ b/R/mic.R @@ -53,8 +53,9 @@ #' ab = "AMX", #' guideline = "EUCAST") #' +#' # plot MIC values, see ?plot #' plot(mic_data) -#' barplot(mic_data) +#' plot(mic_data, mo = "E. coli", ab = "cipro") as.mic <- function(x, na.rm = FALSE) { meet_criteria(x, allow_class = c("mic", "character", "numeric", "integer"), allow_NA = TRUE) meet_criteria(na.rm, allow_class = "logical", has_length = 1) @@ -175,9 +176,11 @@ as.numeric.mic <- function(x, ...) { #' @method droplevels mic #' @export #' @noRd -droplevels.mic <- function(x, exclude = if (any(is.na(levels(x)))) NULL else NA, ...) { +droplevels.mic <- function(x, exclude = if (any(is.na(levels(x)))) NULL else NA, as.mic = TRUE, ...) { x <- droplevels.factor(x, exclude = exclude, ...) - class(x) <- c("mic", "ordered", "factor") + if (as.mic == TRUE) { + class(x) <- c("mic", "ordered", "factor") + } x } @@ -221,54 +224,6 @@ summary.mic <- function(object, ...) { value } -#' @method plot mic -#' @export -#' @importFrom graphics barplot axis -#' @rdname plot -plot.mic <- function(x, - main = paste("MIC values of", deparse(substitute(x))), - ylab = "Frequency", - xlab = "MIC value", - axes = FALSE, - ...) { - meet_criteria(main, allow_class = "character", has_length = 1) - meet_criteria(ylab, allow_class = "character", has_length = 1) - meet_criteria(xlab, allow_class = "character", has_length = 1) - meet_criteria(axes, allow_class = "logical", has_length = 1) - - barplot(table(as.double(x)), - ylab = ylab, - xlab = xlab, - axes = axes, - main = main, - ...) - axis(2, seq(0, max(table(as.double(x))))) -} - -#' @method barplot mic -#' @export -#' @importFrom graphics barplot axis -#' @rdname plot -barplot.mic <- function(height, - main = paste("MIC values of", deparse(substitute(height))), - ylab = "Frequency", - xlab = "MIC value", - axes = FALSE, - ...) { - meet_criteria(main, allow_class = "character", has_length = 1) - meet_criteria(ylab, allow_class = "character", has_length = 1) - meet_criteria(xlab, allow_class = "character", has_length = 1) - meet_criteria(axes, allow_class = "logical", has_length = 1) - - barplot(table(as.double(height)), - ylab = ylab, - xlab = xlab, - axes = axes, - main = main, - ...) - axis(2, seq(0, max(table(as.double(height))))) -} - #' @method [ mic #' @export #' @noRd diff --git a/R/plot.R b/R/plot.R new file mode 100644 index 00000000..0d23358b --- /dev/null +++ b/R/plot.R @@ -0,0 +1,552 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +#' Plotting for Classes `rsi`, `mic` and `disk` +#' +#' Functions to plot classes `rsi`, `mic` and `disk`, with support for base R and `ggplot2`. +#' @inheritSection lifecycle Stable Lifecycle +#' @inheritSection AMR Read more on Our Website! +#' @param x MIC values created with [as.mic()] or disk diffusion values created with [as.disk()] +#' @param mapping aesthetic mappings to use for [`ggplot()`][ggplot2::ggplot()] +#' @param main,title title of the plot +#' @param xlab,ylab axis title +#' @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* +#' @param colours_RSI colours to use for filling in the bars, must be a vector of three values (in the order R, S and I). The default colours are colour-blind friendly. +#' @param expand logical to indicate whether the range on the x axis should be expanded between the lowest and highest value. For MIC values, intermediate values will be factors of 2 starting from the highest MIC value. For disk diameters, the whole diameter range will be filled. +#' @details For interpreting MIC values as well as disk diffusion diameters, supported guidelines to be used as input for the `guideline` argument are: `r vector_and(AMR::rsi_translation$guideline, quotes = TRUE, reverse = TRUE)`. +#' +#' Simply using `"CLSI"` or `"EUCAST"` as input will automatically select the latest version of that guideline. +#' @name plot +#' @rdname plot +#' @return The `ggplot` functions return a [`ggplot`][ggplot2::ggplot()] model that is extendible with any `ggplot2` function. +#' @param ... arguments passed on to [as.rsi()] +#' @examples +#' some_mic_values <- random_mic(size = 100) +#' some_disk_values <- random_disk(size = 100, mo = "Escherichia coli", ab = "cipro") +#' +#' plot(some_mic_values) +#' plot(some_disk_values) +#' +#' # when providing the microorganism and antibiotic, colours will show interpretations: +#' plot(some_mic_values, mo = "S. aureus", ab = "ampicillin") +#' plot(some_disk_values, mo = "Escherichia coli", ab = "cipro") +#' +#' if (require("ggplot2")) { +#' ggplot(some_mic_values) +#' ggplot(some_disk_values, mo = "Escherichia coli", ab = "cipro") +#' } +NULL + +#' @method plot mic +#' @importFrom graphics barplot axis mtext +#' @export +#' @rdname plot +plot.mic <- function(x, + main = paste("MIC values of", deparse(substitute(x))), + ylab = "Frequency", + xlab = "Minimum Inhibitory Concentration (mg/L)", + mo = NULL, + ab = NULL, + guideline = "EUCAST", + colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"), + expand = TRUE, + ...) { + meet_criteria(main, allow_class = "character") + meet_criteria(ylab, allow_class = "character", has_length = 1) + meet_criteria(xlab, allow_class = "character", has_length = 1) + meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE) + meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE) + meet_criteria(guideline, allow_class = "character", has_length = 1) + meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3)) + if (length(colours_RSI) == 1) { + colours_RSI <- rep(colours_RSI, 3) + } + main <- gsub(" +", " ", paste0(main, collapse = " ")) + + x <- plot_prepare_table(x, expand = expand) + + cols_sub <- plot_colours_and_sub(x = x, + mo = mo, + ab = ab, + guideline = guideline, + colours_RSI = colours_RSI, + fn = as.mic, + ...) + + barplot(x, + col = cols_sub$cols, + main = main, + ylim = c(0, max(x) * ifelse(any(colours_RSI %in% cols_sub$cols), 1.1, 1)), + ylab = ylab, + xlab = xlab, + axes = FALSE) + axis(2, seq(0, max(as.double(x)))) + if (!is.null(cols_sub$sub)) { + mtext(side = 3, line = 0.5, adj = 0.5, cex = 0.75, cols_sub$sub) + } + + if (any(colours_RSI %in% cols_sub$cols)) { + legend_txt <- character(0) + legend_col <- character(0) + if (colours_RSI[2] %in% cols_sub$cols) { + legend_txt <- "Susceptible" + legend_col <- colours_RSI[2] + } + if (colours_RSI[3] %in% cols_sub$cols) { + legend_txt <- c(legend_txt, "Incr. exposure") + legend_col <- c(legend_col, colours_RSI[3]) + } + if (colours_RSI[1] %in% cols_sub$cols) { + legend_txt <- c(legend_txt, "Resistant") + legend_col <- c(legend_col, colours_RSI[1]) + } + legend("top", + x.intersp = 0.5, + legend = legend_txt, + fill = legend_col, + horiz = TRUE, + cex = 0.75, + box.lwd = 0, + bg = "#FFFFFF55") + } +} + +#' @method barplot mic +#' @export +#' @noRd +barplot.mic <- function(height, + main = paste("MIC values of", deparse(substitute(height))), + ylab = "Frequency", + xlab = "Minimum Inhibitory Concentration (mg/L)", + mo = NULL, + ab = NULL, + guideline = "EUCAST", + colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"), + expand = TRUE, + ...) { + meet_criteria(main, allow_class = "character") + meet_criteria(ylab, allow_class = "character", has_length = 1) + meet_criteria(xlab, allow_class = "character", has_length = 1) + meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE) + meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE) + meet_criteria(guideline, allow_class = "character", has_length = 1) + meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3)) + main <- gsub(" +", " ", paste0(main, collapse = " ")) + + plot(x = height, + main = main, + ylab = ylab, + xlab = xlab, + mo = mo, + ab = ab, + guideline = guideline, + colours_RSI = colours_RSI, + ...) +} + +#' @method ggplot mic +#' @rdname plot +# will be exported using s3_register() in R/zzz.R +ggplot.mic <- function(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"), + expand = TRUE, + ...) { + stop_ifnot_installed("ggplot2") + meet_criteria(title, allow_class = "character") + meet_criteria(ylab, allow_class = "character", has_length = 1) + meet_criteria(xlab, allow_class = "character", has_length = 1) + meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE) + meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE) + meet_criteria(guideline, allow_class = "character", has_length = 1) + meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3)) + + title <- gsub(" +", " ", paste0(title, collapse = " ")) + + x <- plot_prepare_table(data, expand = expand) + cols_sub <- plot_colours_and_sub(x = x, + mo = mo, + ab = ab, + guideline = guideline, + colours_RSI = colours_RSI, + fn = as.mic, + ...) + df <- as.data.frame(x, stringsAsFactors = TRUE) + colnames(df) <- c("mic", "count") + df$cols <- cols_sub$cols + df$cols[df$cols == colours_RSI[1]] <- "Resistant" + df$cols[df$cols == colours_RSI[2]] <- "Susceptible" + df$cols[df$cols == colours_RSI[3]] <- "Incr. exposure" + df$cols <- factor(df$cols, + levels = c("Susceptible", "Incr. exposure", "Resistant"), + ordered = TRUE) + if (!is.null(mapping)) { + p <- ggplot2::ggplot(df, mapping = mapping) + } else { + p <- ggplot2::ggplot(df) + } + + if (any(colours_RSI %in% cols_sub$cols)) { + p <- p + + ggplot2::geom_col(aes(x = mic, y = count, fill = cols)) + + ggplot2::scale_fill_manual(values = c("Resistant" = colours_RSI[1], + "Susceptible" = colours_RSI[2], + "Incr. exposure" = colours_RSI[3]),, + name = NULL) + } else { + p <- p + + ggplot2::geom_col(aes(x = mic, y = count)) + } + + p + + ggplot2::labs(title = title, x = xlab, y = ylab, subtitle = cols_sub$sub) +} + + +#' @method plot disk +#' @export +#' @importFrom graphics barplot axis mtext +#' @rdname plot +plot.disk <- function(x, + main = paste("Disk zones values of", deparse(substitute(x))), + ylab = "Frequency", + xlab = "Disk diffusion diameter (mm)", + mo = NULL, + ab = NULL, + guideline = "EUCAST", + colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"), + expand = TRUE, + ...) { + meet_criteria(main, allow_class = "character") + meet_criteria(ylab, allow_class = "character", has_length = 1) + meet_criteria(xlab, allow_class = "character", has_length = 1) + meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE) + meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE) + meet_criteria(guideline, allow_class = "character", has_length = 1) + meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3)) + if (length(colours_RSI) == 1) { + colours_RSI <- rep(colours_RSI, 3) + } + main <- gsub(" +", " ", paste0(main, collapse = " ")) + + x <- plot_prepare_table(x, expand = expand) + + cols_sub <- plot_colours_and_sub(x = x, + mo = mo, + ab = ab, + guideline = guideline, + colours_RSI = colours_RSI, + fn = as.disk, + ...) + + barplot(x, + col = cols_sub$cols, + main = main, + ylim = c(0, max(x) * ifelse(any(colours_RSI %in% cols_sub$cols), 1.1, 1)), + ylab = ylab, + xlab = xlab, + axes = FALSE) + axis(2, seq(0, max(x))) + if (!is.null(cols_sub$sub)) { + mtext(side = 3, line = 0.5, adj = 0.5, cex = 0.75, cols_sub$sub) + } + + if (any(colours_RSI %in% cols_sub$cols)) { + legend_txt <- character(0) + legend_col <- character(0) + if (colours_RSI[1] %in% cols_sub$cols) { + legend_txt <- "Resistant" + legend_col <- colours_RSI[1] + } + if (colours_RSI[3] %in% cols_sub$cols) { + legend_txt <- c(legend_txt, "Incr. exposure") + legend_col <- c(legend_col, colours_RSI[3]) + } + if (colours_RSI[2] %in% cols_sub$cols) { + legend_txt <- c(legend_txt, "Susceptible") + legend_col <- c(legend_col, colours_RSI[2]) + } + legend("top", + x.intersp = 0.5, + legend = legend_txt, + fill = legend_col, + horiz = TRUE, + cex = 0.75, + box.lwd = 0, + bg = "#FFFFFF55") + } +} + +#' @method barplot disk +#' @export +#' @noRd +barplot.disk <- function(height, + main = paste("Disk zones values of", deparse(substitute(height))), + ylab = "Frequency", + xlab = "Disk diffusion diameter (mm)", + mo = NULL, + ab = NULL, + guideline = "EUCAST", + colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"), + expand = TRUE, + ...) { + meet_criteria(main, allow_class = "character") + meet_criteria(ylab, allow_class = "character", has_length = 1) + meet_criteria(xlab, allow_class = "character", has_length = 1) + meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE) + meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE) + meet_criteria(guideline, allow_class = "character", has_length = 1) + meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3)) + + main <- gsub(" +", " ", paste0(main, collapse = " ")) + + plot(x = height, + main = main, + ylab = ylab, + xlab = xlab, + mo = mo, + ab = ab, + guideline = guideline, + colours_RSI = colours_RSI, + ...) +} + +#' @method ggplot disk +#' @rdname plot +# will be exported using s3_register() in R/zzz.R +ggplot.disk <- function(data, + mapping = NULL, + title = paste("Disk zones values of", deparse(substitute(data))), + ylab = "Frequency", + xlab = "Disk diffusion diameter (mm)", + mo = NULL, + ab = NULL, + guideline = "EUCAST", + colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"), + expand = TRUE, + ...) { + stop_ifnot_installed("ggplot2") + meet_criteria(title, allow_class = "character") + meet_criteria(ylab, allow_class = "character", has_length = 1) + meet_criteria(xlab, allow_class = "character", has_length = 1) + meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE) + meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE) + meet_criteria(guideline, allow_class = "character", has_length = 1) + meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3)) + + title <- gsub(" +", " ", paste0(title, collapse = " ")) + + x <- plot_prepare_table(data, expand = expand) + cols_sub <- plot_colours_and_sub(x = x, + mo = mo, + ab = ab, + guideline = guideline, + colours_RSI = colours_RSI, + fn = as.disk, + ...) + df <- as.data.frame(x, stringsAsFactors = TRUE) + colnames(df) <- c("disk", "count") + df$cols <- cols_sub$cols + df$cols[df$cols == colours_RSI[1]] <- "Resistant" + df$cols[df$cols == colours_RSI[2]] <- "Susceptible" + df$cols[df$cols == colours_RSI[3]] <- "Incr. exposure" + df$cols <- factor(df$cols, + levels = c("Resistant", "Incr. exposure", "Susceptible"), + ordered = TRUE) + if (!is.null(mapping)) { + p <- ggplot2::ggplot(df, mapping = mapping) + } else { + p <- ggplot2::ggplot(df) + } + + if (any(colours_RSI %in% cols_sub$cols)) { + p <- p + + ggplot2::geom_col(aes(x = disk, y = count, fill = cols)) + + ggplot2::scale_fill_manual(values = c("Resistant" = colours_RSI[1], + "Susceptible" = colours_RSI[2], + "Incr. exposure" = colours_RSI[3]), + name = NULL) + } else { + p <- p + + ggplot2::geom_col(aes(x = disk, y = count)) + } + + p + + ggplot2::labs(title = title, x = xlab, y = ylab, sub = cols_sub$sub) +} + +plot_prepare_table <- function(x, expand) { + if (is.mic(x)) { + if (expand == TRUE) { + # expand range for MIC by adding factors of 2 from lowest to highest so all MICs in between also print + extra_range <- max(as.double(x)) / 2 + while (min(extra_range) / 2 > min(as.double(x))) { + extra_range <- c(min(extra_range) / 2, extra_range) + } + extra_range <- setNames(rep(0, length(extra_range)), extra_range) + x <- table(droplevels(x, as.mic = FALSE)) + extra_range <- extra_range[!names(extra_range) %in% names(x)] + x <- as.table(c(x, extra_range)) + } else { + x <- table(droplevels(x, as.mic = FALSE)) + } + x <- x[order(as.double(as.mic(names(x))))] + } else if (is.disk(x)) { + if (expand == TRUE) { + # expand range for disks from lowest to highest so all mm's in between also print + extra_range <- rep(0, max(x) - min(x) - 1) + names(extra_range) <- seq(min(x) + 1, max(x) - 1) + x <- table(x) + extra_range <- extra_range[!names(extra_range) %in% names(x)] + x <- as.table(c(x, extra_range)) + } else { + x <- table(x) + } + x <- x[order(as.double(names(x)))] + } + as.table(x) +} + +plot_colours_and_sub <- function(x, mo, ab, guideline, colours_RSI, fn, ...) { + if (!is.null(mo) && !is.null(ab)) { + # interpret and give colour based on MIC values + mo <- as.mo(mo) + ab <- as.ab(ab) + guideline <- get_guideline(guideline, AMR::rsi_translation) + rsi <- suppressWarnings(suppressMessages(as.rsi(fn(names(x)), mo = mo, ab = ab, guideline = guideline, ...))) + cols <- character(length = length(rsi)) + cols[is.na(rsi)] <- "#BEBEBE" + cols[rsi == "R"] <- colours_RSI[1] + cols[rsi == "S"] <- colours_RSI[2] + cols[rsi == "I"] <- colours_RSI[3] + moname <- mo_name(mo, language = NULL) + abname <- ab_name(ab, language = NULL) + if (all(cols == "#BEBEBE")) { + message_("No ", guideline, " interpretations found for ", + ab_name(ab, language = NULL, tolower = TRUE), " in ", moname) + guideline <- "" + } else { + guideline <- paste0("(following ", guideline, ")") + } + sub <- bquote(.(abname)~"in"~italic(.(moname))~.(guideline)) + } else { + cols <- "#BEBEBE" + sub <- NULL + } + list(cols = cols, sub = sub) +} + + +#' @method plot rsi +#' @export +#' @importFrom graphics plot text axis +#' @rdname plot +plot.rsi <- function(x, + ylab = "Percentage", + xlab = "Antimicrobial Interpretation", + main = paste("Resistance Overview of", deparse(substitute(x))), + ...) { + meet_criteria(ylab, allow_class = "character", has_length = 1) + meet_criteria(xlab, allow_class = "character", has_length = 1) + meet_criteria(main, allow_class = "character", has_length = 1) + + data <- as.data.frame(table(x), stringsAsFactors = FALSE) + colnames(data) <- c("x", "n") + data$s <- round((data$n / sum(data$n)) * 100, 1) + + if (!"S" %in% data$x) { + data <- rbind(data, data.frame(x = "S", n = 0, s = 0, stringsAsFactors = FALSE), + stringsAsFactors = FALSE) + } + if (!"I" %in% data$x) { + data <- rbind(data, data.frame(x = "I", n = 0, s = 0, stringsAsFactors = FALSE), + stringsAsFactors = FALSE) + } + if (!"R" %in% data$x) { + data <- rbind(data, data.frame(x = "R", n = 0, s = 0, stringsAsFactors = FALSE), + stringsAsFactors = FALSE) + } + + data$x <- factor(data$x, levels = c("R", "S", "I"), ordered = TRUE) + + ymax <- pm_if_else(max(data$s) > 95, 105, 100) + + plot(x = data$x, + y = data$s, + lwd = 2, + ylim = c(0, ymax), + ylab = ylab, + xlab = xlab, + main = main, + axes = FALSE) + # x axis + axis(side = 1, at = 1:pm_n_distinct(data$x), labels = levels(data$x), lwd = 0) + # y axis, 0-100% + axis(side = 2, at = seq(0, 100, 5)) + + text(x = data$x, + y = data$s + 4, + labels = paste0(data$s, "% (n = ", data$n, ")")) +} + + +#' @method barplot rsi +#' @importFrom graphics barplot axis +#' @export +#' @noRd +barplot.rsi <- function(height, + main = paste("Resistance Overview of", deparse(substitute(height))), + xlab = "Antimicrobial Interpretation", + ylab = "Frequency", + colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"), + expand = TRUE, + ...) { + meet_criteria(xlab, allow_class = "character", has_length = 1) + meet_criteria(main, allow_class = "character", has_length = 1) + meet_criteria(ylab, allow_class = "character", has_length = 1) + meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3)) + if (length(colours_RSI) == 1) { + colours_RSI <- rep(colours_RSI, 3) + } + main <- gsub(" +", " ", paste0(main, collapse = " ")) + + x <- table(height) + x <- x[c(3, 1, 2)] + barplot(x, + col = colours_RSI, + xlab = xlab, + main = main, + ylab = ylab, + axes = FALSE) + axis(2, seq(0, max(x))) +} diff --git a/R/random.R b/R/random.R index 96684387..bc3b6d17 100644 --- a/R/random.R +++ b/R/random.R @@ -25,7 +25,7 @@ #' Random MIC Values/Disk Zones/RSI Generation #' -#' These functions can be used for generating random MIC values and disk diffusion diameters, for AMR data analysis practice. +#' These functions can be used for generating random MIC values and disk diffusion diameters, for AMR data analysis practice. By providing a microorganism and antimicrobial agent, the generated results will reflect reality as much as possible. #' @inheritSection lifecycle Maturing Lifecycle #' @param size desired size of the returned vector #' @param mo any character that can be coerced to a valid microorganism code with [as.mo()] @@ -111,8 +111,8 @@ random_exec <- function(type, size, mo = NULL, ab = NULL) { if (log(set_range_max, 2) %% 1 == 0) { # return powers of 2 valid_range <- unique(as.double(valid_range)) - # add one higher MIC level to set_range_max - set_range_max <- 2 ^ (log(set_range_max, 2) + 1) + # add 1-3 higher MIC levels to set_range_max + set_range_max <- 2 ^ (log(set_range_max, 2) + sample(c(1:3), 1)) set_range <- as.mic(valid_range[log(valid_range, 2) %% 1 == 0 & valid_range <= set_range_max]) } else { # no power of 2, return factors of 2 to left and right side @@ -121,8 +121,8 @@ random_exec <- function(type, size, mo = NULL, ab = NULL) { } return(as.mic(sample(set_range, size = size, replace = TRUE))) } else if (type == "DISK") { - set_range <- seq(from = as.integer(min(df$breakpoint_R)), - to = as.integer(max(df$breakpoint_S)), + set_range <- seq(from = as.integer(min(df$breakpoint_R) / 1.25), + to = as.integer(max(df$breakpoint_S) * 1.25), by = 1) out <- sample(set_range, size = size, replace = TRUE) out[out < 6] <- sample(c(6:10), length(out[out < 6]), replace = TRUE) diff --git a/R/rsi.R b/R/rsi.R index df5422b9..0e579a39 100755 --- a/R/rsi.R +++ b/R/rsi.R @@ -252,12 +252,13 @@ is.rsi.eligible <- function(x, threshold = 0.05) { } #' @export +# extra param: warn (never throw warning) as.rsi.default <- function(x, ...) { if (is.rsi(x)) { return(x) } - if (inherits(x, "integer") & all(x %in% c(1:3, NA))) { + if (inherits(x, c("integer", "numeric", "double")) && all(x %in% c(1:3, NA))) { x[x == 1] <- "S" x[x == 2] <- "I" x[x == 3] <- "R" @@ -265,11 +266,11 @@ as.rsi.default <- function(x, ...) { } else if (!all(is.na(x)) && !identical(levels(x), c("S", "I", "R"))) { if (!any(x %like% "(R|S|I)", na.rm = TRUE)) { - # check if they are actually MICs or disks now that the antibiotic name is valid + # check if they are actually MICs or disks if (all_valid_mics(x)) { - warning_("The input seems to be MIC values. Transform them with as.mic() before running as.rsi() to interpret them.") + warning_("The input seems to be MIC values. Transform them with `as.mic()` before running `as.rsi()` to interpret them.") } else if (all_valid_disks(x)) { - warning_("The input seems to be disk diffusion values. Transform them with as.disk() before running as.rsi() to interpret them.") + warning_("The input seems to be disk diffusion values. Transform them with `as.disk()` before running `as.rsi()` to interpret them.") } } @@ -1010,107 +1011,6 @@ summary.rsi <- function(object, ...) { value } -#' @method plot rsi -#' @export -#' @importFrom graphics plot text axis -#' @rdname plot -plot.rsi <- function(x, - lwd = 2, - ylim = NULL, - ylab = "Percentage", - xlab = "Antimicrobial Interpretation", - main = paste("Resistance Overview of", deparse(substitute(x))), - axes = FALSE, - ...) { - meet_criteria(lwd, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE) - meet_criteria(ylim, allow_class = c("numeric", "integer"), allow_NULL = TRUE) - meet_criteria(ylab, allow_class = "character", has_length = 1) - meet_criteria(xlab, allow_class = "character", has_length = 1) - meet_criteria(main, allow_class = "character", has_length = 1) - meet_criteria(axes, allow_class = "logical", has_length = 1) - - data <- as.data.frame(table(x), stringsAsFactors = FALSE) - colnames(data) <- c("x", "n") - data$s <- round((data$n / sum(data$n)) * 100, 1) - - if (!"S" %in% data$x) { - data <- rbind(data, data.frame(x = "S", n = 0, s = 0, stringsAsFactors = FALSE), - stringsAsFactors = FALSE) - } - if (!"I" %in% data$x) { - data <- rbind(data, data.frame(x = "I", n = 0, s = 0, stringsAsFactors = FALSE), - stringsAsFactors = FALSE) - } - if (!"R" %in% data$x) { - data <- rbind(data, data.frame(x = "R", n = 0, s = 0, stringsAsFactors = FALSE), - stringsAsFactors = FALSE) - } - - # don't use as.rsi() here, it will confuse plot() - data$x <- factor(data$x, levels = c("S", "I", "R"), ordered = TRUE) - - ymax <- pm_if_else(max(data$s) > 95, 105, 100) - - plot(x = data$x, - y = data$s, - lwd = lwd, - ylim = c(0, ymax), - ylab = ylab, - xlab = xlab, - main = main, - axes = axes, - ...) - # x axis - axis(side = 1, at = 1:pm_n_distinct(data$x), labels = levels(data$x), lwd = 0) - # y axis, 0-100% - axis(side = 2, at = seq(0, 100, 5)) - - text(x = data$x, - y = data$s + 4, - labels = paste0(data$s, "% (n = ", data$n, ")")) -} - - -#' @method barplot rsi -#' @export -#' @importFrom graphics barplot axis par -#' @rdname plot -barplot.rsi <- function(height, - col = c("chartreuse4", "chartreuse3", "brown3"), - xlab = ifelse(beside, "Antimicrobial Interpretation", ""), - main = paste("Resistance Overview of", deparse(substitute(height))), - ylab = "Frequency", - beside = TRUE, - axes = beside, - ...) { - meet_criteria(col, allow_class = "character", has_length = 3) - meet_criteria(xlab, allow_class = "character", has_length = 1) - meet_criteria(main, allow_class = "character", has_length = 1) - meet_criteria(ylab, allow_class = "character", has_length = 1) - meet_criteria(beside, allow_class = "logical", has_length = 1) - meet_criteria(axes, allow_class = "logical", has_length = 1) - - if (axes == TRUE) { - par(mar = c(5, 4, 4, 2) + 0.1) - } else { - par(mar = c(2, 4, 4, 2) + 0.1) - } - - barplot(as.matrix(table(height)), - col = col, - xlab = xlab, - main = main, - ylab = ylab, - beside = beside, - axes = FALSE, - ...) - # y axis, 0-100% - axis(side = 2, at = seq(0, max(table(height)) + max(table(height)) * 1.1, by = 25)) - if (axes == TRUE && beside == TRUE) { - axis(side = 1, labels = levels(height), at = c(1, 2, 3) + 0.5, lwd = 0) - } -} - #' @method [<- rsi #' @export #' @noRd diff --git a/R/zzz.R b/R/zzz.R index fcf4fb97..4b02815b 100755 --- a/R/zzz.R +++ b/R/zzz.R @@ -50,6 +50,8 @@ pkg_env$mo_failed <- character(0) s3_register("skimr::get_skimmers", "rsi") s3_register("skimr::get_skimmers", "mic") s3_register("skimr::get_skimmers", "disk") + s3_register("ggplot2::ggplot", "mic") + s3_register("ggplot2::ggplot", "disk") # 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 42618ba5..e22f2bc1 100644 Binary files a/data-raw/AMR_latest.tar.gz and b/data-raw/AMR_latest.tar.gz differ diff --git a/docs/404.html b/docs/404.html index 7549388a..5b6d4cbb 100644 --- a/docs/404.html +++ b/docs/404.html @@ -81,7 +81,7 @@ AMR (for R) - 1.5.0.9024 + 1.5.0.9025 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 3751fc57..2380f47f 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -81,7 +81,7 @@ AMR (for R) - 1.5.0.9024 + 1.5.0.9025 diff --git a/docs/articles/benchmarks.html b/docs/articles/benchmarks.html index 1d9abe81..2c1bf65b 100644 --- a/docs/articles/benchmarks.html +++ b/docs/articles/benchmarks.html @@ -39,7 +39,7 @@ AMR (for R) - 1.5.0.9024 + 1.5.0.9025 @@ -226,19 +226,19 @@ times = 25) print(S.aureus, unit = "ms", signif = 2) # Unit: milliseconds -# expr min lq mean median uq max neval -# as.mo("sau") 9.3 10 11.0 10 11.0 13.0 25 -# as.mo("stau") 52.0 55 73.0 58 92.0 100.0 25 -# as.mo("STAU") 50.0 54 73.0 58 96.0 110.0 25 -# as.mo("staaur") 9.7 10 14.0 11 12.0 57.0 25 -# as.mo("STAAUR") 8.9 10 14.0 10 11.0 52.0 25 -# as.mo("S. aureus") 26.0 28 41.0 29 67.0 76.0 25 -# as.mo("S aureus") 27.0 28 41.0 30 65.0 76.0 25 -# as.mo("Staphylococcus aureus") 2.6 3 3.2 3 3.3 4.6 25 -# as.mo("Staphylococcus aureus (MRSA)") 240.0 260 270.0 260 270.0 380.0 25 -# as.mo("Sthafilokkockus aaureuz") 160.0 190 200.0 200 200.0 300.0 25 -# as.mo("MRSA") 9.3 10 15.0 10 12.0 49.0 25 -# as.mo("VISA") 18.0 19 31.0 21 54.0 67.0 25 +# expr min lq mean median uq max neval +# as.mo("sau") 10 11.0 15 11.0 13.0 47 25 +# as.mo("stau") 56 57.0 75 62.0 95.0 100 25 +# as.mo("STAU") 54 56.0 67 58.0 66.0 110 25 +# as.mo("staaur") 10 11.0 12 11.0 12.0 13 25 +# as.mo("STAAUR") 10 11.0 16 11.0 12.0 50 25 +# as.mo("S. aureus") 28 31.0 46 33.0 65.0 71 25 +# as.mo("S aureus") 29 30.0 42 33.0 64.0 67 25 +# as.mo("Staphylococcus aureus") 3 3.2 5 3.3 3.7 40 25 +# as.mo("Staphylococcus aureus (MRSA)") 240 260.0 270 270.0 280.0 290 25 +# as.mo("Sthafilokkockus aaureuz") 170 200.0 210 200.0 210.0 280 25 +# as.mo("MRSA") 10 11.0 17 11.0 13.0 51 25 +# as.mo("VISA") 19 20.0 36 21.0 50.0 150 25

In the table above, all measurements are shown in milliseconds (thousands of seconds). A value of 5 milliseconds means it can determine 200 input values per second. It case of 200 milliseconds, this is only 5 input values per second. It is clear that accepted taxonomic names are extremely fast, but some variations are up to 200 times slower to determine.

To improve performance, we implemented two important algorithms to save unnecessary calculations: repetitive results and already precalculated results.

@@ -260,8 +260,8 @@ # what do these values look like? They are of class <mo>: head(x) # Class <mo> -# [1] B_STPHY_AURS B_STRPT_GRPC B_STPHY_CONS B_STPHY_EPDR B_STRPT_PNMN -# [6] B_PROTS_VLGR +# [1] B_ESCHR_COLI B_PROTS_MRBL B_PROTS_MRBL B_PROTS_MRBL B_STPHY_CONS +# [6] B_ENTRC # as the example_isolates data set has 2,000 rows, we should have 2 million items length(x) @@ -277,8 +277,8 @@ print(run_it, unit = "ms", signif = 3) # Unit: milliseconds # expr min lq mean median uq max neval -# mo_name(x) 157 187 222 206 224 372 10 -

So getting official taxonomic names of 2,000,000 (!!) items consisting of 90 unique values only takes 0.206 seconds. That is 2.471 milliseconds per unique item on average. You only lose time on your unique input values.

+# mo_name(x) 160 189 224 201 228 356 10 +

So getting official taxonomic names of 2,000,000 (!!) items consisting of 90 unique values only takes 0.201 seconds. That is 101 nanoseconds on average. You only lose time on your unique input values.

@@ -291,10 +291,10 @@ times = 10) print(run_it, unit = "ms", signif = 3) # Unit: milliseconds -# expr min lq mean median uq max neval -# A 6.97 7.10 7.55 7.21 8.18 8.32 10 -# B 23.70 24.20 36.30 26.30 29.00 89.70 10 -# C 1.53 1.65 1.80 1.76 2.00 2.19 10

+# expr min lq mean median uq max neval +# A 6.80 7.17 7.46 7.54 7.81 8.0 10 +# B 24.30 25.80 31.60 26.20 28.80 75.6 10 +# C 1.59 1.70 1.89 1.84 2.02 2.5 10

So going from mo_name("Staphylococcus aureus") to "Staphylococcus aureus" takes 0.0018 seconds - it doesn’t even start calculating if the result would be the same as the expected resulting value. That goes for all helper functions:

 run_it <- microbenchmark(A = mo_species("aureus"),
@@ -309,14 +309,14 @@
 print(run_it, unit = "ms", signif = 3)
 # Unit: milliseconds
 #  expr  min   lq mean median   uq  max neval
-#     A 1.44 1.72 1.69   1.74 1.75 1.78    10
-#     B 1.47 1.55 1.67   1.73 1.74 1.89    10
-#     C 1.52 1.59 1.73   1.74 1.89 1.91    10
-#     D 1.46 1.51 1.64   1.64 1.75 1.89    10
-#     E 1.42 1.47 1.60   1.52 1.71 1.97    10
-#     F 1.44 1.71 1.69   1.72 1.75 1.88    10
-#     G 1.42 1.50 1.68   1.61 1.73 2.36    10
-#     H 1.52 1.54 1.66   1.71 1.73 1.87    10
+# A 1.25 1.28 1.39 1.39 1.50 1.56 10 +# B 1.17 1.19 1.41 1.43 1.48 1.92 10 +# C 1.20 1.33 1.43 1.46 1.50 1.61 10 +# D 1.43 1.45 1.50 1.49 1.53 1.61 10 +# E 1.26 1.40 1.45 1.43 1.49 1.81 10 +# F 1.15 1.17 1.32 1.26 1.44 1.69 10 +# G 1.19 1.25 1.37 1.35 1.47 1.58 10 +# H 1.20 1.25 1.46 1.31 1.53 2.33 10

Of course, when running mo_phylum("Firmicutes") the function has zero knowledge about the actual microorganism, namely S. aureus. But since the result would be "Firmicutes" anyway, there is no point in calculating the result. And because this package contains all phyla of all known bacteria, it can just return the initial value immediately.

@@ -343,14 +343,14 @@ times = 100) print(run_it, unit = "ms", signif = 4) # Unit: milliseconds -# expr min lq mean median uq max neval -# en 17.12 17.40 22.65 17.54 18.39 78.39 100 -# de 19.93 20.26 22.60 20.48 20.97 81.27 100 -# nl 24.87 25.24 30.93 25.50 26.90 87.17 100 -# es 20.00 20.26 24.39 20.58 21.13 82.01 100 -# it 19.92 20.26 26.54 20.66 21.38 79.15 100 -# fr 19.62 19.90 24.74 20.10 21.04 77.20 100 -# pt 19.74 20.02 26.76 20.41 22.68 82.61 100
+# expr min lq mean median uq max neval +# en 17.05 17.38 21.26 17.74 18.50 97.23 100 +# de 19.90 20.33 24.80 20.67 21.06 93.34 100 +# nl 24.86 25.30 31.21 25.65 26.34 102.20 100 +# es 19.83 20.22 26.56 20.49 21.20 97.59 100 +# it 19.79 20.20 26.82 20.63 21.31 94.85 100 +# fr 19.61 19.87 24.26 20.21 20.68 92.42 100 +# pt 19.64 20.06 23.78 20.40 21.05 92.91 100

Currently supported non-English languages are German, Dutch, Spanish, Italian, French and Portuguese.

diff --git a/docs/articles/benchmarks_files/figure-html/unnamed-chunk-4-1.png b/docs/articles/benchmarks_files/figure-html/unnamed-chunk-4-1.png index f8429aaf..71a7c0cf 100644 Binary files a/docs/articles/benchmarks_files/figure-html/unnamed-chunk-4-1.png and b/docs/articles/benchmarks_files/figure-html/unnamed-chunk-4-1.png differ diff --git a/docs/articles/index.html b/docs/articles/index.html index 28653326..f038a464 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.5.0.9024 + 1.5.0.9025 diff --git a/docs/authors.html b/docs/authors.html index 245ceccf..5cb562e5 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -81,7 +81,7 @@ AMR (for R) - 1.5.0.9024 + 1.5.0.9025 diff --git a/docs/index.html b/docs/index.html index 3689a9d8..b1bbcd3e 100644 --- a/docs/index.html +++ b/docs/index.html @@ -43,7 +43,7 @@ AMR (for R) - 1.5.0.9024 + 1.5.0.9025 diff --git a/docs/lifecycle_tidyverse.svg b/docs/lifecycle_tidyverse.svg index 2f5e2a96..1d8db94f 100644 --- a/docs/lifecycle_tidyverse.svg +++ b/docs/lifecycle_tidyverse.svg @@ -1,88 +1,32 @@ - 2018-01-05 -19:43ZCanvas -1Layer 1maturingexperimentalstableretireddormantquestioningarchived + + + + + + + + + +Canvas 1 + + +Layer 1 + +experimental + +stable + + + +superseded + + +deprecated + + + diff --git a/docs/news/index.html b/docs/news/index.html index 5e1588e0..ee54c82c 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.5.0.9024 + 1.5.0.9025 @@ -236,13 +236,13 @@ Source: NEWS.md -
-

-AMR 1.5.0.9024 Unreleased +
+

+AMR 1.5.0.9025 Unreleased

-
+

-Last updated: 22 February 2021 +Last updated: 25 February 2021

@@ -280,6 +280,7 @@
  • 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.

  • +
  • 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:

    @@ -321,7 +322,8 @@
     is.rsi.eligible() now detects if the column name resembles an antibiotic name or code and now returns TRUE immediately if the input contains any of the values “R”, “S” or “I”. This drastically improves speed, also for a lot of other functions that rely on automatic determination of antibiotic columns.
  • Functions get_episode() and is_new_episode() now support less than a day as value for argument episode_days (e.g., to include one patient/test per hour)
  • Argument ampc_cephalosporin_resistance in eucast_rules() now also applies to value “I” (not only “S”)
  • -
  • Updated colours of values R, S and I in tibble printing
  • +
  • Updated plot() functions for classes <mic>, <disk> and <rsi> - the former two now support colouring if you supply the microorganism and antimicrobial agent
  • +
  • Updated colours to colour-blind friendly version for values R, S and I in tibble printing and for all plot methods (ggplot_rsi() and using plot() on classes <mic>, <disk> and <rsi>)
  • Functions print() and summary() on a Principal Components Analysis object (pca()) now print additional group info if the original data was grouped using dplyr::group_by()
  • Improved speed and reliability of guess_ab_col(). As this also internally improves the reliability of first_isolate() and mdro(), this might have a slight impact on the results of those functions.
  • @@ -329,6 +331,8 @@
  • The like() function (and its fast alias %like%) now always use Perl compatibility, improving speed for many functions in this package (e.g., as.mo() is now up to 4 times faster)
  • Staphylococcus cornubiensis is now correctly categorised as coagulase-positive
  • +
  • +random_disk() and random_mic() now have an expanded range in their randomisation
  • diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index 67708790..77c9a852 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-22T19:20Z +last_built: 2021-02-25T09:21Z urls: reference: https://msberends.github.io/AMR//reference article: https://msberends.github.io/AMR//articles diff --git a/docs/reference/as.mic.html b/docs/reference/as.mic.html index 3fd49dd1..2f6578da 100644 --- a/docs/reference/as.mic.html +++ b/docs/reference/as.mic.html @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9016 + 1.5.0.9025
    @@ -298,8 +298,9 @@ The lifecycle of this function is stable= "AMX", guideline = "EUCAST") +# plot MIC values, see ?plot plot(mic_data) -barplot(mic_data) +plot(mic_data, mo = "E. coli", ab = "cipro")
    @@ -286,8 +286,9 @@ scale_y_percent(breaks = seq(0, 1, 0.1), limits = NULL) scale_rsi_colours( - colours = c(S = "#61a8ff", SI = "#61a8ff", I = "#61f7ff", IR = "#ff6961", R = - "#ff6961") + colours = c(S = "#3CAEA3", SI = "#3CAEA3", I = "#F6D55C", IR = "#ED553B", R = + "#ED553B"), + aesthetics = "fill" ) theme_rsi() @@ -361,7 +362,7 @@ colours -

    a named vector with colours for the bars. The names must be one or more of: S, SI, I, IR, R or be FALSE to use default ggplot2 colours.

    +

    a named vector with colours for the bars. The names must be one or more of: S, SI, I, IR, R or be FALSE for standard ggplot2 colours. The default colours are colour-blind friendly.

    datalabels @@ -399,6 +400,10 @@ ...

    other arguments passed on to geom_rsi()

    + + aesthetics +

    aesthetics to apply the colours to, defaults to "fill" but can also be "colour" or "both"

    +

    Details

    diff --git a/docs/reference/index.html b/docs/reference/index.html index df67210c..973a9272 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.5.0.9024 + 1.5.0.9025
    @@ -453,7 +453,7 @@ -

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

    +

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

    Plotting for Classes rsi, mic and disk

    diff --git a/docs/reference/like.html b/docs/reference/like.html index 955d0355..cfcb4f03 100644 --- a/docs/reference/like.html +++ b/docs/reference/like.html @@ -49,7 +49,7 @@ - + @@ -82,7 +82,7 @@ AMR (for R) - 1.5.0.9024 + 1.5.0.9025
    @@ -239,7 +239,7 @@

    -

    Convenient wrapper around grep() to match a pattern: x %like% pattern. It always returns a logical vector and is always case-insensitive (use x %like_case% pattern for case-sensitive matching). Also, pattern can be as long as x to compare items of each index in both vectors, or they both can have the same length to iterate over all cases.

    +

    Convenient wrapper around grepl() to match a pattern: x %like% pattern. It always returns a logical vector and is always case-insensitive (use x %like_case% pattern for case-sensitive matching). Also, pattern can be as long as x to compare items of each index in both vectors, or they both can have the same length to iterate over all cases.

    like(x, pattern, ignore.case = TRUE)
    @@ -295,7 +295,7 @@ The lifecycle of this function is stableOn our website https://msberends.github.io/AMR/ you can find a comprehensive tutorial about how to conduct AMR data analysis, the complete documentation of all functions and an example analysis using WHONET data. As we would like to better understand the backgrounds and needs of our users, please participate in our survey!

    See also

    - +

    Examples

    # simple test
    @@ -306,11 +306,15 @@ The lifecycle of this function is stableb %like% a
     #> FALSE
     
    -# also supports multiple patterns, length must be equal to x
    +# also supports multiple patterns
     a <- c("Test case", "Something different", "Yet another thing")
     b <- c(     "case",           "diff",      "yet")
     a %like% b
     #> TRUE TRUE TRUE
    +a[1] %like% b
    +#> TRUE FALSE FALSE
    +a %like% b[1]
    +#> TRUE FALSE FALSE
     
     # get isolates whose name start with 'Ent' or 'ent'
     # \donttest{
    diff --git a/docs/reference/plot.html b/docs/reference/plot.html
    index b71efe64..b7a1516b 100644
    --- a/docs/reference/plot.html
    +++ b/docs/reference/plot.html
    @@ -49,7 +49,7 @@
       
     
     
    -
    +
     
     
     
    @@ -82,7 +82,7 @@
           
           
             AMR (for R)
    -        1.5.0.9016
    +        1.5.0.9025
           
         
     
    @@ -234,65 +234,78 @@
       
    -

    Functions to print classes of the AMR package.

    +

    Functions to plot classes rsi, mic and disk, with support for base R and ggplot2.

    -
    # S3 method for disk
    -plot(
    -  x,
    -  main = paste("Disk zones values of", deparse(substitute(x))),
    -  ylab = "Frequency",
    -  xlab = "Disk diffusion (mm)",
    -  axes = FALSE,
    -  ...
    -)
    -
    -# S3 method for mic
    +    
    # S3 method for mic
     plot(
       x,
       main = paste("MIC values of", deparse(substitute(x))),
       ylab = "Frequency",
    -  xlab = "MIC value",
    -  axes = FALSE,
    +  xlab = "Minimum Inhibitory Concentration (mg/L)",
    +  mo = NULL,
    +  ab = NULL,
    +  guideline = "EUCAST",
    +  colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
    +  expand = TRUE,
       ...
     )
     
     # S3 method for mic
    -barplot(
    -  height,
    -  main = paste("MIC values of", deparse(substitute(height))),
    +ggplot(
    +  data,
    +  mapping = NULL,
    +  title = paste("MIC values of", deparse(substitute(data))),
       ylab = "Frequency",
    -  xlab = "MIC value",
    -  axes = FALSE,
    +  xlab = "Minimum Inhibitory Concentration (mg/L)",
    +  mo = NULL,
    +  ab = NULL,
    +  guideline = "EUCAST",
    +  colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
    +  expand = TRUE,
    +  ...
    +)
    +
    +# S3 method for disk
    +plot(
    +  x,
    +  main = paste("Disk zones values of", deparse(substitute(x))),
    +  ylab = "Frequency",
    +  xlab = "Disk diffusion diameter (mm)",
    +  mo = NULL,
    +  ab = NULL,
    +  guideline = "EUCAST",
    +  colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
    +  expand = TRUE,
    +  ...
    +)
    +
    +# S3 method for disk
    +ggplot(
    +  data,
    +  mapping = NULL,
    +  title = paste("Disk zones values of", deparse(substitute(data))),
    +  ylab = "Frequency",
    +  xlab = "Disk diffusion diameter (mm)",
    +  mo = NULL,
    +  ab = NULL,
    +  guideline = "EUCAST",
    +  colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
    +  expand = TRUE,
       ...
     )
     
     # S3 method for rsi
     plot(
       x,
    -  lwd = 2,
    -  ylim = NULL,
       ylab = "Percentage",
       xlab = "Antimicrobial Interpretation",
       main = paste("Resistance Overview of", deparse(substitute(x))),
    -  axes = FALSE,
    -  ...
    -)
    -
    -# S3 method for rsi
    -barplot(
    -  height,
    -  col = c("chartreuse4", "chartreuse3", "brown3"),
    -  xlab = ifelse(beside, "Antimicrobial Interpretation", ""),
    -  main = paste("Resistance Overview of", deparse(substitute(height))),
    -  ylab = "Frequency",
    -  beside = TRUE,
    -  axes = beside,
       ...
     )
    @@ -301,62 +314,53 @@ x -

    the coordinates of points in the plot. Alternatively, a - single plotting structure, function or any R object with a - plot method can be provided.

    +

    MIC values created with as.mic() or disk diffusion values created with as.disk()

    - main -

    overall and sub title for the plot.

    + main, title +

    title of the plot

    - ylab -

    a label for the y axis.

    + xlab, ylab +

    axis title

    - xlab -

    a label for the x axis.

    + mo +

    any (vector of) text that can be coerced to a valid microorganism code with as.mo()

    - axes -

    logical. If TRUE, a vertical (or horizontal, if - horiz is true) axis is drawn.

    + ab +

    any (vector of) text that can be coerced to a valid antimicrobial code with as.ab()

    + + + guideline +

    interpretation guideline to use, defaults to the latest included EUCAST guideline, see Details

    + + + colours_RSI +

    colours to use for filling in the bars, must be a vector of three values (in the order R, S and I). The default colours are colour-blind friendly.

    + + + expand +

    logical to indicate whether the range on the x axis should be expanded between the lowest and highest value. For MIC values, intermediate values will be factors of 2 starting from the highest MIC value. For disk diameters, the whole diameter range will be filled.

    ... -

    Arguments passed on to functions

    +

    arguments passed on to as.rsi()

    - height -

    either a vector or matrix of values describing the - bars which make up the plot. If height is a vector, the - plot consists of a sequence of rectangular bars with heights - given by the values in the vector. If height is a matrix - and beside is FALSE then each bar of the plot - corresponds to a column of height, with the values in the - column giving the heights of stacked sub-bars making up the - bar. If height is a matrix and beside is - TRUE, then the values in each column are juxtaposed - rather than stacked.

    - - - ylim -

    limits for the y axis.

    - - - col -

    a vector of colors for the bars or bar components. - By default, grey is used if height is a vector, and a - gamma-corrected grey palette if height is a matrix.

    - - - beside -

    a logical value. If FALSE, the columns of - height are portrayed as stacked bars, and if TRUE - the columns are portrayed as juxtaposed bars.

    + mapping +

    aesthetic mappings to use for ggplot()

    +

    Value

    + +

    The ggplot functions return a ggplot model that is extendible with any ggplot2 function.

    +

    Details

    + +

    For interpreting MIC values as well as disk diffusion diameters, supported guidelines to be used as input for the guideline argument are: "EUCAST 2021", "EUCAST 2020", "EUCAST 2019", "EUCAST 2018", "EUCAST 2017", "EUCAST 2016", "EUCAST 2015", "EUCAST 2014", "EUCAST 2013", "EUCAST 2012", "EUCAST 2011", "CLSI 2019", "CLSI 2018", "CLSI 2017", "CLSI 2016", "CLSI 2015", "CLSI 2014", "CLSI 2013", "CLSI 2012", "CLSI 2011" and "CLSI 2010".

    +

    Simply using "CLSI" or "EUCAST" as input will automatically select the latest version of that guideline.

    Stable Lifecycle

    @@ -370,6 +374,22 @@ The lifecycle of this function is stableOn our website https://msberends.github.io/AMR/ you can find a comprehensive tutorial about how to conduct AMR data analysis, the complete documentation of all functions and an example analysis using WHONET data. As we would like to better understand the backgrounds and needs of our users, please participate in our survey!

    +

    Examples

    +
    some_mic_values <- random_mic(size = 100)
    +some_disk_values <- random_disk(size = 100, mo = "Escherichia coli", ab = "cipro")
    +
    +plot(some_mic_values)
    +plot(some_disk_values)
    +
    +# when providing the microorganism and antibiotic, colours will show interpretations:
    +plot(some_mic_values, mo = "S. aureus", ab = "ampicillin")
    +plot(some_disk_values, mo = "Escherichia coli", ab = "cipro")
    +
    +if (require("ggplot2")) {
    +  ggplot(some_mic_values)
    +  ggplot(some_disk_values, mo = "Escherichia coli", ab = "cipro")
    +}
    +
    @@ -239,7 +239,7 @@
    -

    These functions can be used for generating random MIC values and disk diffusion diameters, for AMR data analysis practice.

    +

    These functions can be used for generating random MIC values and disk diffusion diameters, for AMR data analysis practice. By providing a microorganism and antimicrobial agent, the generated results will reflect reality as much as possible.

    random_mic(size, mo = NULL, ab = NULL, ...)
    diff --git a/docs/survey.html b/docs/survey.html
    index 51aec706..5ec1ebb2 100644
    --- a/docs/survey.html
    +++ b/docs/survey.html
    @@ -81,7 +81,7 @@
           
           
             AMR (for R)
    -        1.5.0.9024
    +        1.5.0.9025
           
         
     
    diff --git a/man/as.mic.Rd b/man/as.mic.Rd
    index 38de5a8e..77ec57f6 100755
    --- a/man/as.mic.Rd
    +++ b/man/as.mic.Rd
    @@ -54,8 +54,9 @@ as.rsi(x = as.mic(4),
            ab = "AMX",
            guideline = "EUCAST")
     
    +# plot MIC values, see ?plot
     plot(mic_data)
    -barplot(mic_data)
    +plot(mic_data, mo = "E. coli", ab = "cipro")
     }
     \seealso{
     \code{\link[=as.rsi]{as.rsi()}}
    diff --git a/man/figures/lifecycle_tidyverse.svg b/man/figures/lifecycle_tidyverse.svg
    index 2f5e2a96..1d8db94f 100644
    --- a/man/figures/lifecycle_tidyverse.svg
    +++ b/man/figures/lifecycle_tidyverse.svg
    @@ -1,88 +1,32 @@
    -  2018-01-05
    -19:43ZCanvas
    -1Layer 1maturingexperimentalstableretireddormantquestioningarchived
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +Canvas 1
    +
    +
    +Layer 1
    +
    +experimental
    +
    +stable
    +
    +
    +
    +superseded
    +
    +
    +deprecated
    +
    +
    +
    diff --git a/man/ggplot_rsi.Rd b/man/ggplot_rsi.Rd
    index 4e508790..4eb27701 100644
    --- a/man/ggplot_rsi.Rd
    +++ b/man/ggplot_rsi.Rd
    @@ -54,8 +54,9 @@ facet_rsi(facet = c("interpretation", "antibiotic"), nrow = NULL)
     scale_y_percent(breaks = seq(0, 1, 0.1), limits = NULL)
     
     scale_rsi_colours(
    -  colours = c(S = "#61a8ff", SI = "#61a8ff", I = "#61f7ff", IR = "#ff6961", R =
    -    "#ff6961")
    +  colours = c(S = "#3CAEA3", SI = "#3CAEA3", I = "#F6D55C", IR = "#ED553B", R =
    +    "#ED553B"),
    +  aesthetics = "fill"
     )
     
     theme_rsi()
    @@ -99,7 +100,7 @@ labels_rsi_count(
     
     \item{nrow}{(when using \code{facet}) number of rows}
     
    -\item{colours}{a named vector with colours for the bars. The names must be one or more of: S, SI, I, IR, R or be \code{FALSE} to use default \link[ggplot2:ggplot]{ggplot2} colours.}
    +\item{colours}{a named vector with colours for the bars. The names must be one or more of: S, SI, I, IR, R or be \code{FALSE} for standard \link[ggplot2:ggplot]{ggplot2} colours. The default colours are colour-blind friendly.}
     
     \item{datalabels}{show datalabels using \code{\link[=labels_rsi_count]{labels_rsi_count()}}}
     
    @@ -118,6 +119,8 @@ labels_rsi_count(
     \item{y.title}{text to show as y axis description}
     
     \item{...}{other arguments passed on to \code{\link[=geom_rsi]{geom_rsi()}}}
    +
    +\item{aesthetics}{aesthetics to apply the colours to, defaults to "fill" but can also be "colour" or "both"}
     }
     \description{
     Use these functions to create bar plots for AMR data analysis. All functions rely on \link[ggplot2:ggplot]{ggplot2} functions.
    diff --git a/man/like.Rd b/man/like.Rd
    index 4a5df368..e752f060 100755
    --- a/man/like.Rd
    +++ b/man/like.Rd
    @@ -26,7 +26,7 @@ x \%like_case\% pattern
     A \code{\link{logical}} vector
     }
     \description{
    -Convenient wrapper around \code{\link[=grep]{grep()}} to match a pattern: \code{x \%like\% pattern}. It always returns a \code{\link{logical}} vector and is always case-insensitive (use \code{x \%like_case\% pattern} for case-sensitive matching). Also, \code{pattern} can be as long as \code{x} to compare items of each index in both vectors, or they both can have the same length to iterate over all cases.
    +Convenient wrapper around \code{\link[=grepl]{grepl()}} to match a pattern: \code{x \%like\% pattern}. It always returns a \code{\link{logical}} vector and is always case-insensitive (use \code{x \%like_case\% pattern} for case-sensitive matching). Also, \code{pattern} can be as long as \code{x} to compare items of each index in both vectors, or they both can have the same length to iterate over all cases.
     }
     \details{
     The \verb{\%like\%} function:
    @@ -61,11 +61,15 @@ a \%like\% b
     b \%like\% a
     #> FALSE
     
    -# also supports multiple patterns, length must be equal to x
    +# also supports multiple patterns
     a <- c("Test case", "Something different", "Yet another thing")
     b <- c(     "case",           "diff",      "yet")
     a \%like\% b
     #> TRUE TRUE TRUE
    +a[1] \%like\% b
    +#> TRUE FALSE FALSE
    +a \%like\% b[1]
    +#> TRUE FALSE FALSE
     
     # get isolates whose name start with 'Ent' or 'ent'
     \donttest{
    @@ -76,5 +80,5 @@ if (require("dplyr")) {
     }
     }
     \seealso{
    -\code{\link[=grep]{grep()}}
    +\code{\link[=grepl]{grepl()}}
     }
    diff --git a/man/plot.Rd b/man/plot.Rd
    index 3fe2ea64..11eedbdf 100644
    --- a/man/plot.Rd
    +++ b/man/plot.Rd
    @@ -1,102 +1,107 @@
     % Generated by roxygen2: do not edit by hand
    -% Please edit documentation in R/amr.R, R/disk.R, R/mic.R, R/rsi.R
    +% Please edit documentation in R/plot.R
     \name{plot}
     \alias{plot}
    -\alias{plot.disk}
     \alias{plot.mic}
    -\alias{barplot.mic}
    +\alias{ggplot.mic}
    +\alias{plot.disk}
    +\alias{ggplot.disk}
     \alias{plot.rsi}
    -\alias{barplot.rsi}
     \title{Plotting for Classes \code{rsi}, \code{mic} and \code{disk}}
     \usage{
    -\method{plot}{disk}(
    -  x,
    -  main = paste("Disk zones values of", deparse(substitute(x))),
    -  ylab = "Frequency",
    -  xlab = "Disk diffusion (mm)",
    -  axes = FALSE,
    -  ...
    -)
    -
     \method{plot}{mic}(
       x,
       main = paste("MIC values of", deparse(substitute(x))),
       ylab = "Frequency",
    -  xlab = "MIC value",
    -  axes = FALSE,
    +  xlab = "Minimum Inhibitory Concentration (mg/L)",
    +  mo = NULL,
    +  ab = NULL,
    +  guideline = "EUCAST",
    +  colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
    +  expand = TRUE,
       ...
     )
     
    -\method{barplot}{mic}(
    -  height,
    -  main = paste("MIC values of", deparse(substitute(height))),
    +\method{ggplot}{mic}(
    +  data,
    +  mapping = NULL,
    +  title = paste("MIC values of", deparse(substitute(data))),
       ylab = "Frequency",
    -  xlab = "MIC value",
    -  axes = FALSE,
    +  xlab = "Minimum Inhibitory Concentration (mg/L)",
    +  mo = NULL,
    +  ab = NULL,
    +  guideline = "EUCAST",
    +  colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
    +  expand = TRUE,
    +  ...
    +)
    +
    +\method{plot}{disk}(
    +  x,
    +  main = paste("Disk zones values of", deparse(substitute(x))),
    +  ylab = "Frequency",
    +  xlab = "Disk diffusion diameter (mm)",
    +  mo = NULL,
    +  ab = NULL,
    +  guideline = "EUCAST",
    +  colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
    +  expand = TRUE,
    +  ...
    +)
    +
    +\method{ggplot}{disk}(
    +  data,
    +  mapping = NULL,
    +  title = paste("Disk zones values of", deparse(substitute(data))),
    +  ylab = "Frequency",
    +  xlab = "Disk diffusion diameter (mm)",
    +  mo = NULL,
    +  ab = NULL,
    +  guideline = "EUCAST",
    +  colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
    +  expand = TRUE,
       ...
     )
     
     \method{plot}{rsi}(
       x,
    -  lwd = 2,
    -  ylim = NULL,
       ylab = "Percentage",
       xlab = "Antimicrobial Interpretation",
       main = paste("Resistance Overview of", deparse(substitute(x))),
    -  axes = FALSE,
    -  ...
    -)
    -
    -\method{barplot}{rsi}(
    -  height,
    -  col = c("chartreuse4", "chartreuse3", "brown3"),
    -  xlab = ifelse(beside, "Antimicrobial Interpretation", ""),
    -  main = paste("Resistance Overview of", deparse(substitute(height))),
    -  ylab = "Frequency",
    -  beside = TRUE,
    -  axes = beside,
       ...
     )
     }
     \arguments{
    -\item{x}{the coordinates of points in the plot. Alternatively, a
    -      single plotting structure, function or \emph{any \R object with a
    -        \code{plot} method} can be provided.}
    +\item{x}{MIC values created with \code{\link[=as.mic]{as.mic()}} or disk diffusion values created with \code{\link[=as.disk]{as.disk()}}}
     
    -\item{main}{overall and sub title for the plot.}
    +\item{main, title}{title of the plot}
     
    -\item{ylab}{a label for the y axis.}
    +\item{xlab, ylab}{axis title}
     
    -\item{xlab}{a label for the x axis.}
    +\item{mo}{any (vector of) text that can be coerced to a valid microorganism code with \code{\link[=as.mo]{as.mo()}}}
     
    -\item{axes}{logical.  If \code{TRUE}, a vertical (or horizontal, if
    -    \code{horiz} is true) axis is drawn.}
    +\item{ab}{any (vector of) text that can be coerced to a valid antimicrobial code with \code{\link[=as.ab]{as.ab()}}}
     
    -\item{...}{Arguments passed on to functions}
    +\item{guideline}{interpretation guideline to use, defaults to the latest included EUCAST guideline, see \emph{Details}}
     
    -\item{height}{either a vector or matrix of values describing the
    -    bars which make up the plot.  If \code{height} is a vector, the
    -    plot consists of a sequence of rectangular bars with heights
    -    given by the values in the vector.  If \code{height} is a matrix
    -    and \code{beside} is \code{FALSE} then each bar of the plot
    -    corresponds to a column of \code{height}, with the values in the
    -    column giving the heights of stacked sub-bars making up the
    -    bar.  If \code{height} is a matrix and \code{beside} is
    -    \code{TRUE}, then the values in each column are juxtaposed
    -    rather than stacked.}
    +\item{colours_RSI}{colours to use for filling in the bars, must be a vector of three values (in the order R, S and I). The default colours are colour-blind friendly.}
     
    -\item{ylim}{limits for the y axis.}
    +\item{expand}{logical to indicate whether the range on the x axis should be expanded between the lowest and highest value. For MIC values, intermediate values will be factors of 2 starting from the highest MIC value. For disk diameters, the whole diameter range will be filled.}
     
    -\item{col}{a vector of colors for the bars or bar components.
    -    By default, grey is used if \code{height} is a vector, and a
    -    gamma-corrected grey palette if \code{height} is a matrix.}
    +\item{...}{arguments passed on to \code{\link[=as.rsi]{as.rsi()}}}
     
    -\item{beside}{a logical value.  If \code{FALSE}, the columns of
    -    \code{height} are portrayed as stacked bars, and if \code{TRUE}
    -    the columns are portrayed as juxtaposed bars.}
    +\item{mapping}{aesthetic mappings to use for \code{\link[ggplot2:ggplot]{ggplot()}}}
    +}
    +\value{
    +The \code{ggplot} functions return a \code{\link[ggplot2:ggplot]{ggplot}} model that is extendible with any \code{ggplot2} function.
     }
     \description{
    -Functions to print classes of the \code{AMR} package.
    +Functions to plot classes \code{rsi}, \code{mic} and \code{disk}, with support for base R and \code{ggplot2}.
    +}
    +\details{
    +For interpreting MIC values as well as disk diffusion diameters, supported guidelines to be used as input for the \code{guideline} argument are: "EUCAST 2021", "EUCAST 2020", "EUCAST 2019", "EUCAST 2018", "EUCAST 2017", "EUCAST 2016", "EUCAST 2015", "EUCAST 2014", "EUCAST 2013", "EUCAST 2012", "EUCAST 2011", "CLSI 2019", "CLSI 2018", "CLSI 2017", "CLSI 2016", "CLSI 2015", "CLSI 2014", "CLSI 2013", "CLSI 2012", "CLSI 2011" and "CLSI 2010".
    +
    +Simply using \code{"CLSI"} or \code{"EUCAST"} as input will automatically select the latest version of that guideline.
     }
     \section{Stable Lifecycle}{
     
    @@ -111,4 +116,19 @@ If the unlying code needs breaking changes, they will occur gradually. For examp
     On our website \url{https://msberends.github.io/AMR/} you can find \href{https://msberends.github.io/AMR/articles/AMR.html}{a comprehensive tutorial} about how to conduct AMR data analysis, the \href{https://msberends.github.io/AMR/reference/}{complete documentation of all functions} and \href{https://msberends.github.io/AMR/articles/WHONET.html}{an example analysis using WHONET data}. As we would like to better understand the backgrounds and needs of our users, please \href{https://msberends.github.io/AMR/survey.html}{participate in our survey}!
     }
     
    -\keyword{internal}
    +\examples{
    +some_mic_values <- random_mic(size = 100)
    +some_disk_values <- random_disk(size = 100, mo = "Escherichia coli", ab = "cipro")
    +
    +plot(some_mic_values)
    +plot(some_disk_values)
    +
    +# when providing the microorganism and antibiotic, colours will show interpretations:
    +plot(some_mic_values, mo = "S. aureus", ab = "ampicillin")
    +plot(some_disk_values, mo = "Escherichia coli", ab = "cipro")
    +
    +if (require("ggplot2")) {
    +  ggplot(some_mic_values)
    +  ggplot(some_disk_values, mo = "Escherichia coli", ab = "cipro")
    +}
    +}
    diff --git a/man/random.Rd b/man/random.Rd
    index 1a6f190a..5776869a 100644
    --- a/man/random.Rd
    +++ b/man/random.Rd
    @@ -28,7 +28,7 @@ random_rsi(size, prob_RSI = c(0.33, 0.33, 0.33), ...)
     class \verb{} for \code{\link[=random_mic]{random_mic()}} (see \code{\link[=as.mic]{as.mic()}}) and class \verb{} for \code{\link[=random_disk]{random_disk()}} (see \code{\link[=as.disk]{as.disk()}})
     }
     \description{
    -These functions can be used for generating random MIC values and disk diffusion diameters, for AMR data analysis practice.
    +These functions can be used for generating random MIC values and disk diffusion diameters, for AMR data analysis practice. By providing a microorganism and antimicrobial agent, the generated results will reflect reality as much as possible.
     }
     \details{
     The base R function \code{\link[=sample]{sample()}} is used for generating values.
    diff --git a/pkgdown/logos/lifecycle_tidyverse.svg b/pkgdown/logos/lifecycle_tidyverse.svg
    index 2f5e2a96..1d8db94f 100644
    --- a/pkgdown/logos/lifecycle_tidyverse.svg
    +++ b/pkgdown/logos/lifecycle_tidyverse.svg
    @@ -1,88 +1,32 @@
    -  2018-01-05
    -19:43ZCanvas
    -1Layer 1maturingexperimentalstableretireddormantquestioningarchived
    +
    +
    +
    +
    +
    +
    +
    +
    +
    +Canvas 1
    +
    +
    +Layer 1
    +
    +experimental
    +
    +stable
    +
    +
    +
    +superseded
    +
    +
    +deprecated
    +
    +
    +
    diff --git a/tests/testthat/test-disk.R b/tests/testthat/test-disk.R
    index 0ae02be9..9eef32b9 100755
    --- a/tests/testthat/test-disk.R
    +++ b/tests/testthat/test-disk.R
    @@ -43,9 +43,17 @@ test_that("disk works", {
       expect_s3_class(x, "disk")
       
       pdf(NULL) # prevent Rplots.pdf being created
    +  expect_silent(barplot(as.disk(c(10, 20, 40))))
       expect_silent(plot(as.disk(c(10, 20, 40))))
    -
    +  expect_silent(plot(as.disk(c(10, 20, 40)), expand = FALSE))
    +  expect_silent(plot(as.disk(c(10, 20, 40)), mo = "esco", ab = "cipr"))
    +  if (require("ggplot2")) {
    +    expect_s3_class(ggplot(as.disk(c(10, 20, 40))), "gg")
    +    expect_s3_class(ggplot(as.disk(c(10, 20, 40)), expand = FALSE), "gg")
    +    expect_s3_class(ggplot(as.disk(c(10, 20, 40)), mo = "esco", ab = "cipr"), "gg")
    +  }
       expect_output(print(as.disk(12)))
    +  
       library(dplyr, warn.conflicts = FALSE)
       expect_output(print(tibble(d = as.disk(12))))
     
    diff --git a/tests/testthat/test-mic.R b/tests/testthat/test-mic.R
    index fb5be9ac..a30fefbf 100755
    --- a/tests/testthat/test-mic.R
    +++ b/tests/testthat/test-mic.R
    @@ -51,6 +51,13 @@ test_that("mic works", {
       pdf(NULL) # prevent Rplots.pdf being created
       expect_silent(barplot(as.mic(c(1, 2, 4, 8))))
       expect_silent(plot(as.mic(c(1, 2, 4, 8))))
    +  expect_silent(plot(as.mic(c(1, 2, 4, 8)), expand = FALSE))
    +  expect_silent(plot(as.mic(c(1, 2, 4, 8)), mo = "esco", ab = "cipr"))
    +  if (require("ggplot2")) {
    +    expect_s3_class(ggplot(as.mic(c(1, 2, 4, 8))), "gg")
    +    expect_s3_class(ggplot(as.mic(c(1, 2, 4, 8)), expand = FALSE), "gg")
    +    expect_s3_class(ggplot(as.mic(c(1, 2, 4, 8, 32)), mo = "esco", ab = "cipr"), "gg")
    +  }
       expect_output(print(as.mic(c(1, 2, 4, 8))))
       
       expect_equal(summary(as.mic(c(2, 8))), 
    diff --git a/vignettes/benchmarks.Rmd b/vignettes/benchmarks.Rmd
    index b5b56810..c79e2722 100755
    --- a/vignettes/benchmarks.Rmd
    +++ b/vignettes/benchmarks.Rmd
    @@ -117,7 +117,7 @@ run_it <- microbenchmark(mo_name(x),
     print(run_it, unit = "ms", signif = 3)
     ```
     
    -So getting official taxonomic names of `r format(length(x), big.mark = ",")` (!!) items consisting of `r n_distinct(x)` unique values only takes `r round(median(run_it$time, na.rm = TRUE) / 1e9, 3)` seconds. That is `r round(mean(run_it$time, na.rm = TRUE) / 1e6 / n_distinct(x), 3)` milliseconds per unique item on average. You only lose time on your unique input values.
    +So getting official taxonomic names of `r format(length(x), big.mark = ",")` (!!) items consisting of `r n_distinct(x)` unique values only takes `r round(median(run_it$time, na.rm = TRUE) / 1e9, 3)` seconds. That is `r round(median(run_it$time, na.rm = TRUE) / length(x), 0)` nanoseconds on average. You only lose time on your unique input values.
     
     ### Precalculated results