diff --git a/DESCRIPTION b/DESCRIPTION index c43b3d4d..58450c56 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: AMR -Version: 0.6.1.9045 +Version: 0.6.1.9046 Date: 2019-05-31 Title: Antimicrobial Resistance Analysis Authors@R: c( diff --git a/NEWS.md b/NEWS.md index 8453bbf1..3a7081d0 100755 --- a/NEWS.md +++ b/NEWS.md @@ -22,6 +22,9 @@ system.file("translations.tsv", package = "AMR") ``` Please create an issue in one of our repositories if you want additions in this file. +* Improvements to plotting AMR results with `ggplot_rsi()`: + * New parameter `colours` to set the bar colours + * New parameters `title`, `subtitle`, `caption`, `x.title` and `y.title` to set titles and axis descriptions * Improved intelligence of looking up antibiotic tables in data set using `guess_ab_col()` * Added ~5,000 more old taxonomic names to the `microorganisms.old` data set, which leads to better results finding when using the `as.mo()` function * This package now honours the new EUCAST insight (2019) that S and I are but classified as susceptible, where I is defined as 'increased exposure' and not 'intermediate' anymore. For functions like `portion_df()` and `count_df()` this means that their new parameter `combine_SI` is TRUE at default. @@ -50,6 +53,7 @@ * Function `as.mo()` now gently interprets any number of whitespace characters (like tabs) as one space * Small algorithm fix for `as.mo()` * Removed viruses from data set `microorganisms.codes` and cleaned it up +* Fix for `mo_shortname()` where species would not be determined correctly #### Other * Support for R 3.6.0 diff --git a/R/age.R b/R/age.R index 5ea85226..f35b40a6 100755 --- a/R/age.R +++ b/R/age.R @@ -47,8 +47,8 @@ age <- function(x, reference = Sys.Date(), exact = FALSE) { stop("`x` and `reference` must be of same length, or `reference` must be of length 1.") } } - x <- base::as.POSIXlt(x) - reference <- base::as.POSIXlt(reference) + x <- as.POSIXlt(x) + reference <- as.POSIXlt(reference) # from https://stackoverflow.com/a/25450756/4575331 years_gap <- reference$year - x$year @@ -59,13 +59,17 @@ age <- function(x, reference = Sys.Date(), exact = FALSE) { # add decimals if (exact == TRUE) { # get dates of `x` when `x` would have the year of `reference` - x_in_reference_year <- base::as.POSIXlt(paste0(format(reference, "%Y"), format(x, "-%m-%d"))) + x_in_reference_year <- as.POSIXlt(paste0(format(reference, "%Y"), format(x, "-%m-%d"))) # get differences in days - n_days_x_rest <- base::as.double(base::difftime(reference, x_in_reference_year, units = "days")) + n_days_x_rest <- as.double(difftime(reference, x_in_reference_year, units = "days")) # get numbers of days the years of `reference` has for a reliable denominator - n_days_reference_year <- base::as.POSIXlt(paste0(format(reference, "%Y"), "-12-31"))$yday + 1 + n_days_reference_year <- as.POSIXlt(paste0(format(reference, "%Y"), "-12-31"))$yday + 1 # add decimal parts of year - ages <- ages + (n_days_x_rest / n_days_reference_year) + mod <- n_days_x_rest / n_days_reference_year + # negative mods are cases where `x_in_reference_year` > `reference` - so 'add' a year + mod[mod < 0] <- 1 + mod[mod < 0] + # and finally add to ages + ages <- ages + mod } if (any(ages < 0, na.rm = TRUE)) { @@ -79,10 +83,6 @@ age <- function(x, reference = Sys.Date(), exact = FALSE) { ages } -age_to_toDate <- function(age) { - -} - #' Split ages into age groups #' #' Split ages into age groups defined by the \code{split} parameter. This allows for easier demographic (antimicrobial resistance) analysis. diff --git a/R/ggplot_rsi.R b/R/ggplot_rsi.R index d312a4db..ca203c67 100755 --- a/R/ggplot_rsi.R +++ b/R/ggplot_rsi.R @@ -21,7 +21,7 @@ #' AMR plots with \code{ggplot2} #' -#' Use these functions to create bar plots for antimicrobial resistance analysis. All functions rely on internal \code{\link[ggplot2]{ggplot}} functions. +#' Use these functions to create bar plots for antimicrobial resistance analysis. All functions rely on internal \code{\link[ggplot2]{ggplot}2} functions. #' @param data a \code{data.frame} with column(s) of class \code{"rsi"} (see \code{\link{as.rsi}}) #' @param position position adjustment of bars, either \code{"fill"} (default when \code{fun} is \code{\link{count_df}}), \code{"stack"} (default when \code{fun} is \code{\link{portion_df}}) or \code{"dodge"} #' @param x variable to show on x axis, either \code{"Antibiotic"} (default) or \code{"Interpretation"} or a grouping variable @@ -32,11 +32,17 @@ #' @param fun function to transform \code{data}, either \code{\link{count_df}} (default) or \code{\link{portion_df}} #' @inheritParams portion #' @param nrow (when using \code{facet}) number of rows -#' @param datalabels show datalabels using \code{labels_rsi_count}, will at default only be shown when \code{fun = count_df} +#' @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 \code{FALSE} to use default \code{ggplot2} colours. +#' @param datalabels show datalabels using \code{labels_rsi_count}, will only be shown when \code{fun = count_df} #' @param datalabels.size size of the datalabels #' @param datalabels.colour colour of the datalabels +#' @param title text to show as title of the plot +#' @param subtitle text to show as subtitle of the plot +#' @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 parameters passed on to \code{geom_rsi} -#' @details At default, the names of antibiotics will be shown on the plots using \code{\link{ab_name}}. This can be set with the option \code{get_antibiotic_names} (a logical value), so change it e.g. to \code{FALSE} with \code{options(get_antibiotic_names = FALSE)}. +#' @details At default, the names of antibiotics will be shown on the plots using \code{\link{ab_name}}. This can be set with the \code{translate_ab} parameter. See \code{\link{count_df}}. #' #' \strong{The functions}\cr #' \code{geom_rsi} will take any variable from the data that has an \code{rsi} class (created with \code{\link{as.rsi}}) using \code{fun} (\code{\link{count_df}} at default, can also be \code{\link{portion_df}}) and will plot bars with the percentage R, I and S. The default behaviour is to have the bars stacked and to have the different antibiotics on the x axis. @@ -45,7 +51,7 @@ #' #' \code{scale_y_percent} transforms the y axis to a 0 to 100\% range using \code{\link[ggplot2]{scale_continuous}}. #' -#' \code{scale_rsi_colours} sets colours to the bars: green for S, yellow for I and red for R, using \code{\link[ggplot2]{scale_brewer}}. +#' \code{scale_rsi_colours} sets colours to the bars: pastel blue for S, pastel turquoise for I and pastel red for R, using \code{\link[ggplot2]{scale_brewer}}. #' #' \code{theme_rsi} is a \code{ggplot \link[ggplot2]{theme}} with minimal distraction. #' @@ -65,7 +71,7 @@ #' geom_rsi() #' #' # prettify the plot using some additional functions: -#' df <- septic_patients[, c("AMX", "NIT", "FOS", "TMP", "CIP")] +#' df <- septic_patients %>% select(AMX, NIT, FOS, TMP, CIP) #' ggplot(df) + #' geom_rsi() + #' scale_y_percent() + @@ -92,6 +98,10 @@ #' linetype = 2, #' alpha = 0.25) #' +#' septic_patients %>% +#' select(AMX) %>% +#' ggplot_rsi(colours = c(SI = "yellow")) +#' #' # resistance of ciprofloxacine per age group #' septic_patients %>% #' mutate(first_isolate = first_isolate(.)) %>% @@ -108,45 +118,45 @@ #' septic_patients %>% #' select(AMX, NIT, FOS, TMP, CIP) %>% #' ggplot_rsi() + scale_fill_viridis_d() +#' # a shorter version which also adjusts data label colours: +#' septic_patients %>% +#' select(AMX, NIT, FOS, TMP, CIP) %>% +#' ggplot_rsi(colours = FALSE) #' #' #' # it also supports groups (don't forget to use the group var on `x` or `facet`): #' septic_patients %>% #' select(hospital_id, AMX, NIT, FOS, TMP, CIP) %>% #' group_by(hospital_id) %>% -#' ggplot_rsi(x = hospital_id, -#' facet = Antibiotic, -#' nrow = 1) + -#' labs(title = "AMR of Anti-UTI Drugs Per Hospital", -#' x = "Hospital") +#' ggplot_rsi(x = "hospital_id", +#' facet = "Antibiotic", +#' nrow = 1, +#' title = "AMR of Anti-UTI Drugs Per Hospital", +#' x.title = "Hospital", +#' datalabels = FALSE) #' -#' # genuine analysis: check 2 most prevalent microorganisms +#' # genuine analysis: check 3 most prevalent microorganisms #' septic_patients %>% #' # create new bacterial ID's, with all CoNS under the same group (Becker et al.) #' mutate(mo = as.mo(mo, Becker = TRUE)) %>% #' # filter on top three bacterial ID's #' filter(mo %in% top_freq(freq(.$mo), 3)) %>% -#' # determine first isolates -#' mutate(first_isolate = first_isolate(., -#' col_date = "date", -#' col_patient_id = "patient_id", -#' col_mo = "mo")) %>% #' # filter on first isolates -#' filter(first_isolate == TRUE) %>% +#' filter_first_isolate() %>% #' # get short MO names (like "E. coli") -#' mutate(mo = mo_shortname(mo, Becker = TRUE)) %>% +#' mutate(bug = mo_shortname(mo, Becker = TRUE)) %>% #' # select this short name and some antiseptic drugs -#' select(mo, CXM, GEN, CIP) %>% +#' select(bug, CXM, GEN, CIP) %>% #' # group by MO -#' group_by(mo) %>% +#' group_by(bug) %>% #' # plot the thing, putting MOs on the facet -#' ggplot_rsi(x = Antibiotic, -#' facet = mo, +#' ggplot_rsi(x = "Antibiotic", +#' facet = "bug", #' translate_ab = FALSE, -#' nrow = 1) + -#' labs(title = "AMR of Top Three Microorganisms In Blood Culture Isolates", -#' subtitle = "Only First Isolates, CoNS grouped according to Becker et al. (2014)", -#' x = "Microorganisms") +#' nrow = 1, +#' title = "AMR of Top Three Microorganisms In Blood Culture Isolates", +#' subtitle = expression(paste("Only First Isolates, CoNS grouped according to Becker ", italic("et al."), " (2014)")), +#' x.title = "Antibiotic (EARS-Net code)") #' } ggplot_rsi <- function(data, position = NULL, @@ -162,9 +172,19 @@ ggplot_rsi <- function(data, language = get_locale(), fun = count_df, nrow = NULL, - datalabels = FALSE, - datalabels.size = 3, - datalabels.colour = "white", + colours = c(S = "#61a8ff", + SI = "#61a8ff", + I = "#61f7ff", + IR = "#ff6961", + R = "#ff6961"), + datalabels = TRUE, + datalabels.size = 2.5, + datalabels.colour = "gray15", + title = NULL, + subtitle = NULL, + caption = NULL, + x.title = NULL, + y.title = NULL, ...) { stopifnot_installed_package("ggplot2") @@ -196,6 +216,10 @@ ggplot_rsi <- function(data, facet <- NULL } + if (is.null(position)) { + position <- "fill" + } + p <- ggplot2::ggplot(data = data) + geom_rsi(position = position, x = x, fill = fill, translate_ab = translate_ab, fun = fun, combine_SI = combine_SI, combine_IR = combine_IR, ...) + @@ -203,11 +227,13 @@ ggplot_rsi <- function(data, if (fill == "Interpretation") { # set RSI colours - p <- p + scale_rsi_colours() - } - if (is.null(position)) { - position <- "fill" + if (isFALSE(colours) & missing(datalabels.colour)) { + # set datalabel colour to middle gray + datalabels.colour <- "gray50" + } + p <- p + scale_rsi_colours(colours = colours) } + if (fun_name == "portion_df" | (fun_name == "count_df" & identical(position, "fill"))) { # portions, so use y scale with percentage @@ -217,6 +243,9 @@ ggplot_rsi <- function(data, if (fun_name == "count_df" & datalabels == TRUE) { p <- p + labels_rsi_count(position = position, x = x, + translate_ab = translate_ab, + combine_SI = combine_SI, + combine_IR = combine_IR, datalabels.size = datalabels.size, datalabels.colour = datalabels.colour) } @@ -225,6 +254,12 @@ ggplot_rsi <- function(data, p <- p + facet_rsi(facet = facet, nrow = nrow) } + p <- p + ggplot2::labs(title = title, + subtitle = subtitle, + caption = caption, + x = x.title, + y = y.title) + p } @@ -261,6 +296,10 @@ geom_rsi <- function(position = NULL, } } + if (identical(position, "fill")) { + position <- ggplot2::position_fill(vjust = 0.5, reverse = TRUE) + } + x <- x[1] # we work with aes_string later on @@ -296,7 +335,7 @@ facet_rsi <- function(facet = c("Interpretation", "Antibiotic"), nrow = NULL) { stopifnot_installed_package("ggplot2") - facet <- facet[1] + facet <- facet[1] # we work with aes_string later on facet_deparse <- deparse(substitute(facet)) @@ -331,37 +370,49 @@ scale_y_percent <- function(breaks = seq(0, 1, 0.1), limits = NULL) { #' @rdname ggplot_rsi #' @export -scale_rsi_colours <- function() { +scale_rsi_colours <- function(colours = c(S = "#61a8ff", + SI = "#61a8ff", + I = "#61f7ff", + IR = "#ff6961", + R = "#ff6961")) { stopifnot_installed_package("ggplot2") #ggplot2::scale_fill_brewer(palette = "RdYlGn") #ggplot2::scale_fill_manual(values = c("#b22222", "#ae9c20", "#7cfc00")) - # mixed using https://www.colorhexa.com/b22222 - # and https://www.w3schools.com/colors/colors_mixer.asp - ggplot2::scale_fill_manual(values = c(S = "#22b222", - SI = "#22b222", - I = "#548022", - IR = "#b22222", - R = "#b22222")) - + if (!identical(colours, FALSE)) { + original_cols <- c(S = "#61a8ff", + SI = "#61a8ff", + I = "#61f7ff", + IR = "#ff6961", + R = "#ff6961") + colours <- replace(original_cols, names(colours), colours) + ggplot2::scale_fill_manual(values = colours) + } } #' @rdname ggplot_rsi #' @export theme_rsi <- function() { stopifnot_installed_package("ggplot2") - ggplot2::theme_minimal() + + ggplot2::theme_minimal(base_size = 10) + ggplot2::theme(panel.grid.major.x = ggplot2::element_blank(), panel.grid.minor = ggplot2::element_blank(), - panel.grid.major.y = ggplot2::element_line(colour = "grey75")) + panel.grid.major.y = ggplot2::element_line(colour = "grey75"), + # center title and subtitle + plot.title = ggplot2::element_text(hjust = 0.5), + plot.subtitle = ggplot2::element_text(hjust = 0.5)) } #' @rdname ggplot_rsi +#' @importFrom dplyr mutate %>% group_by_at #' @export labels_rsi_count <- function(position = NULL, x = "Antibiotic", + translate_ab = "name", + combine_SI = TRUE, + combine_IR = FALSE, datalabels.size = 3, - datalabels.colour = "white") { + datalabels.colour = "gray15") { stopifnot_installed_package("ggplot2") if (is.null(position)) { position <- "fill" @@ -369,23 +420,24 @@ labels_rsi_count <- function(position = NULL, if (identical(position, "fill")) { position <- ggplot2::position_fill(vjust = 0.5, reverse = TRUE) } + x_name <- x ggplot2::geom_text(mapping = ggplot2::aes_string(label = "lbl", x = x, y = "Value"), position = position, - data = getlbls, inherit.aes = FALSE, size = datalabels.size, - colour = datalabels.colour) + colour = datalabels.colour, + lineheight = 0.75, + data = function(x) { + # labels are only shown when function is count_df, + # so no need parameterise it here + count_df(data = x, + translate_ab = translate_ab, + combine_SI = combine_SI, + combine_IR = combine_IR) %>% + group_by_at(x_name) %>% + mutate(lbl = paste0(percent(Value / sum(Value, na.rm = TRUE), force_zero = TRUE), + "\n(n=", Value, ")")) + }) } - -#' @importFrom dplyr %>% group_by mutate -getlbls <- function(data) { - data %>% - count_df() %>% - group_by(Antibiotic) %>% - mutate(lbl = paste0(percent(Value / sum(Value, na.rm = TRUE), force_zero = TRUE), - " (n=", Value, ")")) %>% - mutate(lbl = ifelse(lbl == "0.0% (n=0)", "", lbl)) -} - diff --git a/R/mo_property.R b/R/mo_property.R index 206c5345..947f3ef7 100755 --- a/R/mo_property.R +++ b/R/mo_property.R @@ -157,55 +157,32 @@ mo_shortname <- function(x, language = get_locale(), ...) { Lancefield <- FALSE } - shorten <- function(x) { - # easiest: no transformations needed - x <- mo_fullname(x, language = "en") - # shorten for the ones that have a space: shorten first word and write out second word - shorten_these <- x %like% " " & !x %like% "Streptococcus group " - x[shorten_these] <- paste0(substr(x[shorten_these], 1, 1), - ". ", - x[shorten_these] %>% - strsplit(" ", fixed = TRUE) %>% - unlist() %>% - .[2]) - x - } - - if (isFALSE(Becker) & isFALSE(Lancefield)) { - result <- shorten(x) - - } else { - # get result without transformations - res1 <- AMR::as.mo(x, Becker = FALSE, Lancefield = FALSE, reference_df = dots$reference_df) - # and result with transformations - res2 <- suppressWarnings(AMR::as.mo(res1, ...)) - if (res1 == res2 - & !res1 %like% "^B_STRPT_GR") { - result <- shorten(x) - } else { - res2_fullname <- mo_fullname(res2, language = language) - res2_fullname[res2_fullname %like% " \\(CoNS\\)"] <- "CoNS" - res2_fullname[res2_fullname %like% " \\(CoPS\\)"] <- "CoPS" - res2_fullname[res2_fullname %like% " \\(KNS\\)"] <- "KNS" - res2_fullname[res2_fullname %like% " \\(KPS\\)"] <- "KPS" - res2_fullname[res2_fullname %like% " \\(CNS\\)"] <- "CNS" - res2_fullname[res2_fullname %like% " \\(CPS\\)"] <- "CPS" - res2_fullname <- gsub("Streptococcus (group|Gruppe|gruppe|groep|grupo|gruppo|groupe) (.)", - "G\\2S", - res2_fullname) # turn "Streptococcus group A" and "Streptococcus grupo A" to "GAS" - res2_fullname_vector <- res2_fullname[res2_fullname == mo_fullname(res1)] - res2_fullname[res2_fullname == mo_fullname(res1)] <- paste0(substr(mo_genus(res2_fullname_vector), 1, 1), - ". ", - suppressWarnings(mo_species(res2_fullname_vector))) - if (sum(res1 == res2, na.rm = TRUE) > 0) { - res1[res1 == res2] <- paste0(substr(mo_genus(res1[res1 == res2]), 1, 1), - ". ", - suppressWarnings(mo_species(res1[res1 == res2]))) - } - res1[res1 != res2] <- res2_fullname - result <- as.character(res1) - } + # get result without transformations + res1 <- AMR::as.mo(x, Becker = FALSE, Lancefield = FALSE, reference_df = dots$reference_df) + # and result with transformations + res2 <- suppressWarnings(AMR::as.mo(res1, ...)) + res2_fullname <- mo_fullname(res2, language = language) + res2_fullname[res2_fullname %like% " \\(CoNS\\)"] <- "CoNS" + res2_fullname[res2_fullname %like% " \\(CoPS\\)"] <- "CoPS" + res2_fullname[res2_fullname %like% " \\(KNS\\)"] <- "KNS" + res2_fullname[res2_fullname %like% " \\(KPS\\)"] <- "KPS" + res2_fullname[res2_fullname %like% " \\(CNS\\)"] <- "CNS" + res2_fullname[res2_fullname %like% " \\(CPS\\)"] <- "CPS" + res2_fullname[res2_fullname %like% " \\(SCN\\)"] <- "SCN" + res2_fullname <- gsub("Streptococcus (group|Gruppe|gruppe|groep|grupo|gruppo|groupe) (.)", + "G\\2S", + res2_fullname) # turn "Streptococcus group A" and "Streptococcus grupo A" to "GAS" + res2_fullname_vector <- res2_fullname[res2_fullname == mo_fullname(res1)] + res2_fullname[res2_fullname == mo_fullname(res1)] <- paste0(substr(mo_genus(res2_fullname_vector), 1, 1), + ". ", + suppressWarnings(mo_species(res2_fullname_vector))) + if (sum(res1 == res2, na.rm = TRUE) > 0) { + res1[res1 == res2] <- paste0(substr(mo_genus(res1[res1 == res2]), 1, 1), + ". ", + suppressWarnings(mo_species(res1[res1 == res2]))) } + res1[res1 != res2] <- res2_fullname + result <- as.character(res1) t(result, language = language) } diff --git a/_pkgdown.yml b/_pkgdown.yml index 3445ab51..6a5d274e 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -19,9 +19,12 @@ # Visit our website for more info: https://msberends.gitlab.io/AMR. # # ==================================================================== # -url: 'https://msberends.gitlab.io/AMR' - title: 'AMR (for R)' +url: 'https://msberends.gitlab.io/AMR' +development: + mode: release # improves indexing by search engines +news: + one_page: true navbar: title: 'AMR (for R)' @@ -177,9 +180,6 @@ authors: Bhanu N. M. Sinha: href: https://www.rug.nl/staff/b.sinha/ -development: - mode: release # improves indexing by search engines - template: assets: pkgdown/logos # use logos in this folder params: diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 6199e1b3..a0ef0fc6 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -78,7 +78,7 @@ AMR (for R) - 0.6.1.9045 + 0.6.1.9046 diff --git a/docs/articles/index.html b/docs/articles/index.html index ce33f5f7..9f01235f 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -78,7 +78,7 @@ AMR (for R) - 0.6.1.9045 + 0.6.1.9046 diff --git a/docs/authors.html b/docs/authors.html index 48e3be13..23a5a4b6 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -78,7 +78,7 @@ AMR (for R) - 0.6.1.9045 + 0.6.1.9046 diff --git a/docs/index.html b/docs/index.html index bdbec43f..7df35705 100644 --- a/docs/index.html +++ b/docs/index.html @@ -42,7 +42,7 @@ AMR (for R) - 0.6.1.9045 + 0.6.1.9046 diff --git a/docs/news/index.html b/docs/news/index.html index 173c5438..afd0e54e 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -78,7 +78,7 @@ AMR (for R) - 0.6.1.9045 + 0.6.1.9046 @@ -278,6 +278,12 @@ Please create an issue in one of our repositories if you want additions in this file. +
  • Improvements to plotting AMR results with ggplot_rsi(): + +
  • Improved intelligence of looking up antibiotic tables in data set using guess_ab_col()
  • Added ~5,000 more old taxonomic names to the microorganisms.old data set, which leads to better results finding when using the as.mo() function
    • @@ -316,6 +322,7 @@ Please create an issue in one of our repositories if you want additions in this
  • Small algorithm fix for as.mo()
  • Removed viruses from data set microorganisms.codes and cleaned it up
    • +
  • Fix for mo_shortname() where species would not be determined correctly
    • diff --git a/docs/reference/ggplot_rsi.html b/docs/reference/ggplot_rsi.html index b754bf75..04d99d0f 100644 --- a/docs/reference/ggplot_rsi.html +++ b/docs/reference/ggplot_rsi.html @@ -47,7 +47,7 @@ - + @@ -80,7 +80,7 @@ AMR (for R) - 0.6.1.9044 + 0.6.1.9046
    @@ -244,7 +244,7 @@
    -

    Use these functions to create bar plots for antimicrobial resistance analysis. All functions rely on internal ggplot functions.

    +

    Use these functions to create bar plots for antimicrobial resistance analysis. All functions rely on internal ggplot2 functions.

    @@ -252,8 +252,11 @@ fill = "Interpretation", facet = NULL, breaks = seq(0, 1, 0.1), limits = NULL, translate_ab = "name", combine_SI = TRUE, combine_IR = FALSE, language = get_locale(), fun = count_df, - nrow = NULL, datalabels = FALSE, datalabels.size = 3, - datalabels.colour = "white", ...) + nrow = NULL, colours = c(S = "#61a8ff", SI = "#61a8ff", I = + "#61f7ff", IR = "#ff6961", R = "#ff6961"), datalabels = TRUE, + datalabels.size = 2.5, datalabels.colour = "gray15", title = NULL, + subtitle = NULL, caption = NULL, x.title = NULL, y.title = NULL, + ...) geom_rsi(position = NULL, x = c("Antibiotic", "Interpretation"), fill = "Interpretation", translate_ab = "name", @@ -264,12 +267,14 @@ scale_y_percent(breaks = seq(0, 1, 0.1), limits = NULL) -scale_rsi_colours() +scale_rsi_colours(colours = c(S = "#61a8ff", SI = "#61a8ff", I = + "#61f7ff", IR = "#ff6961", R = "#ff6961")) theme_rsi() labels_rsi_count(position = NULL, x = "Antibiotic", - datalabels.size = 3, datalabels.colour = "white") + translate_ab = "name", combine_SI = TRUE, combine_IR = FALSE, + datalabels.size = 3, datalabels.colour = "gray15")

    Arguments

    @@ -326,9 +331,13 @@ + + + + - + @@ -338,6 +347,26 @@ + + + + + + + + + + + + + + + + + + + + @@ -346,12 +375,12 @@

    Details

    -

    At default, the names of antibiotics will be shown on the plots using ab_name. This can be set with the option get_antibiotic_names (a logical value), so change it e.g. to FALSE with options(get_antibiotic_names = FALSE).

    +

    At default, the names of antibiotics will be shown on the plots using ab_name. This can be set with the translate_ab parameter. See count_df.

    The functions
    geom_rsi will take any variable from the data that has an rsi class (created with as.rsi) using fun (count_df at default, can also be portion_df) and will plot bars with the percentage R, I and S. The default behaviour is to have the bars stacked and to have the different antibiotics on the x axis.

    facet_rsi creates 2d plots (at default based on S/I/R) using facet_wrap.

    scale_y_percent transforms the y axis to a 0 to 100% range using scale_continuous.

    -

    scale_rsi_colours sets colours to the bars: green for S, yellow for I and red for R, using scale_brewer.

    +

    scale_rsi_colours sets colours to the bars: pastel blue for S, pastel turquoise for I and pastel red for R, using scale_brewer.

    theme_rsi is a ggplot theme with minimal distraction.

    labels_rsi_count print datalabels on the bars with percentage and amount of isolates using geom_text

    ggplot_rsi is a wrapper around all above functions that uses data as first input. This makes it possible to use this function after a pipe (%>%). See Examples.

    @@ -372,7 +401,7 @@ geom_rsi() # prettify the plot using some additional functions: -df<-septic_patients[, c("AMX", "NIT", "FOS", "TMP", "CIP")] +df<-septic_patients%>%select(AMX, NIT, FOS, TMP, CIP) ggplot(df) + geom_rsi() + scale_y_percent() + @@ -399,6 +428,10 @@ linetype=2, alpha=0.25) +septic_patients%>% + select(AMX) %>% + ggplot_rsi(colours=c(SI="yellow")) + # resistance of ciprofloxacine per age groupseptic_patients%>%mutate(first_isolate=first_isolate(.)) %>% @@ -414,45 +447,45 @@ septic_patients%>%select(AMX, NIT, FOS, TMP, CIP) %>%ggplot_rsi() + scale_fill_viridis_d() +# a shorter version which also adjusts data label colours: +septic_patients%>% + select(AMX, NIT, FOS, TMP, CIP) %>% + ggplot_rsi(colours=FALSE) # it also supports groups (don't forget to use the group var on `x` or `facet`):septic_patients%>%select(hospital_id, AMX, NIT, FOS, TMP, CIP) %>%group_by(hospital_id) %>% - ggplot_rsi(x=hospital_id, - facet=Antibiotic, - nrow=1) + - labs(title="AMR of Anti-UTI Drugs Per Hospital", - x="Hospital") + ggplot_rsi(x="hospital_id", + facet="Antibiotic", + nrow=1, + title="AMR of Anti-UTI Drugs Per Hospital", + x.title="Hospital", + datalabels=FALSE) -# genuine analysis: check 2 most prevalent microorganisms +# genuine analysis: check 3 most prevalent microorganismsseptic_patients%>%# create new bacterial ID's, with all CoNS under the same group (Becker et al.)mutate(mo=as.mo(mo, Becker=TRUE)) %>%# filter on top three bacterial ID'sfilter(mo%in%top_freq(freq(.$mo), 3)) %>% - # determine first isolates - mutate(first_isolate=first_isolate(., - col_date="date", - col_patient_id="patient_id", - col_mo="mo")) %>%# filter on first isolates - filter(first_isolate==TRUE) %>% + filter_first_isolate() %>%# get short MO names (like "E. coli") - mutate(mo=mo_shortname(mo, Becker=TRUE)) %>% + mutate(bug=mo_shortname(mo, Becker=TRUE)) %>%# select this short name and some antiseptic drugs - select(mo, CXM, GEN, CIP) %>% + select(bug, CXM, GEN, CIP) %>%# group by MO - group_by(mo) %>% + group_by(bug) %>%# plot the thing, putting MOs on the facet - ggplot_rsi(x=Antibiotic, - facet=mo, + ggplot_rsi(x="Antibiotic", + facet="bug", translate_ab=FALSE, - nrow=1) + - labs(title="AMR of Top Three Microorganisms In Blood Culture Isolates", - subtitle="Only First Isolates, CoNS grouped according to Becker et al. (2014)", - x="Microorganisms") + nrow=1, + title="AMR of Top Three Microorganisms In Blood Culture Isolates", + subtitle=expression(paste("Only First Isolates, CoNS grouped according to Becker ", italic("et al."), " (2014)")), + x.title="Antibiotic (Ears-Net code)") # } diff --git a/man/ggplot_rsi.Rd b/man/ggplot_rsi.Rd index b432d565..0f227446 100644 --- a/man/ggplot_rsi.Rd +++ b/man/ggplot_rsi.Rd @@ -14,8 +14,11 @@ ggplot_rsi(data, position = NULL, x = "Antibiotic", fill = "Interpretation", facet = NULL, breaks = seq(0, 1, 0.1), limits = NULL, translate_ab = "name", combine_SI = TRUE, combine_IR = FALSE, language = get_locale(), fun = count_df, - nrow = NULL, datalabels = FALSE, datalabels.size = 3, - datalabels.colour = "white", ...) + nrow = NULL, colours = c(S = "#61a8ff", SI = "#61a8ff", I = + "#61f7ff", IR = "#ff6961", R = "#ff6961"), datalabels = TRUE, + datalabels.size = 2.5, datalabels.colour = "gray15", title = NULL, + subtitle = NULL, caption = NULL, x.title = NULL, y.title = NULL, + ...) geom_rsi(position = NULL, x = c("Antibiotic", "Interpretation"), fill = "Interpretation", translate_ab = "name", @@ -26,12 +29,14 @@ facet_rsi(facet = c("Interpretation", "Antibiotic"), nrow = NULL) scale_y_percent(breaks = seq(0, 1, 0.1), limits = NULL) -scale_rsi_colours() +scale_rsi_colours(colours = c(S = "#61a8ff", SI = "#61a8ff", I = + "#61f7ff", IR = "#ff6961", R = "#ff6961")) theme_rsi() labels_rsi_count(position = NULL, x = "Antibiotic", - datalabels.size = 3, datalabels.colour = "white") + translate_ab = "name", combine_SI = TRUE, combine_IR = FALSE, + datalabels.size = 3, datalabels.colour = "gray15") } \arguments{ \item{data}{a \code{data.frame} with column(s) of class \code{"rsi"} (see \code{\link{as.rsi}})} @@ -60,19 +65,31 @@ labels_rsi_count(position = NULL, x = "Antibiotic", \item{nrow}{(when using \code{facet}) number of rows} -\item{datalabels}{show datalabels using \code{labels_rsi_count}, will at default only be shown when \code{fun = count_df}} +\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 \code{ggplot2} colours.} + +\item{datalabels}{show datalabels using \code{labels_rsi_count}, will only be shown when \code{fun = count_df}} \item{datalabels.size}{size of the datalabels} \item{datalabels.colour}{colour of the datalabels} +\item{title}{text to show as title of the plot} + +\item{subtitle}{text to show as subtitle of the plot} + +\item{caption}{text to show as caption of the plot} + +\item{x.title}{text to show as x axis description} + +\item{y.title}{text to show as y axis description} + \item{...}{other parameters passed on to \code{geom_rsi}} } \description{ -Use these functions to create bar plots for antimicrobial resistance analysis. All functions rely on internal \code{\link[ggplot2]{ggplot}} functions. +Use these functions to create bar plots for antimicrobial resistance analysis. All functions rely on internal \code{\link[ggplot2]{ggplot}2} functions. } \details{ -At default, the names of antibiotics will be shown on the plots using \code{\link{ab_name}}. This can be set with the option \code{get_antibiotic_names} (a logical value), so change it e.g. to \code{FALSE} with \code{options(get_antibiotic_names = FALSE)}. +At default, the names of antibiotics will be shown on the plots using \code{\link{ab_name}}. This can be set with the \code{translate_ab} parameter. See \code{\link{count_df}}. \strong{The functions}\cr \code{geom_rsi} will take any variable from the data that has an \code{rsi} class (created with \code{\link{as.rsi}}) using \code{fun} (\code{\link{count_df}} at default, can also be \code{\link{portion_df}}) and will plot bars with the percentage R, I and S. The default behaviour is to have the bars stacked and to have the different antibiotics on the x axis. @@ -81,7 +98,7 @@ At default, the names of antibiotics will be shown on the plots using \code{\lin \code{scale_y_percent} transforms the y axis to a 0 to 100\% range using \code{\link[ggplot2]{scale_continuous}}. -\code{scale_rsi_colours} sets colours to the bars: green for S, yellow for I and red for R, using \code{\link[ggplot2]{scale_brewer}}. +\code{scale_rsi_colours} sets colours to the bars: pastel blue for S, pastel turquoise for I and pastel red for R, using \code{\link[ggplot2]{scale_brewer}}. \code{theme_rsi} is a \code{ggplot \link[ggplot2]{theme}} with minimal distraction. @@ -103,7 +120,7 @@ ggplot(septic_patients \%>\% select(AMX, NIT, FOS, TMP, CIP)) + geom_rsi() # prettify the plot using some additional functions: -df <- septic_patients[, c("AMX", "NIT", "FOS", "TMP", "CIP")] +df <- septic_patients \%>\% select(AMX, NIT, FOS, TMP, CIP) ggplot(df) + geom_rsi() + scale_y_percent() + @@ -130,6 +147,10 @@ septic_patients \%>\% linetype = 2, alpha = 0.25) +septic_patients \%>\% + select(AMX) \%>\% + ggplot_rsi(colours = c(SI = "yellow")) + # resistance of ciprofloxacine per age group septic_patients \%>\% mutate(first_isolate = first_isolate(.)) \%>\% @@ -146,44 +167,44 @@ septic_patients \%>\% septic_patients \%>\% select(AMX, NIT, FOS, TMP, CIP) \%>\% ggplot_rsi() + scale_fill_viridis_d() +# a shorter version which also adjusts data label colours: +septic_patients \%>\% + select(AMX, NIT, FOS, TMP, CIP) \%>\% + ggplot_rsi(colours = FALSE) # it also supports groups (don't forget to use the group var on `x` or `facet`): septic_patients \%>\% select(hospital_id, AMX, NIT, FOS, TMP, CIP) \%>\% group_by(hospital_id) \%>\% - ggplot_rsi(x = hospital_id, - facet = Antibiotic, - nrow = 1) + - labs(title = "AMR of Anti-UTI Drugs Per Hospital", - x = "Hospital") + ggplot_rsi(x = "hospital_id", + facet = "Antibiotic", + nrow = 1, + title = "AMR of Anti-UTI Drugs Per Hospital", + x.title = "Hospital", + datalabels = FALSE) -# genuine analysis: check 2 most prevalent microorganisms +# genuine analysis: check 3 most prevalent microorganisms septic_patients \%>\% # create new bacterial ID's, with all CoNS under the same group (Becker et al.) mutate(mo = as.mo(mo, Becker = TRUE)) \%>\% # filter on top three bacterial ID's filter(mo \%in\% top_freq(freq(.$mo), 3)) \%>\% - # determine first isolates - mutate(first_isolate = first_isolate(., - col_date = "date", - col_patient_id = "patient_id", - col_mo = "mo")) \%>\% # filter on first isolates - filter(first_isolate == TRUE) \%>\% + filter_first_isolate() \%>\% # get short MO names (like "E. coli") - mutate(mo = mo_shortname(mo, Becker = TRUE)) \%>\% + mutate(bug = mo_shortname(mo, Becker = TRUE)) \%>\% # select this short name and some antiseptic drugs - select(mo, CXM, GEN, CIP) \%>\% + select(bug, CXM, GEN, CIP) \%>\% # group by MO - group_by(mo) \%>\% + group_by(bug) \%>\% # plot the thing, putting MOs on the facet - ggplot_rsi(x = Antibiotic, - facet = mo, + ggplot_rsi(x = "Antibiotic", + facet = "bug", translate_ab = FALSE, - nrow = 1) + - labs(title = "AMR of Top Three Microorganisms In Blood Culture Isolates", - subtitle = "Only First Isolates, CoNS grouped according to Becker et al. (2014)", - x = "Microorganisms") + nrow = 1, + title = "AMR of Top Three Microorganisms In Blood Culture Isolates", + subtitle = expression(paste("Only First Isolates, CoNS grouped according to Becker ", italic("et al."), " (2014)")), + x.title = "Antibiotic (EARS-Net code)") } } diff --git a/tests/testthat/test-freq.R b/tests/testthat/test-freq.R index 60ea4265..296a6bfc 100755 --- a/tests/testthat/test-freq.R +++ b/tests/testthat/test-freq.R @@ -79,6 +79,8 @@ test_that("frequency table works", { Sys.time() - runif(5, min = 0, max = 60 * 60 * 24), units = "hours"))))) + expect_output(print(freq(septic_patients$age)[,1:3])) + library(dplyr) expect_output(septic_patients %>% select(1:2) %>% freq() %>% print()) expect_output(septic_patients %>% select(1:3) %>% freq() %>% print())
    nrow

    (when using facet) number of rows
    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.

    datalabels

    show datalabels using labels_rsi_count, will at default only be shown when fun = count_df

    show datalabels using labels_rsi_count, will only be shown when fun = count_df
    datalabels.sizedatalabels.colour

    colour of the datalabels
    title

    text to show as title of the plot

    subtitle

    text to show as subtitle of the plot

    caption

    text to show as caption of the plot

    x.title

    text to show as x axis description

    y.title

    text to show as y axis description

    ...

    other parameters passed on to geom_rsi