(v1.5.0.9025) big plot and ggplot generics update

v1.8.2
parent 31ceba5441
commit a673407904
  1. 4
      DESCRIPTION
  2. 3
      NAMESPACE
  3. 9
      NEWS.md
  4. 9
      R/aa_helper_functions.R
  5. 13
      R/amr.R
  6. 24
      R/disk.R
  7. 33
      R/ggplot_rsi.R
  8. 81
      R/like.R
  9. 57
      R/mic.R
  10. 552
      R/plot.R
  11. 10
      R/random.R
  12. 110
      R/rsi.R
  13. 2
      R/zzz.R
  14. BIN
      data-raw/AMR_latest.tar.gz
  15. 2
      docs/404.html
  16. 2
      docs/LICENSE-text.html
  17. 76
      docs/articles/benchmarks.html
  18. BIN
      docs/articles/benchmarks_files/figure-html/unnamed-chunk-4-1.png
  19. 2
      docs/articles/index.html
  20. 2
      docs/authors.html
  21. 2
      docs/index.html
  22. 120
      docs/lifecycle_tidyverse.svg
  23. 18
      docs/news/index.html
  24. 2
      docs/pkgdown.yml
  25. 5
      docs/reference/as.mic.html
  26. 120
      docs/reference/figures/lifecycle_tidyverse.svg
  27. 13
      docs/reference/ggplot_rsi.html
  28. 4
      docs/reference/index.html
  29. 14
      docs/reference/like.html
  30. 154
      docs/reference/plot.html
  31. 6
      docs/reference/random.html
  32. 2
      docs/survey.html
  33. 3
      man/as.mic.Rd
  34. 120
      man/figures/lifecycle_tidyverse.svg
  35. 9
      man/ggplot_rsi.Rd
  36. 10
      man/like.Rd
  37. 138
      man/plot.Rd
  38. 2
      man/random.Rd
  39. 120
      pkgdown/logos/lifecycle_tidyverse.svg
  40. 10
      tests/testthat/test-disk.R
  41. 7
      tests/testthat/test-mic.R
  42. 2
      vignettes/benchmarks.Rmd

@ -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"),

@ -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)

@ -1,5 +1,5 @@
# AMR 1.5.0.9024
## <small>Last updated: 22 February 2021</small>
# AMR 1.5.0.9025
## <small>Last updated: 25 February 2021</small>
### 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 `<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:
```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 `<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.
* 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

@ -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)

@ -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

@ -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

@ -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)
}
}

@ -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)
}
if (is.factor(x)) {
x <- as.character(x)
}
# 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 {
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)
}
}

@ -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

@ -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)))
}

@ -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)

@ -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

