support groups for portion_df, update README

R/data.R

@@ -279,11 +279,11 @@
 
 #' Dataset with 2000 blood culture isolates of septic patients
 #'
-#' An anonymised dataset containing 2000 microbial blood culture isolates with their antibiogram of septic patients found in 5 different hospitals in the Netherlands, between 2001 and 2017. This data.frame can be used to practice AMR analysis. For examples, press F1.
+#' An anonymised dataset containing 2000 microbial blood culture isolates with their full antibiograms found in septic patients in 4 different hospitals in the Netherlands, between 2001 and 2017. It is true, genuine data. This \code{data.frame} can be used to practice AMR analysis. For examples, press F1.
 #' @format A data.frame with 2000 observations and 49 variables:
 #' \describe{
 #'   \item{\code{date}}{date of receipt at the laboratory}
-#'   \item{\code{hospital_id}}{ID of the hospital}
+#'   \item{\code{hospital_id}}{ID of the hospital, from A to D}
 #'   \item{\code{ward_icu}}{logical to determine if ward is an intensive care unit}
 #'   \item{\code{ward_clinical}}{logical to determine if ward is a regular clinical ward}
 #'   \item{\code{ward_outpatient}}{logical to determine if ward is an outpatient clinic}

R/first_isolate.R

@@ -55,7 +55,7 @@
 #' @return A vector to add to table, see Examples.
 #' @source Methodology of this function is based on: \strong{M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 4th Edition}, 2014, \emph{Clinical and Laboratory Standards Institute (CLSI)}. \url{https://clsi.org/standards/products/microbiology/documents/m39/}.
 #' @examples
-#' # septic_patients is a dataset available in the AMR package. It is true data.
+#' # septic_patients is a dataset available in the AMR package. It is true, genuine data.
 #' ?septic_patients
 #'
 #' library(dplyr)

R/ggplot_rsi.R

@@ -21,8 +21,9 @@
 #' Use these functions to create bar plots for antimicrobial resistance analysis. All functions rely on internal \code{\link[ggplot2]{ggplot}} 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{"stack"} (default) or \code{"dodge"}
-#' @param x parameter to show on x axis, either \code{"Antibiotic"} (default) or \code{"Interpretation"}
-#' @param facet parameter to split plots by, either \code{"Interpretation"} (default) or \code{"Antibiotic"}
+#' @param x variable to show on x axis, either \code{"Antibiotic"} (default) or \code{"Interpretation"}
+#' @param fill variable to categorise using the plots legend
+#' @param facet variable to split plots by, either \code{"Interpretation"} (default) or \code{"Antibiotic"}
 #' @details At default, the names of antibiotics will be shown on the plots using \code{\link{abname}}. 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)}.
 #'
 #' \strong{The functions}\cr
@@ -64,8 +65,18 @@
 #' septic_patients %>%
 #'   select(amox, nitr, fosf, trim, cipr) %>%
 #'   ggplot_rsi(x = "Interpretation", facet = "Antibiotic")
