P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 07:11:57 +02:00
Code Releases Activity

(v1.5.0.9027) website update

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2021-02-26 12:11:29 +01:00
parent 1737d56ae4
commit 41f94cde97
45 changed files with 491 additions and 425 deletions
Download Patch File Download Diff File Expand all files Collapse all files

61
R/ggplot_rsi.R
View File

@ -36,8 +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` for standard [ggplot2][ggplot2::ggplot()] colours. The default colours are colour-blind friendly, while maintaining the convention that e.g. 'susceptible' should be green and 'resistant' should be red.
#' @param aesthetics aesthetics to apply the colours to, defaults to "fill" but can also be "colour" or "both"
#' @param colours a named vactor with colour to be used for filling. The default colours are colour-blind friendly.
#' @param aesthetics aesthetics to apply the colours to, defaults to "fill" but can also be (a combination of) "alpha", "colour", "fill", "linetype", "shape" or "size"
#' @param datalabels show datalabels using [labels_rsi_count()]
#' @param datalabels.size size of the datalabels
#' @param datalabels.colour colour of the datalabels
@ -46,7 +46,7 @@
#' @param caption text to show as caption of the plot
#' @param x.title text to show as x axis description
#' @param y.title text to show as y axis description
#' @param ... other arguments passed on to [geom_rsi()]
#' @param ... other arguments passed on to [geom_rsi()] or, in case of [scale_rsi_colours()], named values to set colours. The default colours are colour-blind friendly, while maintaining the convention that e.g. 'susceptible' should be green and 'resistant' should be red. See *Examples*.
#' @details At default, the names of antibiotics will be shown on the plots using [ab_name()]. This can be set with the `translate_ab` argument. See [count_df()].
#'
#' ## The Functions
@ -56,7 +56,7 @@
#'
#' [scale_y_percent()] transforms the y axis to a 0 to 100% range using [ggplot2::scale_y_continuous()].
#'
#' [scale_rsi_colours()] sets colours to the bars: pastel blue for S, pastel turquoise for I and pastel red for R, using [ggplot2::scale_fill_manual()].
#' [scale_rsi_colours()] sets colours to the bars (green for S, yellow for I, and red for R). with multilingual support. The default colours are colour-blind friendly, while maintaining the convention that e.g. 'susceptible' should be green and 'resistant' should be red.
#'
#' [theme_rsi()] is a [ggplot2 theme][[ggplot2::theme()] with minimal distraction.
#'
@ -219,11 +219,6 @@ ggplot_rsi <- function(data,
theme_rsi()
if (fill == "interpretation") {
# set RSI colours
if (isFALSE(colours) & missing(datalabels.colour)) {
# set datalabel colour to middle grey
datalabels.colour <- "grey50"
}
p <- p + scale_rsi_colours(colours = colours)
}
@ -362,28 +357,50 @@ scale_y_percent <- function(breaks = seq(0, 1, 0.1), limits = NULL) {
#' @rdname ggplot_rsi
#' @export
scale_rsi_colours <- function(colours = c(S = "#3CAEA3",
SI = "#3CAEA3",
I = "#F6D55C",
IR = "#ED553B",
R = "#ED553B"),
scale_rsi_colours <- function(...,
aesthetics = "fill") {
stop_ifnot_installed("ggplot2")
meet_criteria(colours, allow_class = c("character", "logical"))
meet_criteria(aesthetics, allow_class = c("character"), has_length = c(1, 2), is_in = c("colour", "color", "fill", "both"))
meet_criteria(aesthetics, allow_class = c("character"), has_length = c(1, 2), is_in = c("alpha", "colour", "color", "fill", "linetype", "shape", "size"))
if (!identical(colours, FALSE)) {
if ("both" %in% aesthetics) {
aesthetics <- c("colour", "fill")
}
# behaviour until AMR pkg v1.5.0 and also when coming from ggplot_rsi()
if ("colours" %in% names(list(...))) {
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, aesthetics = aesthetics)
colours <- replace(original_cols, names(list(...)$colours), list(...)$colours)
return(ggplot2::scale_fill_manual(values = colours))
}
if (identical(unlist(list(...)), FALSE)) {
return(invisible())
}
names_susceptible <- c("S", "SI", "IS", "S+I", "I+S", "susceptible",
unique(translations_file[which(translations_file$pattern == "susceptible"),
"replacement", drop = TRUE]))
names_incr_exposure <- c("I", "intermediate", "increased exposure", "incr. exposure",
unique(translations_file[which(translations_file$pattern == "intermediate"),
"replacement", drop = TRUE]))
names_resistant <- c("R", "IR", "RI", "R+I", "I+R", "resistant",
unique(translations_file[which(translations_file$pattern == "resistant"),
"replacement", drop = TRUE]))
susceptible <- rep("#3CAEA3", length(names_susceptible))
names(susceptible) <- names_susceptible
incr_exposure <- rep("#F6D55C", length(names_incr_exposure))
names(incr_exposure) <- names_incr_exposure
resistant <- rep("#ED553B", length(names_resistant))
names(resistant) <- names_resistant
original_cols = c(susceptible, incr_exposure, resistant)
dots <- c(...)
# replace S, I, R as colours: scale_rsi_colours(mydatavalue = "S")
dots[dots == "S"] <- "#3CAEA3"
dots[dots == "I"] <- "#F6D55C"
dots[dots == "R"] <- "#ED553B"
colours <- replace(original_cols, names(dots), dots)
ggplot2::scale_discrete_manual(aesthetics = aesthetics, values = colours)
}
#' @rdname ggplot_rsi

55
R/plot.R
View File

@ -50,9 +50,11 @@
#' @examples
#' some_mic_values <- random_mic(size = 100)
#' some_disk_values <- random_disk(size = 100, mo = "Escherichia coli", ab = "cipro")
#' some_rsi_values <- random_rsi(50, prob_RSI = c(0.30, 0.55, 0.05))
#'
#' plot(some_mic_values)
#' plot(some_disk_values)
#' plot(some_rsi_values)
#'
#' # when providing the microorganism and antibiotic, colours will show interpretations:
#' plot(some_mic_values, mo = "S. aureus", ab = "ampicillin")
@ -61,6 +63,7 @@
#' if (require("ggplot2")) {
#' ggplot(some_mic_values)
#' ggplot(some_disk_values, mo = "Escherichia coli", ab = "cipro")
#' ggplot(some_rsi_values)
#' }
NULL
@ -229,7 +232,7 @@ ggplot.mic <- function(data,
name = NULL)
} else {
p <- p +
ggplot2::geom_col(aes(x = mic, y = count))
ggplot2::geom_col(ggplot2::aes(x = mic, y = count))
}
p +
@ -242,7 +245,7 @@ ggplot.mic <- function(data,
#' @importFrom graphics barplot axis mtext legend
#' @rdname plot
plot.disk <- function(x,
main = paste("Disk zones values of", deparse(substitute(x))),
main = paste("Disk zones of", deparse(substitute(x))),
ylab = "Frequency",
xlab = "Disk diffusion diameter (mm)",
mo = NULL,
@ -315,7 +318,7 @@ plot.disk <- function(x,
#' @export
#' @noRd
barplot.disk <- function(height,
main = paste("Disk zones values of", deparse(substitute(height))),
main = paste("Disk zones of", deparse(substitute(height))),
ylab = "Frequency",
xlab = "Disk diffusion diameter (mm)",
mo = NULL,
@ -350,7 +353,7 @@ barplot.disk <- function(height,
# 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))),
title = paste("Disk zones of", deparse(substitute(data))),
ylab = "Frequency",
xlab = "Disk diffusion diameter (mm)",
mo = NULL,
@ -395,7 +398,7 @@ ggplot.disk <- function(data,
if (any(colours_RSI %in% cols_sub$cols)) {
p <- p +
ggplot2::geom_col(aes(x = disk, y = count, fill = cols)) +
ggplot2::geom_col(ggplot2::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],
@ -403,7 +406,7 @@ ggplot.disk <- function(data,
name = NULL)
} else {
p <- p +
ggplot2::geom_col(aes(x = disk, y = count))
ggplot2::geom_col(ggplot2::aes(x = disk, y = count))
}
p +
@ -514,7 +517,7 @@ plot.rsi <- function(x,
stringsAsFactors = FALSE)
}
data$x <- factor(data$x, levels = c("R", "S", "I"), ordered = TRUE)
data$x <- factor(data$x, levels = c("S", "I", "R"), ordered = TRUE)
ymax <- pm_if_else(max(data$s) > 95, 105, 100)
@ -558,7 +561,7 @@ barplot.rsi <- function(height,
main <- gsub(" +", " ", paste0(main, collapse = " "))
x <- table(height)
x <- x[c(3, 1, 2)]
x <- x[c(1, 2, 3)]
barplot(x,
col = colours_RSI,
xlab = xlab,
@ -567,3 +570,39 @@ barplot.rsi <- function(height,
axes = FALSE)
axis(2, seq(0, max(x)))
}
#' @method ggplot rsi
#' @rdname plot
# will be exported using s3_register() in R/zzz.R
ggplot.rsi <- function(data,
mapping = NULL,
title = paste("Resistance Overview of", deparse(substitute(data))),
xlab = "Antimicrobial Interpretation",
ylab = "Frequency",
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
...) {
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(colours_RSI, allow_class = "character", has_length = c(1, 3))
if (length(colours_RSI) == 1) {
colours_RSI <- rep(colours_RSI, 3)
}
df <- as.data.frame(table(data), stringsAsFactors = TRUE)
colnames(df) <- c("rsi", "count")
if (!is.null(mapping)) {
p <- ggplot2::ggplot(df, mapping = mapping)
} else {
p <- ggplot2::ggplot(df)
}
p +
ggplot2::geom_col(ggplot2::aes(x = rsi, y = count, fill = rsi)) +
ggplot2::scale_fill_manual(values = c("R" = colours_RSI[1],
"S" = colours_RSI[2],
"I" = colours_RSI[3])) +
ggplot2::labs(title = title, x = xlab, y = ylab) +
ggplot2::theme(legend.position = "none")
}

1
R/zzz.R
View File

@ -50,6 +50,7 @@ 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", "rsi")
s3_register("ggplot2::ggplot", "mic")
s3_register("ggplot2::ggplot", "disk")