@ -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({

Binary file not shown.

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="https://msberends.github.io/AMR//index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.5.0.9024</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.5.0.9025</span>
</span>
</div>

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.5.0.9024</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.5.0.9025</span>
</span>
</div>

@ -39,7 +39,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.5.0.9024</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.5.0.9025</span>
</span>
</div>
@ -226,19 +226,19 @@
times <span class="op">=</span> <span class="fl">25</span><span class="op">)</span>
<span class="fu"><a href="https://rdrr.io/r/base/print.html">print</a></span><span class="op">(</span><span class="va">S.aureus</span>, unit <span class="op">=</span> <span class="st">"ms"</span>, signif <span class="op">=</span> <span class="fl">2</span><span class="op">)</span>
<span class="co"># Unit: milliseconds</span>
<span class="co"># expr min lq mean median uq max neval</span>
<span class="co"># as.mo("sau") 9.3 10 11.0 10 11.0 13.0 25</span>
<span class="co"># as.mo("stau") 52.0 55 73.0 58 92.0 100.0 25</span>
<span class="co"># as.mo("STAU") 50.0 54 73.0 58 96.0 110.0 25</span>
<span class="co"># as.mo("staaur") 9.7 10 14.0 11 12.0 57.0 25</span>
<span class="co"># as.mo("STAAUR") 8.9 10 14.0 10 11.0 52.0 25</span>
<span class="co"># as.mo("S. aureus") 26.0 28 41.0 29 67.0 76.0 25</span>
<span class="co"># as.mo("S aureus") 27.0 28 41.0 30 65.0 76.0 25</span>
<span class="co"># as.mo("Staphylococcus aureus") 2.6 3 3.2 3 3.3 4.6 25</span>
<span class="co"># as.mo("Staphylococcus aureus (MRSA)") 240.0 260 270.0 260 270.0 380.0 25</span>
<span class="co"># as.mo("Sthafilokkockus aaureuz") 160.0 190 200.0 200 200.0 300.0 25</span>
<span class="co"># as.mo("MRSA") 9.3 10 15.0 10 12.0 49.0 25</span>
<span class="co"># as.mo("VISA") 18.0 19 31.0 21 54.0 67.0 25</span></code></pre></div>
<span class="co"># expr min lq mean median uq max neval</span>
<span class="co"># as.mo("sau") 10 11.0 15 11.0 13.0 47 25</span>
<span class="co"># as.mo("stau") 56 57.0 75 62.0 95.0 100 25</span>
<span class="co"># as.mo("STAU") 54 56.0 67 58.0 66.0 110 25</span>
<span class="co"># as.mo("staaur") 10 11.0 12 11.0 12.0 13 25</span>
<span class="co"># as.mo("STAAUR") 10 11.0 16 11.0 12.0 50 25</span>
<span class="co"># as.mo("S. aureus") 28 31.0 46 33.0 65.0 71 25</span>
<span class="co"># as.mo("S aureus") 29 30.0 42 33.0 64.0 67 25</span>
<span class="co"># as.mo("Staphylococcus aureus") 3 3.2 5 3.3 3.7 40 25</span>
<span class="co"># as.mo("Staphylococcus aureus (MRSA)") 240 260.0 270 270.0 280.0 290 25</span>
<span class="co"># as.mo("Sthafilokkockus aaureuz") 170 200.0 210 200.0 210.0 280 25</span>
<span class="co"># as.mo("MRSA") 10 11.0 17 11.0 13.0 51 25</span>
<span class="co"># as.mo("VISA") 19 20.0 36 21.0 50.0 150 25</span></code></pre></div>
<p><img src="benchmarks_files/figure-html/unnamed-chunk-4-1.png" width="750"></p>
<p>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.</p>
<p>To improve performance, we implemented two important algorithms to save unnecessary calculations: <strong>repetitive results</strong> and <strong>already precalculated results</strong>.</p>
@ -260,8 +260,8 @@
<span class="co"># what do these values look like? They are of class &lt;mo&gt;:</span>
<span class="fu"><a href="https://rdrr.io/r/utils/head.html">head</a></span><span class="op">(</span><span class="va">x</span><span class="op">)</span>
<span class="co"># Class &lt;mo&gt;</span>
<span class="co"># [1] B_STPHY_AURS B_STRPT_GRPC B_STPHY_CONS B_STPHY_EPDR B_STRPT_PNMN</span>
<span class="co"># [6] B_PROTS_VLGR</span>
<span class="co"># [1] B_ESCHR_COLI B_PROTS_MRBL B_PROTS_MRBL B_PROTS_MRBL B_STPHY_CONS</span>
<span class="co"># [6] B_ENTRC</span>
<span class="co"># as the example_isolates data set has 2,000 rows, we should have 2 million items</span>
<span class="fu"><a href="https://rdrr.io/r/base/length.html">length</a></span><span class="op">(</span><span class="va">x</span><span class="op">)</span>
@ -277,8 +277,8 @@
<span class="fu"><a href="https://rdrr.io/r/base/print.html">print</a></span><span class="op">(</span><span class="va">run_it</span>, unit <span class="op">=</span> <span class="st">"ms"</span>, signif <span class="op">=</span> <span class="fl">3</span><span class="op">)</span>
<span class="co"># Unit: milliseconds</span>
<span class="co"