+#'
+#' # it also supports groups (don't forget to use facet on the group):
+#' septic_patients %>%
+#'   select(hospital_id, amox, cipr) %>%
+#'   group_by(hospital_id) %>%
+#'   ggplot_rsi() +
+#'   facet_grid("hospital_id") +
+#'   labs(title = "AMR of Amoxicillin And Ciprofloxacine Per Hospital")
 ggplot_rsi <- function(data,
+                       position = "stack",
                        x = "Antibiotic",
+                       fill = "Interpretation",
                        facet = NULL) {
 
   if (!"ggplot2" %in% rownames(installed.packages())) {
@@ -73,11 +84,15 @@ ggplot_rsi <- function(data,
   }
 
   p <- ggplot2::ggplot(data = data) +
-    geom_rsi(x = x) +
+    geom_rsi(position = position, x = x, fill = fill) +
     scale_y_percent() +
-    scale_rsi_colours() +
     theme_rsi()
 
+  if (fill == "Interpretation") {
+    # set RSI colours
+    p <- p + scale_rsi_colours()
+  }
+
   if (!is.null(facet)) {
     p <- p + facet_rsi(facet = facet)
   }
@@ -87,7 +102,7 @@ ggplot_rsi <- function(data,
 
 #' @rdname ggplot_rsi
 #' @export
-geom_rsi <- function(position = "stack", x = c("Antibiotic", "Interpretation"))  {
+geom_rsi <- function(position = "stack", x = c("Antibiotic", "Interpretation"), fill = "Interpretation")  {
 
   x <- x[1]
   if (!x %in% c("Antibiotic", "Interpretation")) {
@@ -95,8 +110,8 @@ geom_rsi <- function(position = "stack", x = c("Antibiotic", "Interpretation"))
   }
 
   ggplot2::layer(geom = "bar", stat = "identity", position = position,
-        mapping = ggplot2::aes_string(x = x, y = "Percentage", fill = "Interpretation"),
-        data = AMR::portion_df, params = list())
+                 mapping = ggplot2::aes_string(x = x, y = "Percentage", fill = fill),
+                 data = AMR::portion_df, params = list())
 
 }
 

R/portion.R

@@ -29,7 +29,7 @@
 #' @param translate a logical value to indicate whether antibiotic abbreviations should be translated with \code{\link{abname}}
 #' @details \strong{Remember that you should filter your table to let it contain only first isolates!} Use \code{\link{first_isolate}} to determine them in your data set.
 #'
-#' \code{portion_df} takes any variable from \code{data} that has an \code{"rsi"} class (created with \code{\link{as.rsi}}) and calculates the portions R, I and S. The resulting \code{data.frame} will have three rows (for R/I/S) and a column for each variable with class \code{"rsi"}.
+#' \code{portion_df} takes any variable from \code{data} that has an \code{"rsi"} class (created with \code{\link{as.rsi}}) and calculates the portions R, I and S. The resulting \emph{tidy data} (see Source) \code{data.frame} will have three rows (S/I/R) and a column for each variable with class \code{"rsi"}.
 #'
 #' The old \code{\link{rsi}} function is still available for backwards compatibility but is deprecated.
 #' \if{html}{
@@ -45,6 +45,8 @@
 #'   \out{<div style="text-align: center">}\figure{combi_therapy_3.png}\out{</div>}
 #' }
 #' @source \strong{M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 4th Edition}, 2014, \emph{Clinical and Laboratory Standards Institute (CLSI)}. \url{https://clsi.org/standards/products/microbiology/documents/m39/}.
+#'
+#' Wickham H. \strong{Tidy Data.} The Journal of Statistical Software, vol. 59, 2014. \url{http://vita.had.co.nz/papers/tidy-data.html}
 #' @seealso \code{\link{n_rsi}} to count cases with antimicrobial results.
 #' @keywords resistance susceptibility rsi_df rsi antibiotics isolate isolates
 #' @return Double or, when \code{as_percent = TRUE}, a character.
@@ -52,6 +54,9 @@
 #' @name portion
 #' @export
 #' @examples
+#' # septic_patients is a data set available in the AMR package. It is true, genuine data.
+#' ?septic_patients
+#'
 #' # Calculate resistance
 #' portion_R(septic_patients$amox)
 #' portion_IR(septic_patients$amox)
@@ -100,6 +105,18 @@
 #'             combination_p = portion_S(cipr, gent, as_percent = TRUE),
 #'             combination_n = n_rsi(cipr, gent))
 #'
+#' # Get portions S/I/R immediately of all rsi columns
+#' septic_patients %>%
+#'   select(amox, cipr) %>%
+#'   portion_df(translate = FALSE)
+#'
+#' # It also supports grouping variables
+#' septic_patients %>%
+#'   select(hospital_id, amox, cipr) %>%
+#'   group_by(hospital_id) %>%
+#'   portion_df(translate = FALSE)
+#'
+#'
 #' \dontrun{
 #'
 #' # calculate current empiric combination therapy of Helicobacter gastritis:
@@ -177,25 +194,33 @@ portion_S <- function(ab1,
 }
 
 #' @rdname portion
-#' @importFrom dplyr bind_cols summarise_if mutate
+#' @importFrom dplyr bind_rows summarise_if mutate group_vars select everything
 #' @export
 portion_df <- function(data, translate = getOption("get_antibiotic_names", TRUE)) {
-  resS <- bind_cols(data.frame(Interpretation = "S", stringsAsFactors = FALSE),
-                    summarise_if(.tbl = data,
-                                 .predicate = is.rsi,
-                                 .funs = portion_S))
-  resI <- bind_cols(data.frame(Interpretation = "I", stringsAsFactors = FALSE),
-                    summarise_if(.tbl = data,
-                                 .predicate = is.rsi,
-                                 .funs = portion_I))
-  resR <- bind_cols(data.frame(Interpretation = "R", stringsAsFactors = FALSE),
-                    summarise_if(.tbl = data,
-                                 .predicate = is.rsi,
-                                 .funs = portion_R))
+
+  resS <- summarise_if(.tbl = data,
+                       .predicate = is.rsi,
+                       .funs = portion_S) %>%
+    mutate(Interpretation = "S") %>%
+    select(Interpretation, everything())
+
+  resI <- summarise_if(.tbl = data,
+                       .predicate = is.rsi,
+                       .funs = portion_I) %>%
+    mutate(Interpretation = "I") %>%
+    select(Interpretation, everything())
+
+  resR <- summarise_if(.tbl = data,
+                       .predicate = is.rsi,
+                       .funs = portion_R) %>%
+    mutate(Interpretation = "R") %>%
+    select(Interpretation, everything())
+
+  data.groups <- group_vars(data)
 
   res <- bind_rows(resS, resI, resR) %>%
     mutate(Interpretation = factor(Interpretation, levels = c("R", "I", "S"), ordered = TRUE)) %>%
-    tidyr::gather(Antibiotic, Percentage, -Interpretation)
+    tidyr::gather(Antibiotic, Percentage, -Interpretation, -data.groups)
   if (translate == TRUE) {
     res <- res %>% mutate(Antibiotic = abname(Antibiotic, from = "guess", to = "official"))
   }