1
0
mirror of https://github.com/msberends/AMR.git synced 2025-07-09 01:22:25 +02:00

new unit tests for ggplot, small fixes

This commit is contained in:
2018-08-12 17:44:06 +02:00
parent 1ba7d883fe
commit e5d32cafe0
13 changed files with 144 additions and 66 deletions

View File

@ -102,9 +102,14 @@ print.rsi <- function(x, ...) {
#' @noRd
summary.rsi <- function(object, ...) {
x <- object
lst <- c('rsi', sum(is.na(x)), sum(x == "S"), sum(x %in% c("I", "R")), sum(x == "R"), sum(x == "I"))
names(lst) <- c("Mode", "<NA>", "Sum S", "Sum IR", "-Sum R", "-Sum I")
lst
c(
"Mode" = 'rsi',
"<NA>" = sum(is.na(x)),
"Sum S" = sum(x == "S", na.rm = TRUE),
"Sum IR" = sum(x %in% c("I", "R"), na.rm = TRUE),
"-Sum R" = sum(x == "R", na.rm = TRUE),
"-Sum I" = sum(x == "I", na.rm = TRUE)
)
}
#' @exportMethod plot.rsi

View File

@ -18,7 +18,7 @@
#' AMR bar plots with \code{ggplot}
#'
#' Use these functions to create bar plots for antimicrobial resistance analysis. All functions rely on internal \code{\link{ggplot}} functions.
#' 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"}
@ -28,13 +28,13 @@
#' \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{\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.
#'
#' \code{facet_rsi} creates 2d plots (at default based on S/I/R) using \code{\link{facet_wrap}}.
#' \code{facet_rsi} creates 2d plots (at default based on S/I/R) using \code{\link[ggplot2]{facet_wrap}}.
#'
#' \code{scale_y_percent} transforms the y axis to a 0 to 100% range.
#'
#' \code{scale_rsi_colours} sets colours to the bars: green for S, yellow for I and red for R.
#'
#' \code{theme_rsi} is a \code{\link{theme}} with minimal distraction.
#' \code{theme_rsi} is a \code{\link[ggplot2]{theme}} with minimal distraction.
#'
#' \code{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 (\code{\%>\%}). See Examples.
#' @rdname ggplot_rsi
@ -67,6 +67,11 @@
ggplot_rsi <- function(data,
x = "Antibiotic",
facet = NULL) {
if (!"ggplot2" %in% rownames(installed.packages())) {
stop('this function requires the ggplot2 package.', call. = FALSE)
}
p <- ggplot2::ggplot(data = data) +
geom_rsi(x = x) +
scale_y_percent() +

View File

@ -35,7 +35,7 @@
#' combination_n = n_rsi(cipr, gent))
n_rsi <- function(ab1, ab2 = NULL) {
if (NCOL(ab1) > 1) {
stop('`ab` must be a vector of antimicrobial interpretations', call. = FALSE)
stop('`ab1` must be a vector of antimicrobial interpretations', call. = FALSE)
}
if (!is.rsi(ab1)) {
ab1 <- as.rsi(ab1)

View File

@ -176,6 +176,32 @@ portion_S <- function(ab1,
as_percent = as_percent)
}
#' @rdname portion
#' @importFrom dplyr bind_cols summarise_if mutate
#' @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))
res <- bind_rows(resS, resI, resR) %>%
mutate(Interpretation = factor(Interpretation, levels = c("R", "I", "S"), ordered = TRUE)) %>%
tidyr::gather(Antibiotic, Percentage, -Interpretation)
if (translate == TRUE) {
res <- res %>% mutate(Antibiotic = abname(Antibiotic, from = "guess", to = "official"))
}
res
}
rsi_calc <- function(type,
ab1,
ab2,
@ -244,29 +270,3 @@ rsi_calc <- function(type,
found / total
}
}
#' @rdname portion
#' @importFrom dplyr bind_cols summarise_if mutate
#' @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))
res <- bind_rows(resS, resI, resR) %>%
mutate(Interpretation = factor(Interpretation, levels = c("R", "I", "S"), ordered = TRUE)) %>%
tidyr::gather(Antibiotic, Percentage, -Interpretation)
if (translate == TRUE) {
res <- res %>% mutate(Antibiotic = abname(Antibiotic, from = "guess", to = "official"))
}
res
}